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:
parent
22d4fd9978
commit
7c94235f6b
|
@ -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.
|
||||
|
|
|
@ -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))])
|
||||
|
|
|
@ -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)".
|
||||
|
|
|
@ -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)".
|
||||
|
|
|
@ -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)}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
22
s/syntax.ss
22
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,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
|
||||
|
|
Loading…
Reference in New Issue
Block a user