diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index 2b924a7ef3..4d1884e271 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -1163,118 +1163,129 @@ ;; ---------------------------------------- ;; 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)) + (ptr-set! bstr _float 'abs 8 (+ v 0.25)) + (unless (= v (ptr-ref bstr _float)) + (error 'float "failed")) + (unless (= (+ v 0.5) (ptr-ref bstr _float 'abs 4)) + (error 'float "failed(2) ~s ~s" (+ v 0.5) (ptr-ref bstr _float 'abs 4))) + (unless (= (+ v 0.25) (ptr-ref bstr _float 2)) + (error 'float "failed(3)")) + (+ 1.0 v)) -(for/fold ([v 1.0]) ([i (in-range 100)]) - (ptr-set! bstr _float v) - (ptr-set! bstr _float 1 (+ v 0.5)) - (ptr-set! bstr _float 'abs 8 (+ v 0.25)) - (unless (= v (ptr-ref bstr _float)) - (error 'float "failed")) - (unless (= (+ v 0.5) (ptr-ref bstr _float 'abs 4)) - (error 'float "failed(2) ~s ~s" (+ v 0.5) (ptr-ref bstr _float 'abs 4))) - (unless (= (+ v 0.25) (ptr-ref bstr _float 2)) - (error 'float "failed(3)")) - (+ 1.0 v)) + (for/fold ([v 1.0]) ([i (in-range 100)]) + (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/fold ([v 1.0]) ([i (in-range 100)]) - (ptr-set! bstr _double v) - (ptr-set! bstr _double 1 (+ v 0.5)) - (ptr-set! bstr _double 'abs 16 (+ v 0.25)) - (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)")) - (+ 1.0 v)) + (for ([i (in-range 256)]) + (ptr-set! bstr _uint8 i) + (ptr-set! bstr _uint8 1 (- 255 i)) + (unless (= i (ptr-ref bstr _uint8)) + (error 'uint8 "fail ~s vs. ~s" i (ptr-ref bstr _uint8))) + (unless (= (- 255 i) (ptr-ref bstr _uint8 'abs 1)) + (error 'uint8 "fail(2) ~s vs. ~s" (- 255 i) (ptr-ref bstr _uint8 'abs 1)))) -(for ([i (in-range 256)]) - (ptr-set! bstr _uint8 i) - (ptr-set! bstr _uint8 1 (- 255 i)) - (unless (= i (ptr-ref bstr _uint8)) - (error 'uint8 "fail ~s vs. ~s" i (ptr-ref bstr _uint8))) - (unless (= (- 255 i) (ptr-ref bstr _uint8 'abs 1)) - (error 'uint8 "fail(2) ~s vs. ~s" (- 255 i) (ptr-ref bstr _uint8 'abs 1)))) + (for ([i (in-range -128 128)]) + (ptr-set! bstr _int8 i) + (unless (= i (ptr-ref bstr _int8)) + (error 'int8 "fail ~s vs. ~s" i (ptr-ref bstr _int8)))) -(for ([i (in-range -128 128)]) - (ptr-set! bstr _int8 i) - (unless (= i (ptr-ref bstr _int8)) - (error 'int8 "fail ~s vs. ~s" i (ptr-ref bstr _int8)))) + (for ([i (in-range (expt 2 16))]) + (ptr-set! bstr _uint16 i) + (ptr-set! bstr _uint16 3 (- (sub1 (expt 2 16)) i)) + (unless (= i (ptr-ref bstr _uint16)) + (error 'uint16 "fail ~s vs. ~s" i (ptr-ref bstr _uint16))) + (unless (= (- (sub1 (expt 2 16)) i) (ptr-ref bstr _uint16 'abs 6)) + (error 'uint16 "fail(2) ~s vs. ~s" (- (sub1 (expt 2 16)) i) (ptr-ref bstr _uint16 'abs 6)))) -(for ([i (in-range (expt 2 16))]) - (ptr-set! bstr _uint16 i) - (ptr-set! bstr _uint16 3 (- (sub1 (expt 2 16)) i)) - (unless (= i (ptr-ref bstr _uint16)) - (error 'uint16 "fail ~s vs. ~s" i (ptr-ref bstr _uint16))) - (unless (= (- (sub1 (expt 2 16)) i) (ptr-ref bstr _uint16 'abs 6)) - (error 'uint16 "fail(2) ~s vs. ~s" (- (sub1 (expt 2 16)) i) (ptr-ref bstr _uint16 'abs 6)))) + (for ([j (in-range 100)]) + (for ([i (in-range (- (expt 2 15)) (sub1 (expt 2 15)))]) + (ptr-set! bstr _int16 i) + (unless (= i (ptr-ref bstr _int16)) + (error 'int16 "fail ~s vs. ~s" i (ptr-ref bstr _int16))))) -(for ([j (in-range 100)]) - (for ([i (in-range (- (expt 2 15)) (sub1 (expt 2 15)))]) - (ptr-set! bstr _int16 i) - (unless (= i (ptr-ref bstr _int16)) - (error 'int16 "fail ~s vs. ~s" i (ptr-ref bstr _int16))))) + (let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _uint32 i) + (ptr-set! bstr _uint32 1 (- hi (- i lo) 1)) + (unless (= i (ptr-ref bstr _uint32)) + (error 'uint32 "fail ~s vs. ~s" i (ptr-ref bstr _uint32))) + (unless (= (- hi (- i lo) 1) (ptr-ref bstr _uint32 'abs 4)) + (error 'uint32 "fail ~s vs. ~s" (- hi (- i lo) 1) (ptr-ref bstr _uint32))))) + (go 0 256) + (go (- (expt 2 31) 256) (+ (expt 2 31) 256)) + (go (- (expt 2 32) 256) (expt 2 32))) + + (let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _int32 i) + (unless (= i (ptr-ref bstr _int32)) + (error 'int32 "fail ~s vs. ~s" i (ptr-ref bstr _int32))))) + (go -256 256) + (go (- (expt 2 31) 256) (sub1 (expt 2 31))) + (go (- (expt 2 31)) (- 256 (expt 2 31)))) + + (let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _uint64 i) + (ptr-set! bstr _uint64 1 (- hi (- i lo) 1)) + (unless (= i (ptr-ref bstr _uint64)) + (error 'uint64 "fail ~s vs. ~s" i (ptr-ref bstr _uint64))) + (unless (= (- hi (- i lo) 1) (ptr-ref bstr _uint64 'abs 8)) + (error 'uint32 "fail ~s vs. ~s" (- hi (- i lo) 1) (ptr-ref bstr _uint64))))) + (go 0 256) + (go (- (expt 2 63) 256) (+ (expt 2 63) 256)) + (go (- (expt 2 64) 256) (expt 2 64))) + + (let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _int64 i) + (unless (= i (ptr-ref bstr _int64)) + (error 'int64 "fail ~s vs. ~s" i (ptr-ref bstr _int64))))) + (go -256 256) + (go (- (expt 2 63) 256) (sub1 (expt 2 63))) + (go (- (expt 2 63)) (- 256 (expt 2 63)))) + + (let () + (define p (cast bstr _pointer _pointer)) + (for ([i (in-range 100)]) + (ptr-set! bstr _pointer (ptr-add p i)) + (ptr-set! bstr _pointer 2 p) + (unless (ptr-equal? p (ptr-add (ptr-ref bstr _pointer) (- i))) + (error 'pointer "fail ~s vs. ~s" + (cast p _pointer _intptr) + (cast (ptr-ref bstr _pointer) _pointer _intptr))) + (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)))))) (let () - (define (go lo hi) - (for ([i (in-range lo hi)]) - (ptr-set! bstr _uint32 i) - (ptr-set! bstr _uint32 1 (- hi (- i lo) 1)) - (unless (= i (ptr-ref bstr _uint32)) - (error 'uint32 "fail ~s vs. ~s" i (ptr-ref bstr _uint32))) - (unless (= (- hi (- i lo) 1) (ptr-ref bstr _uint32 'abs 4)) - (error 'uint32 "fail ~s vs. ~s" (- hi (- i lo) 1) (ptr-ref bstr _uint32))))) - (go 0 256) - (go (- (expt 2 31) 256) (+ (expt 2 31) 256)) - (go (- (expt 2 32) 256) (expt 2 32))) - -(let () - (define (go lo hi) - (for ([i (in-range lo hi)]) - (ptr-set! bstr _int32 i) - (unless (= i (ptr-ref bstr _int32)) - (error 'int32 "fail ~s vs. ~s" i (ptr-ref bstr _int32))))) - (go -256 256) - (go (- (expt 2 31) 256) (sub1 (expt 2 31))) - (go (- (expt 2 31)) (- 256 (expt 2 31)))) - -(let () - (define (go lo hi) - (for ([i (in-range lo hi)]) - (ptr-set! bstr _uint64 i) - (ptr-set! bstr _uint64 1 (- hi (- i lo) 1)) - (unless (= i (ptr-ref bstr _uint64)) - (error 'uint64 "fail ~s vs. ~s" i (ptr-ref bstr _uint64))) - (unless (= (- hi (- i lo) 1) (ptr-ref bstr _uint64 'abs 8)) - (error 'uint32 "fail ~s vs. ~s" (- hi (- i lo) 1) (ptr-ref bstr _uint64))))) - (go 0 256) - (go (- (expt 2 63) 256) (+ (expt 2 63) 256)) - (go (- (expt 2 64) 256) (expt 2 64))) - -(let () - (define (go lo hi) - (for ([i (in-range lo hi)]) - (ptr-set! bstr _int64 i) - (unless (= i (ptr-ref bstr _int64)) - (error 'int64 "fail ~s vs. ~s" i (ptr-ref bstr _int64))))) - (go -256 256) - (go (- (expt 2 63) 256) (sub1 (expt 2 63))) - (go (- (expt 2 63)) (- 256 (expt 2 63)))) - -(let () - (define p (cast bstr _pointer _pointer)) - (for ([i (in-range 100)]) - (ptr-set! bstr _pointer (ptr-add p i)) - (ptr-set! bstr _pointer 2 p) - (unless (ptr-equal? p (ptr-add (ptr-ref bstr _pointer) (- i))) - (error 'pointer "fail ~s vs. ~s" - (cast p _pointer _intptr) - (cast (ptr-ref bstr _pointer) _pointer _intptr))) - (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))))) + (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))) ;; ---------------------------------------- diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index c6aa9f1b45..a9a4857480 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/racket/src/cs/rumble/foreign.ss @@ -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))]) + (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))]) + (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?