diff --git a/csug/foreign.stex b/csug/foreign.stex index 8453a55777..e9627d2f14 100644 --- a/csug/foreign.stex +++ b/csug/foreign.stex @@ -213,13 +213,14 @@ Multiple procedures may be created for the same \index{foreign entry}foreign ent \label{page:conv-description}% Each \var{conv} adjusts specifies the calling convention to be used. -A \scheme{#f} is allowed as \var{conv} to inicated the default calling convention +A \scheme{#f} is allowed as \var{conv} to indicate the default calling convention on the target machine (so the \scheme{#f} has no effect). Three other conventions are currently supported under Windows: \scheme{__stdcall}, \scheme{__cdecl}, and \scheme{__com} (32-bit only). Since \scheme{__cdecl} is the default, specifying \scheme{__cdecl} is equivalent to specifying \scheme{#f} or no convention. -Finally, \var{conv} can be \scheme{__thread} to control thread deactivation. +Finally, \var{conv} can be \scheme{__collect_safe} to indicate that garbage +collection is allowed concurrent to a call of the foreign procedure. Use \scheme{__stdcall} to access most Windows API procedures. Use \scheme{__cdecl} for Windows API varargs procedures, @@ -250,29 +251,31 @@ encapsulated within the COM instance passed as the first argument, with the second argument being a double float and the return value being an integer. -Use \scheme{__thread} to make the current thread deactivated (see -\scheme{fork-thread}) while a foreign procedure is called. The -thread is activated again when the foreign procedure returns. Deactivation -of the thread allows garbage collection to proceed in other threads, -so do not pass collectable memory to the foreign procedure, or use -\scheme{lock-object} to lock the memory in place; see also -\scheme{Sdeactivate_thread}. The \scheme{__thread} -declaration has no effect on a non-threaded version of the system. +Use \scheme{__collect_safe} to declare that garbage collection is +allowed concurrent to the foreign procedure. The +\scheme{__collect_safe} declaration allows concurrent collection by +deactivating the current thread (see \scheme{fork-thread}) when the +foreign procedure is called, and the thread is activated again when +the foreign procedure returns. Refrain from passing collectable memory to a +\scheme{__collect_safe} foreign procedure, or use \scheme{lock-object} +to lock the memory in place; see also \scheme{Sdeactivate_thread}. The +\scheme{__collect_safe} declaration has no effect on a non-threaded +version of the system. For example, calling the C \scheme{sleep} function with the default convention will block other Scheme threads from performing a garbage -collection, but adding the \scheme{__thread} declaration avoids that +collection, but adding the \scheme{__collect_safe} declaration avoids that problem: \schemedisplay -(define c-sleep (foreign-procedure __thread "sleep" (unsigned) unsigned)) +(define c-sleep (foreign-procedure __collect_safe "sleep" (unsigned) unsigned)) (c-sleep 10) \var{; sleeps for 10 seconds without blocking other threads} \endschemedisplay \noindent -If a foreign procedure that is called with \scheme{__thread} can +If a foreign procedure that is called with \scheme{__collect_safe} can invoke callables, then each callable should also be declared with -\scheme{__thread} so that the callable reactivates the thread. +\scheme{__collect_safe} so that the callable reactivates the thread. Complete type checking and conversion is performed on the parameters. @@ -291,13 +294,17 @@ and \index{\scheme{utf-32be}}\scheme{utf-32be}, must be used with caution, however, since they allow allocated Scheme objects to be used in places the Scheme memory management system -cannot control. -No problems will arise as long as such objects are not +cannot control. No problems will arise as long as such objects are not retained in foreign variables or data structures while Scheme code is running, since garbage collection can occur only while Scheme code is running. -All other parameter types are converted to equivalent foreign -representations and consequently can be retained indefinitely in +The types \scheme{string}, \scheme{wstring}, and \scheme{utf-8} through \scheme{utf-32be} +are disallowed as argument types for a \scheme{__collect_safe} foreign procedure, since the object +passed to the foreign procedure is not accessible for locking +before concurrent garbage collection is enabled. +Parameter types other than \scheme{scheme-object} through \scheme{utf-32be} +are converted to equivalent foreign +representations and consequently they can be retained indefinitely in foreign variables and data structures. Following are the valid parameter types: @@ -534,8 +541,9 @@ with an added null byte, and the address of the first byte of the bytevector is passed to C. The bytevector should not be retained in foreign variables or data structures, since the memory management system may relocate or discard -them between foreign procedure calls, and use their storage for some -other purpose. +them between foreign procedure calls and use their storage for some +other purpose. The \scheme{utf-8} argument type is not allowed for a +\scheme{__collect_safe} foreign procedure. \foreigntype{\scheme{utf-16le}} \index{\scheme{utf-16le}}Arguments of this type are treated like arguments @@ -1029,7 +1037,7 @@ correct. Each \var{conv} adjusts the calling convention to be used. \scheme{foreign-callable} supports the same conventions as \scheme{foreign-procedure} with the exception of \scheme{__com}. -The \scheme{__thread} convention for a callable activates a +The \scheme{__collect_safe} convention for a callable activates a calling thread if the thread is not already activated, and the thread's activation state is reverted when the callable returns. If a calling thread is not currently registered with @@ -1123,7 +1131,7 @@ Interfaces to these functions may be defined in Scheme as follows. (define register-callback (foreign-procedure "register_callback" (char void*) void)) (define event-loop - (foreign-procedure __thread "event_loop" () void)) + (foreign-procedure __collect_safe "event_loop" () void)) \endschemedisplay \noindent @@ -1132,7 +1140,7 @@ A callback for selected characters can then be defined. \schemedisplay (define callback (lambda (p) - (let ([code (foreign-callable __thread p (char) void)]) + (let ([code (foreign-callable __collect_safe p (char) void)]) (lock-object code) (foreign-callable-entry-point code)))) (define ouch @@ -1166,7 +1174,7 @@ Ouch! Hit by 'e' \endschemedisplay \noindent -The \scheme{__thread} declarations in this example ensure that +The \scheme{__collect_safe} declarations in this example ensure that other threads can continue working while \scheme{event-loop} blocks waiting for input. A more well-behaved version of the example would save each code object @@ -3464,7 +3472,7 @@ in the active state and need not be activated. Any thread that has been deactivated, and any thread created by some mechanism other than \scheme{fork-thread} must, however, be activated before before it can access Scheme data or execute -Scheme code. A foreign callable that is declared with \scheme{__thread} +Scheme code. A foreign callable that is declared with \scheme{__collect_safe} can activate a calling thread. Otherwise, \scheme{Sactivate_thread} must be used to activate a thread. It returns 1 the first time the thread is activated and 0 on each @@ -3473,7 +3481,7 @@ subsequent call until the activation is destroyed with \scheme{Sdestroy_thread}. Since active threads operating in C code prevent the storage management system from garbage collecting, a thread should be deactivated via \scheme{Sdeactivate_thread} or -through a \scheme{foreign-procedure} \scheme{__thread} declaration whenever +through a \scheme{foreign-procedure} \scheme{__collect_safe} declaration whenever the thread may spend a significant amount of time in C code. This is especially important whenever the thread calls a C library function, like \scheme{read}, that may block indefinitely. diff --git a/mats/foreign.ms b/mats/foreign.ms index 752210be7d..39bf4dbc7a 100644 --- a/mats/foreign.ms +++ b/mats/foreign.ms @@ -2792,7 +2792,7 @@ (syntax-rules () [(_ arg ...) (and (check* () arg ...) - (check* (__thread) arg ...))])) + (check* (__collect_safe) arg ...))])) (define-syntax check-n (syntax-rules () [(_ [ni ti vi] ...) @@ -2925,9 +2925,23 @@ (check-union [x double 68.0] [y int 0]) ) -(mat thread +(mat collect-safe + (error? (foreign-procedure __collect_safe "unknown" (utf-8) void)) + (error? (foreign-procedure __collect_safe "unknown" (utf-16be) void)) + (error? (foreign-procedure __collect_safe "unknown" (utf-16le) void)) + (error? (foreign-procedure __collect_safe "unknown" (utf-32be) void)) + (error? (foreign-procedure __collect_safe "unknown" (utf-32le) void)) + (error? (foreign-procedure __collect_safe "unknown" (string) void)) + ;; (error? (foreign-procedure __collect_safe "unknown" (wstring) void)) <- error message varies by platform + (error? (foreign-callable __collect_safe (lambda () #f) () utf-8)) + (error? (foreign-callable __collect_safe (lambda () #f) () utf-16le)) + (error? (foreign-callable __collect_safe (lambda () #f) () utf-16be)) + (error? (foreign-callable __collect_safe (lambda () #f) () utf-32le)) + (error? (foreign-callable __collect_safe (lambda () #f) () utf-32be)) + (error? (foreign-callable __collect_safe (lambda () #f) () string)) + ;; (error? (foreign-callable __collect_safe (lambda () #f) () wstring)) <- error message varies by platform (begin - (define-ftype thread-callback-T (function __thread (double) double)) + (define-ftype thread-callback-T (function __collect_safe (double) double)) (define (call-with-thread-callback cb-proc proc) (let ([callback (make-ftype-pointer thread-callback-T cb-proc)]) (let ([r (proc callback)]) @@ -2966,12 +2980,12 @@ (lambda (callback) (call callback arg n-times #t #t))))) call-in-unknown-thread-1)) (define call-in-unknown-thread-4 - ;; In an truly unknown thread, but also using `__thread` to + ;; In an truly unknown thread, but also using `__collect_safe` to ;; deactivate the current thread instead of using `Sdeactivate_thread` ;; within the foreign function: (if (and (threaded?) (foreign-entry? "call_in_unknown_thread")) - (let ([call (foreign-procedure __thread "call_in_unknown_thread" + (let ([call (foreign-procedure __collect_safe "call_in_unknown_thread" ((* thread-callback-T) double int boolean boolean) double)]) (lambda (proc arg n-times) @@ -2999,7 +3013,7 @@ n 1)) 10.5) - ;; Try to crash a `__thread` foreign-procedure call by moving the + ;; Try to crash a `__collect_safe` foreign-procedure call by moving the ;; return address out from under the foreign procedure. This attempt ;; should fail, because deactivating a thread first locks the ;; current code object. @@ -3014,7 +3028,7 @@ (fork-thread (lambda () (let loop ([i 10]) (unless (zero? i) - (let ([spin (eval '(foreign-procedure __thread "spin_a_while" (int unsigned unsigned) unsigned))]) + (let ([spin (eval '(foreign-procedure __collect_safe "spin_a_while" (int unsigned unsigned) unsigned))]) (spin 1000000 0 1)) (loop (sub1 i)))) (mutex-acquire m) @@ -3035,20 +3049,20 @@ (machine-case [(i3nt ti3nt) - (mat i3nt-stdcall-thread + (mat i3nt-stdcall-collect-safe (equal? (let () - (define sum (foreign-procedure __thread __stdcall "_sum_stdcall@8" (int int) int)) + (define sum (foreign-procedure __collect_safe __stdcall "_sum_stdcall@8" (int int) int)) (sum 3 7)) 10) (equal? (let () (define Sinvoke2 - (foreign-procedure __thread "Sinvoke2_stdcall" + (foreign-procedure __collect_safe "Sinvoke2_stdcall" (scheme-object scheme-object iptr) scheme-object)) (define Fcons - (foreign-callable __thread __stdcall + (foreign-callable __collect_safe __stdcall (lambda (x y) (cons x y)) (scheme-object iptr) scheme-object)) @@ -3058,6 +3072,6 @@ (eqv? (let () (define com-instance ((foreign-procedure "get_com_instance" () iptr))) - ((foreign-procedure __thread __com 0 (iptr int) int) com-instance 3) - ((foreign-procedure __thread __com 4 (iptr int) int) com-instance 17)) + ((foreign-procedure __collect_safe __com 0 (iptr int) int) com-instance 3) + ((foreign-procedure __collect_safe __com 4 (iptr int) int) com-instance 17)) 37))]) diff --git a/mats/root-experr-compile-0-f-f-f b/mats/root-experr-compile-0-f-f-f index 472415f8e6..722c43cdd2 100644 --- a/mats/root-experr-compile-0-f-f-f +++ b/mats/root-experr-compile-0-f-f-f @@ -9484,6 +9484,18 @@ foreign.mo:Expected error in mat foreign-ftype: "unexpected function ftype name foreign.mo:Expected error in mat foreign-callable: "foreign-callable: spam is not a procedure". foreign.mo:Expected error in mat foreign-callable: "foreign-callable: spam is not a procedure". foreign.mo:Expected error in mat foreign-callable: "foreign-callable: spam is not a procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-8 argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-16be argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-16le argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-32be argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-32le argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-8 argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-8 result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-16le result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-16be result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-32le result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-32be result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-8 result not allowed with __collect_safe callable". ftype.mo:Expected error in mat ftype: "unexpected function ftype outside pointer field (function #f (int) int)". ftype.mo:Expected error in mat ftype: "unexpected function ftype outside pointer field (function #f (int) int)". ftype.mo:Expected error in mat ftype: "unexpected function ftype outside pointer field (function #f (int) int)". diff --git a/mats/root-experr-compile-2-f-f-f b/mats/root-experr-compile-2-f-f-f index 472415f8e6..722c43cdd2 100644 --- a/mats/root-experr-compile-2-f-f-f +++ b/mats/root-experr-compile-2-f-f-f @@ -9484,6 +9484,18 @@ foreign.mo:Expected error in mat foreign-ftype: "unexpected function ftype name foreign.mo:Expected error in mat foreign-callable: "foreign-callable: spam is not a procedure". foreign.mo:Expected error in mat foreign-callable: "foreign-callable: spam is not a procedure". foreign.mo:Expected error in mat foreign-callable: "foreign-callable: spam is not a procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-8 argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-16be argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-16le argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-32be argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-32le argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-procedure: utf-8 argument not allowed with __collect_safe procedure". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-8 result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-16le result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-16be result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-32le result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-32be result not allowed with __collect_safe callable". +foreign.mo:Expected error in mat collect-safe: "foreign-callable: utf-8 result not allowed with __collect_safe callable". ftype.mo:Expected error in mat ftype: "unexpected function ftype outside pointer field (function #f (int) int)". ftype.mo:Expected error in mat ftype: "unexpected function ftype outside pointer field (function #f (int) int)". ftype.mo:Expected error in mat ftype: "unexpected function ftype outside pointer field (function #f (int) int)". diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 62163c84f4..dcc1b3d4ba 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -60,14 +60,14 @@ Online versions of both books can be found at \subsection{Foreign-procedure thread activation (9.5.1)} -A new \scheme{__thread} foreign-procedure convention, which can be -combined with other conventions, causes a foreign-procedure call -to deactive the current thread during the call. Similarly, the -\scheme{__thread} convention modifier for callables causes the -current thread to be activated on entry to the callable, and the -activation state is reverted on exit from the callable; this -activation makes callables work from threads that are otherwise -unknown to the Scheme system. +A new \scheme{__collect_safe} foreign-procedure convention, which can +be combined with other conventions, causes a foreign-procedure call to +deactive the current thread during the call so that other threads can +perform a garbage collection. Similarly, the \scheme{__collect_safe} +convention modifier for callables causes the current thread to be +activated on entry to the callable, and the activation state is +reverted on exit from the callable; this activation makes callables +work from threads that are otherwise unknown to the Scheme system. \subsection{Foreign-procedure struct arguments and results (9.5.1)} diff --git a/s/cprep.ss b/s/cprep.ss index 0666686228..c230caaa6f 100644 --- a/s/cprep.ss +++ b/s/cprep.ss @@ -90,7 +90,7 @@ (case x [(i3nt-stdcall) '__stdcall] [(i3nt-com) '__com] - [(adjust-active) '__thread] + [(adjust-active) '__collect_safe] [else #f])) x*))) (define-who uncprep-fp-specifier diff --git a/s/ftype.ss b/s/ftype.ss index 3cc4456fc8..6e009c2813 100644 --- a/s/ftype.ss +++ b/s/ftype.ss @@ -1197,7 +1197,7 @@ ftype operators: [(ftd-base? ftd) (do-base (filter-foreign-type (ftd-base-type ftd)) (ftd-base-swap? ftd) offset)] [(ftd-pointer? ftd) #`(#3%$fptr-fptr-ref #,fptr-expr #,offset '#,(ftd-pointer-ftd ftd))] [(ftd-function? ftd) - ($make-foreign-procedure + ($make-foreign-procedure 'make-ftype-pointer (ftd-function-conv ftd) #f #`($fptr-offset-addr #,fptr-expr offset) diff --git a/s/syntax.ss b/s/syntax.ss index bd94aa57e9..4edf85f59a 100644 --- a/s/syntax.ss +++ b/s/syntax.ss @@ -8552,7 +8552,7 @@ [c (syntax->datum orig-c)] [c (cond [(not c) #f] - [(eq? c '__thread) 'adjust-active] + [(eq? c '__collect_safe) 'adjust-active] [else (case ($target-machine) [(i3nt ti3nt) @@ -8579,8 +8579,11 @@ keep-accum)))])))) (define $make-foreign-procedure - (lambda (conv foreign-name ?foreign-addr type* result-type) + (lambda (who conv foreign-name ?foreign-addr type* result-type) (let ([unsafe? (= (optimize-level) 3)]) + (define (check-strings-allowed type) + (when (memq 'adjust-active (syntax->datum conv)) + ($oops who "~s argument not allowed with __collect_safe procedure" type))) (with-syntax ([conv conv] [foreign-name foreign-name] [?foreign-addr ?foreign-addr] @@ -8623,6 +8626,7 @@ (err ($moi) x)))) (unsigned-32))])] [(utf-8) + (check-strings-allowed type) #`(() ((if (eq? x #f) x @@ -8633,6 +8637,7 @@ (err ($moi) x))))) (u8*))] [(utf-16le) + (check-strings-allowed type) #`(() ((if (eq? x #f) x @@ -8643,6 +8648,7 @@ (err ($moi) x))))) (u16*))] [(utf-16be) + (check-strings-allowed type) #`(() ((if (eq? x #f) x @@ -8653,6 +8659,7 @@ (err ($moi) x))))) (u16*))] [(utf-32le) + (check-strings-allowed type) #`(() ((if (eq? x #f) x @@ -8663,6 +8670,7 @@ (err ($moi) x))))) (u32*))] [(utf-32be) + (check-strings-allowed type) #`(() ((if (eq? x #f) x @@ -8750,7 +8758,7 @@ (syntax-case x () [(_ c ... ?name (arg ...) result) (lambda (r) - ($make-foreign-procedure + ($make-foreign-procedure 'foreign-procedure ($filter-conv 'foreign-procedure #'(c ...)) (let ([x (datum ?name)]) (and (string? x) x)) #'($foreign-entry ?name) @@ -8764,10 +8772,13 @@ ($oops who "unsupported convention ~s" c))) (syntax->list conv)) (let ([unsafe? (= (optimize-level) 3)]) + (define (check-strings-allowed result-type) + (when (memq 'adjust-active (syntax->datum conv)) + ($oops who "~s result not allowed with __collect_safe callable" result-type))) (with-syntax ([conv conv] [?proc ?proc]) (with-syntax ([((actual (t ...) (arg ...)) ...) (map - (lambda (type) + (lambda (type) (or (case type [(boolean) (with-syntax ([(x) (generate-temporaries #'(*))]) @@ -8894,6 +8905,7 @@ unsigned-16 [] [])])] [(utf-8) + (check-strings-allowed result-type) #`((lambda (x) (if (eq? x #f) x @@ -8905,6 +8917,7 @@ u8* [] [])] [(utf-16le) + (check-strings-allowed result-type) #`((lambda (x) (if (eq? x #f) x @@ -8916,6 +8929,7 @@ u16* [] [])] [(utf-16be) + (check-strings-allowed result-type) #`((lambda (x) (if (eq? x #f) x @@ -8927,6 +8941,7 @@ u16* [] [])] [(utf-32le) + (check-strings-allowed result-type) #`((lambda (x) (if (eq? x #f) x @@ -8938,6 +8953,7 @@ u32* [] [])] [(utf-32be) + (check-strings-allowed result-type) #`((lambda (x) (if (eq? x #f) x