0.8.2.15:

	Add all remaining required (*ptui*) specialized arrays:
	... (UNSIGNED-BYTE {7,15,29,31});
	While we're at it, make the cross-compiling dumper more likely
		to complain if we give it weird array types; we assume
		(unsigned-byte {8,16,32}) are generally supported by
		implementations.
	Also make (ARRAY NIL) dumpable in the target compiler.
	Tested building from cmucl, openmcl, old and new sbcl on x86 and
		ppc.  Will need confirmation from other architectures.

diff --git a/NEWS b/NEWS
index d0da2bc..1b66f63 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1956,6 +1956,10 @@ changes in sbcl-0.8.3 relative to sbcl-0.8.2:
     printable.  (reported by Eric Marsden)
   * bug fix in sb-posix: mmap() now works on systems with a 64-bit
     off_t, including Darwin and FreeBSD.  (thanks to Andreas Fuchs)
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** The system now obeys the constraint imposed by
+       UPGRADED-ARRAY-ELEMENT-TYPE that the upgraded array element
+       types form a lattice under type intersection.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index cbe768d..726eda7 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1204,10 +1204,14 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
              #!+long-float "OBJECT-NOT-SIMPLE-ARRAY-LONG-FLOAT-ERROR"
             "OBJECT-NOT-SIMPLE-ARRAY-NIL-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-SINGLE-FLOAT-ERROR"
+            "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-15-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-16-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-2-ERROR"
+            "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-29-ERROR"
+            "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-31-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-32-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-4-ERROR"
+            "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-7-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-8-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-16-ERROR"
              "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-30-ERROR"
@@ -1250,10 +1254,14 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
             "SIMPLE-ARRAY-NIL-P"
              "SIMPLE-ARRAY-P"
              "SIMPLE-ARRAY-SINGLE-FLOAT-P"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-15-P"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-16-P"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-2-P"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-29-P"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-31-P"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-32-P"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-4-P"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-7-P"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-8-P"
              "SIMPLE-ARRAY-SIGNED-BYTE-16-P"
              "SIMPLE-ARRAY-SIGNED-BYTE-30-P"
@@ -2033,10 +2041,15 @@ structure representations"
              #!+long-float "SIMPLE-ARRAY-LONG-FLOAT-WIDETAG"
             "SIMPLE-ARRAY-NIL-WIDETAG"
              "SIMPLE-ARRAY-SINGLE-FLOAT-WIDETAG"
