From d5d4504fb4eda653d113457d5c79dcd3a428b0dc Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Tue, 1 Apr 1997 19:24:20 +0000
Subject: [PATCH] Support for some specialised signed array types: (signed-byte
 8), (signed-byte 16), (signed-byte 30), (signed-byte 32).  These patches
 include the general support and the x86 backend support; more to follow. The
 important changes are conditional on the :signed-array feature so shouldn't
 affect the source without this feature. This work has been driven by Raymond
 Toy.

---
 code/array.lisp                   |  26 ++++++-
 code/class.lisp                   |  34 ++++++++-
 code/exports.lisp                 |  15 +++-
 code/interr.lisp                  |  30 +++++++-
 code/load.lisp                    |  34 ++++++++-
 code/pred.lisp                    |   6 +-
 code/room.lisp                    |  10 ++-
 compiler/array-tran.lisp          |   6 +-
 compiler/dump.lisp                |  41 +++++++++-
 compiler/generic/interr.lisp      |  14 +++-
 compiler/generic/objdef.lisp      |  15 ++--
 compiler/generic/primtype.lisp    |  18 ++++-
 compiler/generic/vm-fndb.lisp     |   6 +-
 compiler/generic/vm-type.lisp     |   9 ++-
 compiler/generic/vm-typetran.lisp |  16 +++-
 compiler/x86/array.lisp           | 121 ++++++++++++++++++++++++------
 compiler/x86/type-vops.lisp       |  48 +++++++++++-
 lisp/gc.c                         |  38 +++++++++-
 lisp/purify.c                     |  38 +++++++++-
 19 files changed, 471 insertions(+), 54 deletions(-)

