diff --git a/code/array.lisp b/code/array.lisp index 3a1f6429105aa524945e2336838a301cbc4e3489..938e6534cfeaed55b8045570385aafacbb95faf2 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 8bf9404a596ff7a4077a756aaa60414c8348af7b..0fa9592d1abf099d70bea03fd7f9dc746dab64bb 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 affd1a81741919f6993fd265f2716ef6a3163bf9..828b27c08c931e1e47cc85353a5562aebac8a717 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 c72041e3a772633cd4a773468b946822daa76395..1baffbfb6429ef110f6c14dd7ecf59fc533bb7cd 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 f9be2246eeb83e5e39395fcdb8c9e7b0899427e5..310cc32b476ccf30377136d57ad3f3626d52ec72 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 cf085d12e772561a77f1989e2e2ded769262c4ee..1d93a7d634ba7ca64235f8dce71679bc7b7c43a6 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 57cc8a92e1b40edd74393e556ea436b7db222575..8affc52727b7a5407dfee207b4a6a136692db054 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 002610efd29b80d594eb18c916d06dd128bab52a..76449e95b9fc0eba29395c5ccb4a675b498e0ece 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 31e78861145337641f86c789d6391eec7e4d2a80..beb2ef5ee039ea7c32776786b0426beb9788f679 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 96608123e57fddf57040101ade5ffa1c9100e258..210325a9d79226de07d5c66954743d3094b9bebc 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 60f75b5e43a85e4234a147157264658b01c922f8..322962811bd16b33b1dac6e77aaaccbf6f426f02 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 eb26582fb395bc1e66b0d908728683c7d1ddd532..2c174ed16d83b70c64d8254b34828f6444a33982 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 37fd220e63fc6bf36c9c98adb8f13890c4f06cb2..c55da1a5a9d945444dc5b91cbfee75f5eec8f93c 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 edaed29515f778f1d7c8ceaca6e130898b7ea0ea..9e44b9690e73b5bf75197bf6eae1960d3b94e2cd 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 f176cc45dcdbc16d34ddf3330f7bcb34ee215f36..40b3721d056b05f4ae787771bfcf7a41c3cd1cac 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 a8cbde23dac182c70aa1b8b0d04eb1e57596e06e..1c6776101a627fa9e5b2432be04066e784e6d46b 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 5d8e4ddccd52fa9f2c4bd9be04e78f0badf2fdcd..1bdde895d8ee113d9a49ecc3c07a5a9089fec5c2 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 146f6c2cd2c41858093e080bd7ae34b8ffd3b71c..f1bf40f5fb6c7d67078499cdff7e58c3a15169be 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 d5b12ae6b2c4c3cf4bba1f55f97c63797cf43017..7e2474b85ac1db35780372ab6127de2b13b47bed 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;