/usr/share/scheme48-1.9/big/dynamic-external.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Mike Sperber, Robert Ransom
;; More high-level interface to dynamic loading:
;; This automatically initializes an external shared object, keeps
;; track of which shared objects are loaded, and prevents them from
;; being removed automatically by the GC.
;; The shared object must define a function
;; void s48_on_load(void);
;; It can also define functions:
;; void s48_on_unload(void);
;; which is called just before unloading, and
;; void s48_on_reload(void);
;; which is called after reloading,
;; (which typically do the same thing) that LOAD-DYNAMIC-EXTERNALS
;; calls, depending on whether the object is being loaded for the
;; first time or not.
(define-record-type dynamic-externals :dynamic-externals
(make-dynamic-externals shared-object
complete-name?
reload-on-repeat?
reload-on-resume?)
dynamic-externals?
(shared-object dynamic-externals-shared-object
set-dynamic-externals-shared-object!)
(complete-name? dynamic-externals-complete-name?)
(reload-on-repeat? dynamic-externals-reload-on-repeat?)
(reload-on-resume? dynamic-externals-reload-on-resume?))
(define *the-dynamic-externals-table* '())
(define (find-dynamic-externals name)
(let ((real-name (translate name)))
(any (lambda (dynamic-externals)
(string=? real-name
(shared-object-name
(dynamic-externals-shared-object
dynamic-externals))))
*the-dynamic-externals-table*)))
;; returns the DYNAMIC-EXTERNALS object
(define (load-dynamic-externals name complete-name?
reload-on-repeat? reload-on-resume?)
(cond
((find-dynamic-externals name)
=> (lambda (dynamic-externals)
;; Should we respect the original settings for
;; RELOAD-ON-REPEAT? and RELOAD-ON-RESUME? or the new ones?
;; We assume they're always the same. We should probably
;; verify.
(if reload-on-repeat?
(reload-dynamic-externals-internal dynamic-externals #t))
dynamic-externals))
(else
(let* ((shared-object (open-shared-object (translate name) complete-name?))
(dynamic-externals (make-dynamic-externals shared-object
complete-name?
reload-on-repeat?
reload-on-resume?)))
(set! *the-dynamic-externals-table*
(cons dynamic-externals
*the-dynamic-externals-table*))
(call-shared-object-address
(shared-object-address shared-object "s48_on_load"))
dynamic-externals))))
(define (reload-dynamic-externals-internal dynamic-externals reload?)
(let* ((old-shared-object (dynamic-externals-shared-object dynamic-externals))
(name (shared-object-name old-shared-object)))
(if reload?
(unload-shared-object dynamic-externals))
(let ((shared-object
(open-shared-object (translate name)
(dynamic-externals-complete-name? dynamic-externals))))
(set-dynamic-externals-shared-object! dynamic-externals shared-object)
(cond
((not reload?)
(call-shared-object-address (shared-object-address shared-object "s48_on_load")))
((shared-object-address-or-false shared-object "s48_on_reload")
=> call-shared-object-address)))))
;; for interactive usage
(define (reload-dynamic-externals name)
(cond
((find-dynamic-externals name) =>
(lambda (dynamic-externals)
(reload-dynamic-externals-internal dynamic-externals #t)))
(else
(assertion-violation 'name
"trying to reload dynamic externals that were never loaded"
name))))
;; most common usage, when a Scheme package requires C externals to work
(define (import-dynamic-externals name)
(load-dynamic-externals name #t #f #t))
;; We can't do this via a reinitializer, because the reinitializer
;; will typically call external C code, which is typically in a shared
;; library. So we need to load the shared libraries before we run any
;; reinitializers.
(add-initialization-thunk!
(lambda ()
(set! *the-dynamic-externals-table*
(delete (lambda (dynamic-externals)
(not (dynamic-externals-reload-on-resume? dynamic-externals)))
*the-dynamic-externals-table*))
(for-each (lambda (dynamic-externals)
(reload-dynamic-externals-internal dynamic-externals #f))
*the-dynamic-externals-table*)))
;; note this leaves the shared bindings in place.
(define (unload-dynamic-externals dynamic-externals)
(set! *the-dynamic-externals-table*
(delq dynamic-externals *the-dynamic-externals-table*))
(unload-shared-object dynamic-externals))
(define (unload-shared-object dynamic-externals)
(let ((shared-object (dynamic-externals-shared-object dynamic-externals)))
(cond
((shared-object-address-or-false shared-object "s48_on_unload")
=> call-shared-object-address))
(close-shared-object shared-object)))
|