suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add custodian-based unloading of foreign libraries

Browse Source 
Specificially, add a `#:custodian` argument to `ffi-lib`.
This commit is contained in:
Matthew Flatt 2019-09-06 15:07:09 -06:00
parent 276a102d6a
commit 3024b77ba5
17 changed files with 155 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
pkgs/racket-doc/scribblings/foreign/libs.scrbl
View File

@ -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)]

23
racket/collects/ffi/unsafe.rkt
View File

@ -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,6 +174,7 @@
(string-append name0 "." lib-suffix v)
(string-append name0 v "." lib-suffix))))
versions)])
(define lib
(or ;; try to look in our library paths first
(and (not absolute?)
(ormap (lambda (dir)
@ -198,11 +201,21 @@
(cond [(file-exists?/insecure attempt) " (exists)"]
[else " (no such file)"])]
[else " (using OS library search path)"])))))
(if fail
(fail)
(and (not fail)
(if (pair? names)
(ffi-lib (car names) #f global?)
(ffi-lib name0 #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)))

2
racket/src/cs/Makefile
View File

@ -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

2
racket/src/cs/io.sls
View File

@ -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))

2
racket/src/cs/rumble.sls
View File

@ -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

12
racket/src/cs/rumble/foreign.ss
View File

@ -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))
;; ----------------------------------------

4
racket/src/io/foreign/main.rkt
View File

@ -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

2
racket/src/racket/include/schthread.h
View File

@ -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_)

2
racket/src/racket/src/env.c
View File

@ -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();

2
racket/src/racket/src/mzmark_thread.inc
View File

@ -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);

1
racket/src/racket/src/mzmarksrc.c
View File

@ -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);

2
racket/src/racket/src/schpriv.h
View File

@ -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;

58
racket/src/racket/src/thread.c
View File

@ -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;
@ -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 defined(MZ_USE_PLACES)
if (!RUNNING_IN_ORIGINAL_PLACE) {
if (!post_custodian_shutdowns) {
REGISTER_SO(post_custodian_shutdowns);
post_custodian_shutdowns = scheme_null;
}
if ((argc > 1)
&& !(SCHEME_FALSEP(argv[1])
|| SCHEME_CUSTODIANP(argv[1])))
scheme_wrong_contract("unsafe-add-post-custodian-shutdown", "custodian?", 1, argc, argv);
post_custodian_shutdowns = scheme_make_pair(argv[0], post_custodian_shutdowns);
}
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
&& (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;

3
racket/src/rktio/rktio_dll.c
View File

@ -139,6 +139,9 @@ 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)
return ok;

6
racket/src/thread/custodian-object.rkt
View File

@ -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.

19
racket/src/thread/custodian.rkt
View File

@ -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)))

10
racket/src/thread/place.rkt
View File

@ -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!))