diff --git a/collects/ffi/unsafe.rkt b/collects/ffi/unsafe.rkt index b57927243a..845067d6c4 100644 --- a/collects/ffi/unsafe.rkt +++ b/collects/ffi/unsafe.rkt @@ -1592,11 +1592,25 @@ ;; are run after non-late weak boxes are cleared). (lambda (obj finalizer) (unless killer-thread - (let ([priviledged-custodian ((get-ffi-obj 'scheme_make_custodian #f (_fun _pointer -> _scheme)) #f)]) + ;; We need to make a thread that runs in a privildged custodian and + ;; that doesn't retain the current namespace --- either directly + ;; or indirectly through some parameter setting in the current thread. + (let ([priviledged-custodian ((get-ffi-obj 'scheme_make_custodian #f (_fun _pointer -> _scheme)) #f)] + [no-cells ((get-ffi-obj 'scheme_empty_cell_table #f (_fun -> _gcpointer)))] + [min-config ((get-ffi-obj 'scheme_minimal_config #f (_fun -> _gcpointer)))] + [thread/details (get-ffi-obj 'scheme_thread_w_details #f (_fun _scheme + _gcpointer ; config + _gcpointer ; cells + _pointer ; break_cell + _scheme ; custodian + _int ; suspend-to-kill? + -> _scheme))]) (set! killer-thread - (parameterize ([current-custodian priviledged-custodian] - ;; don't hold onto the namespace in the finalizer thread: - [current-namespace (make-base-empty-namespace)]) - (thread (lambda () - (let loop () (will-execute killer-executor) (loop)))))))) + (thread/details (lambda () + (let loop () (will-execute killer-executor) (loop))) + min-config + no-cells + #f ; default break cell + priviledged-custodian + 0)))) (will-register killer-executor obj finalizer)))) diff --git a/collects/tests/gracket/draw-mem.rkt b/collects/tests/gracket/draw-mem.rkt index 4b91409597..c5f16197ef 100644 --- a/collects/tests/gracket/draw-mem.rkt +++ b/collects/tests/gracket/draw-mem.rkt @@ -2,17 +2,22 @@ ;; Check for a leak via multiple `racket/draw' instantiations. -(define-values (incs m) - (for/fold ([incs 0] [prev-mem 0]) ([i 10]) - (parameterize ([current-namespace (make-base-namespace)]) +(define my-ns-channel (make-parameter #f)) + +(define-values (incs m ns) + (for/fold ([incs 0] [max-mem 0] [ns #f]) ([i 10]) + (define ns (make-base-namespace)) + (parameterize ([current-namespace ns] + [my-ns-channel ns]) (dynamic-require 'racket/draw #f)) (collect-garbage) (sync (system-idle-evt)) (collect-garbage) (let ([m (current-memory-use)]) - (if (m . > . (+ prev-mem (* 100 1024))) - (values (add1 incs) m) - (values incs m))))) + (printf "~s\n" m) + (if (m . > . max-mem) + (values (add1 incs) m 'ns) + (values incs max-mem 'ns))))) (unless (incs . < . 5) (error "multiple `racket/draw' instantiations seem to accumulate memory")) diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index a45cff9328..9c0eeacb77 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -8,6 +8,7 @@ EXPORTS scheme_clear_escape scheme_new_jmpupbuf_holder scheme_current_config + scheme_minimal_config scheme_extend_config scheme_install_config scheme_get_param @@ -15,6 +16,7 @@ EXPORTS scheme_get_thread_param scheme_set_thread_param scheme_get_env + scheme_empty_cell_table scheme_inherit_cells scheme_current_break_cell scheme_current_thread DATA @@ -491,6 +493,7 @@ EXPORTS scheme_get_port_fd scheme_get_port_socket scheme_socket_to_ports + scheme_fd_to_semaphore scheme_set_type_printer scheme_print_bytes scheme_print_utf8 diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index 184116fd78..15e827c87e 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -8,6 +8,7 @@ EXPORTS scheme_clear_escape scheme_new_jmpupbuf_holder scheme_current_config + scheme_minimal_config scheme_extend_config scheme_install_config scheme_get_param @@ -15,6 +16,7 @@ EXPORTS scheme_get_thread_param scheme_set_thread_param scheme_get_env + scheme_empty_cell_table scheme_inherit_cells scheme_current_break_cell scheme_current_thread DATA @@ -506,6 +508,7 @@ EXPORTS scheme_get_port_fd scheme_get_port_socket scheme_socket_to_ports + scheme_fd_to_semaphore scheme_set_type_printer scheme_print_bytes scheme_print_utf8 diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index d98de04cfb..96ca0f86fa 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -6,6 +6,7 @@ scheme_reset_jmpup_buf scheme_clear_escape scheme_new_jmpupbuf_holder scheme_current_config +scheme_minimal_config scheme_extend_config scheme_install_config scheme_get_param @@ -13,6 +14,7 @@ scheme_set_param scheme_get_thread_param scheme_set_thread_param scheme_get_env +scheme_empty_cell_table scheme_inherit_cells scheme_current_break_cell scheme_current_thread @@ -508,6 +510,7 @@ scheme_get_port_file_descriptor scheme_get_port_fd scheme_get_port_socket scheme_socket_to_ports +scheme_fd_to_semaphore scheme_set_type_printer scheme_print_bytes scheme_print_utf8 diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index e4badf6c93..7039b47a05 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -6,6 +6,7 @@ scheme_reset_jmpup_buf scheme_clear_escape scheme_new_jmpupbuf_holder scheme_current_config +scheme_minimal_config scheme_extend_config scheme_install_config scheme_get_param @@ -13,6 +14,7 @@ scheme_set_param scheme_get_thread_param scheme_set_thread_param scheme_get_env +scheme_empty_cell_table scheme_inherit_cells scheme_current_break_cell scheme_current_thread @@ -514,6 +516,7 @@ scheme_get_port_file_descriptor scheme_get_port_fd scheme_get_port_socket scheme_socket_to_ports +scheme_fd_to_semaphore scheme_set_type_printer scheme_print_bytes scheme_print_utf8 diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h index 7ed7233ca9..da03877720 100644 --- a/src/racket/include/schthread.h +++ b/src/racket/include/schthread.h @@ -250,6 +250,7 @@ typedef struct Thread_Local_Variables { struct Scheme_Custodian *main_custodian_; struct Scheme_Custodian *last_custodian_; struct Scheme_Hash_Table *limited_custodians_; + struct Scheme_Config *initial_config_; struct Scheme_Thread *swap_target_; struct Scheme_Object *scheduled_kills_; int do_atomic_; @@ -598,6 +599,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL; #define main_custodian XOA (scheme_get_thread_local_variables()->main_custodian_) #define last_custodian XOA (scheme_get_thread_local_variables()->last_custodian_) #define limited_custodians XOA (scheme_get_thread_local_variables()->limited_custodians_) +#define initial_config XOA (scheme_get_thread_local_variables()->initial_config_) #define swap_target XOA (scheme_get_thread_local_variables()->swap_target_) #define scheduled_kills XOA (scheme_get_thread_local_variables()->scheduled_kills_) #define do_atomic XOA (scheme_get_thread_local_variables()->do_atomic_) diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index d0217154c8..0b5c4949b3 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -55,6 +55,7 @@ MZ_EXTERN Scheme_Jumpup_Buf_Holder *scheme_new_jmpupbuf_holder(void); /*========================================================================*/ MZ_EXTERN Scheme_Config *scheme_current_config(void); +MZ_EXTERN Scheme_Config *scheme_minimal_config(void); MZ_EXTERN Scheme_Config *scheme_extend_config(Scheme_Config *c, int pos, Scheme_Object *init_val); MZ_EXTERN void scheme_install_config(Scheme_Config *); @@ -66,6 +67,7 @@ MZ_EXTERN void scheme_set_thread_param(Scheme_Config *c, Scheme_Thread_Cell_Tabl MZ_EXTERN Scheme_Env *scheme_get_env(Scheme_Config *config); +MZ_EXTERN Scheme_Thread_Cell_Table *scheme_empty_cell_table(); MZ_EXTERN Scheme_Thread_Cell_Table *scheme_inherit_cells(Scheme_Thread_Cell_Table *cells); MZ_EXTERN Scheme_Object *scheme_current_break_cell(); diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index c17aa87077..d9169fad57 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -31,6 +31,7 @@ Scheme_Jumpup_Buf_Holder *(*scheme_new_jmpupbuf_holder)(void); /* parameters */ /*========================================================================*/ Scheme_Config *(*scheme_current_config)(void); +Scheme_Config *(*scheme_minimal_config)(void); Scheme_Config *(*scheme_extend_config)(Scheme_Config *c, int pos, Scheme_Object *init_val); void (*scheme_install_config)(Scheme_Config *); Scheme_Object *(*scheme_get_param)(Scheme_Config *c, int pos); @@ -38,6 +39,7 @@ void (*scheme_set_param)(Scheme_Config *c, int pos, Scheme_Object *o); Scheme_Object *(*scheme_get_thread_param)(Scheme_Config *c, Scheme_Thread_Cell_Table *cells, int pos); void (*scheme_set_thread_param)(Scheme_Config *c, Scheme_Thread_Cell_Table *cells, int pos, Scheme_Object *o); Scheme_Env *(*scheme_get_env)(Scheme_Config *config); +Scheme_Thread_Cell_Table *(*scheme_empty_cell_table)(); Scheme_Thread_Cell_Table *(*scheme_inherit_cells)(Scheme_Thread_Cell_Table *cells); Scheme_Object *(*scheme_current_break_cell)(); /*========================================================================*/ diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 8c0fbf1e7e..a67eb08e1b 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -9,6 +9,7 @@ scheme_extension_table->scheme_clear_escape = scheme_clear_escape; scheme_extension_table->scheme_new_jmpupbuf_holder = scheme_new_jmpupbuf_holder; scheme_extension_table->scheme_current_config = scheme_current_config; + scheme_extension_table->scheme_minimal_config = scheme_minimal_config; scheme_extension_table->scheme_extend_config = scheme_extend_config; scheme_extension_table->scheme_install_config = scheme_install_config; scheme_extension_table->scheme_get_param = scheme_get_param; @@ -16,6 +17,7 @@ scheme_extension_table->scheme_get_thread_param = scheme_get_thread_param; scheme_extension_table->scheme_set_thread_param = scheme_set_thread_param; scheme_extension_table->scheme_get_env = scheme_get_env; + scheme_extension_table->scheme_empty_cell_table = scheme_empty_cell_table; scheme_extension_table->scheme_inherit_cells = scheme_inherit_cells; scheme_extension_table->scheme_current_break_cell = scheme_current_break_cell; #ifndef USE_THREAD_LOCAL @@ -560,6 +562,7 @@ scheme_extension_table->scheme_get_port_fd = scheme_get_port_fd; scheme_extension_table->scheme_get_port_socket = scheme_get_port_socket; scheme_extension_table->scheme_socket_to_ports = scheme_socket_to_ports; + scheme_extension_table->scheme_fd_to_semaphore = scheme_fd_to_semaphore; scheme_extension_table->scheme_set_type_printer = scheme_set_type_printer; scheme_extension_table->scheme_print_bytes = scheme_print_bytes; scheme_extension_table->scheme_print_utf8 = scheme_print_utf8; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 42d68f8aed..60295ea219 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -9,6 +9,7 @@ #define scheme_clear_escape (scheme_extension_table->scheme_clear_escape) #define scheme_new_jmpupbuf_holder (scheme_extension_table->scheme_new_jmpupbuf_holder) #define scheme_current_config (scheme_extension_table->scheme_current_config) +#define scheme_minimal_config (scheme_extension_table->scheme_minimal_config) #define scheme_extend_config (scheme_extension_table->scheme_extend_config) #define scheme_install_config (scheme_extension_table->scheme_install_config) #define scheme_get_param (scheme_extension_table->scheme_get_param) @@ -16,6 +17,7 @@ #define scheme_get_thread_param (scheme_extension_table->scheme_get_thread_param) #define scheme_set_thread_param (scheme_extension_table->scheme_set_thread_param) #define scheme_get_env (scheme_extension_table->scheme_get_env) +#define scheme_empty_cell_table (scheme_extension_table->scheme_empty_cell_table) #define scheme_inherit_cells (scheme_extension_table->scheme_inherit_cells) #define scheme_current_break_cell (scheme_extension_table->scheme_current_break_cell) #ifndef USE_THREAD_LOCAL @@ -560,6 +562,7 @@ #define scheme_get_port_fd (scheme_extension_table->scheme_get_port_fd) #define scheme_get_port_socket (scheme_extension_table->scheme_get_port_socket) #define scheme_socket_to_ports (scheme_extension_table->scheme_socket_to_ports) +#define scheme_fd_to_semaphore (scheme_extension_table->scheme_fd_to_semaphore) #define scheme_set_type_printer (scheme_extension_table->scheme_set_type_printer) #define scheme_print_bytes (scheme_extension_table->scheme_print_bytes) #define scheme_print_utf8 (scheme_extension_table->scheme_print_utf8) diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 5a956dec76..b8f7dec4db 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -581,6 +581,7 @@ void scheme_init_thread_places(void) { REGISTER_SO(gc_prepost_callback_descs); REGISTER_SO(place_local_misc_table); REGISTER_SO(gc_info_prefab); + REGISTER_SO(initial_config); gc_info_prefab = scheme_lookup_prefab_type(scheme_intern_symbol("gc-info"), 10); } @@ -6622,6 +6623,11 @@ void scheme_thread_cell_set(Scheme_Object *cell, Scheme_Thread_Cell_Table *cells scheme_add_to_table(cells, (const char *)cell, (void *)v, 0); } +Scheme_Thread_Cell_Table *scheme_empty_cell_table(void) +{ + return scheme_make_bucket_table(20, SCHEME_hash_weak_ptr); +} + static Scheme_Thread_Cell_Table *inherit_cells(Scheme_Thread_Cell_Table *cells, Scheme_Thread_Cell_Table *t, int inherited) @@ -6634,7 +6640,7 @@ static Scheme_Thread_Cell_Table *inherit_cells(Scheme_Thread_Cell_Table *cells, cells = scheme_current_thread->cell_values; if (!t) - t = scheme_make_bucket_table(20, SCHEME_hash_weak_ptr); + t = scheme_empty_cell_table(); for (i = cells->size; i--; ) { bucket = cells->buckets[i]; @@ -7275,6 +7281,13 @@ static void make_initial_config(Scheme_Thread *p) init_param(cells, paramz, i, scheme_false); } } + + initial_config = config; +} + +Scheme_Config *scheme_minimal_config(void) +{ + return initial_config; } void scheme_set_startup_load_on_demand(int on)