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

fix JIT, `unsafe-struct-ref', chaperone, and procedure property

Browse Source
This commit is contained in:
Matthew Flatt 2012-02-27 06:57:44 -07:00
parent f9247ff3a5
commit 0dcc96c5eb
2 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/tests/racket/unsafe.rktl
View File

@ -314,22 +314,27 @@
(test-bin 65535 'unsafe-u16vector-ref (u16vector 10 65535 187) 1) (test-bin 65535 'unsafe-u16vector-ref (u16vector 10 65535 187) 1)
(let () (let ()
(define-struct posn (x [y #:mutable] z)) (define (try-struct prop prop-val)
(for ([star (list values (add-star "star"))]) (define-struct posn (x [y #:mutable] z)
(test-bin 'a unsafe-struct-ref (make-posn 'a 'b 'c) 0 #:literal-ok? #f) #:property prop prop-val)
(test-bin 'b unsafe-struct-ref (make-posn 'a 'b 'c) 1 #:literal-ok? #f) (for ([star (list values (add-star "star"))])
(let ([p (make-posn 100 200 300)]) (test-bin 'a unsafe-struct-ref (make-posn 'a 'b 'c) 0 #:literal-ok? #f)
(test-tri 500 (star 'unsafe-struct-set!) p 1 500 (test-bin 'b unsafe-struct-ref (make-posn 'a 'b 'c) 1 #:literal-ok? #f)
(let ([p (make-posn 100 200 300)])
(test-tri 500 (star 'unsafe-struct-set!) p 1 500
#:pre (lambda () (set-posn-y! p 0))
#:post (lambda (x) (posn-y p))
#:literal-ok? #f)))
(let ([p (chaperone-struct (make-posn 100 200 300)
posn-y (lambda (p v) v)
set-posn-y! (lambda (p v) v))])
(test-tri 500 'unsafe-struct-set! p 1 500
#:pre (lambda () (set-posn-y! p 0)) #:pre (lambda () (set-posn-y! p 0))
#:post (lambda (x) (posn-y p)) #:post (lambda (x) (posn-y p))
#:literal-ok? #f))) #:literal-ok? #f)))
(let ([p (chaperone-struct (make-posn 100 200 300) (define-values (prop:nothing nothing? nothing-ref) (make-struct-type-property 'nothing))
posn-y (lambda (p v) v) (try-struct prop:nothing 5)
set-posn-y! (lambda (p v) v))]) (try-struct prop:procedure (lambda (s) 'hi!)))
(test-tri 500 'unsafe-struct-set! p 1 500
#:pre (lambda () (set-posn-y! p 0))
#:post (lambda (x) (posn-y p))
#:literal-ok? #f)))
;; test unboxing: ;; test unboxing:
(test-tri 5.4 '(lambda (x y z) (unsafe-fl+ x (unsafe-f64vector-ref y z))) 1.2 (f64vector 1.0 4.2 6.7) 1) (test-tri 5.4 '(lambda (x y z) (unsafe-fl+ x (unsafe-f64vector-ref y z))) 1.2 (f64vector 1.0 4.2 6.7) 1)

2
src/racket/src/jitinline.c
View File

@ -1605,6 +1605,8 @@ static int generate_vector_op(mz_jit_state *jitter, int set, int int_ready, int
__START_TINY_JUMPS__(1); __START_TINY_JUMPS__(1);
mz_patch_branch(ref); mz_patch_branch(ref);
if (for_struct && unsafe && can_chaperone)
(void)mz_beqi_t(reffail, JIT_R0, scheme_proc_chaperone_type, JIT_R2);
if (!unsafe) { if (!unsafe) {
if (!int_ready) if (!int_ready)
(void)jit_bmci_ul(reffail, JIT_R1, 0x1); (void)jit_bmci_ul(reffail, JIT_R1, 0x1);