diff --git a/code/array.lisp b/code/array.lisp
index 3a1f64291..938e6534c 100644
--- a/code/array.lisp
+++ b/code/array.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.22 1997/02/23 09:53:10 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.23 1997/04/01 19:23:31 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -128,6 +128,14 @@
     ((unsigned-byte 8) (values #.vm:simple-array-unsigned-byte-8-type 8))
     ((unsigned-byte 16) (values #.vm:simple-array-unsigned-byte-16-type 16))
     ((unsigned-byte 32) (values #.vm:simple-array-unsigned-byte-32-type 32))
+    #+signed-array ((signed-byte 8)
+		    (values #.vm:simple-array-signed-byte-8-type 8))
+    #+signed-array ((signed-byte 16)
+		    (values #.vm:simple-array-signed-byte-16-type 16))
+    #+signed-array ((signed-byte 30)
+		    (values #.vm:simple-array-signed-byte-30-type 32))
+    #+signed-array ((signed-byte 32)
+		    (values #.vm:simple-array-signed-byte-32-type 32))
     (single-float (values #.vm:simple-array-single-float-type 32))
     (double-float (values #.vm:simple-array-double-float-type 64))
     (t (values #.vm:simple-vector-type #.vm:word-bits))))
@@ -316,6 +324,10 @@
        (unsigned-byte 8)
        (unsigned-byte 16)
        (unsigned-byte 32)
+       #+signed-array (signed-byte 8)
+       #+signed-array (signed-byte 16)
+       #+signed-array (signed-byte 30)
+       #+signed-array (signed-byte 32)
        single-float
        double-float))))
 
@@ -340,6 +352,10 @@
        (unsigned-byte 8)
        (unsigned-byte 16)
        (unsigned-byte 32)
+       #+signed-array (signed-byte 8)
+       #+signed-array (signed-byte 16)
+       #+signed-array (signed-byte 30)
+       #+signed-array (signed-byte 32)
        single-float
        double-float))))
 
@@ -494,6 +510,10 @@
        (vm:simple-array-unsigned-byte-8-type '(unsigned-byte 8))
        (vm:simple-array-unsigned-byte-16-type '(unsigned-byte 16))
        (vm:simple-array-unsigned-byte-32-type '(unsigned-byte 32))
+       #+signed-array (vm:simple-array-signed-byte-8-type '(signed-byte 8))
+       #+signed-array (vm:simple-array-signed-byte-16-type '(signed-byte 16))
+       #+signed-array (vm:simple-array-signed-byte-30-type '(signed-byte 30))
+       #+signed-array (vm:simple-array-signed-byte-32-type '(signed-byte 32))
        (vm:simple-array-single-float-type 'single-float)
        (vm:simple-array-double-float-type 'double-float)
        ((vm:simple-array-type vm:complex-vector-type vm:complex-array-type)
@@ -782,6 +802,10 @@
 	((simple-array (unsigned-byte 8) (*)) 0)
 	((simple-array (unsigned-byte 16) (*)) 0)
 	((simple-array (unsigned-byte 32) (*)) 0)
+	#+signed-array ((simple-array (signed-byte 8) (*)) 0)
+	#+signed-array ((simple-array (signed-byte 16) (*)) 0)
+	#+signed-array ((simple-array (signed-byte 30) (*)) 0)
+	#+signed-array ((simple-array (signed-byte 32) (*)) 0)
 	((simple-array single-float (*)) (coerce 0 'single-float))
 	((simple-array double-float (*)) (coerce 0 'double-float)))))
   ;; Only arrays have fill-pointers, but vectors have their length parameter
diff --git a/code/class.lisp b/code/class.lisp
index 8bf9404a5..0fa9592d1 100644
--- a/code/class.lisp
+++ b/code/class.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.34 1994/10/31 04:11:27 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.35 1997/04/01 19:23:36 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -604,6 +604,38 @@
 	   :inherits (vector simple-array array sequence generic-vector
 		      generic-array mutable-sequence mutable-collection
 		      generic-sequence collection))
+	  #+signed-array 
+	  (simple-array-signed-byte-8
+	   :translation (simple-array (signed-byte 8) (*))
+	   :codes (#.vm:simple-array-signed-byte-8-type)
+	   :direct-superclasses (vector simple-array)
+	   :inherits (vector simple-array array sequence generic-vector
+		      generic-array mutable-sequence mutable-collection
+		      generic-sequence collection))
+	  #+signed-array 
+	  (simple-array-signed-byte-16
+	   :translation (simple-array (signed-byte 16) (*))
+	   :codes (#.vm:simple-array-signed-byte-16-type)
+	   :direct-superclasses (vector simple-array)
+	   :inherits (vector simple-array array sequence generic-vector
+		      generic-array mutable-sequence mutable-collection
+		      generic-sequence collection))
+	  #+signed-array 
+	  (simple-array-signed-byte-30
+	   :translation (simple-array (signed-byte 30) (*))
+	   :codes (#.vm:simple-array-signed-byte-30-type)
+	   :direct-superclasses (vector simple-array)
+	   :inherits (vector simple-array array sequence generic-vector
+		      generic-array mutable-sequence mutable-collection
+		      generic-sequence collection))
+	  #+signed-array 
+	  (simple-array-signed-byte-32
+	   :translation (simple-array (signed-byte 32) (*))
+	   :codes (#.vm:simple-array-signed-byte-32-type)
+	   :direct-superclasses (vector simple-array)
+	   :inherits (vector simple-array array sequence generic-vector
+		      generic-array mutable-sequence mutable-collection
+		      generic-sequence collection))
 	  (simple-array-single-float
 	   :translation (simple-array single-float (*))
 	   :codes (#.vm:simple-array-single-float-type)
diff --git a/code/exports.lisp b/code/exports.lisp
index affd1a817..828b27c08 100644
--- a/code/exports.lisp
+++ b/code/exports.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.114 1997/02/20 01:29:32 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.115 1997/04/01 19:23:42 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -679,7 +679,12 @@
 	   "SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE"
 	   "SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE"
 	   "SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE"
-	   "SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE" "SIMPLE-BIT-VECTOR-TYPE"
+	   "SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE"
+ 	   "SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE"
+ 	   "SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE"
+ 	   "SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE"
+ 	   "SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE"
+	   "SIMPLE-BIT-VECTOR-TYPE"
 	   "SIMPLE-STRING-TYPE" "SIMPLE-VECTOR-TYPE" "SINGLE-FLOAT-BIAS"
 	   "SINGLE-FLOAT-DIGITS" "SINGLE-FLOAT-EXPONENT-BYTE"
 	   "SINGLE-FLOAT-HIDDEN-BIT" "SINGLE-FLOAT-NORMAL-EXPONENT-MAX"
@@ -1455,6 +1460,10 @@
 	   "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-32-ERROR"
 	   "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-4-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"
+ 	   "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-32-ERROR"
+ 	   "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-8-ERROR"
 	   "OBJECT-NOT-SIMPLE-BIT-VECTOR-ERROR"
 	   "OBJECT-NOT-SIMPLE-STRING-ERROR" "OBJECT-NOT-SIMPLE-VECTOR-ERROR"
 	   "OBJECT-NOT-SINGLE-FLOAT-ERROR" "OBJECT-NOT-STRING-ERROR"
@@ -1473,6 +1482,8 @@
 	   "SIMPLE-ARRAY-SINGLE-FLOAT-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-16-P"
 	   "SIMPLE-ARRAY-UNSIGNED-BYTE-2-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-32-P"
 	   "SIMPLE-ARRAY-UNSIGNED-BYTE-4-P" "SIMPLE-ARRAY-UNSIGNED-BYTE-8-P"
+ 	   "SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P"
+	   "SIMPLE-ARRAY-SIGNED-BYTE-32-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P" 
 	   "SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT"
 	   "SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF"
 	   "STREAMLIKE" "STRINGABLE" "STRINGLIKE"
diff --git a/code/interr.lisp b/code/interr.lisp
index c72041e3a..1baffbfb6 100644
--- a/code/interr.lisp
+++ b/code/interr.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.29 1994/10/31 04:11:27 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.30 1997/04/01 19:23:47 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -357,6 +357,34 @@
 	 :datum object
 	 :expected-type '(simple-array (unsigned-byte 32) (*))))
 
+#+signed-array 
+(deferr object-not-simple-array-signed-byte-8-error (object)
+  (error 'type-error
+	 :function-name name
+	 :datum object
+	 :expected-type '(simple-array (signed-byte 8) (*))))
+
+#+signed-array 
+(deferr object-not-simple-array-signed-byte-16-error (object)
+  (error 'type-error
+	 :function-name name
+	 :datum object
+	 :expected-type '(simple-array (signed-byte 16) (*))))
+
+#+signed-array 
+(deferr object-not-simple-array-signed-byte-30-error (object)
+  (error 'type-error
+	 :function-name name
+	 :datum object
+	 :expected-type '(simple-array (signed-byte 30) (*))))
+
+#+signed-array 
+(deferr object-not-simple-array-signed-byte-32-error (object)
+  (error 'type-error
+	 :function-name name
+	 :datum object
+	 :expected-type '(simple-array (signed-byte 32) (*))))
+
 (deferr object-not-simple-array-single-float-error (object)
   (error 'type-error
 	 :function-name name
diff --git a/code/load.lisp b/code/load.lisp
index f9be2246e..310cc32b4 100644
--- a/code/load.lisp
+++ b/code/load.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.61 1997/02/11 00:28:23 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.62 1997/04/01 19:23:49 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -920,6 +920,38 @@
       (make-array n :element-type `(unsigned-byte ,size)
 		  :initial-element value))))
 
+;;; FOP-SIGNED-INT-VECTOR
+;;;
+;;; Same as FOP-INT-VECTOR, except this is for signed simple-arrays.
+;;; It appears that entry 50 and 51 are clear.
+#+signed-array
+(define-fop (fop-signed-int-vector 50)
+  (prepare-for-fast-read-byte *fasl-file*
+    (let* ((len (fast-read-u-integer 4))
+	   (size (fast-read-byte))
+	   (res (case size
+ 		  (8 (make-array len :element-type '(signed-byte 8)))
+ 		  (16 (make-array len :element-type '(signed-byte 16)))
+ 		  (30 (make-array len :element-type '(signed-byte 30)))
+ 		  (32 (make-array len :element-type '(signed-byte 32)))
+ 		  (t (error "Losing i-vector element size: ~S" size)))))
+      (declare (type index len))
+      (done-with-fast-read-byte)
+      (read-n-bytes *fasl-file* res 0
+ 		    (ceiling (the index (* size len)) vm:byte-bits))
+      res)))
+
+;;; Same as fop-uniform-int-vector, but for signed integers
+#+signed-array
+(define-fop (fop-uniform-signed-int-vector 51)
+   (prepare-for-fast-read-byte *fasl-file*
+     (let* ((n (fast-read-u-integer 4))
+	    (size (fast-read-byte))
+	    (value (fast-read-variable-u-integer (ceiling size 8))))
+       (done-with-fast-read-byte)
+       (make-array n :element-type `(signed-byte ,size)
+		   :initial-element value))))
+ 
 (define-fop (fop-eval 53)
   (let ((result (eval (pop-stack))))
     (when *load-print*
diff --git a/code/pred.lisp b/code/pred.lisp
index cf085d12e..1d93a7d63 100644
--- a/code/pred.lisp
+++ b/code/pred.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.38 1997/02/07 20:27:30 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.39 1997/04/01 19:23:52 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -89,6 +89,10 @@
       simple-array-unsigned-byte-8-p
       simple-array-unsigned-byte-16-p
       simple-array-unsigned-byte-32-p
+      #+signed-array simple-array-signed-byte-8-p
+      #+signed-array simple-array-signed-byte-16-p
+      #+signed-array simple-array-signed-byte-30-p
+      #+signed-array simple-array-signed-byte-32-p
       simple-array-single-float-p
       simple-array-double-float-p
       dylan::dylan-function-p
diff --git a/code/room.lisp b/code/room.lisp
index 57cc8a92e..8affc5272 100644
--- a/code/room.lisp
+++ b/code/room.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.24 1994/10/31 04:11:27 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.25 1997/04/01 19:23:53 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -84,6 +84,10 @@
 		 (simple-array-unsigned-byte-8-type . 0)
 		 (simple-array-unsigned-byte-16-type . 1)
 		 (simple-array-unsigned-byte-32-type . 2)
+		 #+signed-array (simple-array-signed-byte-8-type . 0)
+		 #+signed-array (simple-array-signed-byte-16-type . 1)
+		 #+signed-array (simple-array-signed-byte-30-type . 2)
+		 #+signed-array (simple-array-signed-byte-32-type . 2)
 		 (simple-array-single-float-type . 2)
 		 (simple-array-double-float-type . 3)))
   (let ((name (car stuff))
@@ -470,6 +474,10 @@
 	       #.simple-array-unsigned-byte-8-type
 	       #.simple-array-unsigned-byte-16-type
 	       #.simple-array-unsigned-byte-32-type
+	       #+signed-array #.simple-array-signed-byte-8-type
+	       #+signed-array #.simple-array-signed-byte-16-type
+	       #+signed-array #.simple-array-signed-byte-30-type
+	       #+signed-array #.simple-array-signed-byte-32-type
 	       #.simple-array-single-float-type
 	       #.simple-array-double-float-type)
 	      (incf non-descriptor-headers)
diff --git a/compiler/array-tran.lisp b/compiler/array-tran.lisp
index 002610efd..76449e95b 100644
--- a/compiler/array-tran.lisp
+++ b/compiler/array-tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.18 1994/10/31 04:27:28 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.19 1997/04/01 19:23:56 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -191,6 +191,10 @@
     ((unsigned-byte 8) 0 8 vm:simple-array-unsigned-byte-8-type)
     ((unsigned-byte 16) 0 16 vm:simple-array-unsigned-byte-16-type)
     ((unsigned-byte 32) 0 32 vm:simple-array-unsigned-byte-32-type)
+    #+signed-array ((signed-byte 8) 0 8 vm:simple-array-signed-byte-8-type)
+    #+signed-array ((signed-byte 16) 0 16 vm:simple-array-signed-byte-16-type)
+    #+signed-array ((signed-byte 30) 0 32 vm:simple-array-signed-byte-30-type)
+    #+signed-array ((signed-byte 32) 0 32 vm:simple-array-signed-byte-32-type)
     (t 0 32 vm:simple-vector-type)))
 
 ;;; MAKE-ARRAY  --  source-transform.
diff --git a/compiler/dump.lisp b/compiler/dump.lisp
index 31e788611..beb2ef5ee 100644
--- a/compiler/dump.lisp
+++ b/compiler/dump.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.63 1997/02/18 01:35:47 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.64 1997/04/01 19:23:58 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1335,6 +1335,7 @@
 ;;; then just write the bits.  Otherwise, dispatch off of the target byte order
 ;;; and write the vector one element at a time.
 ;;;
+#-signed-array
 (defun dump-i-vector (vec file &optional data-only)
   (declare (type (simple-array * (*)) vec))
   (let* ((ac (etypecase vec
@@ -1354,6 +1355,44 @@
       (dump-byte size file))
     (dump-data-maybe-byte-swapping vec bytes size file)))
 
+#+signed-array
+(defun dump-i-vector (vec file &optional data-only)
+  (declare (type (simple-array * (*)) vec))
+  (let ((len (length vec)))
+    (labels ((dump-unsigned (size bytes)
+	       (unless data-only
+		 (dump-fop 'lisp::fop-int-vector file)
+		 (dump-unsigned-32 len file)
+		 (dump-byte size file))
+	       (dump-data-maybe-byte-swapping vec bytes size file))
+	     (dump-signed (size bytes)
+	       (unless data-only
+		 (dump-fop 'lisp::fop-signed-int-vector file)
+		 (dump-unsigned-32 len file)
+		 (dump-byte size file))
+	       (dump-data-maybe-byte-swapping vec bytes size file)))
+      (etypecase vec
+	(simple-bit-vector
+	 (dump-unsigned 1 (ash (+ (the index len) 7) -3)))
+	((simple-array (unsigned-byte 2) (*))
+	 (dump-unsigned 2 (ash (+ (the index (ash len 1)) 7) -3)))
+	((simple-array (unsigned-byte 4) (*))
+	 (dump-unsigned 4 (ash (+ (the index (ash len 2)) 7) -3)))
+	((simple-array (unsigned-byte 8) (*))
+	 (dump-unsigned 8 len))
+	((simple-array (unsigned-byte 16) (*))
+	 (dump-unsigned 16 (* 2 len)))
+	((simple-array (unsigned-byte 32) (*))
+	 (dump-unsigned 32 (* 4 len)))
+	((simple-array (signed-byte 8) (*))
+	 (dump-signed 8 len))
+	((simple-array (signed-byte 16) (*))
+	 (dump-signed 16 (* 2 len)))
+	((simple-array (signed-byte 30) (*))
+	 (dump-signed 30 (* 4 len)))
+	((simple-array (signed-byte 32) (*))
+	 (dump-signed 32 (* 4 len)))))))
+
 ;;; DUMP-SINGLE-FLOAT-VECTOR  --  internal.
 ;;; 
 (defun dump-single-float-vector (vec file)
diff --git a/compiler/generic/interr.lisp b/compiler/generic/interr.lisp
index 96608123e..210325a9d 100644
--- a/compiler/generic/interr.lisp
+++ b/compiler/generic/interr.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/interr.lisp,v 1.4 1994/10/31 04:38:06 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/interr.lisp,v 1.5 1997/04/01 19:24:01 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -137,6 +137,18 @@
    "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 16) (*)).")
   (object-not-simple-array-unsigned-byte-32
    "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)).")
+  #+signed-array 
+  (object-not-simple-array-signed-byte-8
+   "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 8) (*)).")
+  #+signed-array 
+  (object-not-simple-array-signed-byte-16
+   "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 16) (*)).")
+  #+signed-array 
+  (object-not-simple-array-signed-byte-30
+   "Object is not of type (SIMPLE-ARRAY FIXNUM (*)).")
+  #+signed-array 
+  (object-not-simple-array-signed-byte-32
+   "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 32) (*)).")
   (object-not-simple-array-single-float
    "Object is not of type (SIMPLE-ARRAY SINGLE-FLOAT (*)).")
   (object-not-simple-array-double-float
diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp
index 60f75b5e4..322962811 100644
--- a/compiler/generic/objdef.lisp
+++ b/compiler/generic/objdef.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.37 1994/10/31 04:38:06 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.38 1997/04/01 19:24:03 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -24,10 +24,11 @@
 	  single-float-type double-float-type complex-type
 	  simple-array-type simple-string-type simple-bit-vector-type
 	  simple-vector-type simple-array-unsigned-byte-2-type
-	  simple-array-unsigned-byte-4-type
-	  simple-array-unsigned-byte-8-type
-	  simple-array-unsigned-byte-16-type
-	  simple-array-unsigned-byte-32-type simple-array-single-float-type
+	  simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
+	  simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
+	  simple-array-signed-byte-8-type simple-array-signed-byte-16-type
+	  simple-array-signed-byte-30-type simple-array-signed-byte-32-type
+	  simple-array-single-float-type
 	  simple-array-double-float-type complex-string-type
 	  complex-bit-vector-type complex-vector-type complex-array-type
 	  code-header-type function-header-type closure-header-type
@@ -119,6 +120,10 @@
   simple-array-unsigned-byte-8
   simple-array-unsigned-byte-16
   simple-array-unsigned-byte-32
+  #+signed-array simple-array-signed-byte-8
+  #+signed-array simple-array-signed-byte-16
+  #+signed-array simple-array-signed-byte-30
+  #+signed-array simple-array-signed-byte-32
   simple-array-single-float
   simple-array-double-float
   complex-string
diff --git a/compiler/generic/primtype.lisp b/compiler/generic/primtype.lisp
index eb26582fb..2c174ed16 100644
--- a/compiler/generic/primtype.lisp
+++ b/compiler/generic/primtype.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/primtype.lisp,v 1.14 1994/10/31 04:38:06 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/primtype.lisp,v 1.15 1997/04/01 19:24:04 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -100,6 +100,18 @@
   :type (simple-array (unsigned-byte 16) (*)))
 (def-primitive-type simple-array-unsigned-byte-32 (descriptor-reg)
   :type (simple-array (unsigned-byte 32) (*)))
+#+signed-array 
+(def-primitive-type simple-array-signed-byte-8 (descriptor-reg)
+  :type (simple-array (signed-byte 8) (*)))
+#+signed-array 
+(def-primitive-type simple-array-signed-byte-16 (descriptor-reg)
+  :type (simple-array (signed-byte 16) (*)))
+#+signed-array 
+(def-primitive-type simple-array-signed-byte-30 (descriptor-reg)
+  :type (simple-array (signed-byte 30) (*)))
+#+signed-array 
+(def-primitive-type simple-array-signed-byte-32 (descriptor-reg)
+  :type (simple-array (signed-byte 32) (*)))
 (def-primitive-type simple-array-single-float (descriptor-reg)
   :type (simple-array single-float (*)))
 (def-primitive-type simple-array-double-float (descriptor-reg)
@@ -143,6 +155,10 @@
     ((unsigned-byte 8) . simple-array-unsigned-byte-8)
     ((unsigned-byte 16) . simple-array-unsigned-byte-16)
     ((unsigned-byte 32) . simple-array-unsigned-byte-32)
+    #+signed-array ((signed-byte 8) . simple-array-signed-byte-8)
+    #+signed-array ((signed-byte 16) . simple-array-signed-byte-16)
+    #+signed-array (fixnum . simple-array-signed-byte-30)
+    #+signed-array ((signed-byte 32) . simple-array-signed-byte-32)
     (single-float . simple-array-single-float)
     (double-float . simple-array-double-float)
     (t . simple-vector))
diff --git a/compiler/generic/vm-fndb.lisp b/compiler/generic/vm-fndb.lisp
index 37fd220e6..c55da1a5a 100644
--- a/compiler/generic/vm-fndb.lisp
+++ b/compiler/generic/vm-fndb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.53 1994/10/31 04:38:06 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.54 1997/04/01 19:24:07 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -51,6 +51,10 @@
 	   array-header-p simple-array-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
+	   #+signed-array simple-array-signed-byte-8-p
+	   #+signed-array simple-array-signed-byte-16-p
+	   #+signed-array simple-array-signed-byte-30-p
+	   #+signed-array simple-array-signed-byte-32-p
 	   simple-array-single-float-p simple-array-double-float-p
 	   system-area-pointer-p realp unsigned-byte-32-p signed-byte-32-p
 	   weak-pointer-p scavenger-hook-p code-component-p lra-p
diff --git a/compiler/generic/vm-type.lisp b/compiler/generic/vm-type.lisp
index edaed2951..9e44b9690 100644
--- a/compiler/generic/vm-type.lisp
+++ b/compiler/generic/vm-type.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.31 1994/10/31 04:38:06 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.32 1997/04/01 19:24:09 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -86,8 +86,11 @@
 ;;; The kinds of specialised array that actually exist in this implementation.
 ;;;
 (defparameter specialized-array-element-types
-  '(bit (unsigned-byte 2) (unsigned-byte 4) (unsigned-byte 8) (unsigned-byte 16)
-	(unsigned-byte 32) base-char single-float double-float))
+  '(bit (unsigned-byte 2) (unsigned-byte 4) (unsigned-byte 8)
+    (unsigned-byte 16) (unsigned-byte 32)
+    #+signed-array (signed-byte 8) #+signed-array (signed-byte 16)
+    #+signed-array (signed-byte 30) #+signed-array (signed-byte 32)
+    base-char single-float double-float))
 
 (deftype unboxed-array (&optional dims)
   (collect ((types (list 'or)))
diff --git a/compiler/generic/vm-typetran.lisp b/compiler/generic/vm-typetran.lisp
index f176cc45d..40b3721d0 100644
--- a/compiler/generic/vm-typetran.lisp
+++ b/compiler/generic/vm-typetran.lisp
@@ -5,11 +5,11 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.11 1994/10/31 04:38:06 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.12 1997/04/01 19:24:10 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.11 1994/10/31 04:38:06 ram Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.12 1997/04/01 19:24:10 dtc Exp $
 ;;;
 ;;; This file contains the implimentation specific type transformation magic.
 ;;; Basically, the various non-standard predicates that can be used in typep
@@ -45,6 +45,18 @@
 		       (simple-array (unsigned-byte 16) (*)))
 (define-type-predicate simple-array-unsigned-byte-32-p
 		       (simple-array (unsigned-byte 32) (*)))
+#+signed-array 
+(define-type-predicate simple-array-signed-byte-8-p
+		       (simple-array (signed-byte 8) (*)))
+#+signed-array 
+(define-type-predicate simple-array-signed-byte-16-p
+		       (simple-array (signed-byte 16) (*)))
+#+signed-array 
+(define-type-predicate simple-array-signed-byte-30-p
+		       (simple-array (signed-byte 30) (*)))
+#+signed-array 
+(define-type-predicate simple-array-signed-byte-32-p
+		       (simple-array (signed-byte 32) (*)))
 (define-type-predicate simple-array-single-float-p
 		       (simple-array single-float (*)))
 (define-type-predicate simple-array-double-float-p
diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp
index a8cbde23d..1c6776101 100644
--- a/compiler/x86/array.lisp
+++ b/compiler/x86/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.3 1997/03/25 16:59:26 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.4 1997/04/01 19:24:11 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -132,10 +132,12 @@
 ); eval-when (compile eval)
 
 (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
-
-
 (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
   unsigned-reg)
+#+signed-array 
+(def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
+#+signed-array 
+(def-full-data-vector-frobs simple-array-signed-byte-32 signed-num signed-reg)
 
 ;;; Integer vectors whos elements are smaller than a byte.  I.e. bit, 2-bit,
 ;;; and 4-bit vectors.
@@ -591,9 +593,9 @@
   (:result-types positive-fixnum)
   (:generator 5
     (move eax value)
-    (inst mov
-	  (make-ea :byte :base object :index index :scale 1
-		   :disp (- (* vector-data-offset word-bytes) other-pointer-type))
+    (inst mov (make-ea :byte :base object :index index :scale 1
+		       :disp (- (* vector-data-offset word-bytes)
+				other-pointer-type))
 	  al-tn)
     (move result eax)))
 
@@ -613,10 +615,9 @@
   (:result-types positive-fixnum)
   (:generator 4
     (move eax value)
-    (inst mov
-	  (make-ea :byte :base object
-		   :disp (- (+ (* vector-data-offset word-bytes) index)
-			    other-pointer-type))
+    (inst mov (make-ea :byte :base object
+		       :disp (- (+ (* vector-data-offset word-bytes) index)
+				other-pointer-type))
 	  al-tn)
     (move result eax)))
 
@@ -649,8 +650,7 @@
   (:generator 4
     (inst movzx value
 	  (make-ea :word :base object
-		   :disp (- (+ (* vector-data-offset word-bytes)
-			       (* 2 index))
+		   :disp (- (+ (* vector-data-offset word-bytes) (* 2 index))
 			    other-pointer-type)))))
 
 
@@ -681,7 +681,8 @@
   (: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)
+  (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30))
+	      positive-fixnum)
   (:temporary (:sc dword-reg :offset eax-offset :target result
 		   :from (:argument 1) :to (:result 0))
 	      eax)
@@ -689,11 +690,10 @@
   (:result-types positive-fixnum)
   (:generator 4
     (move eax value)
-    (inst mov
-	  (make-ea :word :base object
-		   :disp (- (+ (* vector-data-offset word-bytes)
-			       (* 2 index))
-			    other-pointer-type))
+    (inst mov (make-ea :word :base object
+		       :disp (- (+ (* vector-data-offset word-bytes)
+				   (* 2 index))
+				other-pointer-type))
 	  ax-tn)
     (move result eax)))
 
@@ -717,7 +717,8 @@
   (:generator 5
     (inst mov al-tn
 	  (make-ea :byte :base object :index index :scale 1
-		   :disp (- (* vector-data-offset word-bytes) other-pointer-type)))
+		   :disp (- (* vector-data-offset word-bytes)
+			    other-pointer-type)))
     (move value al-tn)))
 
 (define-vop (data-vector-ref-c/simple-string)
@@ -768,16 +769,87 @@
   (:result-types base-char)
   (:generator 4
    (inst mov (make-ea :byte :base object
-		      :disp (- (+ (* vector-data-offset word-bytes)
-				  index)
+		      :disp (- (+ (* vector-data-offset word-bytes) index)
 			       other-pointer-type))
 	 value)
    (move result value)))
 
+#+signed-array 
+(progn
+
+;;; signed-byte-8
+
+(define-vop (data-vector-ref/simple-array-signed-byte-8)
+  (:translate data-vector-ref)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+	 (index :scs (unsigned-reg)))
+  (:arg-types simple-array-signed-byte-8 positive-fixnum)
+  (:results (value :scs (signed-reg)))
+  (:result-types tagged-num)
+  (:generator 5
+    (inst movsx value
+	  (make-ea :byte :base object :index index :scale 1
+		   :disp (- (* vector-data-offset word-bytes)
+			    other-pointer-type)))))
+
+(define-vop (data-vector-ref-c/simple-array-signed-byte-8)
+  (:translate data-vector-ref)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg)))
+  (:info index)
+  (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30)))
+  (:results (value :scs (signed-reg)))
+  (:result-types tagged-num)
+  (:generator 4
+    (inst movsx value
+	  (make-ea :byte :base object
+		   :disp (- (+ (* vector-data-offset word-bytes) index)
+			    other-pointer-type)))))
+
+(define-vop (data-vector-set/simple-array-signed-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 (signed-reg) :target eax))
+  (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
+  (:temporary (:sc dword-reg :offset eax-offset :target result
+		   :from (:argument 2) :to (:result 0))
+	      eax)
+  (:results (result :scs (signed-reg)))
+  (:result-types tagged-num)
+  (:generator 5
+    (move eax value)
+    (inst mov (make-ea :byte :base object :index index :scale 1
+		       :disp (- (* vector-data-offset word-bytes)
+				other-pointer-type))
+	  al-tn)
+    (move result eax)))
+
+(define-vop (data-vector-set-c/simple-array-signed-byte-8)
+  (:translate data-vector-set)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg) :to (:eval 0))
+	 (value :scs (signed-reg) :target eax))
+  (:info index)
+  (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30))
+	      tagged-num)
+  (:temporary (:sc dword-reg :offset eax-offset :target result
+		   :from (:argument 1) :to (:result 0))
+	      eax)
+  (:results (result :scs (signed-reg)))
+  (:result-types tagged-num)
+  (:generator 4
+    (move eax value)
+    (inst mov (make-ea :byte :base object
+		       :disp (- (+ (* vector-data-offset word-bytes) index)
+				other-pointer-type))
+	  al-tn)
+    (move result eax)))
 
 ;;; signed-byte-16
 
-#+nil
 (define-vop (data-vector-ref/simple-array-signed-byte-16)
   (:translate data-vector-ref)
   (:policy :fast-safe)
@@ -792,7 +864,6 @@
 		   :disp (- (* vector-data-offset word-bytes)
 			    other-pointer-type)))))
 
-#+nil
 (define-vop (data-vector-ref-c/simple-array-signed-byte-16)
   (:translate data-vector-ref)
   (:policy :fast-safe)
@@ -808,7 +879,6 @@
 			       (* 2 index))
 			    other-pointer-type)))))
 
-#+nil
 (define-vop (data-vector-set/simple-array-signed-byte-16)
   (:translate data-vector-set)
   (:policy :fast-safe)
@@ -829,7 +899,6 @@
 	  ax-tn)
     (move result eax)))
 
-#+nil
 (define-vop (data-vector-set-c/simple-array-signed-byte-16)
   (:translate data-vector-set)
   (:policy :fast-safe)
@@ -851,3 +920,5 @@
 			    other-pointer-type))
 	  ax-tn)
     (move result eax)))
+
+) ; end signed-array
diff --git a/compiler/x86/type-vops.lisp b/compiler/x86/type-vops.lisp
index 5d8e4ddcc..1bdde895d 100644
--- a/compiler/x86/type-vops.lisp
+++ b/compiler/x86/type-vops.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/type-vops.lisp,v 1.1 1997/01/18 14:31:23 ram Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/type-vops.lisp,v 1.2 1997/04/01 19:24:15 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;; 
@@ -334,6 +334,34 @@
   object-not-simple-array-unsigned-byte-32-error
   simple-array-unsigned-byte-32-type)
 
+#+signed-array
+(def-type-vops simple-array-signed-byte-8-p
+  check-simple-array-signed-byte-8
+  simple-array-signed-byte-8
+  object-not-simple-array-signed-byte-8-error
+  simple-array-signed-byte-8-type)
+
+#+signed-array
+(def-type-vops simple-array-signed-byte-16-p
+  check-simple-array-signed-byte-16
+  simple-array-signed-byte-16
+  object-not-simple-array-signed-byte-16-error
+  simple-array-signed-byte-16-type)
+
+#+signed-array
+(def-type-vops simple-array-signed-byte-30-p
+  check-simple-array-signed-byte-30
+  simple-array-signed-byte-30
+  object-not-simple-array-signed-byte-30-error
+  simple-array-signed-byte-30-type)
+
+#+signed-array
+(def-type-vops simple-array-signed-byte-32-p
+  check-simple-array-signed-byte-32
+  simple-array-signed-byte-32
+  object-not-simple-array-signed-byte-32-error
+  simple-array-signed-byte-32-type)
+
 (def-type-vops simple-array-single-float-p check-simple-array-single-float
   simple-array-single-float object-not-simple-array-single-float-error
   simple-array-single-float-type)
@@ -384,15 +412,23 @@
   simple-string-type simple-bit-vector-type simple-vector-type
   simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type
   simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type
-  simple-array-unsigned-byte-32-type simple-array-single-float-type
-  simple-array-double-float-type complex-string-type
-  complex-bit-vector-type complex-vector-type)
+  simple-array-unsigned-byte-32-type
+  #+signed-array simple-array-signed-byte-8-type
+  #+signed-array simple-array-signed-byte-16-type
+  #+signed-array simple-array-signed-byte-30-type
+  #+signed-array simple-array-signed-byte-32-type
+  simple-array-single-float-type simple-array-double-float-type
+  complex-string-type complex-bit-vector-type complex-vector-type)
 
 (def-type-vops simple-array-p check-simple-array nil object-not-simple-array-error
   simple-array-type simple-string-type simple-bit-vector-type
   simple-vector-type simple-array-unsigned-byte-2-type
   simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
   simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
+  #+signed-array simple-array-signed-byte-8-type
+  #+signed-array simple-array-signed-byte-16-type
+  #+signed-array simple-array-signed-byte-30-type
+  #+signed-array simple-array-signed-byte-32-type
   simple-array-single-float-type simple-array-double-float-type)
 
 (def-type-vops arrayp check-array nil object-not-array-error
@@ -400,6 +436,10 @@
   simple-vector-type simple-array-unsigned-byte-2-type
   simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
   simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
+  #+signed-array simple-array-signed-byte-8-type
+  #+signed-array simple-array-signed-byte-16-type
+  #+signed-array simple-array-signed-byte-30-type
+  #+signed-array simple-array-signed-byte-32-type
   simple-array-single-float-type simple-array-double-float-type
   complex-string-type complex-bit-vector-type complex-vector-type
   complex-array-type)
diff --git a/lisp/gc.c b/lisp/gc.c
index 146f6c2cd..f1bf40f5f 100644
--- a/lisp/gc.c
+++ b/lisp/gc.c
@@ -1,7 +1,7 @@
 /*
  * Stop and Copy GC based on Cheney's algorithm.
  *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.11 1997/02/17 09:17:15 dtc Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.12 1997/04/01 19:24:17 dtc Exp $
  * 
  * Written by Christopher Hoover.
  */
@@ -1795,6 +1795,18 @@ void gc_init(void)
 	scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
 	scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
 	scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
+#ifdef type_SimpleArraySignedByte8
+	scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8;
+#endif
+#ifdef type_SimpleArraySignedByte16
+	scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16;
+#endif
+#ifdef type_SimpleArraySignedByte30
+	scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32;
+#endif
+#ifdef type_SimpleArraySignedByte32
+	scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32;
+#endif
 	scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
 	scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
 	scavtab[type_ComplexString] = scav_boxed;
@@ -1849,6 +1861,18 @@ void gc_init(void)
 	transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
 	transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
 	transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
+#ifdef type_SimpleArraySignedByte8
+	transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8;
+#endif
+#ifdef type_SimpleArraySignedByte16
+	transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16;
+#endif
+#ifdef type_SimpleArraySignedByte30
+	transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32;
+#endif
+#ifdef type_SimpleArraySignedByte32
+	transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32;
+#endif
 	transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
 	transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
 	transother[type_ComplexString] = trans_boxed;
@@ -1902,6 +1926,18 @@ void gc_init(void)
 	sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
 	sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
 	sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
+#ifdef type_SimpleArraySignedByte8
+	sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8;
+#endif
+#ifdef type_SimpleArraySignedByte16
+	sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16;
+#endif
+#ifdef type_SimpleArraySignedByte30
+	sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32;
+#endif
+#ifdef type_SimpleArraySignedByte32
+	sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32;
+#endif
 	sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
 	sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
 	sizetab[type_ComplexString] = size_boxed;
diff --git a/lisp/purify.c b/lisp/purify.c
index d5b12ae6b..7e2474b85 100644
--- a/lisp/purify.c
+++ b/lisp/purify.c
@@ -1,6 +1,6 @@
 /* Purify. */
 
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.8 1997/02/05 18:01:18 pw Exp $ */
+/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.9 1997/04/01 19:24:20 dtc Exp $ */
 
 /* This file has been hacked a bunch by Werkowski as part of
  * the x86 port. Stack direction changes as well as more conservative
@@ -117,6 +117,18 @@ maybe_can_move_p(lispobj thing)
       case type_SimpleArrayUnsignedByte8:
       case type_SimpleArrayUnsignedByte16:
       case type_SimpleArrayUnsignedByte32:
+#ifdef type_SimpleArraySignedByte8
+      case type_SimpleArraySignedByte8:
+#endif
+#ifdef type_SimpleArraySignedByte16
+      case type_SimpleArraySignedByte16:
+#endif
+#ifdef type_SimpleArraySignedByte30
+      case type_SimpleArraySignedByte30:
+#endif
+#ifdef type_SimpleArraySignedByte32
+      case type_SimpleArraySignedByte32:
+#endif
       case type_SimpleArraySingleFloat:
       case type_SimpleArrayDoubleFloat:
       case type_CodeHeader:
@@ -546,12 +558,24 @@ static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
         return ptrans_vector(thing, 4, 0, FALSE, constant);
 
       case type_SimpleArrayUnsignedByte8:
+#ifdef type_SimpleArraySignedByte8
+      case type_SimpleArraySignedByte8:
+#endif
         return ptrans_vector(thing, 8, 0, FALSE, constant);
 
       case type_SimpleArrayUnsignedByte16:
+#ifdef type_SimpleArraySignedByte16
+      case type_SimpleArraySignedByte16:
+#endif
         return ptrans_vector(thing, 16, 0, FALSE, constant);
 
       case type_SimpleArrayUnsignedByte32:
+#ifdef type_SimpleArraySignedByte30
+      case type_SimpleArraySignedByte30:
+#endif
+#ifdef type_SimpleArraySignedByte32
+      case type_SimpleArraySignedByte32:
+#endif
         return ptrans_vector(thing, 32, 0, FALSE, constant);
 
       case type_SimpleArraySingleFloat:
@@ -719,16 +743,28 @@ static lispobj *pscav(lispobj *addr, int nwords, boolean constant)
                 break;
 
               case type_SimpleArrayUnsignedByte8:
+#ifdef type_SimpleArraySignedByte8
+              case type_SimpleArraySignedByte8:
+#endif
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
                 break;
 
               case type_SimpleArrayUnsignedByte16:
+#ifdef type_SimpleArraySignedByte16
+              case type_SimpleArraySignedByte16:
+#endif
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
                 break;
 
               case type_SimpleArrayUnsignedByte32:
+#ifdef type_SimpleArraySignedByte30
+              case type_SimpleArraySignedByte30:
+#endif
+#ifdef type_SimpleArraySignedByte32
+              case type_SimpleArraySignedByte32:
+#endif
                 vector = (struct vector *)addr;
                 count = CEILING(fixnum_value(vector->length)+2,2);
                 break;
-- 
GitLab