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

cs: fix checking for a non-atomic argument to a foreign call

Browse Source 
In CS, a pointer to non-atomic memory cannot usefully be passed to a
foreign function. The general foreign-call path checked for that kind
of argument and raised an exception, but the check was missing from
the common-case fast path, so a meaningless argument would be quietly
passed to the foreign function.

Related to #3825
This commit is contained in:
Matthew Flatt 2021-05-08 05:19:35 -06:00
parent c35a843e71
commit f35a92744d
3 changed files with 28 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/racket-doc/scribblings/foreign/types.scrbl
View File

@ -1125,6 +1125,11 @@ allocated using @racket[(malloc type-expr)] if
@racket[maybe-malloc-mode] is not specified or if it is @racket[#f],
@racket[(malloc type-expr '@#,racket[maybe-malloc-mode])] otherwise.
Note that in the @CS[] implementation of Racket, a @racket[(_ptr i
__ctype)] argument will trigger an error if @racket[__ctype] indicates
values that are managed by the garbage collector, since pointers to
non-atomic memory cannot be passed to foreign functions.
@history[#:changed "7.7.0.6" @elem{The modes @racket[i], @racket[o],
and @racket[io] match as symbols
instead of free identifiers.}
@ -1195,6 +1200,11 @@ return two values, the vector and the boolean.
-> (values vec res))
]
Note that in the @CS[] implementation of Racket, a @racket[(_list i
__ctype)] argument will trigger an error if @racket[__ctype] indicates
values that are managed by the garbage collector, since pointers to
non-atomic memory cannot be passed to foreign functions.
@history[#:changed "7.7.0.2" @elem{Added @racket[maybe-mode].}]
#:changed "7.7.0.6" @elem{The modes @racket[i], @racket[o],
and @racket[io] match as symbols

7
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

@ -360,6 +360,13 @@
(with-keeper b)
(set-box! b #f)))
;; ---
;; test error reported when trying to pass non-atomic on CS
(when (eq? 'chez-scheme (system-type 'vm))
(err/rt-test ((ffi 'grab7th (_fun (_list i _string) -> _int ))
(list "hello"))
exn:fail?
"non-atomic"))
;; ---
;; test exposing internal mzscheme functionality
(when (eq? 'racket (system-type 'vm))
(test '(1 2)

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

@ -1717,7 +1717,7 @@
[unwrap (lambda (arg in-type)
(let ([c (s->c name in-type arg)])
(if (cpointer? c)
(unwrap-cpointer 'ffi-call c)
(unwrap-cpointer-for-foreign-call c arg proc-p)
c)))]
[unpack (lambda (arg in-type)
(case (array-rep-to-pointer-rep (ctype-host-rep in-type))
@ -1787,11 +1787,7 @@
(let ([arg (s->c name in-type orig-arg)])
(if (and (cpointer? arg)
(not (eq? 'scheme-object (ctype-host-rep in-type))))
(let ([p (unwrap-cpointer 'ffi-call arg)])
(when (and (cpointer-nonatomic? p)
(not (cpointer/cell? p)))
(disallow-nonatomic-pointer 'argument orig-arg proc-p))
p)
(unwrap-cpointer-for-foreign-call arg orig-arg proc-p)
arg)))
orig-args in-types)]
[r (let ([ret-ptr (and ret-id
@ -1905,11 +1901,15 @@
(loop (cdr types) (cons id reps) (append id-decls decls)))
(loop (cdr types) (cons (ctype-host-rep type) reps) decls)))])))
(define (disallow-nonatomic-pointer what arg proc-p)
(raise-arguments-error 'foreign-call "cannot pass non-atomic pointer to a function"
"pointer" arg
"function" (or (cpointer->name proc-p)
'unknown)))
(define (unwrap-cpointer-for-foreign-call arg orig-arg proc-p)
(let ([p (unwrap-cpointer 'ffi-call arg)])
(when (and (cpointer-nonatomic? p)
(not (cpointer/cell? p)))
(raise-arguments-error 'foreign-call "cannot pass non-atomic pointer to a function"
"pointer" arg
"function" (or (cpointer->name proc-p)
'unknown)))
p))
;; Rely on the fact that a virtual register defaults to 0 to detect a
;; thread that we didn't start. For a thread that we did start, a