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

cs: fix ptr-ref on result of ptr-add

Browse Source 
Fix `ptr-ref` to properly handle the offset in a pointer for
specialized references, like extracting ` _double`.

Thanks to Laurent Orseau for the bug report and Jens Axel Søgaard for
intial debugging.
This commit is contained in:
Matthew Flatt 2020-05-10 07:00:08 -06:00
parent e301d3061d
commit b0e65199fd
2 changed files with 127 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1163,8 +1163,7 @@
;; ----------------------------------------
;; Test JIT inlining
(define bstr (cast (make-bytes 64) _pointer _pointer))
(define (test-ptr-jit-inline bstr)
(for/fold ([v 1.0]) ([i (in-range 100)])
(ptr-set! bstr _float v)
(ptr-set! bstr _float 1 (+ v 0.5))
@ -1181,12 +1180,17 @@
(ptr-set! bstr _double v)
(ptr-set! bstr _double 1 (+ v 0.5))
(ptr-set! bstr _double 'abs 16 (+ v 0.25))
(ptr-set! (ptr-add bstr 24) _double (+ v 0.125))
(unless (= v (ptr-ref bstr _double))
(error 'double "failed"))
(unless (= (+ v 0.5) (ptr-ref bstr _double 'abs 8))
(error 'double "failed(2)"))
(unless (= (+ v 0.25) (ptr-ref bstr _double 2))
(error 'double "failed(3)"))
(unless (= (+ v 0.5) (ptr-ref (ptr-add bstr 8) _double))
(error 'double "failed(4)"))
(unless (= (+ v 0.125) (ptr-ref (ptr-add bstr 24) _double))
(error 'double "failed(5)"))
(+ 1.0 v))
(for ([i (in-range 256)])
@ -1274,7 +1278,14 @@
(unless (ptr-equal? p (ptr-ref bstr _pointer 'abs (* 2 (ctype-sizeof _pointer))))
(error 'pointer "fail ~s vs. ~s"
(cast p _pointer _intptr)
(cast (ptr-ref bstr _pointer 'abs (ctype-sizeof _pointer)) _pointer _intptr)))))
(cast (ptr-ref bstr _pointer 'abs (ctype-sizeof _pointer)) _pointer _intptr))))))
(let ()
(test-ptr-jit-inline (make-bytes 64))
(test-ptr-jit-inline (cast (make-bytes 64) _pointer _pointer))
(let ([p (malloc 'raw 64)])
(test-ptr-jit-inline p)
(free p)))
;; ----------------------------------------

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

@ -969,12 +969,12 @@
[(and simple-p
(fixnum? offset)
(or (not abs?) (fx= 0 (fxand offset (fx- (fxsll 1 type-bits) 1)))))
(if (bytevector? simple-p)
(bytes-ref simple-p (if abs? offset (fxsll offset type-bits)))
(let ([offset (let ([offset (if abs? offset (fxsll offset type-bits))])
(if (cpointer+offset? p)
(+ offset (cpointer+offset-offset p))
offset))])
(if (bytevector? simple-p)
(bytes-ref simple-p offset)
(foreign-ref 'foreign-type simple-p offset)))]
[else
(if abs?
@ -993,12 +993,12 @@
(fixnum? offset)
(or (not abs?) (fx= 0 (fxand offset (fx- (fxsll 1 type-bits) 1))))
(ok-v? v))
(if (bytevector? simple-p)
(bytes-set simple-p (if abs? offset (fxsll offset type-bits)) v)
(let ([offset (let ([offset (if abs? offset (fxsll offset type-bits))])
(if (cpointer+offset? p)
(+ offset (cpointer+offset-offset p))
offset))])
(if (bytevector? simple-p)
(bytes-set simple-p offset v)
(foreign-set! 'foreign-type simple-p offset v)))]
[else
(if abs?