;; and for all in any reasonable user programs.)
((t)
(values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
- ((base-char standard-char)
+ ((base-char standard-char character)
(values #.sb!vm:simple-base-string-widetag #.sb!vm:n-byte-bits))
((bit)
(values #.sb!vm:simple-bit-vector-widetag 1))
;; Pick off some easy common cases.
((t)
#.sb!vm:complex-vector-widetag)
- ((base-char)
+ ((base-char character)
#.sb!vm:complex-base-string-widetag)
((nil)
#.sb!vm:complex-vector-nil-widetag)
(t
(pick-vector-type type
(nil #.sb!vm:complex-vector-nil-widetag)
- (base-char #.sb!vm:complex-base-string-widetag)
+ (character #.sb!vm:complex-base-string-widetag)
(bit #.sb!vm:complex-bit-vector-widetag)
(t #.sb!vm:complex-vector-widetag)))))
(fill array initial-element))
(when initial-contents-p
(when initial-element-p
- (error "can't specify both :INITIAL-ELEMENT and ~
- :INITIAL-CONTENTS"))
- (unless (= length (length initial-contents))
- (error "There are ~W elements in the :INITIAL-CONTENTS, but ~
- the vector length is ~W."
- (length initial-contents)
- length))
+ (error "can't specify both :INITIAL-ELEMENT and ~
+ :INITIAL-CONTENTS"))
+ (unless (= length (length initial-contents))
+ (error "There are ~W elements in the :INITIAL-CONTENTS, but ~
+ the vector length is ~W."
+ (length initial-contents)
+ length))
(replace array initial-contents))
array))
;; it's either a complex array or a multidimensional array.
(cond (displaced-to
(when (or initial-element-p initial-contents-p)
(error "Neither :INITIAL-ELEMENT nor :INITIAL-CONTENTS ~
- can be specified along with :DISPLACED-TO"))
+ can be specified along with :DISPLACED-TO"))
(let ((offset (or displaced-index-offset 0)))
(when (> (+ offset total-size)
(array-total-size displaced-to))
initial-element initial-element-p)
(when (and initial-contents-p initial-element-p)
(error "cannot supply both :INITIAL-CONTENTS and :INITIAL-ELEMENT to
- either MAKE-ARRAY or ADJUST-ARRAY."))
+ either MAKE-ARRAY or ADJUST-ARRAY."))
(let ((data (if initial-element-p
(make-array total-size
:element-type element-type
(incf index))
(t
(unless (typep contents 'sequence)
- (error "malformed :INITIAL-CONTENTS: ~S is not a ~
- sequence, but ~W more layer~:P needed."
+ (error "malformed :INITIAL-CONTENTS: ~S is not a ~
+ sequence, but ~W more layer~:P needed."
contents
(- (length dimensions) axis)))
(unless (= (length contents) (car dims))
- (error "malformed :INITIAL-CONTENTS: Dimension of ~
- axis ~W is ~W, but ~S is ~W long."
+ (error "malformed :INITIAL-CONTENTS: Dimension of ~
+ axis ~W is ~W, but ~S is ~W long."
axis (car dims) contents (length contents)))
(if (listp contents)
(dolist (content contents)
(error "Axis number ~W is too big; ~S only has ~D dimension~:P."
axis-number array (%array-rank array)))
(t
- (%array-dimension array axis-number))))
+ ;; ANSI sayeth (ADJUST-ARRAY dictionary entry):
+ ;;
+ ;; "If A is displaced to B, the consequences are
+ ;; unspecified if B is adjusted in such a way that it no
+ ;; longer has enough elements to satisfy A.
+ ;;
+ ;; In situations where this matters we should be doing a
+ ;; bounds-check, which in turn uses ARRAY-DIMENSION -- so
+ ;; this seems like a good place to signal an error.
+ (multiple-value-bind (target offset) (array-displacement array)
+ (when (and target
+ (> (array-total-size array)
+ (- (array-total-size target) offset)))
+ (error 'displaced-to-array-too-small-error
+ :format-control "~@<The displaced-to array is too small. ~S ~
+ elements after offset required, ~S available.~:@>"
+ :format-arguments (list (array-total-size array)
+ (- (array-total-size target) offset))))
+ (%array-dimension array axis-number)))))
(defun array-dimensions (array)
#!+sb-doc
(declare (fixnum fill-pointer))
(when (= fill-pointer (%array-available-elements vector))
(adjust-array vector (+ fill-pointer extension)))
- (setf (aref vector fill-pointer) new-element)
+ ;; disable bounds checking
+ (locally (declare (optimize (safety 0)))
+ (setf (aref vector fill-pointer) new-element))
(setf (%array-fill-pointer vector) (1+ fill-pointer))
fill-pointer))
(declare (fixnum fill-pointer))
(if (zerop fill-pointer)
(error "There is nothing left to pop.")
- (aref array
- (setf (%array-fill-pointer array)
- (1- fill-pointer))))))
+ ;; disable bounds checking (and any fixnum test)
+ (locally (declare (optimize (safety 0)))
+ (aref array
+ (setf (%array-fill-pointer array)
+ (1- fill-pointer)))))))
+
\f
;;;; ADJUST-ARRAY
element-type)))
(let ((array-rank (length (the list dimensions))))
(declare (fixnum array-rank))
- (when (and fill-pointer (> array-rank 1))
- (error "Multidimensional arrays can't have fill pointers."))
+ (unless (= array-rank 1)
+ (when fill-pointer
+ (error "Only vectors can have fill pointers.")))
(cond (initial-contents-p
;; array former contents replaced by INITIAL-CONTENTS
(if (or initial-element-p displaced-to)
- (error "INITIAL-CONTENTS may not be specified with ~
- the :INITIAL-ELEMENT or :DISPLACED-TO option."))
+ (error "INITIAL-CONTENTS may not be specified with ~
+ the :INITIAL-ELEMENT or :DISPLACED-TO option."))
(let* ((array-size (apply #'* dimensions))
(array-data (data-vector-from-inits
dimensions array-size element-type
(displaced-to
;; We already established that no INITIAL-CONTENTS was supplied.
(when initial-element
- (error "The :INITIAL-ELEMENT option may not be specified ~
- with :DISPLACED-TO."))
- (unless (subtypep element-type (array-element-type displaced-to))
- (error "can't displace an array of type ~S into another of ~
- type ~S"
+ (error "The :INITIAL-ELEMENT option may not be specified ~
+ with :DISPLACED-TO."))
+ (unless (subtypep element-type (array-element-type displaced-to))
+ (error "can't displace an array of type ~S into another of ~
+ type ~S"
element-type (array-element-type displaced-to)))
(let ((displacement (or displaced-index-offset 0))
(array-size (apply #'* dimensions)))
(when (array-has-fill-pointer-p old-array)
(when (> (%array-fill-pointer old-array) new-array-size)
(error "cannot ADJUST-ARRAY an array (~S) to a size (~S) that is ~
- smaller than its fill pointer (~S)"
+ smaller than its fill pointer (~S)"
old-array new-array-size (fill-pointer old-array)))
(%array-fill-pointer old-array)))
((not (array-has-fill-pointer-p old-array))
(error "cannot supply a non-NIL value (~S) for :FILL-POINTER ~
- in ADJUST-ARRAY unless the array (~S) was originally ~
- created with a fill pointer"
+ in ADJUST-ARRAY unless the array (~S) was originally ~
+ created with a fill pointer"
fill-pointer
old-array))
((numberp fill-pointer)
(when (> fill-pointer new-array-size)
(error "can't supply a value for :FILL-POINTER (~S) that is larger ~
- than the new length of the vector (~S)"
+ than the new length of the vector (~S)"
fill-pointer new-array-size))
fill-pointer)
((eq fill-pointer t)
,@(map 'list
(lambda (saetp)
`((simple-array ,(sb!vm:saetp-specifier saetp) (*))
- ,(if (eq (sb!vm:saetp-specifier saetp) 'base-char)
+ ,(if (eq (sb!vm:saetp-specifier saetp) 'character)
*default-init-char-form*
(sb!vm:saetp-initial-element-default saetp))))
(remove-if-not
(defmacro def-bit-array-op (name function)
`(defun ,name (bit-array-1 bit-array-2 &optional result-bit-array)
+ #!+sb-doc
,(format nil
"Perform a bit-wise ~A on the elements of BIT-ARRAY-1 and ~
- BIT-ARRAY-2,~% putting the results in RESULT-BIT-ARRAY. ~
- If RESULT-BIT-ARRAY is T,~% BIT-ARRAY-1 is used. If ~
- RESULT-BIT-ARRAY is NIL or omitted, a new array is~% created. ~
- All the arrays must have the same rank and dimensions."
+ BIT-ARRAY-2,~% putting the results in RESULT-BIT-ARRAY. ~
+ If RESULT-BIT-ARRAY is T,~% BIT-ARRAY-1 is used. If ~
+ RESULT-BIT-ARRAY is NIL or omitted, a new array is~% created. ~
+ All the arrays must have the same rank and dimensions."
(symbol-name function))
(declare (type (array bit) bit-array-1 bit-array-2)
(type (or (array bit) (member t nil)) result-bit-array))