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

add fvectors and unsafe-{s,u}16-{ref,set!}

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-24 16:30:56 -06:00
parent 4038ce4bd1
commit c1aa594657
27 changed files with 1091 additions and 325 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/ffi/vector.rkt
View File

@ -36,7 +36,9 @@
[_TAG (id "_" "")]
[_TAG* (id "_" "*")]
[TAGname name]
[f64? (if (eq? (syntax-e #'TAG) 'f64) #'#t #'#f)])
[f64? (if (eq? (syntax-e #'TAG) 'f64) #'#t #'#f)]
[s16? (if (eq? (syntax-e #'TAG) 's16) #'#t #'#f)]
[u16? (if (eq? (syntax-e #'TAG) 'u16) #'#t #'#f)])
#'(begin
(define-struct TAG (ptr length))
(provide TAG? TAG-length (rename-out [TAG s:TAG]))
@ -57,19 +59,28 @@
(define* (TAG-ref v i)
(if (TAG? v)
(if (and (exact-nonnegative-integer? i) (< i (TAG-length v)))
(if f64? ;; use JIT-inlined operation
(unsafe-f64vector-ref v i)
(ptr-ref (TAG-ptr v) type i))
;; use JIT-inlined operation if available:
(cond
[f64? (unsafe-f64vector-ref v i)]
[s16? (unsafe-s16vector-ref v i)]
[u16? (unsafe-u16vector-ref v i)]
[else (ptr-ref (TAG-ptr v) type i)])
(error 'TAG-ref "bad index ~e for ~a bounds of 0..~e"
i 'TAG (sub1 (TAG-length v))))
(raise-type-error 'TAG-ref TAGname v)))
(define* (TAG-set! v i x)
(if (TAG? v)
(if (and (exact-nonnegative-integer? i) (< i (TAG-length v)))
(if (and f64? ;; use JIT-inlined operation
(inexact-real? x))
(unsafe-f64vector-set! v i x)
(ptr-set! (TAG-ptr v) type i x))
;; use JIT-inlined operation if available:
(cond
[(and f64? (inexact-real? x))
(unsafe-f64vector-set! v i x)]
[(and s16? (fixnum? x) (unsafe-fx<= -32768 x) (unsafe-fx<= x 32767))
(unsafe-s16vector-set! v i x)]
[(and u16? (fixnum? x) (unsafe-fx<= 0 x) (unsafe-fx<= x 65535))
(unsafe-u16vector-set! v i x)]
[else
(ptr-set! (TAG-ptr v) type i x)])
(error 'TAG-set! "bad index ~e for ~a bounds of 0..~e"
i 'TAG (sub1 (TAG-length v))))
(raise-type-error 'TAG-set! TAGname v)))

18
collects/racket/fixnum.rkt
View File

@ -1,5 +1,6 @@
#lang scheme/base
(require '#%flfxnum)
(require '#%flfxnum
"private/vector-wraps.rkt")
(provide fx->fl fl->fx
fxabs
@ -8,4 +9,17 @@
fxand fxior fxxor
fxnot fxrshift fxlshift
fx>= fx> fx= fx< fx<=
fxmin fxmax)
fxmin fxmax
fxvector? fxvector make-fxvector
shared-fxvector make-shared-fxvector
fxvector-length fxvector-ref fxvector-set!
fxvector-copy
in-fxvector for/fxvector for*/fxvector)
(define-vector-wraps "fxvector"
fxvector? fxvector-length fxvector-ref fxvector-set! make-fxvector
in-fxvector*
in-fxvector
for/fxvector
for*/fxvector
fxvector-copy)

110
collects/racket/flonum.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require '#%flfxnum (for-syntax racket/base))
(require '#%flfxnum
"private/vector-wraps.rkt")
(provide fl+ fl- fl* fl/
flabs flsqrt flexp fllog
@ -8,105 +9,16 @@
fl= fl< fl<= fl> fl>= flmin flmax
->fl fl->exact-integer
flvector? flvector make-flvector
shared-flvector make-shared-flvector
flvector-length flvector-ref flvector-set!
flvector-copy
flreal-part flimag-part make-flrectangular
in-flvector for/flvector for*/flvector shared-flvector make-shared-flvector)
(define (in-flvector* flv)
(let ((n (flvector-length flv)))
(make-do-sequence
(lambda ()
(values (lambda (i) (flvector-ref flv i))
add1
0
(lambda (i) (fx< i n))
(lambda (x) #t)
(lambda (i x) #t))))))
(define-sequence-syntax in-flvector
(lambda () (syntax in-flvector*))
(lambda (stx)
(syntax-case stx ()
(((x) (in-flvector flv-expr))
(syntax/loc stx
(() (:do-in (((v) flv-expr))
(when (not (flvector? v))
(error 'in-flvector "expecting a flvector, got ~a" v))
((i 0) (n (flvector-length v)))
(fx< i n)
(((x) (flvector-ref v i)))
#t
#t
((add1 i) n))))))))
(define (list->flvector l)
(let ((n (length l)))
(let ((v (make-flvector n)))
(for ((i (in-range n))
(x (in-list l)))
(flvector-set! v i x))
v)))
(define-syntax (for/flvector stx)
(syntax-case stx ()
((for/flvector (for-clause ...) body ...)
(syntax/loc stx
(list->flvector
(for/list (for-clause ...) body ...))))
((for/flvector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx
(let ((len length-expr))
(unless (exact-nonnegative-integer? len)
(raise-type-error 'for/flvector "exact nonnegative integer" len))
(let ((v (make-flvector len)))
(for/fold ((i 0))
(for-clause ...
#:when (< i len))
(flvector-set! v i (begin body ...))
(add1 i))
v))))))
(define-syntax (for*/flvector stx)
(syntax-case stx ()
((for*/flvector (for-clause ...) body ...)
(syntax/loc stx
(list->flvector
(for*/list (for-clause ...) body ...))))
((for*/flvector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx
(let ((len length-expr))
(unless (exact-nonnegative-integer? len)
(raise-type-error 'for*/flvector "exact nonnegative integer" len))
(let ((v (make-flvector len)))
(for*/fold ((i 0))
(for-clause ...
#:when (< i len))
(flvector-set! v i (begin body ...))
(add1 i))
v))))))
(define (flvector-copy flv [start 0] [end (and (flvector? flv) (flvector-length flv))])
(unless (flvector? flv)
(raise-type-error 'flvector-copy "flvector" flv))
(unless (exact-nonnegative-integer? start)
(raise-type-error 'flvector-copy "non-negative exact integer" start))
(unless (exact-nonnegative-integer? end)
(raise-type-error 'flvector-copy "non-negative exact integer" end))
(let ([orig-len (flvector-length flv)])
(unless (<= start end orig-len)
(unless (<= start orig-len)
(raise-mismatch-error 'flvector-copy
(format "start index ~s out of range [~a, ~a] for flvector: "
start 0 orig-len)
flv))
(raise-mismatch-error 'flvector-copy
(format "end index ~s out of range [~a, ~a] for flvector: "
end start orig-len)
flv)))
(let* ([len (- end start)]
[vec (make-flvector len)])
(for ([i (in-range len)])
(flvector-set! vec i (flvector-ref flv (+ i start))))
vec))
in-flvector for/flvector for*/flvector)
(define-vector-wraps "flvector"
flvector? flvector-length flvector-ref flvector-set! make-flvector
in-flvector*
in-flvector
for/flvector
for*/flvector
flvector-copy)

112
collects/racket/private/vector-wraps.rkt Normal file
View File

@ -0,0 +1,112 @@
#lang racket/base
(require '#%flfxnum
(for-syntax racket/base))
(provide define-vector-wraps)
(define-syntax-rule (define-vector-wraps
fXvector-str
fXvector? fXvector-length fXvector-ref fXvector-set! make-fXvector
in-fXvector*
in-fXvector
for/fXvector
for*/fXvector
fXvector-copy)
(...
(begin
(define (in-fXvector* flv)
(let ((n (fXvector-length flv)))
(make-do-sequence
(lambda ()
(values (lambda (i) (fXvector-ref flv i))
add1
0
(lambda (i) (fx< i n))
(lambda (x) #t)
(lambda (i x) #t))))))
(define-sequence-syntax in-fXvector
(lambda () (syntax in-fXvector*))
(lambda (stx)
(syntax-case stx ()
(((x) (in-fXvector flv-expr))
(syntax/loc stx
(() (:do-in (((v) flv-expr))
(when (not (fXvector? v))
(error 'in-fXvector "expecting a ~a, got ~a" fXvector-str v))
((i 0) (n (fXvector-length v)))
(fx< i n)
(((x) (fXvector-ref v i)))
#t
#t
((add1 i) n))))))))
(define (list->fXvector l)
(let ((n (length l)))
(let ((v (make-fXvector n)))
(for ((i (in-range n))
(x (in-list l)))
(fXvector-set! v i x))
v)))
(define-syntax (for/fXvector stx)
(syntax-case stx ()
((for/fXvector (for-clause ...) body ...)
(syntax/loc stx
(list->fXvector
(for/list (for-clause ...) body ...))))
((for/fXvector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx
(let ((len length-expr))
(unless (exact-nonnegative-integer? len)
(raise-type-error 'for/fXvector "exact nonnegative integer" len))
(let ((v (make-fXvector len)))
(for/fold ((i 0))
(for-clause ...
#:when (< i len))
(fXvector-set! v i (begin body ...))
(add1 i))
v))))))
(define-syntax (for*/fXvector stx)
(syntax-case stx ()
((for*/fXvector (for-clause ...) body ...)
(syntax/loc stx
(list->fXvector
(for*/list (for-clause ...) body ...))))
((for*/fXvector #:length length-expr (for-clause ...) body ...)
(syntax/loc stx
(let ((len length-expr))
(unless (exact-nonnegative-integer? len)
(raise-type-error 'for*/fXvector "exact nonnegative integer" len))
(let ((v (make-fXvector len)))
(for*/fold ((i 0))
(for-clause ...
#:when (< i len))
(fXvector-set! v i (begin body ...))
(add1 i))
v))))))
(define (fXvector-copy flv [start 0] [end (and (fXvector? flv) (fXvector-length flv))])
(unless (fXvector? flv)
(raise-type-error 'fXvector-copy fXvector-str flv))
(unless (exact-nonnegative-integer? start)
(raise-type-error 'fXvector-copy "non-negative exact integer" start))
(unless (exact-nonnegative-integer? end)
(raise-type-error 'fXvector-copy "non-negative exact integer" end))
(let ([orig-len (fXvector-length flv)])
(unless (<= start end orig-len)
(unless (<= start orig-len)
(raise-mismatch-error 'fXvector-copy
(format "start index ~s out of range [~a, ~a] for ~a: "
start 0 orig-len fXvector-str)
flv))
(raise-mismatch-error 'fXvector-copy
(format "end index ~s out of range [~a, ~a] for ~a: "
end start orig-len fXvector-str)
flv)))
(let* ([len (- end start)]
[vec (make-fXvector len)])
(for ([i (in-range len)])
(fXvector-set! vec i (fXvector-ref flv (+ i start))))
vec)))))

119
collects/scribblings/reference/numbers.scrbl
View File

@ -11,6 +11,10 @@
@(define math-eval (make-base-eval))
@(interaction-eval #:eval math-eval (require racket/math))
@(define flfx-eval (make-base-eval))
@(interaction-eval #:eval flfx-eval (require racket/fixnum))
@(interaction-eval #:eval flfx-eval (require racket/flonum))
@title[#:tag "numbers"]{Numbers}
@guideintro["numbers"]{numbers}
@ -1064,7 +1068,7 @@ Returns @racket[#t] if @racket[v] is a @tech{flvector}, @racket[#f] otherwise.}
Creates a @tech{flvector} containing the given inexact real numbers.
@mz-examples[(flvector 2.0 3.0 4.0 5.0)]}
@mz-examples[#:eval flfx-eval (flvector 2.0 3.0 4.0 5.0)]}
@defproc[(make-flvector [size exact-nonnegative-integer?]
[x inexact-real? 0.0])
@ -1073,7 +1077,7 @@ Creates a @tech{flvector} containing the given inexact real numbers.
Creates a @tech{flvector} with @racket[size] elements, where every
slot in the @tech{flvector} is filled with @racket[x].
@mz-examples[(make-flvector 4 3.0)]}
@mz-examples[#:eval flfx-eval (make-flvector 4 3.0)]}
@defproc[(flvector-length [vec flvector?]) exact-nonnegative-integer?]{
@ -1103,9 +1107,7 @@ first slot is position @racket[0], and the last slot is one less than
Creates a fresh @tech{flvector} of size @racket[(- end start)], with all of the
elements of @racket[vec] from @racket[start] (inclusive) to
@racket[end] (exclusive).
Returns a fresh copy of @racket[vec].}
@racket[end] (exclusive).}
@defproc[(in-flvector (v flvector?)) sequence?]{
@ -1126,10 +1128,10 @@ Like @scheme[for/vector] or @scheme[for*/vector], but for
@defproc[(shared-flvector [x inexact-real?] ...) flvector?]{
Creates a @tech{flvector} containing the given inexact real numbers.
When @secref["places"] are enabled, the new @tech{flvector} is
When @tech{places} are enabled, the new @tech{flvector} is
allocated in the @tech{shared memory space}.
@mz-examples[(shared-flvector 2.0 3.0 4.0 5.0)]}
@mz-examples[#:eval flfx-eval (shared-flvector 2.0 3.0 4.0 5.0)]}
@defproc[(make-shared-flvector [size exact-nonnegative-integer?]
@ -1138,10 +1140,10 @@ allocated in the @tech{shared memory space}.
Creates a @tech{flvector} with @racket[size] elements, where every
slot in the @tech{flvector} is filled with @racket[x].
When @secref["places"] are enabled, the new @tech{flvector} is
When @tech{places} are enabled, the new @tech{flvector} is
allocated in the @tech{shared memory space}.
@mz-examples[(make-shared-flvector 4 3.0)]}
@mz-examples[#:eval flfx-eval (make-shared-flvector 4 3.0)]}
@section{Fixnum Operations}
@ -1165,6 +1167,8 @@ to drop in unsafe versions of the library. Alternately, when
encountering crashes with code that uses unsafe fixnum operations, use
the @racketmodname[racket/fixnum] library to help debug the problems.
@subsection{Fixnum Arithmetic}
@deftogether[(
@defproc[(fx+ [a fixnum?] [b fixnum?]) fixnum?]
@defproc[(fx- [a fixnum?] [b fixnum?]) fixnum?]
@ -1220,6 +1224,102 @@ Safe versions of @racket[unsafe-fx=], @racket[unsafe-fx<],
Safe versions of @racket[unsafe-fx->fl] and @racket[unsafe-fl->fx].}
@subsection{Fixnum Vectors}
A @deftech{fxvector} is like a @tech{vector}, but it holds only
@tech{fixnums}. The only advantage of an @tech{fxvector} over a
@tech{vector} is that a shared version can be created with functions
like @racket[shared-fxvector].
Two @tech{fxvectors} are @racket[equal?] if they have the same length,
and if the values in corresponding slots of the @tech{fxvectors} are
@racket[equal?].
@defproc[(fxvector? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{fxvector}, @racket[#f] otherwise.}
@defproc[(fxvector [x fixnum?] ...) fxvector?]{
Creates a @tech{fxvector} containing the given @tech{fixnums}.
@mz-examples[#:eval flfx-eval (fxvector 2 3 4 5)]}
@defproc[(make-fxvector [size exact-nonnegative-integer?]
[x fixnum? 0])
fxvector?]{
Creates a @tech{fxvector} with @racket[size] elements, where every
slot in the @tech{fxvector} is filled with @racket[x].
@mz-examples[#:eval flfx-eval (make-fxvector 4 3)]}
@defproc[(fxvector-length [vec fxvector?]) exact-nonnegative-integer?]{
Returns the length of @racket[vec] (i.e., the number of slots in the
@tech{fxvector}).}
@defproc[(fxvector-ref [vec fxvector?] [pos exact-nonnegative-integer?])
fixnum?]{
Returns the @tech{fixnum} in slot @racket[pos] of
@racket[vec]. The first slot is position @racket[0], and the last slot
is one less than @racket[(fxvector-length vec)].}
@defproc[(fxvector-set! [vec fxvector?] [pos exact-nonnegative-integer?]
[x fixnum?])
fixnum?]{
Sets the @tech{fixnum} in slot @racket[pos] of @racket[vec]. The
first slot is position @racket[0], and the last slot is one less than
@racket[(fxvector-length vec)].}
@defproc[(fxvector-copy [vec fxvector?]
[start exact-nonnegative-integer? 0]
[end exact-nonnegative-integer? (vector-length v)])
fxvector?]{
Creates a fresh @tech{fxvector} of size @racket[(- end start)], with all of the
elements of @racket[vec] from @racket[start] (inclusive) to
@racket[end] (exclusive).}
@defproc[(in-fxvector (v fxvector?)) sequence?]{
Produces a sequence that gives the elements of @scheme[v] in order.
Inside a @scheme[for] form, this can be optimized to step through the
elements of @scheme[v] efficiently as in @scheme[in-list],
@scheme[in-vector], etc.}
@deftogether[(
@defform*[((for/fxvector (for-clause ...) body ...)
(for/fxvector #:length length-expr (for-clause ...) body ...))]
@defform*[((for*/fxvector (for-clause ...) body ...)
(for*/fxvector #:length length-expr (for-clause ...) body ...))])]{
Like @scheme[for/vector] or @scheme[for*/vector], but for
@tech{fxvector}s.}
@defproc[(shared-fxvector [x fixnum?] ...) fxvector?]{
Creates a @tech{fxvector} containing the given @tech{fixnums}.
When @tech{places} are enabled, the new @tech{fxvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (shared-fxvector 2 3 4 5)]}
@defproc[(make-shared-fxvector [size exact-nonnegative-integer?]
[x fixnum? 0])
fxvector?]{
Creates a @tech{fxvector} with @racket[size] elements, where every
slot in the @tech{fxvector} is filled with @racket[x].
When @tech{places} are enabled, the new @tech{fxvector} is
allocated in the @tech{shared memory space}.
@mz-examples[#:eval flfx-eval (make-shared-fxvector 4 3)]}
@; ------------------------------------------------------------------------
@section{Extra Constants and Functions}
@ -1287,3 +1387,4 @@ Hence also:
@; ----------------------------------------------------------------------
@close-eval[math-eval]
@close-eval[flfx-eval]

2
collects/scribblings/reference/places.scrbl
View File

@ -16,7 +16,7 @@
@; ----------------------------------------------------------------------
The PLT Places API enables the development of parallel programs which
@deftech{Places} enable the development of parallel programs that
take advantage of machines with multiple processors, cores, or
hardware threads.

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

@ -5,7 +5,13 @@
(only-in ffi/vector
f64vector?
f64vector-ref
f64vector-set!)))
f64vector-set!
u16vector?
u16vector-ref
u16vector-set!
s16vector?
s16vector-ref
s16vector-set!)))
@title[#:tag "unsafe"]{Unsafe Operations}
@ -257,6 +263,24 @@ Unsafe versions of @scheme[f64vector-ref] and
@scheme[f64vector-set!].}
@deftogether[(
@defproc[(unsafe-s16vector-ref [vec s16vector?] [k fixnum?]) (integer-in -32768 32767)]
@defproc[(unsafe-s16vector-set! [vec s16vector?] [k fixnum?] [n (integer-in -32768 32767)]) void?]
)]{
Unsafe versions of @scheme[s16vector-ref] and
@scheme[s16vector-set!].}
@deftogether[(
@defproc[(unsafe-u16vector-ref [vec u16vector?] [k fixnum?]) (integer-in 0 65535)]
@defproc[(unsafe-u16vector-set! [vec u16vector?] [k fixnum?] [n (integer-in 0 65535)]) void?]
)]{
Unsafe versions of @scheme[u16vector-ref] and
@scheme[u16vector-set!].}
@deftogether[(
@defproc[(unsafe-struct-ref [v (not/c chaperone?)] [k fixnum?]) any/c]
@defproc[(unsafe-struct-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?]

70
collects/tests/racket/fixnum.rktl
View File

@ -151,4 +151,74 @@
;; check a small range
(same-results/range/table)
;; ----------------------------------------
;; in-fxvector tests.
(let ((flv (fxvector 1 2 3)))
(let ((flv-seq (in-fxvector flv)))
(for ((x (in-fxvector flv))
(xseq flv-seq)
(i (in-naturals)))
(test (+ i 1) 'in-fxvector-fast x)
(test (+ i 1) 'in-fxvector-sequence xseq))))
;; for/fxvector test
(let ((flv (fxvector 1 2 3))
(flv1 (for/fxvector ((i (in-range 3))) (+ i 1)))
(flv2 (for/fxvector #:length 3 ((i (in-range 3))) (+ i 1))))
(test flv 'for/fxvector flv1)
(test flv 'for/fxvector-fast flv2))
;; for*/fxvector test
(let ((flv (fxvector 0 0 0 0 1 2 0 2 4))
(flv1 (for*/fxvector ((i (in-range 3)) (j (in-range 3))) (* 1 i j)))
(flv2 (for*/fxvector #:length 9 ((i (in-range 3)) (j (in-range 3))) (* 1 i j))))
(test flv 'for*/fxvector flv1)
(test flv 'for*/fxvector-fast flv2))
;; Test for both length too long and length too short
(let ((v (make-fxvector 3)))
(fxvector-set! v 0 0)
(fxvector-set! v 1 1)
(let ((w (for/fxvector #:length 3 ((i (in-range 2))) i)))
(test v 'for/fxvector-short-iter w)))
(let ((v (make-fxvector 10)))
(for* ((i (in-range 3))
(j (in-range 3)))
(fxvector-set! v (+ j (* i 3)) (+ 1 i j)))
(let ((w (for*/fxvector #:length 10 ((i (in-range 3)) (j (in-range 3))) (+ 1 i j))))
(test v 'for*/fxvector-short-iter w)))
(test 2 'for/fxvector-long-iter
(fxvector-length (for/fxvector #:length 2 ((i (in-range 10))) i)))
(test 5 'for*/fxvector-long-iter
(fxvector-length (for*/fxvector #:length 5 ((i (in-range 3)) (j (in-range 3))) (+ i j))))
;; Test for many body expressions
(let* ((flv (fxvector 1 2 3))
(flv2 (for/fxvector ((i (in-range 3)))
(fxvector-set! flv i (+ (fxvector-ref flv i) 1))
(fxvector-ref flv i)))
(flv3 (for/fxvector #:length 3 ((i (in-range 3)))
(fxvector-set! flv i (+ (fxvector-ref flv i) 1))
(fxvector-ref flv i))))
(test (fxvector 2 3 4) 'for/fxvector-many-body flv2)
(test (fxvector 3 4 5) 'for/fxvector-length-many-body flv3))
;; fxvector-copy test
(let ((v (fxvector 0 1 2 3)))
(let ((vc (fxvector-copy v)))
(test (fxvector-length v) 'fxvector-copy (fxvector-length vc))
(for ((vx (in-fxvector v))
(vcx (in-fxvector vc)))
(test vx 'fxvector-copy vcx))
(fxvector-set! vc 2 -10)
(test 2 'fxvector-copy (fxvector-ref v 2))
(test -10 'fxvector-copy (fxvector-ref vc 2))
(test '(2 3) 'fxvector-copy (for/list ([i (in-fxvector (fxvector-copy v 2))]) i))
(test '(2) 'fxvector-copy (for/list ([i (in-fxvector (fxvector-copy v 2 3))]) i))))
;; ----------------------------------------
(report-errs)

7
collects/tests/racket/optimize.rktl
View File

@ -552,6 +552,10 @@
(bin-exact 3.3 'flvector-ref (flvector 1.1 2.2 3.3) 2)
(un-exact 3 'flvector-length (flvector 1.1 2.2 3.3) #t)
(bin-exact 11 'fxvector-ref (fxvector 11 21 31) 0 #t)
(bin-exact 31 'fxvector-ref (fxvector 11 21 31) 2)
(un-exact 3 'fxvector-length (fxvector 11 21 31) #t)
(bin-exact #\a 'string-ref "abc\u2001" 0 #t)
(bin-exact #\b 'string-ref "abc\u2001" 1)
(bin-exact #\c 'string-ref "abc\u2001" 2)
@ -594,7 +598,8 @@
(test-setter make-vector #f 7 'vector-set! vector-set! vector-ref #t)
(test-setter make-bytes 0 7 'bytes-set! bytes-set! bytes-ref #f)
(test-setter make-string #\a #\7 'string-set! string-set! string-ref #f)
(test-setter make-flvector 1.0 7.0 'flvector-set! flvector-set! flvector-ref #f))
(test-setter make-flvector 1.0 7.0 'flvector-set! flvector-set! flvector-ref #f)
(test-setter make-fxvector 1 7 'fxvector-set! fxvector-set! fxvector-ref #f))
(let ([v (box 1)])
(check-error-message 'set-box! (eval `(lambda (x) (set-box! x 10))))

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

@ -5,6 +5,7 @@
(require scheme/unsafe/ops
scheme/flonum
scheme/fixnum
scheme/foreign)
(let ()
@ -271,6 +272,31 @@
#:post (lambda (x) (list x (f64vector-ref v 2)))
#:literal-ok? #f))
(test-bin 95 'unsafe-fxvector-ref (fxvector 10 95 187) 1)
(test-un 5 'unsafe-fxvector-length (fxvector 11 20 31 45 57))
(let ([v (fxvector 10 95 187)])
(test-tri (list (void) 274) 'unsafe-fxvector-set! v 2 274
#:pre (lambda () (fxvector-set! v 2 0))
#:post (lambda (x) (list x (fxvector-ref v 2)))
#:literal-ok? #f))
(test-bin 95 'unsafe-s16vector-ref (s16vector 10 95 187) 1)
(let ([v (s16vector 10 95 187)])
(test-tri (list (void) 274) 'unsafe-s16vector-set! v 2 274
#:pre (lambda () (s16vector-set! v 2 0))
#:post (lambda (x) (list x (s16vector-ref v 2)))
#:literal-ok? #f))
(test-bin -32768 'unsafe-s16vector-ref (s16vector 10 -32768 187) 1)
(test-bin 32767 'unsafe-s16vector-ref (s16vector 10 32767 187) 1)
(test-bin 95 'unsafe-u16vector-ref (u16vector 10 95 187) 1)
(let ([v (u16vector 10 95 187)])
(test-tri (list (void) 274) 'unsafe-u16vector-set! v 2 274
#:pre (lambda () (u16vector-set! v 2 0))
#:post (lambda (x) (list x (u16vector-ref v 2)))
#:literal-ok? #f))
(test-bin 65535 'unsafe-u16vector-ref (u16vector 10 65535 187) 1)
(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)

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

@ -1,3 +1,7 @@
Version 5.0.1.7
Added fxvectors
Added unsafe-{s,u}16-{ref,set!}
Version 5.0.1.6
Added prop:proxy-of

4
src/racket/include/scheme.h
View File

@ -432,6 +432,7 @@ typedef long (*Scheme_Secondary_Hash_Proc)(Scheme_Object *obj, void *cycle_data)
#define SCHEME_IMMUTABLE_VECTORP(obj) (SCHEME_VECTORP(obj) && SCHEME_IMMUTABLEP(obj))
#define SCHEME_FLVECTORP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_flvector_type)
#define SCHEME_FXVECTORP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_fxvector_type)
#define SCHEME_STRUCTP(obj) (SAME_TYPE(SCHEME_TYPE(obj), scheme_structure_type) || SAME_TYPE(SCHEME_TYPE(obj), scheme_proc_struct_type))
#define SCHEME_STRUCT_TYPEP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_struct_type_type)
@ -543,6 +544,9 @@ typedef long (*Scheme_Secondary_Hash_Proc)(Scheme_Object *obj, void *cycle_data)
#define SCHEME_FLVEC_SIZE(obj) (((Scheme_Double_Vector *)(obj))->size)
#define SCHEME_FLVEC_ELS(obj) (((Scheme_Double_Vector *)(obj))->els)
#define SCHEME_FXVEC_SIZE(obj) SCHEME_VEC_SIZE(obj)
#define SCHEME_FXVEC_ELS(obj) SCHEME_VEC_ELS(obj)
#define SCHEME_ENVBOX_VAL(obj) (*((Scheme_Object **)(obj)))
#define SCHEME_WEAK_BOX_VAL(obj) SCHEME_BOX_VAL(obj)

3
src/racket/src/bool.c
View File

@ -424,7 +424,8 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
goto top;
} else
return 0;
} else if (SCHEME_VECTORP(obj1)) {
} else if (SCHEME_VECTORP(obj1)
|| SCHEME_FXVECTORP(obj1)) {
# include "mzeqchk.inc"
if ((eql->for_chaperone == 1) && (!SCHEME_IMMUTABLEP(obj1)
|| !SCHEME_IMMUTABLEP(obj2)))

50
src/racket/src/cstartup.inc
View File

@ -1,44 +1,44 @@
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,54,51,0,0,0,1,0,0,10,0,13,0,
22,0,26,0,31,0,38,0,45,0,50,0,55,0,59,0,72,0,79,0,82,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,55,51,0,0,0,1,0,0,10,0,13,0,
22,0,26,0,31,0,38,0,45,0,50,0,55,0,68,0,72,0,79,0,82,
0,88,0,102,0,116,0,119,0,125,0,129,0,131,0,142,0,144,0,158,0,
165,0,187,0,189,0,203,0,14,1,43,1,54,1,65,1,75,1,111,1,144,
1,177,1,236,1,46,2,124,2,190,2,195,2,215,2,106,3,126,3,177,3,
243,3,128,4,14,5,66,5,89,5,168,5,0,0,109,7,0,0,69,35,37,
109,105,110,45,115,116,120,29,11,11,68,104,101,114,101,45,115,116,120,63,108,
101,116,64,99,111,110,100,66,117,110,108,101,115,115,66,100,101,102,105,110,101,
64,119,104,101,110,64,108,101,116,42,63,97,110,100,72,112,97,114,97,109,101,
116,101,114,105,122,101,66,108,101,116,114,101,99,62,111,114,65,113,117,111,116,
64,119,104,101,110,64,108,101,116,42,72,112,97,114,97,109,101,116,101,114,105,
122,101,63,97,110,100,66,108,101,116,114,101,99,62,111,114,65,113,117,111,116,
101,29,94,2,14,68,35,37,107,101,114,110,101,108,11,29,94,2,14,68,35,
37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105,110,63,115,116,120,
61,115,70,108,101,116,45,118,97,108,117,101,115,61,120,73,108,101,116,114,101,
99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1,20,112,97,114,97,
109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,61,118,73,100,101,
102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,141,85,0,0,95,
102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,151,85,0,0,95,
159,2,16,36,36,159,2,15,36,36,159,2,15,36,36,16,20,2,4,2,2,
2,6,2,2,2,7,2,2,2,8,2,2,2,9,2,2,2,10,2,2,2,
5,2,2,2,11,2,2,2,12,2,2,2,13,2,2,97,37,11,8,240,141,
11,2,2,2,5,2,2,2,12,2,2,2,13,2,2,97,37,11,8,240,151,
85,0,0,93,159,2,15,36,37,16,2,2,3,161,2,2,37,2,3,2,2,
2,3,96,38,11,8,240,141,85,0,0,16,0,96,11,11,8,240,141,85,0,
2,3,96,38,11,8,240,151,85,0,0,16,0,96,11,11,8,240,151,85,0,
0,16,0,13,16,4,36,29,11,11,2,2,11,18,16,2,99,64,104,101,114,
101,8,32,8,31,8,30,8,29,8,28,93,8,224,148,85,0,0,95,9,8,
224,148,85,0,0,2,2,27,248,22,150,4,195,249,22,143,4,80,158,39,36,
101,8,32,8,31,8,30,8,29,8,28,93,8,224,158,85,0,0,95,9,8,
224,158,85,0,0,2,2,27,248,22,150,4,195,249,22,143,4,80,158,39,36,
251,22,82,2,17,248,22,97,199,12,249,22,72,2,18,248,22,99,201,27,248,
22,150,4,195,249,22,143,4,80,158,39,36,251,22,82,2,17,248,22,97,199,
249,22,72,2,18,248,22,99,201,12,27,248,22,74,248,22,150,4,196,28,248,
22,80,193,20,15,159,37,36,37,28,248,22,80,248,22,74,194,248,22,73,193,
249,22,143,4,80,158,39,36,251,22,82,2,17,248,22,73,199,249,22,72,2,
10,248,22,74,201,11,18,16,2,101,10,8,32,8,31,8,30,8,29,8,28,
16,4,11,11,2,19,3,1,8,101,110,118,49,51,50,56,54,16,4,11,11,
2,20,3,1,8,101,110,118,49,51,50,56,55,93,8,224,149,85,0,0,95,
9,8,224,149,85,0,0,2,2,27,248,22,74,248,22,150,4,196,28,248,22,
11,248,22,74,201,11,18,16,2,101,10,8,32,8,31,8,30,8,29,8,28,
16,4,11,11,2,19,3,1,8,101,110,118,49,51,51,48,54,16,4,11,11,
2,20,3,1,8,101,110,118,49,51,51,48,55,93,8,224,159,85,0,0,95,
9,8,224,159,85,0,0,2,2,27,248,22,74,248,22,150,4,196,28,248,22,
80,193,20,15,159,37,36,37,28,248,22,80,248,22,74,194,248,22,73,193,249,
22,143,4,80,158,39,36,250,22,82,2,21,248,22,82,249,22,82,248,22,82,
2,22,248,22,73,201,251,22,82,2,17,2,22,2,22,249,22,72,2,13,248,
22,74,204,18,16,2,101,11,8,32,8,31,8,30,8,29,8,28,16,4,11,
11,2,19,3,1,8,101,110,118,49,51,50,56,57,16,4,11,11,2,20,3,
1,8,101,110,118,49,51,50,57,48,93,8,224,150,85,0,0,95,9,8,224,
150,85,0,0,2,2,248,22,150,4,193,27,248,22,150,4,194,249,22,72,248,
11,2,19,3,1,8,101,110,118,49,51,51,48,57,16,4,11,11,2,20,3,
1,8,101,110,118,49,51,51,49,48,93,8,224,160,85,0,0,95,9,8,224,
160,85,0,0,2,2,248,22,150,4,193,27,248,22,150,4,194,249,22,72,248,
22,82,248,22,73,196,248,22,74,195,27,248,22,74,248,22,150,4,23,197,1,
249,22,143,4,80,158,39,36,28,248,22,57,248,22,144,4,248,22,73,23,198,
2,27,249,22,2,32,0,89,162,8,44,37,43,9,222,33,40,248,22,150,4,
@ -67,9 +67,9 @@
26,248,22,74,202,251,22,82,2,17,28,249,22,191,8,248,22,144,4,248,22,
73,200,64,101,108,115,101,10,248,22,73,197,250,22,83,2,21,9,248,22,74,
200,249,22,72,2,5,248,22,74,202,100,8,32,8,31,8,30,8,29,8,28,
16,4,11,11,2,19,3,1,8,101,110,118,49,51,51,49,50,16,4,11,11,
2,20,3,1,8,101,110,118,49,51,51,49,51,93,8,224,151,85,0,0,18,
16,2,158,94,10,64,118,111,105,100,8,48,95,9,8,224,151,85,0,0,2,
16,4,11,11,2,19,3,1,8,101,110,118,49,51,51,51,50,16,4,11,11,
2,20,3,1,8,101,110,118,49,51,51,51,51,93,8,224,161,85,0,0,18,
16,2,158,94,10,64,118,111,105,100,8,48,95,9,8,224,161,85,0,0,2,
2,27,248,22,74,248,22,150,4,196,249,22,143,4,80,158,39,36,28,248,22,
57,248,22,144,4,248,22,73,197,250,22,82,2,27,248,22,82,248,22,73,199,
248,22,97,198,27,248,22,144,4,248,22,73,197,250,22,82,2,27,248,22,82,
@ -84,13 +84,13 @@
36,36,20,105,159,36,16,0,16,1,33,33,10,16,5,2,6,89,162,8,44,
37,53,9,223,0,33,34,36,20,105,159,36,16,1,2,3,16,0,11,16,5,
2,8,89,162,8,44,37,53,9,223,0,33,35,36,20,105,159,36,16,1,2,
3,16,0,11,16,5,2,10,89,162,8,44,37,53,9,223,0,33,36,36,20,
3,16,0,11,16,5,2,11,89,162,8,44,37,53,9,223,0,33,36,36,20,
105,159,36,16,1,2,3,16,1,33,37,11,16,5,2,13,89,162,8,44,37,
56,9,223,0,33,38,36,20,105,159,36,16,1,2,3,16,1,33,39,11,16,
5,2,4,89,162,8,44,37,58,9,223,0,33,42,36,20,105,159,36,16,1,
2,3,16,0,11,16,5,2,12,89,162,8,44,37,53,9,223,0,33,44,36,
20,105,159,36,16,1,2,3,16,0,11,16,5,2,9,89,162,8,44,37,54,
9,223,0,33,45,36,20,105,159,36,16,1,2,3,16,0,11,16,5,2,11,
9,223,0,33,45,36,20,105,159,36,16,1,2,3,16,0,11,16,5,2,10,
89,162,8,44,37,55,9,223,0,33,46,36,20,105,159,36,16,1,2,3,16,
0,11,16,5,2,5,89,162,8,44,37,58,9,223,0,33,47,36,20,105,159,
36,16,1,2,3,16,1,33,49,11,16,5,2,7,89,162,8,44,37,54,9,
@ -99,7 +99,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 2024);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,54,72,0,0,0,1,0,0,8,0,21,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,55,72,0,0,0,1,0,0,8,0,21,0,
26,0,43,0,58,0,76,0,92,0,106,0,128,0,146,0,166,0,182,0,200,
0,231,0,4,1,26,1,40,1,46,1,60,1,65,1,75,1,83,1,111,1,
143,1,188,1,194,1,201,1,207,1,252,1,20,2,59,2,61,2,227,2,61,
@ -514,13 +514,13 @@
EVAL_ONE_SIZED_STR((char *)expr, 8641);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,54,9,0,0,0,1,0,0,10,0,16,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,55,9,0,0,0,1,0,0,10,0,16,0,
29,0,44,0,58,0,72,0,86,0,128,0,0,0,57,1,0,0,69,35,37,
98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67,35,37,117,
116,105,108,115,11,29,94,2,2,69,35,37,110,101,116,119,111,114,107,11,29,
94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2,68,35,37,101,
120,112,111,98,115,11,29,94,2,2,68,35,37,107,101,114,110,101,108,11,97,
36,11,8,240,34,86,0,0,98,159,2,3,36,36,159,2,4,36,36,159,2,
36,11,8,240,44,86,0,0,98,159,2,3,36,36,159,2,4,36,36,159,2,
5,36,36,159,2,6,36,36,159,2,7,36,36,159,2,7,36,36,16,0,159,
36,20,105,159,36,16,1,11,16,0,83,158,42,20,103,145,2,1,2,1,29,
11,11,11,11,11,18,96,11,44,44,44,36,80,158,36,36,20,105,159,36,16,
@ -534,7 +534,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 352);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,54,74,0,0,0,1,0,0,7,0,18,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,48,46,49,46,55,74,0,0,0,1,0,0,7,0,18,0,
45,0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,162,0,180,0,200,
0,212,0,228,0,251,0,7,1,38,1,45,1,50,1,55,1,60,1,65,1,
70,1,79,1,84,1,88,1,94,1,101,1,107,1,115,1,124,1,145,1,166,

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

@ -1066,6 +1066,7 @@ static long equal_hash_key(Scheme_Object *o, long k, Hash_Info *hi)
break;
}
case scheme_vector_type:
case scheme_fxvector_type:
case scheme_wrap_chunk_type:
{
int len = SCHEME_VEC_SIZE(o), i, val;
@ -1479,6 +1480,7 @@ static long equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
return v1 + v2;
}
case scheme_vector_type:
case scheme_fxvector_type:
case scheme_wrap_chunk_type:
{
int len = SCHEME_VEC_SIZE(o), i;

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

@ -150,10 +150,12 @@ SHARED_OK static void *bad_flimag_part_code, *bad_flreal_part_code, *bad_make_fl
SHARED_OK static void *unbox_code, *set_box_code;
SHARED_OK static void *bad_vector_length_code;
SHARED_OK static void *bad_flvector_length_code;
SHARED_OK static void *bad_fxvector_length_code;
SHARED_OK static void *vector_ref_code, *vector_ref_check_index_code, *vector_set_code, *vector_set_check_index_code;
SHARED_OK static void *string_ref_code, *string_ref_check_index_code, *string_set_code, *string_set_check_index_code;
SHARED_OK static void *bytes_ref_code, *bytes_ref_check_index_code, *bytes_set_code, *bytes_set_check_index_code;
SHARED_OK static void *flvector_ref_check_index_code, *flvector_set_check_index_code, *flvector_set_flonum_check_index_code;
SHARED_OK static void *fxvector_ref_code, *fxvector_ref_check_index_code, *fxvector_set_code, *fxvector_set_check_index_code;
SHARED_OK static void *struct_ref_code, *struct_set_code;
SHARED_OK static void *syntax_e_code;
SHARED_OK void *scheme_on_demand_jit_code;
@ -6702,14 +6704,17 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
return 1;
} else if (IS_NAMED_PRIM(rator, "vector-length")
|| IS_NAMED_PRIM(rator, "fxvector-length")
|| IS_NAMED_PRIM(rator, "unsafe-vector-length")
|| IS_NAMED_PRIM(rator, "unsafe-fxvector-length")
|| IS_NAMED_PRIM(rator, "unsafe-vector*-length")
|| IS_NAMED_PRIM(rator, "flvector-length")
|| IS_NAMED_PRIM(rator, "unsafe-flvector-length")) {
GC_CAN_IGNORE jit_insn *reffail, *ref;
int unsafe = 0, for_fl = 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")) {
unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-length")) {
unsafe = 1;
@ -6719,6 +6724,8 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
} else if (IS_NAMED_PRIM(rator, "unsafe-flvector-length")) {
unsafe = 1;
for_fl = 1;
} else if (IS_NAMED_PRIM(rator, "fxvector-length")) {
for_fx = 1;
} else {
can_chaperone = 1;
}
@ -6740,19 +6747,23 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
__END_TINY_JUMPS__(1);
reffail = _jit.x.pc;
if (!for_fl)
(void)jit_calli(bad_vector_length_code);
else
if (for_fl)
(void)jit_calli(bad_flvector_length_code);
else if (for_fx)
(void)jit_calli(bad_fxvector_length_code);
else
(void)jit_calli(bad_vector_length_code);
/* bad_vector_length_code may unpack a proxied object */
__START_TINY_JUMPS__(1);
mz_patch_branch(ref);
jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type);
if (!for_fl)
(void)jit_bnei_i(reffail, JIT_R1, scheme_vector_type);
else
if (for_fl)
(void)jit_bnei_i(reffail, JIT_R1, scheme_flvector_type);
else if (for_fx)
(void)jit_bnei_i(reffail, JIT_R1, scheme_fxvector_type);
else
(void)jit_bnei_i(reffail, JIT_R1, scheme_vector_type);
__END_TINY_JUMPS__(1);
} else if (can_chaperone) {
__START_TINY_JUMPS__(1);
@ -7294,7 +7305,8 @@ static int generate_binary_char(mz_jit_state *jitter, Scheme_App3_Rec *app,
static int generate_vector_op(mz_jit_state *jitter, int set, int int_ready, int base_offset,
int for_fl, int unsafe,
int unbox_flonum, int result_ignored, int can_chaperone, int for_struct)
int unbox_flonum, int result_ignored, int can_chaperone,
int for_struct, int for_fx)
/* R0 has vector. In set mode, R2 has value; if not unboxed, not unsafe, or can chaperone,
RUNSTACK has space for a temporary (intended for R2).
If int_ready, R1 has num index (for safe mode) and V1 has pre-computed offset,
@ -7323,6 +7335,8 @@ static int generate_vector_op(mz_jit_state *jitter, int set, int int_ready, int
if (set) {
if (for_struct)
(void)jit_calli(struct_set_code);
else if (for_fx)
(void)jit_calli(fxvector_set_check_index_code);
else if (!for_fl)
(void)jit_calli(vector_set_check_index_code);
else if (unbox_flonum)
@ -7332,6 +7346,8 @@ static int generate_vector_op(mz_jit_state *jitter, int set, int int_ready, int
} else {
if (for_struct)
(void)jit_calli(struct_ref_code);
else if (for_fx)
(void)jit_calli(fxvector_ref_check_index_code);
else if (!for_fl)
(void)jit_calli(vector_ref_check_index_code);
else
@ -7350,8 +7366,13 @@ static int generate_vector_op(mz_jit_state *jitter, int set, int int_ready, int
if (!unsafe) {
if (!int_ready)
(void)jit_bmci_ul(reffail, JIT_R1, 0x1);
if (set && for_fx)
(void)jit_bmci_ul(reffail, JIT_R2, 0x1);
jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Object *)0x0)->type);
if (!for_fl) {
if (for_fx) {
(void)jit_bnei_i(reffail, JIT_R2, scheme_fxvector_type);
jit_ldxi_i(JIT_R2, JIT_R0, (int)&SCHEME_FXVEC_SIZE(0x0));
} else if (!for_fl) {
(void)jit_bnei_i(reffail, JIT_R2, scheme_vector_type);
jit_ldxi_i(JIT_R2, JIT_R0, (int)&SCHEME_VEC_SIZE(0x0));
} else {
@ -7807,18 +7828,28 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
|| IS_NAMED_PRIM(rator, "unsafe-string-ref")
|| IS_NAMED_PRIM(rator, "bytes-ref")
|| IS_NAMED_PRIM(rator, "unsafe-bytes-ref")
|| IS_NAMED_PRIM(rator, "flvector-ref")) {
|| IS_NAMED_PRIM(rator, "flvector-ref")
|| IS_NAMED_PRIM(rator, "fxvector-ref")
|| IS_NAMED_PRIM(rator, "unsafe-fxvector-ref")) {
int simple;
int which, unsafe = 0, base_offset = ((int)&SCHEME_VEC_ELS(0x0));
int unbox = jitter->unbox;
int can_chaperone = 1, for_struct = 0;
int can_chaperone = 1, for_struct = 0, for_fx = 0;
if (IS_NAMED_PRIM(rator, "vector-ref"))
which = 0;
else if (IS_NAMED_PRIM(rator, "fxvector-ref")) {
which = 0;
else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) {
for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-ref")) {
which = 0;
unsafe = 1;
can_chaperone = 0;
} else if (IS_NAMED_PRIM(rator, "unsafe-fxvector-ref")) {
which = 0;
unsafe = 1;
can_chaperone = 0;
for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-ref")) {
which = 0;
unsafe = 1;
@ -7867,12 +7898,12 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
if (!which) {
/* vector-ref is relatively simple and worth inlining */
generate_vector_op(jitter, 0, 0, base_offset, 0, unsafe,
0, 0, can_chaperone, for_struct);
0, 0, can_chaperone, for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 3) {
/* flvector-ref is relatively simple and worth inlining */
generate_vector_op(jitter, 0, 0, base_offset, 1, unsafe,
unbox, 0, can_chaperone, for_struct);
unbox, 0, can_chaperone, for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 1) {
if (unsafe) {
@ -7924,12 +7955,12 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
if (!which) {
/* vector-ref is relatively simple and worth inlining */
generate_vector_op(jitter, 0, 1, base_offset, 0, unsafe,
0, 0, can_chaperone, for_struct);
0, 0, can_chaperone, for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 3) {
/* flvector-ref is relatively simple and worth inlining */
generate_vector_op(jitter, 0, 1, base_offset, 1, unsafe,
unbox, 0, can_chaperone, for_struct);
unbox, 0, can_chaperone, for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 1) {
if (unsafe) {
@ -7997,6 +8028,27 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
generate_alloc_double(jitter, 0);
}
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-s16vector-ref")
|| IS_NAMED_PRIM(rator, "unsafe-u16vector-ref")) {
int is_u;
is_u = IS_NAMED_PRIM(rator, "unsafe-u16vector-ref");
generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
jit_ldxi_p(JIT_R0, JIT_R0, (long)&(((Scheme_Structure *)0x0)->slots[0]));
jit_ldxi_p(JIT_R0, JIT_R0, (long)&SCHEME_CPTR_VAL(0x0));
jit_subi_l(JIT_R1, JIT_R1, 1);
if (is_u)
jit_ldxr_us(JIT_R0, JIT_R0, JIT_R1);
else
jit_ldxr_s(JIT_R0, JIT_R0, JIT_R1);
jit_lshi_l(JIT_R0, JIT_R0, 0x1);
jit_ori_l(JIT_R0, JIT_R0, 0x1);
return 1;
} else if (IS_NAMED_PRIM(rator, "set-mcar!")
|| IS_NAMED_PRIM(rator, "set-mcdr!")) {
@ -8312,6 +8364,8 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
|| IS_NAMED_PRIM(rator, "unsafe-vector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-vector*-set!")
|| IS_NAMED_PRIM(rator, "flvector-set!")
|| IS_NAMED_PRIM(rator, "fxvector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-fxvector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-struct-set!")
|| IS_NAMED_PRIM(rator, "unsafe-struct*-set!")
|| IS_NAMED_PRIM(rator, "string-set!")
@ -8321,14 +8375,22 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
int simple, constval, can_delay_vec, can_delay_index;
int which, unsafe = 0, base_offset = ((int)&SCHEME_VEC_ELS(0x0));
int pushed, flonum_arg;
int can_chaperone = 1, for_struct = 0;
int can_chaperone = 1, for_struct = 0, for_fx = 0;
if (IS_NAMED_PRIM(rator, "vector-set!"))
which = 0;
else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) {
else if (IS_NAMED_PRIM(rator, "fxvector-set!")) {
which = 0;
for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector-set!")) {
which = 0;
unsafe = 1;
can_chaperone = 0;
} else if (IS_NAMED_PRIM(rator, "unsafe-fxvector-set!")) {
which = 0;
unsafe = 1;
can_chaperone = 0;
for_fx = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-vector*-set!")) {
which = 0;
unsafe = 1;
@ -8484,12 +8546,14 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
if (!which) {
/* vector-set! is relatively simple and worth inlining */
generate_vector_op(jitter, 1, 0, base_offset, 0, unsafe,
flonum_arg, result_ignored, can_chaperone, for_struct);
flonum_arg, result_ignored, can_chaperone,
for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 3) {
/* flvector-set! is relatively simple and worth inlining */
generate_vector_op(jitter, 1, 0, base_offset, 1, unsafe,
flonum_arg, result_ignored, can_chaperone, for_struct);
flonum_arg, result_ignored, can_chaperone,
for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 1) {
if (unsafe) {
@ -8531,12 +8595,14 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
if (!which) {
/* vector-set! is relatively simple and worth inlining */
generate_vector_op(jitter, 1, 1, base_offset, 0, unsafe,
flonum_arg, result_ignored, can_chaperone, for_struct);
flonum_arg, result_ignored, can_chaperone,
for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 3) {
/* flvector-set! is relatively simple and worth inlining */
generate_vector_op(jitter, 1, 1, base_offset, 1, unsafe,
flonum_arg, result_ignored, can_chaperone, for_struct);
flonum_arg, result_ignored, can_chaperone,
for_struct, for_fx);
CHECK_LIMIT();
} else if (which == 1) {
if (unsafe) {
@ -8629,6 +8695,36 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
jit_stxr_d_fppop(JIT_R1, JIT_R0, JIT_FPR0);
CHECK_LIMIT();
if (!result_ignored)
(void)jit_movi_p(JIT_R0, scheme_void);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-s16vector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-u16vector-set!")) {
int is_u;
is_u = IS_NAMED_PRIM(rator, "unsafe-u16vector-set!");
generate_app(app, NULL, 3, jitter, 0, 0, 2);
CHECK_LIMIT();
mz_rs_ldxi(JIT_R2, 2);
mz_rs_ldr(JIT_R0);
mz_rs_ldxi(JIT_R1, 1);
mz_rs_inc(3); /* no sync */
mz_runstack_popped(jitter, 3);
CHECK_LIMIT();
jit_ldxi_p(JIT_R0, JIT_R0, (long)&(((Scheme_Structure *)0x0)->slots[0]));
jit_ldxi_p(JIT_R0, JIT_R0, (long)&SCHEME_CPTR_VAL(0x0));
jit_subi_l(JIT_R1, JIT_R1, 1);
jit_rshi_ul(JIT_R2, JIT_R2, 1);
if (is_u)
jit_stxr_us(JIT_R1, JIT_R0, JIT_R2);
else
jit_stxr_s(JIT_R1, JIT_R0, JIT_R2);
CHECK_LIMIT();
if (!result_ignored)
(void)jit_movi_p(JIT_R0, scheme_void);
@ -11096,6 +11192,16 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
CHECK_LIMIT();
register_sub_func(jitter, bad_flvector_length_code, scheme_false);
/* *** bad_fxvector_length_code *** */
/* R0 is argument */
bad_fxvector_length_code = jit_get_ip().ptr;
mz_prolog(JIT_R1);
jit_prepare(1);
jit_pusharg_i(JIT_R0);
(void)mz_finish(ts_scheme_fxvector_length);
CHECK_LIMIT();
register_sub_func(jitter, bad_fxvector_length_code, scheme_false);
/* *** call_original_unary_arith_code *** */
/* R0 is arg, R2 is code pointer, V1 is return address (for false);
if for branch, LOCAL2 is target address for true */
@ -11386,7 +11492,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
vector, it includes the offset to the start of the elements array.
In set mode, value is on run stack. */
for (iii = 0; iii < 2; iii++) { /* ref, set */
for (ii = 0; ii < 3; ii++) { /* vector, string, bytes */
for (ii = 0; ii < 4; ii++) { /* vector, string, bytes, fx */
for (i = 0; i < 2; i++) { /* check index? */
jit_insn *ref, *reffail;
Scheme_Type ty;
@ -11434,7 +11540,6 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
}
}
break;
default:
case 2:
ty = scheme_byte_string_type;
offset = (int)&SCHEME_BYTE_STR_VAL(0x0);
@ -11454,6 +11559,26 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
}
}
break;
default:
case 3:
ty = scheme_fxvector_type;
offset = (int)&SCHEME_VEC_ELS(0x0);
count_offset = (int)&SCHEME_VEC_SIZE(0x0);
log_elem_size = JIT_LOG_WORD_SIZE;
if (!iii) {
if (!i) {
fxvector_ref_code = code;
} else {
fxvector_ref_check_index_code = code;
}
} else {
if (!i) {
fxvector_set_code = code;
} else {
fxvector_set_check_index_code = code;
}
}
break;
}
__START_TINY_JUMPS__(1);
@ -11521,6 +11646,13 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
(void)mz_finish(ts_scheme_checked_byte_string_set);
}
break;
case 3:
if (!iii) {
(void)mz_finish(ts_scheme_checked_fxvector_ref);
} else {
(void)mz_finish(ts_scheme_checked_fxvector_set);
}
break;
}
/* doesn't return */
CHECK_LIMIT();
@ -11556,6 +11688,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
/* ref mode: */
switch (ii) {
case 0: /* vector */
case 3: /* fxvector */
jit_ldxr_p(JIT_R0, JIT_R0, JIT_V1);
break;
case 1: /* string */
@ -11581,7 +11714,9 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
/* set mode: */
jit_ldr_p(JIT_R2, JIT_RUNSTACK);
switch (ii) {
case 0: /* vector */
case 3: /* fxvector */
(void)jit_bmci_l(reffail, JIT_R2, 0x1);
case 0: /* vector, fall-though from fxvector */
jit_stxr_p(JIT_V1, JIT_R0, JIT_R2);
break;
case 1: /* string */

6
src/racket/src/jit_ts.c
View File

@ -73,6 +73,7 @@ define_ts_tt_s(scheme_make_complex, FSRC_OTHER)
define_ts_s_s(scheme_unbox, FSRC_MARKS)
define_ts_s_s(scheme_vector_length, FSRC_MARKS)
define_ts_s_s(scheme_flvector_length, FSRC_MARKS)
define_ts_s_s(scheme_fxvector_length, FSRC_MARKS)
define_ts_si_s(scheme_struct_ref, FSRC_MARKS)
define_ts_sis_v(scheme_struct_set, FSRC_MARKS)
define_ts_s_s(tail_call_with_values_from_multiple_result, FSRC_MARKS)
@ -87,6 +88,8 @@ define_ts_iS_s(scheme_checked_byte_string_ref, FSRC_MARKS)
define_ts_iS_s(scheme_checked_byte_string_set, FSRC_MARKS)
define_ts_iS_s(scheme_checked_flvector_ref, FSRC_MARKS)
define_ts_iS_s(scheme_checked_flvector_set, FSRC_MARKS)
define_ts_iS_s(scheme_checked_fxvector_ref, FSRC_MARKS)
define_ts_iS_s(scheme_checked_fxvector_set, FSRC_MARKS)
define_ts_iS_s(scheme_checked_syntax_e, FSRC_MARKS)
define_ts_iS_s(scheme_extract_checked_procedure, FSRC_MARKS)
define_ts_S_s(apply_checked_fail, FSRC_MARKS)
@ -145,6 +148,7 @@ define_ts_siS_v(wrong_argument_count, FSRC_MARKS)
# define ts_scheme_set_box scheme_set_box
# define ts_scheme_vector_length scheme_vector_length
# define ts_scheme_flvector_length scheme_flvector_length
# define ts_scheme_fxvector_length scheme_fxvector_length
# define ts_scheme_struct_ref scheme_struct_ref
# define ts_scheme_struct_set scheme_struct_set
# define ts_tail_call_with_values_from_multiple_result tail_call_with_values_from_multiple_result
@ -159,6 +163,8 @@ define_ts_siS_v(wrong_argument_count, FSRC_MARKS)
# define ts_scheme_checked_byte_string_set scheme_checked_byte_string_set
# define ts_scheme_checked_flvector_ref scheme_checked_flvector_ref
# define ts_scheme_checked_flvector_set scheme_checked_flvector_set
# define ts_scheme_checked_fxvector_ref scheme_checked_fxvector_ref
# define ts_scheme_checked_fxvector_set scheme_checked_fxvector_set
# define ts_scheme_checked_syntax_e scheme_checked_syntax_e
# define ts_scheme_extract_checked_procedure scheme_extract_checked_procedure
# define ts_apply_checked_fail apply_checked_fail

3
src/racket/src/lightning/i386/asm.h
View File

@ -265,6 +265,7 @@ typedef _uc jit_insn;
#define _qO_r_XB( OP ,R ,MD,MB,MI,MS ) ( _qO ( OP,R,0,MB),_qr_X(R,MD,MB,MI,MS) )
#define _qO_r_Xd( OP ,R ,MD,MB,MI,MS ) ( _qOd ( OP,R,0,MB),_qr_X(R,MD,MB,MI,MS) )
#define _OO_r_X( OP ,R ,MD,MB,MI,MS ) ( _OO ( OP ),_r_X( R ,MD,MB,MI,MS) )
#define _qOO_r_X( OP ,R ,MD,MB,MI,MS ) ( _qOO ( OP ),_r_X( R ,MD,MB,MI,MS) )
#define _O_r_X_B( OP ,R ,MD,MB,MI,MS,B ) ( _O ( OP ),_r_X( R ,MD,MB,MI,MS) ,_jit_B(B) )
#define _O_r_X_W( OP ,R ,MD,MB,MI,MS,W ) ( _O ( OP ),_r_X( R ,MD,MB,MI,MS) ,_jit_W(W) )
#define _O_r_X_L( OP ,R ,MD,MB,MI,MS,L ) ( _O ( OP ),_r_X( R ,MD,MB,MI,MS) ,_jit_I(L) )
@ -706,6 +707,8 @@ typedef _uc jit_insn;
#define MOVSWLrr(RS, RD) _OO_Mrm (0x0fbf ,_b11,_r1(RD),_r1(RS) )
#define MOVSWLmr(MD, MB, MI, MS, RD) _OO_r_X (0x0fbf ,_r1(RD) ,MD,MB,MI,MS )
#define MOVSWQmr(MD, MB, MI, MS, RD) _qOO_r_X (0x0fbf ,_r1(RD) ,MD,MB,MI,MS )
#define MULBr(RS) _O_Mrm (0xf6 ,_b11,_b100 ,_r1(RS) )
#define MULBm(MD,MB,MI,MS) _O_r_X (0xf6 ,_b100 ,MD,MB,MI,MS )

2
src/racket/src/lightning/i386/core.h
View File

@ -596,7 +596,7 @@ static long _CHECK_TINY(long diff) { if ((diff < -128) || (diff > 127)) *(long *
#define jit_ldi_s(d, is) MOVSWLmr((is), 0, 0, 0, (d))
#define jit_ldr_s(d, rs) MOVSWLmr(0, (rs), 0, 0, (d))
#define jit_ldxr_s(d, s1, s2) MOVSWLmr(0, (s1), (s2), 1, (d))
#define jit_ldxr_s(d, s1, s2) MOVSWQmr(0, (s1), (s2), 1, (d))
#define jit_ldxi_s(d, rs, is) MOVSWLmr((is), (rs), 0, 0, (d))
#define jit_ldi_us(d, is) MOVZWLmr((is), 0, 0, 0, (d))

28
src/racket/src/mzmark.c
View File

@ -1453,6 +1453,34 @@ static int vector_obj_FIXUP(void *p, struct NewGC *gc) {
#define vector_obj_IS_CONST_SIZE 0
static int fxvector_obj_SIZE(void *p, struct NewGC *gc) {
Scheme_Vector *vec = (Scheme_Vector *)p;
return
gcBYTES_TO_WORDS((sizeof(Scheme_Vector)
+ ((vec->size - 1) * sizeof(Scheme_Object *))));
}
static int fxvector_obj_MARK(void *p, struct NewGC *gc) {
Scheme_Vector *vec = (Scheme_Vector *)p;
return
gcBYTES_TO_WORDS((sizeof(Scheme_Vector)
+ ((vec->size - 1) * sizeof(Scheme_Object *))));
}
static int fxvector_obj_FIXUP(void *p, struct NewGC *gc) {
Scheme_Vector *vec = (Scheme_Vector *)p;
return
gcBYTES_TO_WORDS((sizeof(Scheme_Vector)
+ ((vec->size - 1) * sizeof(Scheme_Object *))));
}
#define fxvector_obj_IS_ATOMIC 1
#define fxvector_obj_IS_CONST_SIZE 0
static int flvector_obj_SIZE(void *p, struct NewGC *gc) {
Scheme_Double_Vector *vec = (Scheme_Double_Vector *)p;

9
src/racket/src/mzmarksrc.c
View File

@ -548,6 +548,15 @@ vector_obj {
+ ((vec->size - 1) * sizeof(Scheme_Object *))));
}
fxvector_obj {
Scheme_Vector *vec = (Scheme_Vector *)p;
mark:
size:
gcBYTES_TO_WORDS((sizeof(Scheme_Vector)
+ ((vec->size - 1) * sizeof(Scheme_Object *))));
}
flvector_obj {
Scheme_Double_Vector *vec = (Scheme_Double_Vector *)p;

434
src/racket/src/number.c
View File

@ -101,6 +101,15 @@ static Scheme_Object *shared_flvector (int argc, Scheme_Object *argv[]);
static Scheme_Object *make_shared_flvector (int argc, Scheme_Object *argv[]);
#endif
static Scheme_Object *fxvector (int argc, Scheme_Object *argv[]);
static Scheme_Object *fxvector_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *fxvector_length (int argc, Scheme_Object *argv[]);
static Scheme_Object *make_fxvector (int argc, Scheme_Object *argv[]);
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Object *shared_fxvector (int argc, Scheme_Object *argv[]);
static Scheme_Object *make_shared_fxvector (int argc, Scheme_Object *argv[]);
#endif
static Scheme_Object *integer_to_fl (int argc, Scheme_Object *argv[]);
static Scheme_Object *fl_to_integer (int argc, Scheme_Object *argv[]);
@ -141,6 +150,14 @@ static Scheme_Object *unsafe_flvector_length (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_flvector_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_flvector_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_fxvector_length (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_fxvector_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_fxvector_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *s16_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *s16_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *u16_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *u16_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_make_flrectangular (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_flreal_part (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_flimag_part (int argc, Scheme_Object *argv[]);
@ -580,6 +597,46 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("flvector-set!", p, env);
scheme_add_global_constant("fxvector",
scheme_make_prim_w_arity(fxvector,
"fxvector",
0, -1),
env);
scheme_add_global_constant("fxvector?",
scheme_make_folding_prim(fxvector_p,
"fxvector?",
1, 1, 1),
env);
scheme_add_global_constant("make-fxvector",
scheme_make_immed_prim(make_fxvector,
"make-fxvector",
1, 2),
env);
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
GLOBAL_PRIM_W_ARITY("shared-fxvector", shared_fxvector, 0, -1, env);
GLOBAL_PRIM_W_ARITY("make-shared-fxvector", make_shared_fxvector, 1, 2, env);
#else
GLOBAL_PRIM_W_ARITY("shared-fxvector", fxvector, 0, -1, env);
GLOBAL_PRIM_W_ARITY("make-shared-fxvector", make_fxvector, 1, 2, env);
#endif
p = scheme_make_immed_prim(fxvector_length, "fxvector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("fxvector-length", p, env);
p = scheme_make_immed_prim(scheme_checked_fxvector_ref,
"fxvector-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("fxvector-ref", p, env);
p = scheme_make_immed_prim(scheme_checked_fxvector_set,
"fxvector-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("fxvector-set!", p, env);
p = scheme_make_folding_prim(integer_to_fl, "->fl", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
@ -815,6 +872,45 @@ void scheme_init_unsafe_number(Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-flvector-set!", p, env);
p = scheme_make_immed_prim(unsafe_fxvector_length, "unsafe-fxvector-length",
1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fxvector-length", p, env);
p = scheme_make_immed_prim(unsafe_fxvector_ref, "unsafe-fxvector-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fxvector-ref", p, env);
p = scheme_make_immed_prim(unsafe_fxvector_set, "unsafe-fxvector-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-fxvector-set!", p, env);
p = scheme_make_immed_prim(s16_ref, "unsafe-s16vector-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-s16vector-ref", p, env);
p = scheme_make_immed_prim(s16_set, "unsafe-s16vector-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-s16vector-set!", p, env);
p = scheme_make_immed_prim(u16_ref, "unsafe-u16vector-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-u16vector-ref", p, env);
p = scheme_make_immed_prim(u16_set, "unsafe-u16vector-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-u16vector-set!", p, env);
p = scheme_make_folding_prim(unsafe_make_flrectangular, "unsafe-make-flrectangular", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
@ -3171,60 +3267,37 @@ static Scheme_Double_Vector *alloc_shared_flvector(long size)
void *original_gc;
original_gc = GC_switch_to_master_gc();
vec = (Scheme_Double_Vector *)scheme_malloc_fail_ok(scheme_malloc_atomic_tagged,
sizeof(Scheme_Double_Vector)
+ ((size - 1) * sizeof(double)));
vec = scheme_alloc_flvector(size);
GC_switch_back_from_master(original_gc);
vec->iso.so.type = scheme_flvector_type;
SHARED_ALLOCATED_SET(vec);
vec->size = size;
return vec;
}
#endif
static Scheme_Object *flvector (int argc, Scheme_Object *argv[])
static Scheme_Object *do_flvector (const char *name, Scheme_Double_Vector *vec, int argc, Scheme_Object *argv[])
{
int i;
Scheme_Double_Vector *vec;
for (i = 0; i < argc; i++) {
if (!SCHEME_FLOATP(argv[i])) {
scheme_wrong_type("flvector", "inexact real", i, argc, argv);
scheme_wrong_type(name, "inexact real", i, argc, argv);
return NULL;
}
}
vec = scheme_alloc_flvector(argc);
for (i = 0; i < argc; i++) {
vec->els[i] = SCHEME_FLOAT_VAL(argv[i]);
}
return (Scheme_Object *)vec;
}
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Object *shared_flvector (int argc, Scheme_Object *argv[])
static Scheme_Object *flvector (int argc, Scheme_Object *argv[])
{
int i;
Scheme_Double_Vector *vec;
return do_flvector("flvector", scheme_alloc_flvector(argc), argc, argv);
}
for (i = 0; i < argc; i++) {
if (!SCHEME_FLOATP(argv[i])) {
scheme_wrong_type("flvector", "inexact real", i, argc, argv);
return NULL;
}
}
vec = alloc_shared_flvector(argc);
for (i = 0; i < argc; i++) {
vec->els[i] = SCHEME_FLOAT_VAL(argv[i]);
}
return (Scheme_Object *)vec;
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Object *flvector (int argc, Scheme_Object *argv[])
{
return do_flvector("shared-flvector", scheme_alloc_shared_flvector(argc), argc, argv);
}
#endif
@ -3236,7 +3309,7 @@ static Scheme_Object *flvector_p (int argc, Scheme_Object *argv[])
return scheme_false;
}
static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[])
static Scheme_Object *do_make_flvector (const char *name, int as_shared, int argc, Scheme_Object *argv[])
{
Scheme_Double_Vector *vec;
long size;
@ -3245,7 +3318,7 @@ static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[])
size = SCHEME_INT_VAL(argv[0]);
else if (SCHEME_BIGNUMP(argv[0])) {
if (SCHEME_BIGPOS(argv[0])) {
scheme_raise_out_of_memory("make-flvector", NULL);
scheme_raise_out_of_memory(name, NULL);
return NULL;
} else
size = -1;
@ -3253,14 +3326,20 @@ static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[])
size = -1;
if (size < 0)
scheme_wrong_type("make-flvector", "exact non-negative integer", 0, argc, argv);
scheme_wrong_type(name, "exact non-negative integer", 0, argc, argv);
if (argc > 1) {
if (!SCHEME_FLOATP(argv[1]))
scheme_wrong_type("make-flvector", "inexact real", 1, argc, argv);
scheme_wrong_type(name, "inexact real", 1, argc, argv);
}
vec = scheme_alloc_flvector(size);
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
if (as_shared)
vec = scheme_alloc_shared_flvector(size);
else
#else
vec = scheme_alloc_flvector(size);
#endif
if (argc > 1) {
int i;
@ -3273,42 +3352,15 @@ static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[])
return (Scheme_Object *)vec;
}
static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[])
{
return do_make_flvector("make-flvector", 0, argc, argv);
}
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Object *make_shared_flvector (int argc, Scheme_Object *argv[])
{
Scheme_Double_Vector *vec;
long size;
if (SCHEME_INTP(argv[0]))
size = SCHEME_INT_VAL(argv[0]);
else if (SCHEME_BIGNUMP(argv[0])) {
if (SCHEME_BIGPOS(argv[0])) {
scheme_raise_out_of_memory("make-flvector", NULL);
return NULL;
} else
size = -1;
} else
size = -1;
if (size < 0)
scheme_wrong_type("make-flvector", "exact non-negative integer", 0, argc, argv);
if (argc > 1) {
if (!SCHEME_FLOATP(argv[1]))
scheme_wrong_type("make-flvector", "inexact real", 1, argc, argv);
}
vec = alloc_shared_flvector(size);
if (argc > 1) {
int i;
double d = SCHEME_FLOAT_VAL(argv[1]);
for (i = 0; i < size; i++) {
vec->els[i] = d;
}
}
return (Scheme_Object *)vec;
return do_make_flvector("make-shared-flvector", 1, argc, argv);
}
#endif
@ -3377,6 +3429,189 @@ Scheme_Object *scheme_checked_flvector_set (int argc, Scheme_Object *argv[])
return scheme_void;
}
/************************************************************************/
/* fxvectors */
/************************************************************************/
Scheme_Vector *scheme_alloc_fxvector(long size)
{
Scheme_Vector *vec;
vec = (Scheme_Vector *)scheme_malloc_fail_ok(scheme_malloc_atomic_tagged,
sizeof(Scheme_Vector)
+ ((size - 1) * sizeof(Scheme_Object*)));
vec->iso.so.type = scheme_fxvector_type;
vec->size = size;
return vec;
}
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Vector *alloc_shared_fxvector(long size)
{
Scheme_Vector *vec;
void *original_gc;
original_gc = GC_switch_to_master_gc();
vec = scheme_alloc_fxvector(size);
GC_switch_back_from_master(original_gc);
return vec;
}
#endif
static Scheme_Object *do_fxvector (const char *name, Scheme_Vector *vec, int argc, Scheme_Object *argv[])
{
int i;
for (i = 0; i < argc; i++) {
if (!SCHEME_INTP(argv[i])) {
scheme_wrong_type(name, "fixnum", i, argc, argv);
return NULL;
}
vec->els[i] = argv[i];
}
return (Scheme_Object *)vec;
}
static Scheme_Object *fxvector (int argc, Scheme_Object *argv[])
{
return do_fxvector("fxvector", scheme_alloc_fxvector(argc), argc, argv);
}
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Object *fxvector (int argc, Scheme_Object *argv[])
{
return do_fxvector("shared-fxvector", scheme_alloc_shared_fxvector(argc), argc, argv);
}
#endif
static Scheme_Object *fxvector_p (int argc, Scheme_Object *argv[])
{
if (SCHEME_FXVECTORP(argv[0]))
return scheme_true;
else
return scheme_false;
}
static Scheme_Object *do_make_fxvector (const char *name, int as_shared, int argc, Scheme_Object *argv[])
{
Scheme_Vector *vec;
long size;
if (SCHEME_INTP(argv[0]))
size = SCHEME_INT_VAL(argv[0]);
else if (SCHEME_BIGNUMP(argv[0])) {
if (SCHEME_BIGPOS(argv[0])) {
scheme_raise_out_of_memory(name, NULL);
return NULL;
} else
size = -1;
} else
size = -1;
if (size < 0)
scheme_wrong_type(name, "exact non-negative integer", 0, argc, argv);
if (argc > 1) {
if (!SCHEME_INTP(argv[1]))
scheme_wrong_type(name, "fixnum", 1, argc, argv);
}
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
if (as_shared)
vec = scheme_alloc_shared_fxvector(size);
else
#else
vec = scheme_alloc_fxvector(size);
#endif
{
int i;
Scheme_Object *val = ((argc > 1) ? argv[1] : scheme_make_integer(0));
for (i = 0; i < size; i++) {
vec->els[i] = val;
}
}
return (Scheme_Object *)vec;
}
static Scheme_Object *make_fxvector (int argc, Scheme_Object *argv[])
{
return do_make_fxvector("make-fxvector", 0, argc, argv);
}
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
static Scheme_Object *make_shared_fxvector (int argc, Scheme_Object *argv[])
{
return do_make_fxvector("make-shared-fxvector", 1, argc, argv);
}
#endif
Scheme_Object *scheme_fxvector_length(Scheme_Object *vec)
{
if (!SCHEME_FXVECTORP(vec))
scheme_wrong_type("fxvector-length", "fxvector", 0, 1, &vec);
return scheme_make_integer(SCHEME_FXVEC_SIZE(vec));
}
static Scheme_Object *fxvector_length (int argc, Scheme_Object *argv[])
{
return scheme_fxvector_length(argv[0]);
}
Scheme_Object *scheme_checked_fxvector_ref (int argc, Scheme_Object *argv[])
{
Scheme_Object *vec;
long len, pos;
vec = argv[0];
if (!SCHEME_FXVECTORP(vec))
scheme_wrong_type("fxvector-ref", "fxvector", 0, argc, argv);
len = SCHEME_FXVEC_SIZE(vec);
pos = scheme_extract_index("fxvector-ref", 1, argc, argv, len, 0);
if (pos >= len) {
scheme_bad_vec_index("fxvector-ref", argv[1],
"fxvector", vec,
0, len);
return NULL;
}
return SCHEME_FXVEC_ELS(vec)[pos];
}
Scheme_Object *scheme_checked_fxvector_set (int argc, Scheme_Object *argv[])
{
Scheme_Object *vec;
long len, pos;
vec = argv[0];
if (!SCHEME_FXVECTORP(vec))
scheme_wrong_type("fxvector-set!", "fxvector", 0, argc, argv);
len = SCHEME_FXVEC_SIZE(vec);
pos = scheme_extract_index("fxvector-set!", 1, argc, argv, len, 0);
if (!SCHEME_INTP(argv[2]))
scheme_wrong_type("fxvector-set!", "fixnum", 2, argc, argv);
if (pos >= len) {
scheme_bad_vec_index("fxvector-set!", argv[1],
"fxvector", vec,
0, len);
return NULL;
}
SCHEME_FXVEC_ELS(vec)[pos] = argv[2];
return scheme_void;
}
/************************************************************************/
/* Unsafe */
/************************************************************************/
@ -3560,6 +3795,63 @@ static Scheme_Object *unsafe_flvector_set (int argc, Scheme_Object *argv[])
return scheme_void;
}
static Scheme_Object *unsafe_fxvector_length (int argc, Scheme_Object *argv[])
{
return scheme_make_integer(SCHEME_FXVEC_SIZE(argv[0]));
}
static Scheme_Object *unsafe_fxvector_ref (int argc, Scheme_Object *argv[])
{
long pos;
pos = SCHEME_INT_VAL(argv[1]);
return SCHEME_FXVEC_ELS(argv[0])[pos];
}
static Scheme_Object *unsafe_fxvector_set (int argc, Scheme_Object *argv[])
{
long pos;
pos = SCHEME_INT_VAL(argv[1]);
SCHEME_FXVEC_ELS(argv[0])[pos] = argv[2];
return scheme_void;
}
static Scheme_Object *s16_ref (int argc, Scheme_Object *argv[])
{
long v;
Scheme_Object *p;
p = ((Scheme_Structure *)argv[0])->slots[0];
v = ((short *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])];
return scheme_make_integer(v);
}
static Scheme_Object *s16_set (int argc, Scheme_Object *argv[])
{
Scheme_Object *p;
p = ((Scheme_Structure *)argv[0])->slots[0];
((short *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])] = (short)SCHEME_INT_VAL(argv[2]);
return scheme_void;
}
static Scheme_Object *u16_ref (int argc, Scheme_Object *argv[])
{
long v;
Scheme_Object *p;
p = ((Scheme_Structure *)argv[0])->slots[0];
v = ((unsigned short *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])];
return scheme_make_integer(v);
}
static Scheme_Object *u16_set (int argc, Scheme_Object *argv[])
{
Scheme_Object *p;
p = ((Scheme_Structure *)argv[0])->slots[0];
((unsigned short *)SCHEME_CPTR_VAL(p))[SCHEME_INT_VAL(argv[1])] = (unsigned short)SCHEME_INT_VAL(argv[2]);
return scheme_void;
}
static Scheme_Object *integer_to_fl (int argc, Scheme_Object *argv[])
{
if (SCHEME_INTP(argv[0])

4
src/racket/src/schminc.h
View File

@ -14,8 +14,8 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1011
#define EXPECTED_UNSAFE_COUNT 69
#define EXPECTED_FLFXNUM_COUNT 60
#define EXPECTED_UNSAFE_COUNT 76
#define EXPECTED_FLFXNUM_COUNT 68
#define EXPECTED_FUTURES_COUNT 5
#ifdef MZSCHEME_SOMETHING_OMITTED

4
src/racket/src/schpriv.h
View File

@ -3455,6 +3455,10 @@ Scheme_Double_Vector *scheme_alloc_flvector(long size);
Scheme_Object *scheme_checked_flvector_ref(int argc, Scheme_Object **argv);
Scheme_Object *scheme_checked_flvector_set(int argc, Scheme_Object **argv);
Scheme_Object *scheme_flvector_length(Scheme_Object *v);
Scheme_Vector *scheme_alloc_fxvector(long size);
Scheme_Object *scheme_checked_fxvector_ref(int argc, Scheme_Object **argv);
Scheme_Object *scheme_checked_fxvector_set(int argc, Scheme_Object **argv);
Scheme_Object *scheme_fxvector_length(Scheme_Object *v);
Scheme_Object *scheme_checked_real_part (int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_imag_part (int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_make_rectangular (int argc, Scheme_Object *argv[]);

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.0.1.6"
#define MZSCHEME_VERSION "5.0.1.7"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 6
#define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

151
src/racket/src/stypes.h
View File

@ -176,86 +176,87 @@ enum {
scheme_prune_context_type, /* 157 */
scheme_future_type, /* 158 */
scheme_flvector_type, /* 159 */
scheme_place_type, /* 160 */
scheme_place_async_channel_type, /* 161 */
scheme_place_bi_channel_type, /* 162 */
scheme_once_used_type, /* 163 */
scheme_serialized_symbol_type, /* 164 */
scheme_serialized_structure_type, /* 165 */
scheme_fxvector_type, /* 160 */
scheme_place_type, /* 161 */
scheme_place_async_channel_type, /* 162 */
scheme_place_bi_channel_type, /* 163 */
scheme_once_used_type, /* 164 */
scheme_serialized_symbol_type, /* 165 */
scheme_serialized_structure_type, /* 166 */
#ifdef MZTAG_REQUIRED
_scheme_last_normal_type_, /* 166 */
_scheme_last_normal_type_, /* 167 */
scheme_rt_weak_array, /* 167 */
scheme_rt_weak_array, /* 168 */
scheme_rt_comp_env, /* 168*/
scheme_rt_constant_binding, /* 169 */
scheme_rt_resolve_info, /* 170 */
scheme_rt_optimize_info, /* 171 */
scheme_rt_compile_info, /* 172 */
scheme_rt_cont_mark, /* 173 */
scheme_rt_saved_stack, /* 174 */
scheme_rt_reply_item, /* 175 */
scheme_rt_closure_info, /* 176 */
scheme_rt_overflow, /* 177 */
scheme_rt_overflow_jmp, /* 178 */
scheme_rt_meta_cont, /* 179 */
scheme_rt_dyn_wind_cell, /* 180 */
scheme_rt_dyn_wind_info, /* 181 */
scheme_rt_dyn_wind, /* 182 */
scheme_rt_dup_check, /* 183 */
scheme_rt_thread_memory, /* 184 */
scheme_rt_input_file, /* 185 */
scheme_rt_input_fd, /* 186 */
scheme_rt_oskit_console_input, /* 187 */
scheme_rt_tested_input_file, /* 188 */
scheme_rt_tested_output_file, /* 189 */
scheme_rt_indexed_string, /* 190 */
scheme_rt_output_file, /* 191 */
scheme_rt_load_handler_data, /* 192 */
scheme_rt_pipe, /* 193 */
scheme_rt_beos_process, /* 194 */
scheme_rt_system_child, /* 195 */
scheme_rt_tcp, /* 196 */
scheme_rt_write_data, /* 197 */
scheme_rt_tcp_select_info, /* 198 */
scheme_rt_param_data, /* 199 */
scheme_rt_will, /* 200 */
scheme_rt_struct_proc_info, /* 201 */
scheme_rt_linker_name, /* 202 */
scheme_rt_param_map, /* 203 */
scheme_rt_finalization, /* 204 */
scheme_rt_finalizations, /* 205 */
scheme_rt_cpp_object, /* 206 */
scheme_rt_cpp_array_object, /* 207 */
scheme_rt_stack_object, /* 208 */
scheme_rt_preallocated_object, /* 209 */
scheme_thread_hop_type, /* 210 */
scheme_rt_srcloc, /* 211 */
scheme_rt_evt, /* 212 */
scheme_rt_syncing, /* 213 */
scheme_rt_comp_prefix, /* 214 */
scheme_rt_user_input, /* 215 */
scheme_rt_user_output, /* 216 */
scheme_rt_compact_port, /* 217 */
scheme_rt_read_special_dw, /* 218 */
scheme_rt_regwork, /* 219 */
scheme_rt_buf_holder, /* 220 */
scheme_rt_parameterization, /* 221 */
scheme_rt_print_params, /* 222 */
scheme_rt_read_params, /* 223 */
scheme_rt_native_code, /* 224 */
scheme_rt_native_code_plus_case, /* 225 */
scheme_rt_jitter_data, /* 226 */
scheme_rt_module_exports, /* 227 */
scheme_rt_delay_load_info, /* 228 */
scheme_rt_marshal_info, /* 229 */
scheme_rt_unmarshal_info, /* 230 */
scheme_rt_runstack, /* 231 */
scheme_rt_sfs_info, /* 232 */
scheme_rt_validate_clearing, /* 233 */
scheme_rt_rb_node, /* 234 */
scheme_rt_frozen_tramp, /* 235 */
scheme_rt_constant_binding, /* 170 */
scheme_rt_resolve_info, /* 171 */
scheme_rt_optimize_info, /* 172 */
scheme_rt_compile_info, /* 173 */
scheme_rt_cont_mark, /* 174 */
scheme_rt_saved_stack, /* 175 */
scheme_rt_reply_item, /* 176 */
scheme_rt_closure_info, /* 177 */
scheme_rt_overflow, /* 178 */
scheme_rt_overflow_jmp, /* 179 */
scheme_rt_meta_cont, /* 180 */
scheme_rt_dyn_wind_cell, /* 181 */
scheme_rt_dyn_wind_info, /* 182 */
scheme_rt_dyn_wind, /* 183 */
scheme_rt_dup_check, /* 184 */
scheme_rt_thread_memory, /* 185 */
scheme_rt_input_file, /* 186 */
scheme_rt_input_fd, /* 187 */
scheme_rt_oskit_console_input, /* 188 */
scheme_rt_tested_input_file, /* 189 */
scheme_rt_tested_output_file, /* 190 */
scheme_rt_indexed_string, /* 191 */
scheme_rt_output_file, /* 192 */
scheme_rt_load_handler_data, /* 193 */
scheme_rt_pipe, /* 194 */
scheme_rt_beos_process, /* 195 */
scheme_rt_system_child, /* 196 */
scheme_rt_tcp, /* 197 */
scheme_rt_write_data, /* 198 */
scheme_rt_tcp_select_info, /* 199 */
scheme_rt_param_data, /* 200 */
scheme_rt_will, /* 201 */
scheme_rt_struct_proc_info, /* 202 */
scheme_rt_linker_name, /* 203 */
scheme_rt_param_map, /* 204 */
scheme_rt_finalization, /* 205 */
scheme_rt_finalizations, /* 206 */
scheme_rt_cpp_object, /* 207 */
scheme_rt_cpp_array_object, /* 208 */
scheme_rt_stack_object, /* 209 */
scheme_rt_preallocated_object, /* 210 */
scheme_thread_hop_type, /* 211 */
scheme_rt_srcloc, /* 212 */
scheme_rt_evt, /* 213 */
scheme_rt_syncing, /* 214 */
scheme_rt_comp_prefix, /* 215 */
scheme_rt_user_input, /* 216 */
scheme_rt_user_output, /* 217 */
scheme_rt_compact_port, /* 218 */
scheme_rt_read_special_dw, /* 219 */
scheme_rt_regwork, /* 220 */
scheme_rt_buf_holder, /* 221 */
scheme_rt_parameterization, /* 222 */
scheme_rt_print_params, /* 223 */
scheme_rt_read_params, /* 224 */
scheme_rt_native_code, /* 225 */
scheme_rt_native_code_plus_case, /* 226 */
scheme_rt_jitter_data, /* 227 */
scheme_rt_module_exports, /* 228 */
scheme_rt_delay_load_info, /* 229 */
scheme_rt_marshal_info, /* 230 */
scheme_rt_unmarshal_info, /* 231 */
scheme_rt_runstack, /* 232 */
scheme_rt_sfs_info, /* 233 */
scheme_rt_validate_clearing, /* 234 */
scheme_rt_rb_node, /* 235 */
scheme_rt_frozen_tramp, /* 236 */
#endif

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

@ -167,6 +167,7 @@ scheme_init_type ()
set_name(scheme_macro_type, "<macro>");
set_name(scheme_vector_type, "<vector>");
set_name(scheme_flvector_type, "<flvector>");
set_name(scheme_fxvector_type, "<fxvector>");
set_name(scheme_bignum_type, "<bignum-integer>");
set_name(scheme_escaping_cont_type, "<escape-continuation>");
set_name(scheme_sema_type, "<semaphore>");
@ -552,6 +553,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_raw_pair_type, cons_cell);
GC_REG_TRAV(scheme_vector_type, vector_obj);
GC_REG_TRAV(scheme_flvector_type, flvector_obj);
GC_REG_TRAV(scheme_fxvector_type, fxvector_obj);
GC_REG_TRAV(scheme_cpointer_type, cpointer_obj);
GC_REG_TRAV(scheme_offset_cpointer_type, offset_cpointer_obj);