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

swap vector*-ref' and vector-ref', etc.

Browse Source 
Merge to 5.0.2
(cherry picked from commit 5d8e000d6d)
This commit is contained in:
Matthew Flatt 2010-10-25 10:51:35 -06:00 committed by Ryan Culpepper
parent e7a2a3b062
commit 6f2f04b979
12 changed files with 79 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/racket/match/compiler.rkt
View File

@ -105,10 +105,10 @@
esc)] esc)]
[(n ...) ns]) [(n ...) ns])
#`[(#,arity) #`[(#,arity)
(let ([tmps (unsafe-vector*-ref #,x n)] ...) (let ([tmps (unsafe-vector-ref #,x n)] ...)
body)]))))])]) body)]))))])])
#`[(vector? #,x) #`[(vector? #,x)
(case (unsafe-vector*-length #,x) (case (unsafe-vector-length #,x)
clauses ... clauses ...
[else (#,esc)])])] [else (#,esc)])])]
;; it's a structure ;; it's a structure
@ -117,7 +117,7 @@
(let* ([s (Row-first-pat (car rows))] (let* ([s (Row-first-pat (car rows))]
[accs (Struct-accessors s)] [accs (Struct-accessors s)]
[accs (if (Struct-complete? s) [accs (if (Struct-complete? s)
(build-list (length accs) (λ (i) #`(λ (x) (unsafe-struct*-ref x #,i)))) (build-list (length accs) (λ (i) #`(λ (x) (unsafe-struct-ref x #,i))))
accs)] accs)]
[pred (Struct-pred s)]) [pred (Struct-pred s)])
(compile-con-pat accs pred Struct-ps))] (compile-con-pat accs pred Struct-ps))]

6
collects/racket/private/for.rkt
View File

@ -420,7 +420,7 @@
(define (:vector-gen v start stop step) (define (:vector-gen v start stop step)
(values (values
;; pos->element ;; pos->element
(lambda (i) (unsafe-vector*-ref v i)) (lambda (i) (unsafe-vector-ref v i))
;; next-pos ;; next-pos
;; Minor optimisation. I assume add1 is faster than \x.x+1 ;; Minor optimisation. I assume add1 is faster than \x.x+1
(if (= step 1) add1 (lambda (i) (+ i step))) (if (= step 1) add1 (lambda (i) (+ i step)))
@ -1236,9 +1236,9 @@
(define-sequence-syntax *in-vector (define-sequence-syntax *in-vector
(lambda () #'in-vector) (lambda () #'in-vector)
(vector-like-gen #'vector? (vector-like-gen #'vector?
#'unsafe-vector*-length #'unsafe-vector-length
#'in-vector #'in-vector
#'unsafe-vector*-ref)) #'unsafe-vector-ref))
(define-sequence-syntax *in-string (define-sequence-syntax *in-string
(lambda () #'in-string) (lambda () #'in-string)

28
collects/racket/vector.rkt
View File

@ -59,9 +59,9 @@
;; length is passed to save the computation ;; length is passed to save the computation
(define (vector-map/update f target length vs) (define (vector-map/update f target length vs)
(for ([i (in-range length)]) (for ([i (in-range length)])
(unsafe-vector*-set! (unsafe-vector-set!
target i target i
(apply f (map (lambda (vec) (unsafe-vector*-ref vec i)) vs))))) (apply f (map (lambda (vec) (unsafe-vector-ref vec i)) vs)))))
;; check that `v' is a vector ;; check that `v' is a vector
;; that `v' and all the `vs' have the same length ;; that `v' and all the `vs' have the same length
@ -77,12 +77,12 @@
0 f)) 0 f))
(unless (vector? v) (unless (vector? v)
(raise-type-error name "vector" 1 v)) (raise-type-error name "vector" 1 v))
(let ([len (unsafe-vector*-length v)]) (let ([len (unsafe-vector-length v)])
(for ([e (in-list vs)] (for ([e (in-list vs)]
[i (in-naturals 2)]) [i (in-naturals 2)])
(unless (vector? e) (unless (vector? e)
(raise-type-error name "vector" e i)) (raise-type-error name "vector" e i))
(unless (= len (unsafe-vector*-length e)) (unless (= len (unsafe-vector-length e))
(raise (raise
(make-exn:fail:contract (make-exn:fail:contract
(format "~e: all vectors must have same size; ~a" (format "~e: all vectors must have same size; ~a"
@ -138,8 +138,8 @@
([i (in-range len)] ([i (in-range len)]
#:when #:when
(apply f (apply f
(unsafe-vector*-ref v i) (unsafe-vector-ref v i)
(map (lambda (v) (unsafe-vector*-ref v i)) vs))) (map (lambda (v) (unsafe-vector-ref v i)) vs)))
(add1 c)) (add1 c))
(error 'vector-count "all vectors must have same size"))) (error 'vector-count "all vectors must have same size")))
(for/fold ([cnt 0]) ([i (in-vector v)] #:when (f i)) (for/fold ([cnt 0]) ([i (in-vector v)] #:when (f i))
@ -150,7 +150,7 @@
(raise-type-error name "vector" v)) (raise-type-error name "vector" v))
(unless (exact-nonnegative-integer? n) (unless (exact-nonnegative-integer? n)
(raise-type-error name "non-negative exact integer" n)) (raise-type-error name "non-negative exact integer" n))
(let ([len (unsafe-vector*-length v)]) (let ([len (unsafe-vector-length v)])
(unless (<= 0 n len) (unless (<= 0 n len)
(raise-mismatch-error (raise-mismatch-error
name name
@ -186,14 +186,14 @@
(let* ([vs (cons v vs)] (let* ([vs (cons v vs)]
[lens (for/list ([e (in-list vs)] [i (in-naturals)]) [lens (for/list ([e (in-list vs)] [i (in-naturals)])
(if (vector? e) (if (vector? e)
(unsafe-vector*-length e) (unsafe-vector-length e)
(raise-type-error 'vector-append "vector" e i)))] (raise-type-error 'vector-append "vector" e i)))]
[new-v (make-vector (apply + lens))]) [new-v (make-vector (apply + lens))])
(let loop ([start 0] [lens lens] [vs vs]) (let loop ([start 0] [lens lens] [vs vs])
(when (pair? lens) (when (pair? lens)
(let ([len (car lens)] [v (car vs)]) (let ([len (car lens)] [v (car vs)])
(for ([i (in-range len)]) (for ([i (in-range len)])
(unsafe-vector*-set! new-v (+ i start) (unsafe-vector*-ref v i))) (unsafe-vector-set! new-v (+ i start) (unsafe-vector-ref v i)))
(loop (+ start len) (cdr lens) (cdr vs))))) (loop (+ start len) (cdr lens) (cdr vs)))))
new-v)) new-v))
@ -203,13 +203,13 @@
(procedure-arity-includes? f 1)) (procedure-arity-includes? f 1))
(raise-type-error name "procedure (arity 1)" f)) (raise-type-error name "procedure (arity 1)" f))
(unless (and (vector? xs) (unless (and (vector? xs)
(< 0 (unsafe-vector*-length xs))) (< 0 (unsafe-vector-length xs)))
(raise-type-error name "non-empty vector" xs)) (raise-type-error name "non-empty vector" xs))
(let ([init-min-var (f (unsafe-vector*-ref xs 0))]) (let ([init-min-var (f (unsafe-vector-ref xs 0))])
(unless (real? init-min-var) (unless (real? init-min-var)
(raise-type-error name "procedure that returns real numbers" f)) (raise-type-error name "procedure that returns real numbers" f))
(let-values ([(min* min-var*) (let-values ([(min* min-var*)
(for/fold ([min (unsafe-vector*-ref xs 0)] (for/fold ([min (unsafe-vector-ref xs 0)]
[min-var init-min-var]) [min-var init-min-var])
([e (in-vector xs 1)]) ([e (in-vector xs 1)])
(let ([new-min (f e)]) (let ([new-min (f e)])
@ -228,11 +228,11 @@
(define (name val vec) (define (name val vec)
(unless (vector? vec) (unless (vector? vec)
(raise-type-error 'name "vector" 1 vec)) (raise-type-error 'name "vector" 1 vec))
(let ([sz (unsafe-vector*-length vec)]) (let ([sz (unsafe-vector-length vec)])
(let loop ([k 0]) (let loop ([k 0])
(cond [(= k sz) #f] (cond [(= k sz) #f]
[(cmp val [(cmp val
(unsafe-vector*-ref vec k)) (unsafe-vector-ref vec k))
k] k]
[else (loop (unsafe-fx+ 1 k))]))))) [else (loop (unsafe-fx+ 1 k))])))))

28
collects/scribblings/reference/unsafe.scrbl
View File

@ -192,22 +192,22 @@ Unsafe variants of @scheme[car], @scheme[cdr], @scheme[mcar],
@deftogether[( @deftogether[(
@defproc[(unsafe-unbox [v (and/c box? (not/c chaperone?))]) any/c] @defproc[(unsafe-unbox [b box?]) fixnum?]
@defproc[(unsafe-set-box! [v (and/c box? (not/c chaperone?))] [val any/c]) void?] @defproc[(unsafe-set-box! [b box?] [k fixnum?]) void?]
@defproc[(unsafe-unbox* [b box?]) fixnum?] @defproc[(unsafe-unbox* [v (and/c box? (not/c chaperone?))]) any/c]
@defproc[(unsafe-set-box*! [b box?] [k fixnum?]) void?] @defproc[(unsafe-set-box*! [v (and/c box? (not/c chaperone?))] [val any/c]) void?]
)]{ )]{
Unsafe versions of @scheme[unbox] and @scheme[set-box!].} Unsafe versions of @scheme[unbox] and @scheme[set-box!].}
@deftogether[( @deftogether[(
@defproc[(unsafe-vector-length [v (and/c vector? (not/c chaperone?))]) fixnum?] @defproc[(unsafe-vector-length [v vector?]) fixnum?]
@defproc[(unsafe-vector-ref [v (and/c vector? (not/c chaperone?))] [k fixnum?]) any/c] @defproc[(unsafe-vector-ref [v vector?] [k fixnum?]) any/c]
@defproc[(unsafe-vector-set! [v (and/c vector? (not/c chaperone?))] [k fixnum?] [val any/c]) void?] @defproc[(unsafe-vector-set! [v vector?] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-vector*-length [v vector?]) fixnum?] @defproc[(unsafe-vector*-length [v (and/c vector? (not/c chaperone?))]) fixnum?]
@defproc[(unsafe-vector*-ref [v vector?] [k fixnum?]) any/c] @defproc[(unsafe-vector*-ref [v (and/c vector? (not/c chaperone?))] [k fixnum?]) any/c]
@defproc[(unsafe-vector*-set! [v vector?] [k fixnum?] [val any/c]) void?] @defproc[(unsafe-vector*-set! [v (and/c vector? (not/c chaperone?))] [k fixnum?] [val any/c]) void?]
)]{ )]{
Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and
@ -282,10 +282,10 @@ Unsafe versions of @scheme[u16vector-ref] and
@deftogether[( @deftogether[(
@defproc[(unsafe-struct-ref [v (not/c chaperone?)] [k fixnum?]) any/c] @defproc[(unsafe-struct-ref [v any/c] [k fixnum?]) any/c]
@defproc[(unsafe-struct-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?] @defproc[(unsafe-struct-set! [v any/c] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-struct*-ref [v any/c] [k fixnum?]) any/c] @defproc[(unsafe-struct*-ref [v (not/c chaperone?)] [k fixnum?]) any/c]
@defproc[(unsafe-struct*-set! [v any/c] [k fixnum?] [val any/c]) void?] @defproc[(unsafe-struct*-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?]
)]{ )]{
Unsafe field access and update for an instance of a structure Unsafe field access and update for an instance of a structure

16
collects/tests/racket/benchmarks/shootout/nbody-vec.rkt
View File

@ -94,10 +94,10 @@ Correct output N = 1000 is
(let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0]) (let loop-i ([i 0] [px 0.0] [py 0.0] [pz 0.0])
(if (unsafe-fx= i *system-size*) (if (unsafe-fx= i *system-size*)
(begin (begin
(set-body-vx! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+)) (set-body-vx! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 px) +solar-mass+))
(set-body-vy! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+)) (set-body-vy! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 py) +solar-mass+))
(set-body-vz! (unsafe-vector-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+))) (set-body-vz! (unsafe-vector*-ref *system* 0) (fl/ (fl- 0.0 pz) +solar-mass+)))
(let ([i1 (unsafe-vector-ref *system* i)]) (let ([i1 (unsafe-vector*-ref *system* i)])
(loop-i (unsafe-fx+ i 1) (loop-i (unsafe-fx+ i 1)
(fl+ px (fl* (body-vx i1) (body-mass i1))) (fl+ px (fl* (body-vx i1) (body-mass i1)))
(fl+ py (fl* (body-vy i1) (body-mass i1))) (fl+ py (fl* (body-vy i1) (body-mass i1)))
@ -108,7 +108,7 @@ Correct output N = 1000 is
(let loop-o ([o 0] [e 0.0]) (let loop-o ([o 0] [e 0.0])
(if (unsafe-fx= o *system-size*) (if (unsafe-fx= o *system-size*)
e e
(let* ([o1 (unsafe-vector-ref *system* o)] (let* ([o1 (unsafe-vector*-ref *system* o)]
[e (fl+ e (fl* (fl* 0.5 (body-mass o1)) [e (fl+ e (fl* (fl* 0.5 (body-mass o1))
(fl+ (fl+ (fl* (body-vx o1) (body-vx o1)) (fl+ (fl+ (fl* (body-vx o1) (body-vx o1))
(fl* (body-vy o1) (body-vy o1))) (fl* (body-vy o1) (body-vy o1)))
@ -116,7 +116,7 @@ Correct output N = 1000 is
(let loop-i ([i (unsafe-fx+ o 1)] [e e]) (let loop-i ([i (unsafe-fx+ o 1)] [e e])
(if (unsafe-fx= i *system-size*) (if (unsafe-fx= i *system-size*)
(loop-o (unsafe-fx+ o 1) e) (loop-o (unsafe-fx+ o 1) e)
(let* ([i1 (unsafe-vector-ref *system* i)] (let* ([i1 (unsafe-vector*-ref *system* i)]
[dx (fl- (body-x o1) (body-x i1))] [dx (fl- (body-x o1) (body-x i1))]
[dy (fl- (body-y o1) (body-y i1))] [dy (fl- (body-y o1) (body-y i1))]
[dz (fl- (body-z o1) (body-z i1))] [dz (fl- (body-z o1) (body-z i1))]
@ -128,13 +128,13 @@ Correct output N = 1000 is
(define (advance) (define (advance)
(let loop-o ([o 0]) (let loop-o ([o 0])
(unless (unsafe-fx= o *system-size*) (unless (unsafe-fx= o *system-size*)
(let* ([o1 (unsafe-vector-ref *system* o)]) (let* ([o1 (unsafe-vector*-ref *system* o)])
(let loop-i ([i (unsafe-fx+ o 1)] (let loop-i ([i (unsafe-fx+ o 1)]
[vx (body-vx o1)] [vx (body-vx o1)]
[vy (body-vy o1)] [vy (body-vy o1)]
[vz (body-vz o1)]) [vz (body-vz o1)])
(if (unsafe-fx< i *system-size*) (if (unsafe-fx< i *system-size*)
(let* ([i1 (unsafe-vector-ref *system* i)] (let* ([i1 (unsafe-vector*-ref *system* i)]
[dx (fl- (body-x o1) (body-x i1))] [dx (fl- (body-x o1) (body-x i1))]
[dy (fl- (body-y o1) (body-y i1))] [dy (fl- (body-y o1) (body-y i1))]
[dz (fl- (body-z o1) (body-z i1))] [dz (fl- (body-z o1) (body-z i1))]

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

@ -231,9 +231,9 @@
#:pre (lambda () (set-box! b 12)) #:pre (lambda () (set-box! b 12))
#:post (lambda (x) (list x (unbox b))) #:post (lambda (x) (list x (unbox b)))
#:literal-ok? #f))) #:literal-ok? #f)))
(test-un 3 'unsafe-unbox* (chaperone-box (box 3) (test-un 3 'unsafe-unbox (chaperone-box (box 3)
(lambda (b v) v) (lambda (b v) v)
(lambda (b v) v))) (lambda (b v) v)))
(for ([star (list values (add-star "vector"))]) (for ([star (list values (add-star "vector"))])
(test-bin 5 (star 'unsafe-vector-ref) #(1 5 7) 1) (test-bin 5 (star 'unsafe-vector-ref) #(1 5 7) 1)
@ -243,13 +243,13 @@
#:pre (lambda () (vector-set! v 2 0)) #:pre (lambda () (vector-set! v 2 0))
#:post (lambda (x) (list x (vector-ref v 2))) #:post (lambda (x) (list x (vector-ref v 2)))
#:literal-ok? #f))) #:literal-ok? #f)))
(test-bin 5 'unsafe-vector*-ref (chaperone-vector #(1 5 7) (test-bin 5 'unsafe-vector-ref (chaperone-vector #(1 5 7)
(lambda (v i x) x) (lambda (v i x) x)
(lambda (v i x) x)) (lambda (v i x) x))
1) 1)
(test-un 3 'unsafe-vector*-length (chaperone-vector #(1 5 7) (test-un 3 'unsafe-vector-length (chaperone-vector #(1 5 7)
(lambda (v i x) x) (lambda (v i x) x)
(lambda (v i x) x))) (lambda (v i x) x)))
(test-bin 53 'unsafe-bytes-ref #"157" 1) (test-bin 53 'unsafe-bytes-ref #"157" 1)
(test-un 3 'unsafe-bytes-length #"157") (test-un 3 'unsafe-bytes-length #"157")

4
collects/typed-scheme/optimizer/box.rkt
View File

@ -21,8 +21,8 @@
(define-syntax-class box-op (define-syntax-class box-op
#:commit #:commit
;; we need the * versions of these unsafe operations to be chaperone-safe ;; we need the * versions of these unsafe operations to be chaperone-safe
(pattern (~literal unbox) #:with unsafe #'unsafe-unbox*) (pattern (~literal unbox) #:with unsafe #'unsafe-unbox)
(pattern (~literal set-box!) #:with unsafe #'unsafe-set-box*!)) (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box!))
(define-syntax-class box-opt-expr (define-syntax-class box-opt-expr
#:commit #:commit

4
collects/typed-scheme/optimizer/sequence.rkt
View File

@ -51,8 +51,8 @@
#:with opt #:with opt
(begin (log-optimization "in-vector" #'op) (begin (log-optimization "in-vector" #'op)
#'(let* ((i v*.opt) #'(let* ((i v*.opt)
(len (unsafe-vector*-length i))) (len (unsafe-vector-length i)))
(values (lambda (x) (unsafe-vector*-ref i x)) (values (lambda (x) (unsafe-vector-ref i x))
(lambda (x) (unsafe-fx+ 1 x)) (lambda (x) (unsafe-fx+ 1 x))
0 0
(lambda (x) (unsafe-fx< x len)) (lambda (x) (unsafe-fx< x len))

6
collects/typed-scheme/optimizer/vector.rkt
View File

@ -14,8 +14,8 @@
(define-syntax-class vector-op (define-syntax-class vector-op
#:commit #:commit
;; we need the * versions of these unsafe operations to be chaperone-safe ;; we need the * versions of these unsafe operations to be chaperone-safe
(pattern (~literal vector-ref) #:with unsafe #'unsafe-vector*-ref) (pattern (~literal vector-ref) #:with unsafe #'unsafe-vector-ref)
(pattern (~literal vector-set!) #:with unsafe #'unsafe-vector*-set!)) (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector-set!))
(define-syntax-class vector-expr (define-syntax-class vector-expr
#:commit #:commit
@ -43,7 +43,7 @@
(pattern (#%plain-app (~and op (~literal vector-length)) v:expr) (pattern (#%plain-app (~and op (~literal vector-length)) v:expr)
#:with opt #:with opt
(begin (log-optimization "vector-length" #'op) (begin (log-optimization "vector-length" #'op)
#`(unsafe-vector*-length #,((optimize) #'v)))) #`(unsafe-vector-length #,((optimize) #'v))))
;; same for flvector-length ;; same for flvector-length
(pattern (#%plain-app (~and op (~literal flvector-length)) v:expr) (pattern (#%plain-app (~and op (~literal flvector-length)) v:expr)
#:with opt #:with opt

1
doc/release-notes/racket/HISTORY.txt
View File

@ -1,6 +1,7 @@
Version 5.0.2, October 2010 Version 5.0.2, October 2010
Changed body of `when', `unless', `cond' clauses, `case' Changed body of `when', `unless', `cond' clauses, `case'
clauses, and `match' clauses to be internal-definition contexts clauses, and `match' clauses to be internal-definition contexts
Swapped unsafe-vector*-ref with unsafe-vector-ref, etc.
Added ->i to the contract library, improved ->*, adding #:pre and Added ->i to the contract library, improved ->*, adding #:pre and
#:post, as well as making the optional arguments clause optional. #:post, as well as making the optional arguments clause optional.
Added #true and #false, and changed #t/#T and #f/#F to Added #true and #false, and changed #t/#T and #f/#F to

32
src/racket/src/jit.c
View File

@ -7025,10 +7025,10 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
GC_CAN_IGNORE jit_insn *reffail, *ref; GC_CAN_IGNORE jit_insn *reffail, *ref;
int unsafe = 0, for_fl = 0, for_fx = 0, can_chaperone = 0; int unsafe = 0, for_fl = 0, for_fx = 0, can_chaperone = 0;
if (IS_NAMED_PRIM(rator, "unsafe-vector-length") if (IS_NAMED_PRIM(rator, "unsafe-vector*-length")
|| IS_NAMED_PRIM(rator, "unsafe-fxvector-length")) { || IS_NAMED_PRIM(rator, "unsafe-fxvector-length")) {
unsafe = 1; unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-length")) { } else if (IS_NAMED_PRIM(rator, "unsafe-vector-length")) {
unsafe = 1; unsafe = 1;
can_chaperone = 1; can_chaperone = 1;
} else if (IS_NAMED_PRIM(rator, "flvector-length")) { } else if (IS_NAMED_PRIM(rator, "flvector-length")) {
@ -7151,7 +7151,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
__END_TINY_JUMPS__(1); __END_TINY_JUMPS__(1);
return 1; return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-unbox")) { } else if (IS_NAMED_PRIM(rator, "unsafe-unbox*")) {
LOG_IT(("inlined unbox\n")); LOG_IT(("inlined unbox\n"));
mz_runstack_skipped(jitter, 1); mz_runstack_skipped(jitter, 1);
@ -7164,7 +7164,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
(void)jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_BOX_VAL(0x0)); (void)jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_BOX_VAL(0x0));
return 1; return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-unbox*")) { } else if (IS_NAMED_PRIM(rator, "unsafe-unbox")) {
GC_CAN_IGNORE jit_insn *ref, *ref2; GC_CAN_IGNORE jit_insn *ref, *ref2;
LOG_IT(("inlined unbox\n")); LOG_IT(("inlined unbox\n"));
@ -8215,7 +8215,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
which = 0; which = 0;
for_fx = 1; for_fx = 1;
can_chaperone = 0; can_chaperone = 0;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) { } else if (IS_NAMED_PRIM(rator, "unsafe-vector*-ref")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
can_chaperone = 0; can_chaperone = 0;
@ -8224,7 +8224,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
unsafe = 1; unsafe = 1;
can_chaperone = 0; can_chaperone = 0;
for_fx = 1; for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-ref")) { } else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "flvector-ref")) { } else if (IS_NAMED_PRIM(rator, "flvector-ref")) {
@ -8236,13 +8236,13 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
jitter->unbox = 0; jitter->unbox = 0;
} }
can_chaperone = 0; can_chaperone = 0;
} else if (IS_NAMED_PRIM(rator, "unsafe-struct-ref")) { } else if (IS_NAMED_PRIM(rator, "unsafe-struct*-ref")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots); base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
can_chaperone = 0; can_chaperone = 0;
for_struct = 1; for_struct = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-struct*-ref")) { } else if (IS_NAMED_PRIM(rator, "unsafe-struct-ref")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots); base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
@ -8482,13 +8482,13 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
return 1; return 1;
} else if (IS_NAMED_PRIM(rator, "set-box!") } else if (IS_NAMED_PRIM(rator, "set-box!")
|| IS_NAMED_PRIM(rator, "unsafe-set-box*!")) { || IS_NAMED_PRIM(rator, "unsafe-set-box!")) {
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *reffail; GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *reffail;
int unsafe; int unsafe;
LOG_IT(("inlined set-box!\n")); LOG_IT(("inlined set-box!\n"));
unsafe = IS_NAMED_PRIM(rator, "unsafe-set-box*!"); unsafe = IS_NAMED_PRIM(rator, "unsafe-set-box!");
generate_two_args(app->rand1, app->rand2, jitter, 1, 2); generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
CHECK_LIMIT(); CHECK_LIMIT();
@ -8522,8 +8522,8 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
(void)jit_movi_p(JIT_R0, scheme_void); (void)jit_movi_p(JIT_R0, scheme_void);
return 1; return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-set-box!")) { } else if (IS_NAMED_PRIM(rator, "unsafe-set-box*!")) {
LOG_IT(("inlined unsafe-set-box!\n")); LOG_IT(("inlined unsafe-set-box*!\n"));
generate_two_args(app->rand1, app->rand2, jitter, 1, 2); generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
CHECK_LIMIT(); CHECK_LIMIT();
@ -8766,7 +8766,7 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
} else if (IS_NAMED_PRIM(rator, "fxvector-set!")) { } else if (IS_NAMED_PRIM(rator, "fxvector-set!")) {
which = 0; which = 0;
for_fx = 1; for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) { } else if (IS_NAMED_PRIM(rator, "unsafe-vector*-set!")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
can_chaperone = 0; can_chaperone = 0;
@ -8775,19 +8775,19 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
unsafe = 1; unsafe = 1;
can_chaperone = 0; can_chaperone = 0;
for_fx = 1; for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-set!")) { } else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "flvector-set!")) { } else if (IS_NAMED_PRIM(rator, "flvector-set!")) {
which = 3; which = 3;
base_offset = ((int)&SCHEME_FLVEC_ELS(0x0)); base_offset = ((int)&SCHEME_FLVEC_ELS(0x0));
} else if (IS_NAMED_PRIM(rator, "unsafe-struct-set!")) { } else if (IS_NAMED_PRIM(rator, "unsafe-struct*-set!")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots); base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
can_chaperone = 0; can_chaperone = 0;
for_struct = 1; for_struct = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-struct*-set!")) { } else if (IS_NAMED_PRIM(rator, "unsafe-struct-set!")) {
which = 0; which = 0;
unsafe = 1; unsafe = 1;
base_offset = ((int)&((Scheme_Structure *)0x0)->slots); base_offset = ((int)&((Scheme_Structure *)0x0)->slots);

8
src/racket/src/list.c
View File

@ -3431,12 +3431,12 @@ static Scheme_Object *unsafe_set_mcdr (int argc, Scheme_Object *argv[])
return scheme_void; return scheme_void;
} }
static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[]) static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[])
{ {
return SCHEME_BOX_VAL(argv[0]); return SCHEME_BOX_VAL(argv[0]);
} }
static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[]) static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[])
{ {
if (SCHEME_NP_CHAPERONEP(argv[0])) if (SCHEME_NP_CHAPERONEP(argv[0]))
return chaperone_unbox(argv[0]); return chaperone_unbox(argv[0]);
@ -3444,13 +3444,13 @@ static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[])
return SCHEME_BOX_VAL(argv[0]); return SCHEME_BOX_VAL(argv[0]);
} }
static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[]) static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[])
{ {
SCHEME_BOX_VAL(argv[0]) = argv[1]; SCHEME_BOX_VAL(argv[0]) = argv[1];
return scheme_void; return scheme_void;
} }
static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[]) static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[])
{ {
if (SCHEME_NP_CHAPERONEP(argv[0])) if (SCHEME_NP_CHAPERONEP(argv[0]))
chaperone_set_box(argv[0], argv[1]); chaperone_set_box(argv[0], argv[1]);