Change __thread to __collect_safe

Also, report an error if a string type is misused as an argument (for
foreign procedures) or result (for foreign callables) with
`__collect_safe`.

original commit: cdbfa3d86cb0719bf0979b3fe0aa5c4383282b77
This commit is contained in:
Matthew Flatt 2018-03-28 09:29:47 -06:00
parent 22d4fd9978
commit 7c94235f6b
8 changed files with 115 additions and 53 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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,6 +8772,9 @@
($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
@ -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