(sb!xc:defmacro pick-vector-type (type &rest specs)
`(cond ,@(mapcar #'(lambda (spec)
`(,(if (eq (car spec) t)
- t
- `(subtypep ,type ',(car spec)))
+ t
+ `(subtypep ,type ',(car spec)))
,@(cdr spec)))
specs))))
;;; MAKE-ARRAY for any non-simple array. Thus, there's some value to
;;; making this somewhat efficient, at least not doing full calls to
;;; SUBTYPEP in the easy cases.
-(defun %vector-type-code (type)
+(defun %vector-widetag-and-n-bits (type)
(case type
;; Pick off some easy common cases.
;;
;; on smarter compiler transforms which do the calculation once
;; and for all in any reasonable user programs.)
((t)
- (values #.sb!vm:simple-vector-type #.sb!vm:word-bits))
+ (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
((character base-char standard-char)
- (values #.sb!vm:simple-string-type #.sb!vm:byte-bits))
+ (values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
((bit)
- (values #.sb!vm:simple-bit-vector-type 1))
+ (values #.sb!vm:simple-bit-vector-widetag 1))
;; OK, we have to wade into SUBTYPEPing after all.
(t
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-vector-type type
- (base-char (values #.sb!vm:simple-string-type #.sb!vm:byte-bits))
- (bit (values #.sb!vm:simple-bit-vector-type 1))
+ (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
+ (bit (values #.sb!vm:simple-bit-vector-widetag 1))
((unsigned-byte 2)
- (values #.sb!vm:simple-array-unsigned-byte-2-type 2))
+ (values #.sb!vm:simple-array-unsigned-byte-2-widetag 2))
((unsigned-byte 4)
- (values #.sb!vm:simple-array-unsigned-byte-4-type 4))
+ (values #.sb!vm:simple-array-unsigned-byte-4-widetag 4))
((unsigned-byte 8)
- (values #.sb!vm:simple-array-unsigned-byte-8-type 8))
+ (values #.sb!vm:simple-array-unsigned-byte-8-widetag 8))
((unsigned-byte 16)
- (values #.sb!vm:simple-array-unsigned-byte-16-type 16))
+ (values #.sb!vm:simple-array-unsigned-byte-16-widetag 16))
((unsigned-byte 32)
- (values #.sb!vm:simple-array-unsigned-byte-32-type 32))
+ (values #.sb!vm:simple-array-unsigned-byte-32-widetag 32))
((signed-byte 8)
- (values #.sb!vm:simple-array-signed-byte-8-type 8))
+ (values #.sb!vm:simple-array-signed-byte-8-widetag 8))
((signed-byte 16)
- (values #.sb!vm:simple-array-signed-byte-16-type 16))
+ (values #.sb!vm:simple-array-signed-byte-16-widetag 16))
((signed-byte 30)
- (values #.sb!vm:simple-array-signed-byte-30-type 32))
+ (values #.sb!vm:simple-array-signed-byte-30-widetag 32))
((signed-byte 32)
- (values #.sb!vm:simple-array-signed-byte-32-type 32))
- (single-float (values #.sb!vm:simple-array-single-float-type 32))
- (double-float (values #.sb!vm:simple-array-double-float-type 64))
+ (values #.sb!vm:simple-array-signed-byte-32-widetag 32))
+ (single-float (values #.sb!vm:simple-array-single-float-widetag 32))
+ (double-float (values #.sb!vm:simple-array-double-float-widetag 64))
#!+long-float
(long-float
- (values #.sb!vm:simple-array-long-float-type #!+x86 96 #!+sparc 128))
+ (values #.sb!vm:simple-array-long-float-widetag
+ #!+x86 96 #!+sparc 128))
((complex single-float)
- (values #.sb!vm:simple-array-complex-single-float-type 64))
+ (values #.sb!vm:simple-array-complex-single-float-widetag 64))
((complex double-float)
- (values #.sb!vm:simple-array-complex-double-float-type 128))
+ (values #.sb!vm:simple-array-complex-double-float-widetag 128))
#!+long-float
((complex long-float)
- (values #.sb!vm:simple-array-complex-long-float-type
+ (values #.sb!vm:simple-array-complex-long-float-widetag
#!+x86 192
#!+sparc 256))
- (t (values #.sb!vm:simple-vector-type #.sb!vm:word-bits))))))
-(defun %complex-vector-type-code (type)
+ (t (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))))))
+(defun %complex-vector-widetag (type)
(case type
;; Pick off some easy common cases.
((t)
- #.sb!vm:complex-vector-type)
+ #.sb!vm:complex-vector-widetag)
((character base-char)
- #.sb!vm:complex-string-type)
+ #.sb!vm:complex-string-widetag)
((bit)
- #.sb!vm:complex-bit-vector-type)
+ #.sb!vm:complex-bit-vector-widetag)
;; OK, we have to wade into SUBTYPEPing after all.
(t
(pick-vector-type type
- (base-char #.sb!vm:complex-string-type)
- (bit #.sb!vm:complex-bit-vector-type)
- (t #.sb!vm:complex-vector-type)))))
+ (base-char #.sb!vm:complex-string-widetag)
+ (bit #.sb!vm:complex-bit-vector-widetag)
+ (t #.sb!vm:complex-vector-widetag)))))
(defun make-array (dimensions &key
(element-type t)
(error "can't specify :DISPLACED-INDEX-OFFSET without :DISPLACED-TO"))
(if (and simple (= array-rank 1))
;; Its a (simple-array * (*))
- (multiple-value-bind (type bits) (%vector-type-code element-type)
+ (multiple-value-bind (type n-bits)
+ (%vector-widetag-and-n-bits element-type)
(declare (type (unsigned-byte 8) type)
- (type (integer 1 256) bits))
+ (type (integer 1 256) n-bits))
(let* ((length (car dimensions))
(array (allocate-vector
type
length
- (ceiling (* (if (= type sb!vm:simple-string-type)
+ (ceiling (* (if (= type sb!vm:simple-string-widetag)
(1+ length)
length)
- bits)
- sb!vm:word-bits))))
+ n-bits)
+ sb!vm:n-word-bits))))
(declare (type index length))
(when initial-element-p
(fill array initial-element))
initial-contents initial-element initial-element-p)))
(array (make-array-header
(cond ((= array-rank 1)
- (%complex-vector-type-code element-type))
- (simple sb!vm:simple-array-type)
- (t sb!vm:complex-array-type))
+ (%complex-vector-widetag element-type))
+ (simple sb!vm:simple-array-widetag)
+ (t sb!vm:complex-array-widetag))
array-rank)))
(cond (fill-pointer
(unless (= array-rank 1)
(defun array-in-bounds-p (array &rest subscripts)
#!+sb-doc
- "Returns T if the Subscipts are in bounds for the Array, Nil otherwise."
+ "Return T if the Subscipts are in bounds for the Array, Nil otherwise."
(if (%array-row-major-index array subscripts nil)
t))
(defun aref (array &rest subscripts)
#!+sb-doc
- "Returns the element of the Array specified by the Subscripts."
+ "Return the element of the Array specified by the Subscripts."
(row-major-aref array (%array-row-major-index array subscripts)))
(defun %aset (array &rest stuff)
(defun row-major-aref (array index)
#!+sb-doc
- "Returns the element of array corressponding to the row-major index. This is
+ "Return the element of array corressponding to the row-major index. This is
SETF'able."
(declare (optimize (safety 1)))
(row-major-aref array index))
(defun svref (simple-vector index)
#!+sb-doc
- "Returns the Index'th element of the given Simple-Vector."
+ "Return the INDEX'th element of the given Simple-Vector."
(declare (optimize (safety 1)))
(aref simple-vector index))
(defun bit (bit-array &rest subscripts)
#!+sb-doc
- "Returns the bit from the Bit-Array at the specified Subscripts."
+ "Return the bit from the BIT-ARRAY at the specified SUBSCRIPTS."
(declare (type (array bit) bit-array) (optimize (safety 1)))
(row-major-aref bit-array (%array-row-major-index bit-array subscripts)))
(defun sbit (simple-bit-array &rest subscripts)
#!+sb-doc
- "Returns the bit from the Simple-Bit-Array at the specified Subscripts."
+ "Return the bit from SIMPLE-BIT-ARRAY at the specified SUBSCRIPTS."
(declare (type (simple-array bit) simple-bit-array) (optimize (safety 1)))
(row-major-aref simple-bit-array
(%array-row-major-index simple-bit-array subscripts)))
(defun array-element-type (array)
#!+sb-doc
- "Returns the type of the elements of the array"
+ "Return the type of the elements of the array"
(let ((type (get-type array)))
(macrolet ((pick-element-type (&rest stuff)
`(cond ,@(mapcar #'(lambda (stuff)
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-element-type
- ((sb!vm:simple-string-type sb!vm:complex-string-type) 'base-char)
- ((sb!vm:simple-bit-vector-type sb!vm:complex-bit-vector-type) 'bit)
- (sb!vm:simple-vector-type t)
- (sb!vm:simple-array-unsigned-byte-2-type '(unsigned-byte 2))
- (sb!vm:simple-array-unsigned-byte-4-type '(unsigned-byte 4))
- (sb!vm:simple-array-unsigned-byte-8-type '(unsigned-byte 8))
- (sb!vm:simple-array-unsigned-byte-16-type '(unsigned-byte 16))
- (sb!vm:simple-array-unsigned-byte-32-type '(unsigned-byte 32))
- (sb!vm:simple-array-signed-byte-8-type '(signed-byte 8))
- (sb!vm:simple-array-signed-byte-16-type '(signed-byte 16))
- (sb!vm:simple-array-signed-byte-30-type '(signed-byte 30))
- (sb!vm:simple-array-signed-byte-32-type '(signed-byte 32))
- (sb!vm:simple-array-single-float-type 'single-float)
- (sb!vm:simple-array-double-float-type 'double-float)
+ ((sb!vm:simple-string-widetag sb!vm:complex-string-widetag) 'base-char)
+ ((sb!vm:simple-bit-vector-widetag
+ sb!vm:complex-bit-vector-widetag) 'bit)
+ (sb!vm:simple-vector-widetag t)
+ (sb!vm:simple-array-unsigned-byte-2-widetag '(unsigned-byte 2))
+ (sb!vm:simple-array-unsigned-byte-4-widetag '(unsigned-byte 4))
+ (sb!vm:simple-array-unsigned-byte-8-widetag '(unsigned-byte 8))
+ (sb!vm:simple-array-unsigned-byte-16-widetag '(unsigned-byte 16))
+ (sb!vm:simple-array-unsigned-byte-32-widetag '(unsigned-byte 32))
+ (sb!vm:simple-array-signed-byte-8-widetag '(signed-byte 8))
+ (sb!vm:simple-array-signed-byte-16-widetag '(signed-byte 16))
+ (sb!vm:simple-array-signed-byte-30-widetag '(signed-byte 30))
+ (sb!vm:simple-array-signed-byte-32-widetag '(signed-byte 32))
+ (sb!vm:simple-array-single-float-widetag 'single-float)
+ (sb!vm:simple-array-double-float-widetag 'double-float)
#!+long-float
- (sb!vm:simple-array-long-float-type 'long-float)
- (sb!vm:simple-array-complex-single-float-type '(complex single-float))
- (sb!vm:simple-array-complex-double-float-type '(complex double-float))
+ (sb!vm:simple-array-long-float-widetag 'long-float)
+ (sb!vm:simple-array-complex-single-float-widetag
+ '(complex single-float))
+ (sb!vm:simple-array-complex-double-float-widetag
+ '(complex double-float))
#!+long-float
- (sb!vm:simple-array-complex-long-float-type '(complex long-float))
- ((sb!vm:simple-array-type sb!vm:complex-vector-type
- sb!vm:complex-array-type)
+ (sb!vm:simple-array-complex-long-float-widetag '(complex long-float))
+ ((sb!vm:simple-array-widetag
+ sb!vm:complex-vector-widetag
+ sb!vm:complex-array-widetag)
(with-array-data ((array array) (start) (end))
(declare (ignore start end))
(array-element-type array)))
(defun array-dimension (array axis-number)
#!+sb-doc
- "Returns the length of dimension AXIS-NUMBER of ARRAY."
+ "Return the length of dimension AXIS-NUMBER of ARRAY."
(declare (array array) (type index axis-number))
(cond ((not (array-header-p array))
(unless (= axis-number 0)
projects / sbcl.git / blobdiff