From 3024b77ba58b5f06af6007efd93f90eb781738d9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 6 Sep 2019 15:07:09 -0600 Subject: [PATCH] add custodian-based unloading of foreign libraries Specificially, add a `#:custodian` argument to `ffi-lib`. --- .../racket-doc/scribblings/foreign/libs.scrbl | 37 +++++++-- racket/collects/ffi/unsafe.rkt | 79 +++++++++++-------- racket/src/cs/Makefile | 2 +- racket/src/cs/io.sls | 2 +- racket/src/cs/rumble.sls | 2 +- racket/src/cs/rumble/foreign.ss | 12 ++- racket/src/io/foreign/main.rkt | 4 +- racket/src/racket/include/schthread.h | 2 - racket/src/racket/src/env.c | 2 - racket/src/racket/src/mzmark_thread.inc | 2 + racket/src/racket/src/mzmarksrc.c | 1 + racket/src/racket/src/schpriv.h | 2 +- racket/src/racket/src/thread.c | 60 ++++++++------ racket/src/rktio/rktio_dll.c | 3 + racket/src/thread/custodian-object.rkt | 6 +- racket/src/thread/custodian.rkt | 19 ++++- racket/src/thread/place.rkt | 10 +-- 17 files changed, 155 insertions(+), 90 deletions(-) diff --git a/pkgs/racket-doc/scribblings/foreign/libs.scrbl b/pkgs/racket-doc/scribblings/foreign/libs.scrbl index ead0d82d69..a179dc6fac 100644 --- a/pkgs/racket-doc/scribblings/foreign/libs.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/libs.scrbl @@ -18,7 +18,8 @@ Returns @racket[#t] if @racket[v] is a @deftech{foreign-library value}, [version (or/c string? (listof (or/c string? #f)) #f) #f] [#:get-lib-dirs get-lib-dirs (-> (listof path?)) get-lib-search-dirs] [#:fail fail (or/c #f (-> any)) #f] - [#:global? global? any/c (eq? 'global (system-type 'so-mode))]) + [#:global? global? any/c (eq? 'global (system-type 'so-mode))] + [#:custodian custodian (or/c 'place custodian? #f) #f]) any]{ Returns a @tech{foreign-library value} or the result of @racket[fail]. @@ -115,23 +116,43 @@ library's symbols are not made available for future resolution. This local-versus-global choice does not affect whether the library's symbols are available via @racket[(ffi-lib #f)]. +If @racket[custodian] is @racket['place] or a custodian, the +library is unloaded when a custodian is shut down---either the given +custodian or the place's main custodian if @racket[custodian] is +@racket['place]. When a library is unloaded, all references to the +library become invalid. Supplying @racket['place] for +@racket[custodian] is consistent with finalization via +@racketmodname[ffi/unsafe/alloc] but will not, for example, unload the +library when hitting in the @onscreen{Run} button in DrRacket. +Supplying @racket[(current-custodian)] for @racket[custodian] tends to +unload the library for eagerly, but requires even more care to ensure +that library references are not accessed after the library is +unloaded. + +If @racket[custodian] is @racket[#f], the loaded library is associated +with Racket (or DrRacket) for the duration of the process. Loading +again with @racket[ffi-lib], will not force a re-load of the +corresponding library. + +When @racket[ffi-lib] returns a reference to a library that was +previously loaded within the current place, it increments a +reference count on the loaded library rather than loading the library +fresh. Unloading a library reference decrements the reference count +and requests unloading at the operating-system level only if the +reference count goes to zero. + The @racket[ffi-lib] procedure logs (see @secref["logging" #:doc '(lib "scribblings/reference/reference.scrbl")]) on the topic @racket['ffi-lib]. In particular, on failure it logs the paths attempted according to the rules above, but it cannot report the paths tried due to the operating system's library search path. -Due to the way the operating system performs dynamic binding, loaded -libraries are associated with Racket (or DrRacket) for the duration of -the process. Re-evaluating @racket[ffi-lib] (or hitting the -@onscreen{Run} button in DrRacket) will not force a re-load of the -corresponding library. - @history[#:changed "6.1.0.5" @elem{Changed the way a version number is added with a @filepath{.dll} suffix to place it before the suffix, instead of after.} - #:changed "7.3.0.3" @elem{Added logging.}]} + #:changed "7.3.0.3" @elem{Added logging.} + #:changed "7.4.0.7" @elem{Added the @racket[#:custodian] argument.}]} @defproc[(get-ffi-obj [objname (or/c string? bytes? symbol?)] [lib (or/c ffi-lib? path-string? #f)] diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index 0dab11803d..25873c9de5 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -4,7 +4,8 @@ (require '#%foreign setup/dirs racket/unsafe/ops racket/private/for (only-in '#%unsafe unsafe-thread-at-root - unsafe-make-security-guard-at-root) + unsafe-make-security-guard-at-root + unsafe-add-post-custodian-shutdown) (for-syntax racket/base racket/list syntax/stx racket/syntax racket/struct-info)) @@ -130,7 +131,8 @@ (define (get-ffi-lib name [version/s ""] #:fail [fail #f] #:get-lib-dirs [get-lib-dirs get-lib-search-dirs] - #:global? [global? (eq? (system-type 'so-mode) 'global)]) + #:global? [global? (eq? (system-type 'so-mode) 'global)] + #:custodian [custodian #f]) (cond [(not name) (ffi-lib name)] ; #f => NULL => open this executable [(not (or (string? name) (path? name))) @@ -172,37 +174,48 @@ (string-append name0 "." lib-suffix v) (string-append name0 v "." lib-suffix)))) versions)]) - (or ;; try to look in our library paths first - (and (not absolute?) - (ormap (lambda (dir) - ;; try good names first, then original - (or (ormap (lambda (name) (try-lib (build-path dir name))) - names) - (try-lib (build-path dir name0)))) - (get-lib-dirs))) - ;; try a system search - (ormap try-lib names) ; try good names first - (try-lib name0) ; try original - (ormap try-lib-if-exists? names) ; try relative paths - (try-lib-if-exists? name0) ; relative with original - ;; give up: by default, call ffi-lib so it will raise an error - (begin - (log-ffi-lib-debug - "failed for (ffi-lib ~v ~v), tried: ~a" - name0 version/s - (apply - string-append - (for/list ([attempt (reverse tried)]) - (format "\n ~e~a" attempt - (cond [(absolute-path? attempt) - (cond [(file-exists?/insecure attempt) " (exists)"] - [else " (no such file)"])] - [else " (using OS library search path)"]))))) - (if fail - (fail) - (if (pair? names) - (ffi-lib (car names) #f global?) - (ffi-lib name0 #f global?))))))])) + (define lib + (or ;; try to look in our library paths first + (and (not absolute?) + (ormap (lambda (dir) + ;; try good names first, then original + (or (ormap (lambda (name) (try-lib (build-path dir name))) + names) + (try-lib (build-path dir name0)))) + (get-lib-dirs))) + ;; try a system search + (ormap try-lib names) ; try good names first + (try-lib name0) ; try original + (ormap try-lib-if-exists? names) ; try relative paths + (try-lib-if-exists? name0) ; relative with original + ;; give up: by default, call ffi-lib so it will raise an error + (begin + (log-ffi-lib-debug + "failed for (ffi-lib ~v ~v), tried: ~a" + name0 version/s + (apply + string-append + (for/list ([attempt (reverse tried)]) + (format "\n ~e~a" attempt + (cond [(absolute-path? attempt) + (cond [(file-exists?/insecure attempt) " (exists)"] + [else " (no such file)"])] + [else " (using OS library search path)"]))))) + (and (not fail) + (if (pair? names) + (ffi-lib (car names) #f global?) + (ffi-lib name0 #f global?)))))) + (cond + [lib + (when custodian + (unsafe-add-post-custodian-shutdown (lambda () (ffi-lib-unload lib)) + (if (eq? custodian 'place) + #f + custodian))) + lib] + [fail + (fail)] + [else (error 'ffi-lib "internal error; shouldn't get here")]))])) (define (get-ffi-lib-internal x) (if (ffi-lib? x) x (get-ffi-lib x))) diff --git a/racket/src/cs/Makefile b/racket/src/cs/Makefile index 7e99ff9c29..da4bffee90 100644 --- a/racket/src/cs/Makefile +++ b/racket/src/cs/Makefile @@ -5,7 +5,7 @@ RACKET = ../../bin/racket SCHEME = scheme # Controls whether Racket layers are built as unsafe: -UNSAFE_COMP = --unsafe +UNSAFE_COMP = # --unsafe # Controls whether compiled code is compressed: COMPRESS_COMP = # --compress diff --git a/racket/src/cs/io.sls b/racket/src/cs/io.sls index e3f9b82735..0cda96b7bd 100644 --- a/racket/src/cs/io.sls +++ b/racket/src/cs/io.sls @@ -476,7 +476,7 @@ (1/log-message (|#%app| 1/current-logger) level str #f))) (set-error-display-eprintf! (lambda (fmt . args) (apply 1/fprintf (|#%app| 1/current-error-port) fmt args))) - (set-ffi-get-lib-and-obj! ffi-get-lib ffi-get-obj ptr->address) + (set-ffi-get-lib-and-obj! ffi-get-lib ffi-get-obj ffi-unload-lib ptr->address) (set-make-async-callback-poll-wakeup! unsafe-make-signal-received) (set-get-machine-info! get-machine-info) (set-processor-count! (1/processor-count)) diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index cc3da13163..5570b560b2 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -610,7 +610,7 @@ ctype-alignof ctype-basetype ctype-c->scheme ctype-scheme->c ctype-sizeof ctype? end-stubborn-change extflvector->cpointer ffi-call ffi-call-maker ffi-callback ffi-callback-maker ffi-callback? - ffi-lib-name ffi-lib? ffi-obj ffi-obj-lib + ffi-lib-name ffi-lib? ffi-obj ffi-obj-lib ffi-lib-unload ffi-obj-name ffi-obj? flvector->cpointer free free-immobile-cell lookup-errno make-array-type make-cstruct-type make-ctype make-late-weak-box make-late-weak-hasheq make-sized-byte-string make-union-type malloc malloc-immobile-cell diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index 0b14a0f77e..e9f948eff4 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/racket/src/cs/rumble/foreign.ss @@ -748,6 +748,10 @@ (lambda (h) (make-ffi-lib h name))))])) +(define/who (ffi-lib-unload lib) + (check who ffi-lib? lib) + (ffi-unload-lib (ffi-lib-handle lib))) + (define-record-type (cpointer/ffi-obj make-ffi-obj ffi-obj?) (parent cpointer) (fields lib name)) @@ -777,6 +781,11 @@ #f (success-k #f)))) +(define ffi-unload-lib + ;; Placeholder implementation that does nothing: + (lambda (lib) + (void))) + (define ffi-get-obj ;; Placeholder implementation that always fails: (lambda (who lib lib-name name success-k) @@ -790,9 +799,10 @@ ;; Placeholder implementation (lambda (p) p)) -(define (set-ffi-get-lib-and-obj! do-ffi-get-lib do-ffi-get-obj do-ffi-ptr->address) +(define (set-ffi-get-lib-and-obj! do-ffi-get-lib do-ffi-get-obj do-ffi-unload-lib do-ffi-ptr->address) (set! ffi-get-lib do-ffi-get-lib) (set! ffi-get-obj do-ffi-get-obj) + (set! ffi-unload-lib do-ffi-unload-lib) (set! ffi-ptr->address do-ffi-ptr->address)) ;; ---------------------------------------- diff --git a/racket/src/io/foreign/main.rkt b/racket/src/io/foreign/main.rkt index b228fb1f33..18fda7accc 100644 --- a/racket/src/io/foreign/main.rkt +++ b/racket/src/io/foreign/main.rkt @@ -10,7 +10,7 @@ "../locale/string.rkt") (provide ffi-get-lib - ffi-lib-unload + ffi-unload-lib ffi-get-obj current-load-extension) @@ -36,7 +36,7 @@ (raise-dll-error who msg err-str dll)])] [else (success-k dll)])) -(define/who (ffi-lib-unload dll) +(define/who (ffi-unload-lib dll) (start-atomic) (define r (rktio_dll_close rktio dll)) (cond diff --git a/racket/src/racket/include/schthread.h b/racket/src/racket/include/schthread.h index fe8b2ec510..7a1cd54db8 100644 --- a/racket/src/racket/include/schthread.h +++ b/racket/src/racket/include/schthread.h @@ -251,7 +251,6 @@ typedef struct Thread_Local_Variables { intptr_t scheme_current_cont_mark_pos_; struct Scheme_Custodian *main_custodian_; struct Scheme_Hash_Table *limited_custodians_; - struct Scheme_Object *post_custodian_shutdowns_; struct Scheme_Plumber *initial_plumber_; struct Scheme_Config *initial_config_; struct Scheme_Thread *swap_target_; @@ -639,7 +638,6 @@ 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 post_custodian_shutdowns XOA (scheme_get_thread_local_variables()->post_custodian_shutdowns_) #define initial_plumber XOA (scheme_get_thread_local_variables()->initial_plumber_) #define initial_config XOA (scheme_get_thread_local_variables()->initial_config_) #define swap_target XOA (scheme_get_thread_local_variables()->swap_target_) diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index 0898091f82..90c26ab661 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -571,8 +571,6 @@ void scheme_place_instance_destroy(int force) else scheme_run_atexit_closers_on_all(force_more_closed_after); - scheme_run_post_custodian_shutdown(); - scheme_release_fd_semaphores(); scheme_release_file_descriptor(); diff --git a/racket/src/racket/src/mzmark_thread.inc b/racket/src/racket/src/mzmark_thread.inc index 4947d48025..6b6aca193a 100644 --- a/racket/src/racket/src/mzmark_thread.inc +++ b/racket/src/racket/src/mzmark_thread.inc @@ -156,6 +156,7 @@ static int mark_custodian_val_MARK(void *p, struct NewGC *gc) { gcMARK2(m->closers, gc); gcMARK2(m->data, gc); gcMARK2(m->data_ptr, gc); + gcMARK2(m->post_callbacks, gc); gcMARK2(m->parent, gc); gcMARK2(m->sibling, gc); @@ -184,6 +185,7 @@ static int mark_custodian_val_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(m->closers, gc); gcFIXUP2(m->data, gc); gcFIXUP2(m->data_ptr, gc); + gcFIXUP2(m->post_callbacks, gc); gcFIXUP2(m->parent, gc); gcFIXUP2(m->sibling, gc); diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 4897d22f3a..698ee9f641 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/racket/src/racket/src/mzmarksrc.c @@ -1691,6 +1691,7 @@ mark_custodian_val { gcMARK2(m->closers, gc); gcMARK2(m->data, gc); gcMARK2(m->data_ptr, gc); + gcMARK2(m->post_callbacks, gc); gcMARK2(m->parent, gc); gcMARK2(m->sibling, gc); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 8f370f10fa..a79ae834b2 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -850,6 +850,7 @@ struct Scheme_Custodian { Scheme_Close_Custodian_Client **closers; void **data; void ***data_ptr; /* points to `data`, registered as finalizer data for strong retention */ + Scheme_Object *post_callbacks; /* additional callbacks run after all others */ /* weak indirections: */ Scheme_Custodian_Reference *parent; @@ -877,7 +878,6 @@ Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_F Scheme_Custodian *scheme_get_current_custodian(void); void scheme_run_atexit_closers_on_all(Scheme_Exit_Closer_Func alt); void scheme_run_atexit_closers(Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data); -void scheme_run_post_custodian_shutdown(); typedef struct Scheme_Security_Guard { Scheme_Object so; diff --git a/racket/src/racket/src/thread.c b/racket/src/racket/src/thread.c index 0bff5b2b7f..c605116bcb 100644 --- a/racket/src/racket/src/thread.c +++ b/racket/src/racket/src/thread.c @@ -650,7 +650,7 @@ scheme_init_unsafe_thread (Scheme_Startup_Env *env) ADD_PRIM_W_ARITY("unsafe-custodian-register", unsafe_custodian_register, 5, 5, env); ADD_PRIM_W_ARITY("unsafe-custodian-unregister", unsafe_custodian_unregister, 2, 2, env); - ADD_PRIM_W_ARITY("unsafe-add-post-custodian-shutdown", unsafe_add_post_custodian_shutdown, 1, 1, env); + ADD_PRIM_W_ARITY("unsafe-add-post-custodian-shutdown", unsafe_add_post_custodian_shutdown, 1, 2, env); ADD_PRIM_W_ARITY("unsafe-register-process-global", unsafe_register_process_global, 2, 2, env); ADD_PRIM_W_ARITY("unsafe-get-place-table", unsafe_get_place_table, 0, 0, env); @@ -1236,6 +1236,8 @@ Scheme_Custodian *scheme_make_custodian(Scheme_Custodian *parent) data_ptr = (void ***)scheme_malloc(sizeof(void**)); m->data_ptr = data_ptr; + m->post_callbacks = scheme_null; + insert_custodian(m, parent); scheme_add_finalizer(m, do_adjust_custodian_family, data_ptr); @@ -1553,6 +1555,17 @@ Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_F } #endif + if (SCHEME_PAIRP(m->post_callbacks)) { + Scheme_Object *proc; + scheme_start_in_scheduler(); + while (SCHEME_PAIRP(m->post_callbacks)) { + proc = SCHEME_CAR(m->post_callbacks); + m->post_callbacks = SCHEME_CDR(m->post_callbacks); + _scheme_apply_multi(proc, 0, NULL); + } + scheme_end_in_scheduler(); + } + m->count = 0; m->alloc = 0; m->elems = 0; @@ -1571,7 +1584,7 @@ Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_F adjust_custodian_family(m, m); adjust_limit_table(m); - + m = next_m; } @@ -1950,38 +1963,33 @@ void do_run_atexit_closers_on_all() static Scheme_Object *unsafe_add_post_custodian_shutdown(int argc, Scheme_Object *argv[]) { + Scheme_Custodian *c; + Scheme_Object *l; + scheme_check_proc_arity("unsafe-add-post-custodian-shutdown", 0, 0, argc, argv); + if ((argc > 1) + && !(SCHEME_FALSEP(argv[1]) + || SCHEME_CUSTODIANP(argv[1]))) + scheme_wrong_contract("unsafe-add-post-custodian-shutdown", "custodian?", 1, argc, argv); + + if ((argc > 1) && !SCHEME_FALSEP(argv[1])) + c = (Scheme_Custodian *)argv[1]; + else + c = main_custodian; + #if defined(MZ_USE_PLACES) - if (!RUNNING_IN_ORIGINAL_PLACE) { - if (!post_custodian_shutdowns) { - REGISTER_SO(post_custodian_shutdowns); - post_custodian_shutdowns = scheme_null; - } - - post_custodian_shutdowns = scheme_make_pair(argv[0], post_custodian_shutdowns); - } + if (RUNNING_IN_ORIGINAL_PLACE + && (c == main_custodian)) + return scheme_void; #endif + + l = scheme_make_pair(argv[0], c->post_callbacks); + c->post_callbacks = l; return scheme_void; } -void scheme_run_post_custodian_shutdown() -{ -#if defined(MZ_USE_PLACES) - if (post_custodian_shutdowns) { - Scheme_Object *proc; - scheme_start_in_scheduler(); - while (SCHEME_PAIRP(post_custodian_shutdowns)) { - proc = SCHEME_CAR(post_custodian_shutdowns); - post_custodian_shutdowns = SCHEME_CDR(post_custodian_shutdowns); - _scheme_apply_multi(proc, 0, NULL); - } - scheme_end_in_scheduler(); - } -#endif -} - void scheme_set_atexit(Scheme_At_Exit_Proc p) { replacement_at_exit = p; diff --git a/racket/src/rktio/rktio_dll.c b/racket/src/rktio/rktio_dll.c index 761553562b..81948e1909 100644 --- a/racket/src/rktio/rktio_dll.c +++ b/racket/src/rktio/rktio_dll.c @@ -138,6 +138,9 @@ rktio_dll_t *rktio_dll_open(rktio_t *rktio, rktio_const_string_t name, rktio_boo rktio_ok_t rktio_dll_close(rktio_t *rktio, rktio_dll_t *dll) { int ok = 1; + + if (!dll->name) + return ok; dll->refcount--; if (dll->refcount) diff --git a/racket/src/thread/custodian-object.rkt b/racket/src/thread/custodian-object.rkt index a002dafa52..43af066c37 100644 --- a/racket/src/thread/custodian-object.rkt +++ b/racket/src/thread/custodian-object.rkt @@ -22,7 +22,8 @@ [gc-roots #:mutable] ; weak references to charge to custodian; access without interrupts [memory-limits #:mutable] ; list of (cons limit cust) [immediate-limit #:mutable] ; limit on immediate allocation - [sync-futures? #:mutable]) ; whether a sync witht future threads is needed on shutdown + [sync-futures? #:mutable] ; whether a sync witht future threads is needed on shutdown + [post-shutdown #:mutable]) ; callbacks to run in atomic mode after shutdown #:authentic) (define (create-custodian parent) @@ -37,7 +38,8 @@ #f ; GC roots null ; memory limits #f ; immediate limit - #f)) ; sync-futures? + #f ; sync-futures? + null)) ; post-shutdown ;; Call only from a place's main pthread, and only a ;; place's main thread should change the box value. diff --git a/racket/src/thread/custodian.rkt b/racket/src/thread/custodian.rkt index eff0799413..bf116cdde2 100644 --- a/racket/src/thread/custodian.rkt +++ b/racket/src/thread/custodian.rkt @@ -33,9 +33,10 @@ custodian-register-thread custodian-register-place raise-custodian-is-shut-down - set-post-shutdown-action! + unsafe-add-post-custodian-shutdown check-queued-custodian-shutdown set-place-custodian-procs! + set-post-shutdown-action! custodian-check-immediate-limit) (module+ scheduling @@ -186,6 +187,10 @@ (when self-ref (set-custodian-reference-c! self-ref (custodian-self-reference parent))) (hash-clear! (custodian-children c)) + (set-custodian-post-shutdown! parent + (append (custodian-post-shutdown c) + (custodian-post-shutdown parent))) + (set-custodian-post-shutdown! c null) (when gc-roots (hash-clear! gc-roots)))) ;; Called in scheduler thread: @@ -274,6 +279,9 @@ (callback child c) (callback child))) (hash-clear! (custodian-children c)) + (for ([proc (in-list (custodian-post-shutdown c))]) + (proc)) + (set-custodian-post-shutdown! c null) (let ([sema (custodian-shutdown-sema c)]) (when sema (semaphore-post-all sema))) @@ -291,6 +299,15 @@ (semaphore-post-all sema)) sema)))) +(define/who (unsafe-add-post-custodian-shutdown proc [custodian #f]) + (check who (procedure-arity-includes/c 0) proc) + (check who custodian? #:or-false custodian) + (define c (or custodian (place-custodian current-place))) + (unless (and (not (place-parent current-place)) + (eq? c (place-custodian current-place))) + (atomically + (set-custodian-post-shutdown! c (cons proc (custodian-post-shutdown c)))))) + (define (custodian-subordinate? c super-c) (let loop ([p-cref (custodian-parent-reference c)]) (define p (and p-cref (custodian-reference->custodian p-cref))) diff --git a/racket/src/thread/place.rkt b/racket/src/thread/place.rkt index b387fd8c98..f38ad782a7 100644 --- a/racket/src/thread/place.rkt +++ b/racket/src/thread/place.rkt @@ -34,8 +34,7 @@ place-channel-put set-make-place-ports+fds! - place-pumper-threads - unsafe-add-post-custodian-shutdown) + place-pumper-threads) ;; For `(struct place ...)`, see "place-object.rkt" @@ -441,13 +440,6 @@ (define (place-pumper-threads p vec) (set-place-pumpers! p vec)) -(define (unsafe-add-post-custodian-shutdown proc) - (when (place-parent current-place) - (atomically - (set-place-post-shutdown! current-place - (cons proc - (place-post-shutdown current-place)))))) - (void (set-place-custodian-procs! (lambda () (atomically (ensure-wakeup-handle!))