From c1aa594657419ae0ad8edc55925d0d5aba98038a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 24 Sep 2010 16:30:56 -0600 Subject: [PATCH] add fvectors and unsafe-{s,u}16-{ref,set!} --- collects/ffi/vector.rkt | 27 +- collects/racket/fixnum.rkt | 18 +- collects/racket/flonum.rkt | 110 +---- collects/racket/private/vector-wraps.rkt | 112 +++++ collects/scribblings/reference/numbers.scrbl | 119 ++++- collects/scribblings/reference/places.scrbl | 2 +- collects/scribblings/reference/unsafe.scrbl | 26 +- collects/tests/racket/fixnum.rktl | 70 +++ collects/tests/racket/optimize.rktl | 7 +- collects/tests/racket/unsafe.rktl | 26 ++ doc/release-notes/racket/HISTORY.txt | 4 + src/racket/include/scheme.h | 4 + src/racket/src/bool.c | 3 +- src/racket/src/cstartup.inc | 50 +-- src/racket/src/hash.c | 2 + src/racket/src/jit.c | 187 ++++++-- src/racket/src/jit_ts.c | 6 + src/racket/src/lightning/i386/asm.h | 3 + src/racket/src/lightning/i386/core.h | 2 +- src/racket/src/mzmark.c | 28 ++ src/racket/src/mzmarksrc.c | 9 + src/racket/src/number.c | 436 ++++++++++++++++--- src/racket/src/schminc.h | 4 +- src/racket/src/schpriv.h | 4 + src/racket/src/schvers.h | 4 +- src/racket/src/stypes.h | 151 +++---- src/racket/src/type.c | 2 + 27 files changed, 1091 insertions(+), 325 deletions(-) create mode 100644 collects/racket/private/vector-wraps.rkt diff --git a/collects/ffi/vector.rkt b/collects/ffi/vector.rkt index 0d7e661a15..fa9796ea48 100644 --- a/collects/ffi/vector.rkt +++ b/collects/ffi/vector.rkt @@ -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))) diff --git a/collects/racket/fixnum.rkt b/collects/racket/fixnum.rkt index ef8c74c105..1e6a6aeac7 100644 --- a/collects/racket/fixnum.rkt +++ b/collects/racket/fixnum.rkt @@ -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) \ No newline at end of file diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index 0a9869bc22..e7f4d65622 100644 --- a/collects/racket/flonum.rkt +++ b/collects/racket/flonum.rkt @@ -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) diff --git a/collects/racket/private/vector-wraps.rkt b/collects/racket/private/vector-wraps.rkt new file mode 100644 index 0000000000..9f335e6cf9 --- /dev/null +++ b/collects/racket/private/vector-wraps.rkt @@ -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))))) diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index 19e08dde8b..87eb940c5a 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/collects/scribblings/reference/numbers.scrbl @@ -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] diff --git a/collects/scribblings/reference/places.scrbl b/collects/scribblings/reference/places.scrbl index b5189c328d..aef84adfb3 100644 --- a/collects/scribblings/reference/places.scrbl +++ b/collects/scribblings/reference/places.scrbl @@ -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. diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index c7bb9566cd..17d83d1738 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/collects/scribblings/reference/unsafe.scrbl @@ -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?] diff --git a/collects/tests/racket/fixnum.rktl b/collects/tests/racket/fixnum.rktl index 7e6a0ec8bc..0c9b4f52ef 100644 --- a/collects/tests/racket/fixnum.rktl +++ b/collects/tests/racket/fixnum.rktl @@ -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) diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index 2cef0ff679..03f559bc64 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -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)))) diff --git a/collects/tests/racket/unsafe.rktl b/collects/tests/racket/unsafe.rktl index c75a3272a5..16985933f4 100644 --- a/collects/tests/racket/unsafe.rktl +++ b/collects/tests/racket/unsafe.rktl @@ -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) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 48ff6cd152..56b5843bb2 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -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 diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index a0a1db9ad0..e5b2ec1ba1 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -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) diff --git a/src/racket/src/bool.c b/src/racket/src/bool.c index 4c3052470a..9a3e021901 100644 --- a/src/racket/src/bool.c +++ b/src/racket/src/bool.c @@ -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))) diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc index 1e01c706f9..4131dae33c 100644 --- a/src/racket/src/cstartup.inc +++ b/src/racket/src/cstartup.inc @@ -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, diff --git a/src/racket/src/hash.c b/src/racket/src/hash.c index f4d12699cf..ec9c6b14b0 100644 --- a/src/racket/src/hash.c +++ b/src/racket/src/hash.c @@ -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; diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index 5575326792..7eaf8a7d54 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -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 */ diff --git a/src/racket/src/jit_ts.c b/src/racket/src/jit_ts.c index 6971e70f5b..97bb70b53f 100644 --- a/src/racket/src/jit_ts.c +++ b/src/racket/src/jit_ts.c @@ -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 diff --git a/src/racket/src/lightning/i386/asm.h b/src/racket/src/lightning/i386/asm.h index 24b0b050e5..ee8be8e757 100644 --- a/src/racket/src/lightning/i386/asm.h +++ b/src/racket/src/lightning/i386/asm.h @@ -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 ) diff --git a/src/racket/src/lightning/i386/core.h b/src/racket/src/lightning/i386/core.h index 455eab5702..72dd4bd2c6 100644 --- a/src/racket/src/lightning/i386/core.h +++ b/src/racket/src/lightning/i386/core.h @@ -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)) diff --git a/src/racket/src/mzmark.c b/src/racket/src/mzmark.c index 13efaf3ecc..0eb9d6f139 100644 --- a/src/racket/src/mzmark.c +++ b/src/racket/src/mzmark.c @@ -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; diff --git a/src/racket/src/mzmarksrc.c b/src/racket/src/mzmarksrc.c index a8b2c50ccc..27df32d713 100644 --- a/src/racket/src/mzmarksrc.c +++ b/src/racket/src/mzmarksrc.c @@ -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; diff --git a/src/racket/src/number.c b/src/racket/src/number.c index 1590530557..efae26fcbf 100644 --- a/src/racket/src/number.c +++ b/src/racket/src/number.c @@ -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]) diff --git a/src/racket/src/schminc.h b/src/racket/src/schminc.h index ffec73e7f7..5258781466 100644 --- a/src/racket/src/schminc.h +++ b/src/racket/src/schminc.h @@ -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 diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index da897daf56..a54a238c76 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -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[]); diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index ec801f25c9..2df5e2beb0 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -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) diff --git a/src/racket/src/stypes.h b/src/racket/src/stypes.h index ea6b126aab..fb8ec69451 100644 --- a/src/racket/src/stypes.h +++ b/src/racket/src/stypes.h @@ -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 diff --git a/src/racket/src/type.c b/src/racket/src/type.c index a13fc29bad..e46296ab4e 100644 --- a/src/racket/src/type.c +++ b/src/racket/src/type.c @@ -167,6 +167,7 @@ scheme_init_type () set_name(scheme_macro_type, ""); set_name(scheme_vector_type, ""); set_name(scheme_flvector_type, ""); + set_name(scheme_fxvector_type, ""); set_name(scheme_bignum_type, ""); set_name(scheme_escaping_cont_type, ""); set_name(scheme_sema_type, ""); @@ -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);