(assert-array-rank array (1- (length stuff)))
(assert-new-value-type (car (last stuff)) array))
-(defoptimizer (hairy-data-vector-ref derive-type) ((array index))
- (extract-upgraded-element-type array))
-(defoptimizer (data-vector-ref derive-type) ((array index))
- (extract-upgraded-element-type array))
-#!+x86
+(macrolet ((define (name)
+ `(defoptimizer (,name derive-type) ((array index))
+ (extract-upgraded-element-type array))))
+ (define hairy-data-vector-ref)
+ (define hairy-data-vector-ref/check-bounds)
+ (define data-vector-ref))
+
+#!+(or x86 x86-64)
(defoptimizer (data-vector-ref-with-offset derive-type) ((array index offset))
(extract-upgraded-element-type array))
-(defoptimizer (data-vector-set derive-type) ((array index new-value))
- (assert-new-value-type new-value array))
-#!+x86
+(macrolet ((define (name)
+ `(defoptimizer (,name derive-type) ((array index new-value))
+ (assert-new-value-type new-value array))))
+ (define hairy-data-vector-set)
+ (define hairy-data-vector-set/check-bounds)
+ (define data-vector-set))
+
+#!+(or x86 x86-64)
(defoptimizer (data-vector-set-with-offset derive-type) ((array index offset new-value))
(assert-new-value-type new-value array))
-(defoptimizer (hairy-data-vector-set derive-type) ((array index new-value))
- (assert-new-value-type new-value array))
;;; Figure out the type of the data vector if we know the argument
;;; element type.
,@(mapcar (lambda (el)
(once-only ((n-val el))
`(locally (declare (optimize (safety 0)))
- (setf (svref ,n-vec ,(incf n))
- ,n-val))))
+ (setf (svref ,n-vec ,(incf n)) ,n-val))))
elements)
,n-vec))))
:node node
:policy (> speed space))
"inline non-SIMPLE-vector-handling logic"
- (let ((element-type (upgraded-element-type-specifier-or-give-up array)))
- `(%with-array-data-macro array start end
- :unsafe? ,(policy node (= safety 0))
- :element-type ,element-type)))
+ (let ((element-type (upgraded-element-type-specifier-or-give-up array))
+ (type (lvar-type array)))
+ (if (and (array-type-p type)
+ (listp (array-type-dimensions type))
+ (not (null (cdr (array-type-dimensions type)))))
+ ;; If it's a simple multidimensional array, then just return its
+ ;; data vector directly rather than going through
+ ;; %WITH-ARRAY-DATA-MACRO. SBCL doesn't generally generate code
+ ;; that would use this currently, but we have encouraged users
+ ;; to use WITH-ARRAY-DATA and we may use it ourselves at some
+ ;; point in the future for optimized libraries or similar.
+ `(let ((data (truly-the (simple-array ,element-type (*))
+ (%array-data-vector array))))
+ (values data 0 (length data) 0))
+ `(%with-array-data-macro array start end
+ :unsafe? ,(policy node (= safety 0))
+ :element-type ,element-type))))
\f
;;;; array accessors
(deftransform aref ((array &rest indices))
(with-row-major-index (array indices index)
(hairy-data-vector-ref array index)))
+
(deftransform %aset ((array &rest stuff))
(let ((indices (butlast stuff)))
(with-row-major-index (array indices index new-value)
(hairy-data-vector-set array index new-value)))))
+;; For AREF of vectors we do the bounds checking in the callee. This
+;; lets us do a significantly more efficient check for simple-arrays
+;; without bloating the code.
+(deftransform aref ((array index) (t t) * :node node)
+ (if (policy node (zerop insert-array-bounds-checks))
+ `(hairy-data-vector-ref array index)
+ `(hairy-data-vector-ref/check-bounds array index)))
+
+(deftransform %aset ((array index new-value) (t t t) * :node node)
+ (if (policy node (zerop insert-array-bounds-checks))
+ `(hairy-data-vector-set array index new-value)
+ `(hairy-data-vector-set/check-bounds array index new-value)))
+
+;;; But if we find out later that there's some useful type information
+;;; available, switch back to the normal one to give other transforms
+;;; a stab at it.
+(macrolet ((define (name transform-to extra extra-type)
+ `(deftransform ,name ((array index ,@extra))
+ (let ((type (lvar-type array))
+ (element-type (extract-upgraded-element-type array)))
+ ;; If an element type has been declared, we want to
+ ;; use that information it for type checking (even
+ ;; if the access can't be optimized due to the array
+ ;; not being simple).
+ (when (and (eql element-type *wild-type*)
+ ;; This type logic corresponds to the special
+ ;; case for strings in HAIRY-DATA-VECTOR-REF
+ ;; (generic/vm-tran.lisp)
+ (not (csubtypep type (specifier-type 'simple-string))))
+ (when (or (not (array-type-p type))
+ ;; If it's a simple array, we might be able
+ ;; to inline the access completely.
+ (not (null (array-type-complexp type))))
+ (give-up-ir1-transform
+ "Upgraded element type of array is not known at compile time."))))
+ `(,',transform-to array
+ (%check-bound array
+ (array-dimension array 0)
+ index)
+ ,@',extra))))
+ (define hairy-data-vector-ref/check-bounds
+ hairy-data-vector-ref nil nil)
+ (define hairy-data-vector-set/check-bounds
+ hairy-data-vector-set (new-value) (*)))
+
+(deftransform aref ((array index) ((or simple-vector
+ (simple-unboxed-array 1))
+ index))
+ (let ((type (lvar-type array)))
+ (unless (array-type-p type)
+ ;; Not an exactly specified one-dimensional simple array -> punt
+ ;; to the complex version.
+ (give-up-ir1-transform)))
+ `(data-vector-ref array (%check-bound array
+ (array-dimension array 0)
+ index)))
+
;;; Just convert into a HAIRY-DATA-VECTOR-REF (or
;;; HAIRY-DATA-VECTOR-SET) after checking that the index is inside the
;;; array total size.
projects / sbcl.git / blobdiff