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

cs ffi: fix handling of struct results

Browse Source
This commit is contained in:
Matthew Flatt 2020-08-13 13:51:16 -06:00
parent 1e91db8053
commit ab1b164982
2 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -396,6 +396,7 @@
(let ([ic7i-3 ((ffi 'ic7i_cb (_fun _ic7i (_fun _ic7i -> _ic7i) -> _ic7i)) (let ([ic7i-3 ((ffi 'ic7i_cb (_fun _ic7i (_fun _ic7i -> _ic7i) -> _ic7i))
ic7i ic7i
(lambda (ic7i-4) (lambda (ic7i-4)
(collect-garbage 'minor)
(test 12 ic7i-i1 ic7i-4) (test 12 ic7i-i1 ic7i-4)
(test (cons 255 (map sub1 (cdr v))) ic7i-c7 ic7i-4) (test (cons 255 (map sub1 (cdr v))) ic7i-c7 ic7i-4)
(test 13 ic7i-i2 ic7i-4) (test 13 ic7i-i2 ic7i-4)

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

@ -1423,6 +1423,14 @@
(with-interrupts-disabled* (with-interrupts-disabled*
(foreign-free (cpointer-address p))))) (foreign-free (cpointer-address p)))))
(define (lock-cpointer p)
(when (authentic-cpointer? p)
(lock-object (cpointer-memory p))))
(define (unlock-cpointer p)
(when (authentic-cpointer? p)
(unlock-object (cpointer-memory p))))
(define-record-type (cpointer/cell make-cpointer/cell cpointer/cell?) (define-record-type (cpointer/cell make-cpointer/cell cpointer/cell?)
(parent cpointer) (parent cpointer)
(fields)) (fields))
@ -1758,7 +1766,9 @@
(let ([r (#%apply (gen-proc (cpointer-address proc-p)) (let ([r (#%apply (gen-proc (cpointer-address proc-p))
(append (append
(if ret-ptr (if ret-ptr
(list (ret-maker (cpointer-address ret-ptr))) (begin
(lock-cpointer ret-ptr)
(list (ret-maker (cpointer-address ret-ptr))))
'()) '())
(map (lambda (arg in-type maker) (map (lambda (arg in-type maker)
(let ([host-rep (array-rep-to-pointer-rep (let ([host-rep (array-rep-to-pointer-rep
@ -1775,7 +1785,7 @@
[(posix) (thread-cell-set! errno-cell (get-errno))] [(posix) (thread-cell-set! errno-cell (get-errno))]
[(windows) (thread-cell-set! errno-cell (get-last-error))]) [(windows) (thread-cell-set! errno-cell (get-last-error))])
(cond (cond
[ret-ptr ret-ptr] [ret-ptr (unlock-cpointer ret-ptr) ret-ptr]
[(eq? (ctype-our-rep out-type) 'gcpointer) [(eq? (ctype-our-rep out-type) 'gcpointer)
(addr->gcpointer-memory r)] (addr->gcpointer-memory r)]
[else r])))))]) [else r])))))])