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

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
+                       ;; use JIT-inlined operation if available:
-                           (unsafe-f64vector-ref v i)
+                       (cond
-                           (ptr-ref (TAG-ptr v) type i))
+                        [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
+                       ;; use JIT-inlined operation if available:
-                                (inexact-real? x))
+                       (cond
-                           (unsafe-f64vector-set! v i x)
+                        [(and f64? (inexact-real? x))
-                           (ptr-set! (TAG-ptr v) type i 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)))

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)

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)
+         in-flvector for/flvector for*/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))
 
+(define-vector-wraps "flvector"
+  flvector? flvector-length flvector-ref flvector-set! make-flvector
+  in-flvector*
+  in-flvector
+  for/flvector
+  for*/flvector
+  flvector-copy)

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)))))

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).
+@racket[end] (exclusive).}
-
-Returns a fresh copy of @racket[vec].}
 
 @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]

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.
 

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?]

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)

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))))

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)

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
 

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)
 

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)))

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,
+    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,59,0,72,0,79,0,82,
+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,
+64,119,104,101,110,64,108,101,116,42,72,112,97,114,97,109,101,116,101,114,105,
-116,101,114,105,122,101,66,108,101,116,114,101,99,62,111,114,65,113,117,111,116,
+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,
+101,8,32,8,31,8,30,8,29,8,28,93,8,224,158,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,
+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,
+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,50,56,54,16,4,11,11,
+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,50,56,55,93,8,224,149,85,0,0,95,
+2,20,3,1,8,101,110,118,49,51,51,48,55,93,8,224,159,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,
+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,
+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,50,57,48,93,8,224,150,85,0,0,95,9,8,224,
+1,8,101,110,118,49,51,51,49,48,93,8,224,160,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,
+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,
+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,49,51,93,8,224,151,85,0,0,18,
+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,151,85,0,0,2,
+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,

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;

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)
+        if (for_fl)
-          (void)jit_calli(bad_vector_length_code);
-        else
           (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)
+        if (for_fl)
-          (void)jit_bnei_i(reffail, JIT_R1, scheme_vector_type);
-        else
           (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, "unsafe-vector-ref")) {
+      else if (IS_NAMED_PRIM(rator, "fxvector-ref")) {
+	which = 0;
+        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 */

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

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		)

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))

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;
 

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;
 

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, 
+  vec = scheme_alloc_flvector(size);
-                                                      sizeof(Scheme_Double_Vector) 
-                                                      + ((size - 1) * sizeof(double)));
   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 *flvector (int argc, Scheme_Object *argv[])
-static Scheme_Object *shared_flvector (int argc, Scheme_Object *argv[])
 {
-  int i;
+  return do_flvector("flvector", scheme_alloc_flvector(argc), argc, argv);
-  Scheme_Double_Vector *vec;
+}
 
-  for (i = 0; i < argc; i++) {
+#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
-    if (!SCHEME_FLOATP(argv[i])) {
+static Scheme_Object *flvector (int argc, Scheme_Object *argv[])
-      scheme_wrong_type("flvector", "inexact real", i, argc, argv);
+{
-      return NULL;
+  return do_flvector("shared-flvector", scheme_alloc_shared_flvector(argc), argc, argv);
-    }
-  }
-
-  vec = alloc_shared_flvector(argc);
-
-  for (i = 0; i < argc; i++) {
-    vec->els[i] = SCHEME_FLOAT_VAL(argv[i]);
-  }
-
-  return (Scheme_Object *)vec;
 }
 #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);
   }
   
+#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;
+  return do_make_flvector("make-shared-flvector", 1, argc, argv);
-  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;
 }
 #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])

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_UNSAFE_COUNT 76
-#define EXPECTED_FLFXNUM_COUNT 60
+#define EXPECTED_FLFXNUM_COUNT 68
 #define EXPECTED_FUTURES_COUNT 5
 
 #ifdef MZSCHEME_SOMETHING_OMITTED

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[]);

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)

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

src/racket/src/type.c

@@ -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);