From e4da074025136047c85103d665f601cb61707a48 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 11 Jun 2005 01:48:19 +0000 Subject: [PATCH] *** empty log message *** --- INSTALL | 11 ++++++++--- ice-9/ChangeLog | 6 ++++++ ice-9/boot-9.scm | 12 +++++++----- libguile/ChangeLog | 9 +++++++++ libguile/gc.c | 2 +- libguile/modules.c | 13 +++++++++++++ libguile/modules.h | 1 + test-suite/ChangeLog | 5 +++++ test-suite/tests/gc.test | 14 ++++++++++++++ test-suite/tests/hash.test | 1 - 10 files changed, 64 insertions(+), 10 deletions(-) diff --git a/INSTALL b/INSTALL index 095b1eb40..56b077d6a 100644 --- a/INSTALL +++ b/INSTALL @@ -1,7 +1,7 @@ Installation Instructions ************************* -Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004 Free +Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc. This file is free documentation; the Free Software Foundation gives @@ -189,8 +189,13 @@ them in the `configure' command line, using `VAR=value'. For example: ./configure CC=/usr/local2/bin/gcc -will cause the specified gcc to be used as the C compiler (unless it is -overridden in the site shell script). +causes the specified `gcc' to be used as the C compiler (unless it is +overridden in the site shell script). Here is a another example: + + /bin/bash ./configure CONFIG_SHELL=/bin/bash + +Here the `CONFIG_SHELL=/bin/bash' operand causes subsequent +configuration-related scripts to be executed by `/bin/bash'. `configure' Invocation ====================== diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 111dd027f..a4b6a4104 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,9 @@ +2005-06-10 Han-Wen Nienhuys + + * boot-9.scm (set-module-eval-closure!): remove + set-procedure-property! closure 'module. Setting this property + causes un-gc-able modules. + 2005-06-05 Marius Vollmer * boot-9.scm (substring-fill!): New, for compatability. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 5314d7d8a..7a91485e4 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -339,7 +339,7 @@ (define (environment-module env) (let ((closure (and (pair? env) (car (last-pair env))))) - (and closure (procedure-property closure 'module)))) + (and closure (eval-closure-module closure)))) @@ -1266,10 +1266,11 @@ (let ((setter (record-modifier module-type 'eval-closure))) (lambda (module closure) (setter module closure) - ;; Make it possible to lookup the module from the environment. - ;; This implementation is correct since an eval closure can belong - ;; to maximally one module. - (set-procedure-property! closure 'module module)))) + + ;; do not set procedure properties on closures. + ;; since procedure properties are weak-hashes, they cannot + ;; have cyclical data, otherwise the data cannot be GC-ed. + ))) @@ -2037,6 +2038,7 @@ (exports '()) (re-exports '()) (replacements '())) + (if (null? kws) (call-with-deferred-observers (lambda () diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 62a70f094..d637cbaab 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,12 @@ +2005-06-10 Han-Wen Nienhuys + + * modules.c (s_scm_eval_closure_module): new function. Return the + module inside an eval-closure. + + * gc.c (scm_init_storage): make scm_stand_in_procs a weak_key hash + table. This means that procedure properties are GC'd if the + procedure dies. + 2005-06-11 Kevin Ryde * srfi-13.c (scm_string_filter, scm_string_delete): For char and diff --git a/libguile/gc.c b/libguile/gc.c index 039ae8e4f..b9269116a 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -935,7 +935,7 @@ scm_init_storage () #endif - scm_stand_in_procs = scm_c_make_hash_table (257); + scm_stand_in_procs = scm_make_weak_key_hash_table (scm_from_int (257)); scm_permobjs = SCM_EOL; scm_protects = scm_c_make_hash_table (31); scm_gc_registered_roots = scm_c_make_hash_table (31); diff --git a/libguile/modules.c b/libguile/modules.c index 557b33aaa..d2d1d4492 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -346,6 +346,19 @@ SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0, } #undef FUNC_NAME + +SCM_DEFINE (scm_eval_closure_module, "eval-closure-module", 1, 0, 0, + (SCM closure), + "Return the module for @var{closure}.") +#define FUNC_NAME s_scm_eval_closure_module +{ + SCM_ASSERT_TYPE(SCM_EVAL_CLOSURE_P (closure), closure, SCM_ARG1, FUNC_NAME, "eval-closure"); + return SCM_PACK (SCM_CELL_WORD_1(closure)); +} +#undef FUNC_NAME + + + SCM_DEFINE (scm_standard_interface_eval_closure, "standard-interface-eval-closure", 1, 0, 0, (SCM module), diff --git a/libguile/modules.h b/libguile/modules.h index abfe69765..7b3d114f4 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -98,6 +98,7 @@ SCM_API SCM scm_current_module_lookup_closure (void); SCM_API SCM scm_current_module_transformer (void); SCM_API SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep); SCM_API SCM scm_standard_eval_closure (SCM module); +SCM_API SCM scm_eval_closure_module (SCM closure); SCM_API SCM scm_standard_interface_eval_closure (SCM module); SCM_API SCM scm_get_pre_modules_obarray (void); SCM_API SCM scm_lookup_closure_module (SCM proc); diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 7bdd98e39..c4a468a4f 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2005-06-10 Han-Wen Nienhuys + + * tests/gc.test ("gc"): add a test to verify that modules are + garbage collected. + 2005-06-11 Kevin Ryde * tests/srfi-13.test (string-filter): A few more tests. diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test index 59c7f7cb6..c425e2daa 100644 --- a/test-suite/tests/gc.test +++ b/test-suite/tests/gc.test @@ -55,3 +55,17 @@ (gc) (remove-hook! after-gc-hook thunk) foo))) + + +(with-test-prefix "gc" + (pass-if "Unused modules are removed" + (let* + ((dummy (gc)) + (last-count (cdr (assoc + "eval-closure" (gc-live-object-stats))))) + + (for-each (lambda (x) (make-module)) (iota 1000)) + (gc) + (gc) ;; twice: have to kill the weak vectors. + (= last-count (cdr (assoc "eval-closure" (gc-live-object-stats))))) + )) diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test index 58469744f..2c589a088 100644 --- a/test-suite/tests/hash.test +++ b/test-suite/tests/hash.test @@ -65,7 +65,6 @@ ;;; ;;; hashx-remove! ;;; - (with-test-prefix "hashx-remove!" (pass-if (->bool (object-documentation hashx-remove!))) -- 2.20.1