-             "SIMPLE-ARRAY-WIDETAG" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-WIDETAG"
+             "SIMPLE-ARRAY-WIDETAG"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-15-WIDETAG"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-16-WIDETAG"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-2-WIDETAG"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-29-WIDETAG"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-31-WIDETAG"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-32-WIDETAG"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-4-WIDETAG"
+            "SIMPLE-ARRAY-UNSIGNED-BYTE-7-WIDETAG"
              "SIMPLE-ARRAY-UNSIGNED-BYTE-8-WIDETAG"
              "SIMPLE-ARRAY-SIGNED-BYTE-16-WIDETAG"
              "SIMPLE-ARRAY-SIGNED-BYTE-30-WIDETAG"

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 8da8e98..fd432d4 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -1064,18 +1064,42 @@
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence)
       :prototype-form (make-array 0 :element-type '(unsigned-byte 4)))
+     (simple-array-unsigned-byte-7
+      :translation (simple-array (unsigned-byte 7) (*))
+      :codes (#.sb!vm:simple-array-unsigned-byte-7-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence)
+      :prototype-form (make-array 0 :element-type '(unsigned-byte 7)))
      (simple-array-unsigned-byte-8
       :translation (simple-array (unsigned-byte 8) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-8-widetag)
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence)
       :prototype-form (make-array 0 :element-type '(unsigned-byte 8)))
+     (simple-array-unsigned-byte-15
+      :translation (simple-array (unsigned-byte 7) (*))
+      :codes (#.sb!vm:simple-array-unsigned-byte-15-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence)
+      :prototype-form (make-array 0 :element-type '(unsigned-byte 15)))
      (simple-array-unsigned-byte-16
       :translation (simple-array (unsigned-byte 16) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence)
       :prototype-form (make-array 0 :element-type '(unsigned-byte 16)))
+     (simple-array-unsigned-byte-29
+      :translation (simple-array (unsigned-byte 29) (*))
+      :codes (#.sb!vm:simple-array-unsigned-byte-29-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence)
+      :prototype-form (make-array 0 :element-type '(unsigned-byte 29)))
+     (simple-array-unsigned-byte-31
+      :translation (simple-array (unsigned-byte 31) (*))
+      :codes (#.sb!vm:simple-array-unsigned-byte-31-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence)
+      :prototype-form (make-array 0 :element-type '(unsigned-byte 31)))
      (simple-array-unsigned-byte-32
       :translation (simple-array (unsigned-byte 32) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 22df57f..26b7234 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -449,11 +449,18 @@
     (let* ((len (fast-read-u-integer 4))
           (size (fast-read-byte))
           (res (case size
+                 (0 (make-array len :element-type 'nil))
                  (1 (make-array len :element-type 'bit))
                  (2 (make-array len :element-type '(unsigned-byte 2)))
                  (4 (make-array len :element-type '(unsigned-byte 4)))
+                 (7 (prog1 (make-array len :element-type '(unsigned-byte 7))
+                      (setf size 8)))
                  (8 (make-array len :element-type '(unsigned-byte 8)))
+                 (15 (prog1 (make-array len :element-type '(unsigned-byte 15))
+                       (setf size 16)))
                  (16 (make-array len :element-type '(unsigned-byte 16)))
+                 (31 (prog1 (make-array len :element-type '(unsigned-byte 31))
+                       (setf size 32)))
                  (32 (make-array len :element-type '(unsigned-byte 32)))
                  (t (bug "losing i-vector element size: ~S" size)))))
       (declare (type index len))
@@ -474,6 +481,7 @@
           (res (case size
                  (8 (make-array len :element-type '(signed-byte 8)))
                  (16 (make-array len :element-type '(signed-byte 16)))
+                 (29 (make-array len :element-type '(unsigned-byte 29)))
                  (30 (make-array len :element-type '(signed-byte 30)))
                  (32 (make-array len :element-type '(signed-byte 32)))
                  (t (bug "losing si-vector element size: ~S" size)))))
@@ -482,7 +490,7 @@
       (read-n-bytes *fasl-input-stream*
                    res
                    0
-                   (ceiling (the index (* (if (= size 30)
+                   (ceiling (the index (* (if (or (= size 30) (= size 29))
                                               32 ; Adjust for (signed-byte 30)
                                               size) len)) sb!vm:n-byte-bits))
       res)))

diff --git a/src/code/room.lisp b/src/code/room.lisp
index 8c7e450..0faffae 100644 (file)
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -69,11 +69,15 @@
                 (simple-vector-widetag . 2)
                 (simple-array-unsigned-byte-2-widetag . -2)
                 (simple-array-unsigned-byte-4-widetag . -1)
+                (simple-array-unsigned-byte-7-widetag . 0)
                 (simple-array-unsigned-byte-8-widetag . 0)
+                (simple-array-unsigned-byte-15-widetag . 1)
                 (simple-array-unsigned-byte-16-widetag . 1)
+                (simple-array-unsigned-byte-31-widetag . 2)
                 (simple-array-unsigned-byte-32-widetag . 2)
                 (simple-array-signed-byte-8-widetag . 0)
                 (simple-array-signed-byte-16-widetag . 1)
+                (simple-array-unsigned-byte-29-widetag . 2)
                 (simple-array-signed-byte-30-widetag . 2)
                 (simple-array-signed-byte-32-widetag . 2)
                 (simple-array-single-float-widetag . 2)

diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp
index f5587ac..09bb4fc 100644 (file)
--- a/src/compiler/alpha/array.lisp
+++ b/src/compiler/alpha/array.lisp
@@ -314,12 +314,18 @@
   (def-partial-data-vector-frobs simple-base-string base-char :byte nil
     base-char-reg)
   
+  (def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
+    :byte nil unsigned-reg signed-reg)
   (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
     :byte nil unsigned-reg signed-reg)
   
+  (def-partial-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
+    :short nil unsigned-reg signed-reg)
   (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
     :short nil unsigned-reg signed-reg)
   
+  (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
+    unsigned-reg)
   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
     unsigned-reg)
   
@@ -329,6 +335,7 @@
   (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num
     :short t signed-reg)
   
+  (def-full-data-vector-frobs simple-array-signed-byte-29 positive-fixnum any-reg)  
   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
   
   (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index bf9bfbb..43a1a1e 100644 (file)
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -277,13 +277,7 @@
 ;;; a vector whose element size is an integer multiple of output byte
 ;;; size.
 (defun coerce-to-smallest-eltype (seq)
-  (let ((maxoid ;; It's probably better to avoid (UNSIGNED-BYTE 0).
-               #-sb-xc-host 1 
-               ;; An initial value of 255 prevents us from
-               ;; specializing the array to anything smaller than
-               ;; (UNSIGNED-BYTE 8), which keeps the cross-compiler's
-               ;; portable specialized array output functions happy.
-               #+sb-xc-host 255))
+  (let ((maxoid 0))
     (flet ((frob (x)
             (if (typep x 'unsigned-byte)
                 (when (>= x maxoid)
@@ -295,18 +289,29 @@
            (frob i))
          (dovector (i seq)
            (frob i)))
-      (let ((specializer `(unsigned-byte ,(integer-length maxoid))))
+      (let ((specializer `(unsigned-byte
+                          ,(etypecase maxoid
+                             ((unsigned-byte 8) 8)
+                             ((unsigned-byte 16) 16)
+                             ((unsigned-byte 32) 32)))))
        ;; cross-compilers beware! It would be possible for the
-       ;; upgraded-array-element-type of (UNSIGNED-BYTE 15) to be
-       ;; (SIGNED-BYTE 16), and this is completely valid by
-       ;; ANSI. However, the cross-compiler doesn't know how to dump
-       ;; SIGNED-BYTE arrays, so better make it break now if it ever
-       ;; will:
+       ;; upgraded-array-element-type of (UNSIGNED-BYTE 16) to be
+       ;; (SIGNED-BYTE 17) or (UNSIGNED-BYTE 23), and this is
+       ;; completely valid by ANSI.  However, the cross-compiler
+       ;; doesn't know how to dump (in practice) anything but the
+       ;; above three specialized array types, so make it break here
+       ;; if this is violated.
        #+sb-xc-host
-       ;; not SB!XC:UPGRADED-ARRAY-ELEMENT-TYPE, because we are
-       ;; worried about whether the host's implementation of arrays.
-       (aver (subtypep (upgraded-array-element-type specializer) 
-                       'unsigned-byte))
+       (aver
+        ;; not SB!XC:UPGRADED-ARRAY-ELEMENT-TYPE, because we are
+        ;; worried about whether the host's implementation of arrays.
+        (let ((uaet (upgraded-array-element-type specializer)))
+          (dolist (et '((unsigned-byte 8)
+                        (unsigned-byte 16)
+                        (unsigned-byte 32))
+                   nil)
+            (when (and (subtypep et uaet) (subtypep uaet et))
+              (return t)))))
        (coerce seq `(simple-array ,specializer (*)))))))
 \f
 ;;;; variables

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 991dc18..4959995 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -798,9 +798,12 @@
               ;; (SIMPLE-ARRAY (UNSIGNED-BYTE 8) *).) The other cases are only
               ;; needed in the target SBCL, so we let them be handled with
               ;; unportable bit bashing.
-              (cond ((>= size 8) ; easy cases
+              (cond ((>= size 7) ; easy cases
                      (multiple-value-bind (floor rem) (floor size 8)
-                       (aver (zerop rem))
+                       (aver (or (zerop rem) (= rem 7)))
+                       (when (= rem 7)
+                         (setq size (1+ size))
+                         (setq floor (1+ floor)))
                        (dovector (i vec)
                          (dump-integer-as-n-bytes
                           (ecase sb!c:*backend-byte-order*
@@ -821,6 +824,9 @@
                 (dump-byte size file))
               (dump-raw-bytes vec bytes file)))
       (etypecase vec
+       #-sb-xc-host
+       ((simple-array nil (*))
+        (dump-unsigned-vector 0 0))
        ;; KLUDGE: What exactly does the (ASH .. -3) stuff do? -- WHN 19990902
        (simple-bit-vector
         (dump-unsigned-vector 1 (ash (+ (the index len) 7) -3)))
@@ -837,16 +843,27 @@
        #-sb-xc-host
        ((simple-array (unsigned-byte 4) (*))
         (dump-unsigned-vector 4 (ash (+ (the index (ash len 2)) 7) -3)))
+       #-sb-xc-host
+       ((simple-array (unsigned-byte 7) (*))
+        (dump-unsigned-vector 7 len))
        ((simple-array (unsigned-byte 8) (*))
         (dump-unsigned-vector 8 len))
+       #-sb-xc-host
+       ((simple-array (unsigned-byte 15) (*))
+        (dump-unsigned-vector 15 (* 2 len)))
        ((simple-array (unsigned-byte 16) (*))
         (dump-unsigned-vector 16 (* 2 len)))
+       #-sb-xc-host
+       ((simple-array (unsigned-byte 31) (*))
+        (dump-unsigned-vector 31 (* 4 len)))
        ((simple-array (unsigned-byte 32) (*))
         (dump-unsigned-vector 32 (* 4 len)))
        ((simple-array (signed-byte 8) (*))
         (dump-signed-vector 8 len))
        ((simple-array (signed-byte 16) (*))
         (dump-signed-vector 16 (* 2 len)))
+       ((simple-array (unsigned-byte 29) (*))
+        (dump-signed-vector 29 (* 4 len)))
        ((simple-array (signed-byte 30) (*))
         (dump-signed-vector 30 (* 4 len)))
        ((simple-array (signed-byte 32) (*))

diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp
index a3addaa..25c1e0f 100644 (file)
--- a/src/compiler/generic/early-objdef.lisp
+++ b/src/compiler/generic/early-objdef.lisp
@@ -78,8 +78,12 @@
   simple-vector
   simple-array-unsigned-byte-2
   simple-array-unsigned-byte-4
+  simple-array-unsigned-byte-7
   simple-array-unsigned-byte-8
+  simple-array-unsigned-byte-15
   simple-array-unsigned-byte-16
+  simple-array-unsigned-byte-29
+  simple-array-unsigned-byte-31
   simple-array-unsigned-byte-32
   simple-array-signed-byte-8
   simple-array-signed-byte-16

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index ed46288..7a06d2b 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -2125,11 +2125,18 @@
   (let* ((len (read-arg 4))
         (sizebits (read-arg 1))
         (type (case sizebits
+                (0 sb!vm:simple-array-nil-widetag)
                 (1 sb!vm:simple-bit-vector-widetag)
                 (2 sb!vm:simple-array-unsigned-byte-2-widetag)
                 (4 sb!vm:simple-array-unsigned-byte-4-widetag)
+                (7 (prog1 sb!vm:simple-array-unsigned-byte-7-widetag
+                     (setf sizebits 8)))
                 (8 sb!vm:simple-array-unsigned-byte-8-widetag)
+                (15 (prog1 sb!vm:simple-array-unsigned-byte-15-widetag
+                      (setf sizebits 16)))
                 (16 sb!vm:simple-array-unsigned-byte-16-widetag)
+                (31 (prog1 sb!vm:simple-array-unsigned-byte-31-widetag
+                      (setf sizebits 32)))
                 (32 sb!vm:simple-array-unsigned-byte-32-widetag)
                 (t (error "losing element size: ~W" sizebits))))
         (result (allocate-vector-object *dynamic* sizebits len type))

diff --git a/src/compiler/generic/vm-array.lisp b/src/compiler/generic/vm-array.lisp
index eeada76..dcf0092 100644 (file)
--- a/src/compiler/generic/vm-array.lisp
+++ b/src/compiler/generic/vm-array.lisp
@@ -94,10 +94,18 @@
                            :importance 15)
         ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4
                            :importance 14)
+        ((unsigned-byte 7) 0 8 simple-array-unsigned-byte-7
+                           :importance 13)
         ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8
          :importance 13)
+        ((unsigned-byte 15) 0 16 simple-array-unsigned-byte-15
+         :importance 12)
         ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16
          :importance 12)
+        ((unsigned-byte 29) 0 32 simple-array-unsigned-byte-29
+         :importance 8)
+        ((unsigned-byte 31) 0 32 simple-array-unsigned-byte-31
+         :importance 11)
         ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32
          :importance 11)
         ((signed-byte 8) 0 8 simple-array-signed-byte-8

diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index ed30375..04d1452 100644 (file)
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -25,8 +25,11 @@
           array-header-p
           simple-array-p simple-array-nil-p vector-nil-p
           simple-array-unsigned-byte-2-p
-          simple-array-unsigned-byte-4-p simple-array-unsigned-byte-8-p
-          simple-array-unsigned-byte-16-p simple-array-unsigned-byte-32-p
+          simple-array-unsigned-byte-4-p simple-array-unsigned-byte-7-p
+          simple-array-unsigned-byte-8-p simple-array-unsigned-byte-15-p
+          simple-array-unsigned-byte-16-p simple-array-unsigned-byte-29-p
+          simple-array-unsigned-byte-31-p
+          simple-array-unsigned-byte-32-p
           simple-array-signed-byte-8-p simple-array-signed-byte-16-p
           simple-array-signed-byte-30-p simple-array-signed-byte-32-p
           simple-array-single-float-p simple-array-double-float-p

diff --git a/src/compiler/generic/vm-typetran.lisp b/src/compiler/generic/vm-typetran.lisp
index 4a0ba1a..f80e41f 100644 (file)
--- a/src/compiler/generic/vm-typetran.lisp
+++ b/src/compiler/generic/vm-typetran.lisp
@@ -39,10 +39,18 @@
                       (simple-array (unsigned-byte 2) (*)))
 (define-type-predicate simple-array-unsigned-byte-4-p
                       (simple-array (unsigned-byte 4) (*)))
+(define-type-predicate simple-array-unsigned-byte-7-p
+                       (simple-array (unsigned-byte 7) (*)))
 (define-type-predicate simple-array-unsigned-byte-8-p
                       (simple-array (unsigned-byte 8) (*)))
+(define-type-predicate simple-array-unsigned-byte-15-p
+                       (simple-array (unsigned-byte 15) (*)))
 (define-type-predicate simple-array-unsigned-byte-16-p
                       (simple-array (unsigned-byte 16) (*)))
+(define-type-predicate simple-array-unsigned-byte-29-p
+                       (simple-array (unsigned-byte 29) (*)))
+(define-type-predicate simple-array-unsigned-byte-31-p
+                       (simple-array (unsigned-byte 31) (*)))
 (define-type-predicate simple-array-unsigned-byte-32-p
                       (simple-array (unsigned-byte 32) (*)))
 (define-type-predicate simple-array-signed-byte-8-p

diff --git a/src/compiler/hppa/array.lisp b/src/compiler/hppa/array.lisp
index 421b2e9..9c804ef 100644 (file)
--- a/src/compiler/hppa/array.lisp
+++ b/src/compiler/hppa/array.lisp
@@ -106,12 +106,18 @@
   
   (def-partial-data-vector-frobs simple-base-string base-char :byte nil base-char-reg)
   
+  (def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
+    :byte nil unsigned-reg signed-reg)
   (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
     :byte nil unsigned-reg signed-reg)
   
+  (def-partial-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
+    :short nil unsigned-reg signed-reg)
   (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
     :short nil unsigned-reg signed-reg)
   
+  (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
+    unsigned-reg)
   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
     unsigned-reg)
   
@@ -121,6 +127,7 @@
   (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num
     :short t signed-reg)
   
+  (def-full-data-vector-frobs simple-array-signed-byte-29 positive-fixnum any-reg)
   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
   
   (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num signed-reg))

diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index a3fcba1..f306dea 100644 (file)
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -679,8 +679,16 @@
                                       nil)
                                   t)))
                           :key #'car))
-            (oe-type '(mod #.max-vop-tn-refs)) ; :REF-ORDERING element type
-            (te-type '(mod #.(* max-vop-tn-refs 2))) ; :TARGETS element type
+            ;; :REF-ORDERING element type
+            ;;
+            ;; KLUDGE: was (MOD #.MAX-VOP-TN-REFS), which is still right
+            (oe-type '(unsigned-byte 8))
+            ;; :TARGETS element-type
+            ;;
+            ;; KLUDGE: was (MOD #.(* MAX-VOP-TN-REFS 2)), which does
+            ;; not correspond to the definition in
+            ;; src/compiler/vop.lisp.
+            (te-type '(unsigned-byte 16))
             (ordering (make-specializable-array
                        (length sorted)
                        :element-type oe-type)))

diff --git a/src/compiler/mips/array.lisp b/src/compiler/mips/array.lisp
index 9861300..3d63a26 100644 (file)
--- a/src/compiler/mips/array.lisp
+++ b/src/compiler/mips/array.lisp
@@ -115,12 +115,18 @@
   (def-partial-data-vector-frobs simple-base-string base-char 
     :byte nil base-char-reg)
   
+  (def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
+    :byte nil unsigned-reg signed-reg)
   (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
     :byte nil unsigned-reg signed-reg)
 
+  (def-partial-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
+    :short nil unsigned-reg signed-reg)
   (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
     :short nil unsigned-reg signed-reg)
 
+  (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
+    unsigned-reg)
   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
     unsigned-reg)
 
@@ -130,6 +136,8 @@
   (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num
     :short t signed-reg)
 
+  (def-full-data-vector-frobs simple-array-signed-byte-29 positive-fixnum
+    any-reg)
   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num
     any-reg)
 

diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp
index 5f6e1d4..a00f0ad 100644 (file)
--- a/src/compiler/ppc/array.lisp
+++ b/src/compiler/ppc/array.lisp
@@ -126,13 +126,21 @@
   (def-data-vector-frobs simple-vector word-index
     * descriptor-reg any-reg)
 
+  (def-data-vector-frobs simple-array-unsigned-byte-7 byte-index
+    positive-fixnum unsigned-reg)
   (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index
     positive-fixnum unsigned-reg)
+  (def-data-vector-frobs simple-array-unsigned-byte-15 halfword-index
+    positive-fixnum unsigned-reg)
   (def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index
     positive-fixnum unsigned-reg)
+  (def-data-vector-frobs simple-array-unsigned-byte-31 word-index
+    unsigned-num unsigned-reg)
   (def-data-vector-frobs simple-array-unsigned-byte-32 word-index
     unsigned-num unsigned-reg)
   
+  (def-data-vector-frobs simple-array-unsigned-byte-29 word-index
+    positive-fixnum any-reg)
   (def-data-vector-frobs simple-array-signed-byte-30 word-index
     tagged-num any-reg)
   (def-data-vector-frobs simple-array-signed-byte-32 word-index

diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp
index e68fe13..e48b0a0 100644 (file)
--- a/src/compiler/sparc/array.lisp
+++ b/src/compiler/sparc/array.lisp
@@ -128,13 +128,21 @@
   (def-data-vector-frobs simple-vector word-index
     * descriptor-reg any-reg)
 
+  (def-data-vector-frobs simple-array-unsigned-byte-7 byte-index
+    positive-fixnum unsigned-reg)
   (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index
     positive-fixnum unsigned-reg)
+  (def-data-vector-frobs simple-array-unsigned-byte-15 halfword-index
+    positive-fixnum unsigned-reg)
   (def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index
     positive-fixnum unsigned-reg)
+  (def-data-vector-frobs simple-array-unsigned-byte-31 word-index
+    unsigned-num unsigned-reg)
   (def-data-vector-frobs simple-array-unsigned-byte-32 word-index
     unsigned-num unsigned-reg)
 
+  (def-data-vector-frobs simple-array-unsigned-byte-29 word-index
+    positive-fixnum any-reg)
   (def-data-vector-frobs simple-array-signed-byte-30 word-index
     tagged-num any-reg)
   (def-data-vector-frobs simple-array-signed-byte-32 word-index

diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp
index 966cb7a..6d9d9a6 100644 (file)
--- a/src/compiler/x86/array.lisp
+++ b/src/compiler/x86/array.lisp
@@ -150,8 +150,11 @@
   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
     unsigned-reg)
   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
+  (def-full-data-vector-frobs simple-array-unsigned-byte-29 positive-fixnum any-reg)
   (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
-    signed-reg))
+    signed-reg)
+  (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
+    unsigned-reg))
 \f
 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
 ;;;; bit, 2-bit, and 4-bit vectors
@@ -1099,147 +1102,148 @@
       (inst fxch value-imag))))
 \f
 ;;; unsigned-byte-8
-
-(define-vop (data-vector-ref/simple-array-unsigned-byte-8)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg))
-        (index :scs (unsigned-reg)))
-  (:arg-types simple-array-unsigned-byte-8 positive-fixnum)
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 5
-    (inst movzx value
-         (make-ea :byte :base object :index index :scale 1
-                  :disp (- (* vector-data-offset n-word-bytes)
-                           other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-array-unsigned-byte-8)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg)))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30)))
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 4
-    (inst movzx value
-         (make-ea :byte :base object
-                  :disp (- (+ (* vector-data-offset n-word-bytes) index)
-                           other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-array-unsigned-byte-8)
-  (:translate data-vector-set)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to (:eval 0))
-        (index :scs (unsigned-reg) :to (:eval 0))
-        (value :scs (unsigned-reg signed-reg) :target eax))
-  (:arg-types simple-array-unsigned-byte-8 positive-fixnum positive-fixnum)
-  (:temporary (:sc unsigned-reg :offset eax-offset :target result
-                  :from (:argument 2) :to (:result 0))
-             eax)
-  (:results (result :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 5
-    (move eax value)
-    (inst mov (make-ea :byte :base object :index index :scale 1
+(macrolet ((define-data-vector-frobs (ptype)
+  `(progn
+    (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
+      (:translate data-vector-ref)
+      (:policy :fast-safe)
+      (:args (object :scs (descriptor-reg))
+             (index :scs (unsigned-reg)))
+      (:arg-types ,ptype positive-fixnum)
+      (:results (value :scs (unsigned-reg signed-reg)))
+      (:result-types positive-fixnum)
+      (:generator 5
+       (inst movzx value
+             (make-ea :byte :base object :index index :scale 1
                       :disp (- (* vector-data-offset n-word-bytes)
-                               other-pointer-lowtag))
-         al-tn)
-    (move result eax)))
-
-(define-vop (data-vector-set-c/simple-array-unsigned-byte-8)
-  (:translate data-vector-set)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to (:eval 0))
-        (value :scs (unsigned-reg signed-reg) :target eax))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30))
-             positive-fixnum)
-  (:temporary (:sc unsigned-reg :offset eax-offset :target result
-                  :from (:argument 1) :to (:result 0))
-             eax)
-  (:results (result :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 4
-    (move eax value)
-    (inst mov (make-ea :byte :base object
+                               other-pointer-lowtag)))))
+    (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
+      (:translate data-vector-ref)
+      (:policy :fast-safe)
+      (:args (object :scs (descriptor-reg)))
+      (:info index)
+      (:arg-types ,ptype (:constant (signed-byte 30)))
+      (:results (value :scs (unsigned-reg signed-reg)))
+      (:result-types positive-fixnum)
+      (:generator 4
+       (inst movzx value
+             (make-ea :byte :base object
                       :disp (- (+ (* vector-data-offset n-word-bytes) index)
-                               other-pointer-lowtag))
-         al-tn)
-    (move result eax)))
+                               other-pointer-lowtag)))))
+    (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
+      (:translate data-vector-set)
+      (:policy :fast-safe)
+      (:args (object :scs (descriptor-reg) :to (:eval 0))
+            (index :scs (unsigned-reg) :to (:eval 0))
+            (value :scs (unsigned-reg signed-reg) :target eax))
+      (:arg-types ,ptype positive-fixnum positive-fixnum)
+      (:temporary (:sc unsigned-reg :offset eax-offset :target result
+                      :from (:argument 2) :to (:result 0))
+                 eax)
+      (:results (result :scs (unsigned-reg signed-reg)))
+      (:result-types positive-fixnum)
+      (:generator 5
+       (move eax value)
+       (inst mov (make-ea :byte :base object :index index :scale 1
+                          :disp (- (* vector-data-offset n-word-bytes)
+                                   other-pointer-lowtag))
+             al-tn)
+       (move result eax)))
+    (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
+      (:translate data-vector-set)
+      (:policy :fast-safe)
+      (:args (object :scs (descriptor-reg) :to (:eval 0))
+            (value :scs (unsigned-reg signed-reg) :target eax))
+      (:info index)
+      (:arg-types ,ptype (:constant (signed-byte 30))
+                 positive-fixnum)
+      (:temporary (:sc unsigned-reg :offset eax-offset :target result
+                      :from (:argument 1) :to (:result 0))
+                 eax)
+      (:results (result :scs (unsigned-reg signed-reg)))
+      (:result-types positive-fixnum)
+      (:generator 4
+       (move eax value)
+       (inst mov (make-ea :byte :base object
+                          :disp (- (+ (* vector-data-offset n-word-bytes) index)
+                                   other-pointer-lowtag))
+             al-tn)
+       (move result eax))))))
+  (define-data-vector-frobs simple-array-unsigned-byte-7)
+  (define-data-vector-frobs simple-array-unsigned-byte-8))
 
 ;;; unsigned-byte-16
-
-(define-vop (data-vector-ref/simple-array-unsigned-byte-16)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg))
-        (index :scs (unsigned-reg)))
-  (:arg-types simple-array-unsigned-byte-16 positive-fixnum)
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 5
-    (inst movzx value
-         (make-ea :word :base object :index index :scale 2
-                  :disp (- (* vector-data-offset n-word-bytes)
-                           other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-array-unsigned-byte-16)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg)))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30)))
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 4
-    (inst movzx value
-         (make-ea :word :base object
-                  :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
-                           other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-array-unsigned-byte-16)
-  (:translate data-vector-set)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to (:eval 0))
-        (index :scs (unsigned-reg) :to (:eval 0))
-        (value :scs (unsigned-reg signed-reg) :target eax))
-  (:arg-types simple-array-unsigned-byte-16 positive-fixnum positive-fixnum)
-  (:temporary (:sc unsigned-reg :offset eax-offset :target result
-                  :from (:argument 2) :to (:result 0))
-             eax)
-  (:results (result :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 5
-    (move eax value)
-    (inst mov (make-ea :word :base object :index index :scale 2
-                      :disp (- (* vector-data-offset n-word-bytes)
-                               other-pointer-lowtag))
-         ax-tn)
-    (move result eax)))
-
-(define-vop (data-vector-set-c/simple-array-unsigned-byte-16)
-  (:translate data-vector-set)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to (:eval 0))
-        (value :scs (unsigned-reg signed-reg) :target eax))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30))
-             positive-fixnum)
-  (:temporary (:sc unsigned-reg :offset eax-offset :target result
-                  :from (:argument 1) :to (:result 0))
-             eax)
-  (:results (result :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 4
-    (move eax value)
-    (inst mov (make-ea :word :base object
-                      :disp (- (+ (* vector-data-offset n-word-bytes)
-                                  (* 2 index))
-                               other-pointer-lowtag))
-         ax-tn)
-    (move result eax)))
+(macrolet ((define-data-vector-frobs (ptype)
+    `(progn
+      (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
+       (:translate data-vector-ref)
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg))
+              (index :scs (unsigned-reg)))
+       (:arg-types ,ptype positive-fixnum)
+       (:results (value :scs (unsigned-reg signed-reg)))
+       (:result-types positive-fixnum)
+       (:generator 5
+         (inst movzx value
+               (make-ea :word :base object :index index :scale 2
+                        :disp (- (* vector-data-offset n-word-bytes)
+                                 other-pointer-lowtag)))))
+      (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
+       (:translate data-vector-ref)
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg)))
+       (:info index)
+       (:arg-types ,ptype (:constant (signed-byte 30)))
+       (:results (value :scs (unsigned-reg signed-reg)))
+       (:result-types positive-fixnum)
+       (:generator 4
+         (inst movzx value
+               (make-ea :word :base object
+                        :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
+                                 other-pointer-lowtag)))))
+      (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
+       (:translate data-vector-set)
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg) :to (:eval 0))
+              (index :scs (unsigned-reg) :to (:eval 0))
+              (value :scs (unsigned-reg signed-reg) :target eax))
+       (:arg-types ,ptype positive-fixnum positive-fixnum)
+       (:temporary (:sc unsigned-reg :offset eax-offset :target result
+                        :from (:argument 2) :to (:result 0))
+                   eax)
+       (:results (result :scs (unsigned-reg signed-reg)))
+       (:result-types positive-fixnum)
+       (:generator 5
+         (move eax value)
+         (inst mov (make-ea :word :base object :index index :scale 2
+                            :disp (- (* vector-data-offset n-word-bytes)
+                                     other-pointer-lowtag))
+               ax-tn)
+         (move result eax)))
+
+      (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
+       (:translate data-vector-set)
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg) :to (:eval 0))
+              (value :scs (unsigned-reg signed-reg) :target eax))
+       (:info index)
+       (:arg-types ,ptype (:constant (signed-byte 30))
+                   positive-fixnum)
+       (:temporary (:sc unsigned-reg :offset eax-offset :target result
+                        :from (:argument 1) :to (:result 0))
+                   eax)
+       (:results (result :scs (unsigned-reg signed-reg)))
+       (:result-types positive-fixnum)
+       (:generator 4
+         (move eax value)
+         (inst mov (make-ea :word :base object
+                            :disp (- (+ (* vector-data-offset n-word-bytes)
+                                        (* 2 index))
+                                     other-pointer-lowtag))
+               ax-tn)
+         (move result eax))))))
+  (define-data-vector-frobs simple-array-unsigned-byte-15)
+  (define-data-vector-frobs simple-array-unsigned-byte-16))
 
 ;;; simple-string
 

diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index 08baf74..04096e8 100644 (file)
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -1536,10 +1536,18 @@ gc_init_tables(void)
        scav_vector_unsigned_byte_2;
     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
        scav_vector_unsigned_byte_4;
+    scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
+       scav_vector_unsigned_byte_8;
     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
        scav_vector_unsigned_byte_8;
+    scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
+       scav_vector_unsigned_byte_16;
     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
        scav_vector_unsigned_byte_16;
+    scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
+       scav_vector_unsigned_byte_32;
+    scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
+       scav_vector_unsigned_byte_32;
     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
        scav_vector_unsigned_byte_32;
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
@@ -1633,10 +1641,18 @@ gc_init_tables(void)
        trans_vector_unsigned_byte_2;
     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
        trans_vector_unsigned_byte_4;
+    transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
+       trans_vector_unsigned_byte_8;
     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
        trans_vector_unsigned_byte_8;
+    transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
+       trans_vector_unsigned_byte_16;
     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
        trans_vector_unsigned_byte_16;
+    transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
+       trans_vector_unsigned_byte_32;
+    transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
+       trans_vector_unsigned_byte_32;
     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
        trans_vector_unsigned_byte_32;
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
@@ -1734,10 +1750,18 @@ gc_init_tables(void)
        size_vector_unsigned_byte_2;
     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
        size_vector_unsigned_byte_4;
+    sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
+       size_vector_unsigned_byte_8;
     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
        size_vector_unsigned_byte_8;
+    sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
+       size_vector_unsigned_byte_16;
     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
        size_vector_unsigned_byte_16;
+    sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
+       size_vector_unsigned_byte_32;
+    sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
+       size_vector_unsigned_byte_32;
     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
        size_vector_unsigned_byte_32;
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 34e592c..1afe504 100644 (file)
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -2322,8 +2322,12 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
        case SIMPLE_ARRAY_NIL_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
        case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
@@ -2406,8 +2410,12 @@ maybe_adjust_large_object(lispobj *where)
     case SIMPLE_ARRAY_NIL_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
     case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
@@ -3399,8 +3407,12 @@ verify_space(lispobj *start, size_t words)
                case SIMPLE_ARRAY_NIL_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
                case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:

diff --git a/src/runtime/purify.c b/src/runtime/purify.c
index c4309e2..f841573 100644 (file)
--- a/src/runtime/purify.c
+++ b/src/runtime/purify.c
@@ -289,8 +289,12 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
        case SIMPLE_BIT_VECTOR_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
        case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
@@ -959,21 +963,25 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
       case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
 #endif
         return ptrans_vector(thing, 8, 0, 0, constant);
 
       case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
 #endif
         return ptrans_vector(thing, 16, 0, 0, constant);
 
       case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
 #endif
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
 #endif
         return ptrans_vector(thing, 32, 0, 0, constant);
 
@@ -1179,6 +1187,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
               case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
+              case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
 #endif
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
@@ -1187,6 +1196,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
               case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
+              case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
 #endif
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
@@ -1195,9 +1205,11 @@ pscav(lispobj *addr, int nwords, boolean constant)
               case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
+             case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
 #endif
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
+              case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
 #endif
                 vector = (struct vector *)addr;
                 count = CEILING(fixnum_value(vector->length)+2,2);

diff --git a/version.lisp-expr b/version.lisp-expr
index 47e996b..140d45f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.2.14"
+"0.8.2.15"