(svref ,',table-name tag)))))))
(def !find-data-vector-setter %%data-vector-setters%%)
(def !find-data-vector-setter/check-bounds %%data-vector-setters/check-bounds%%)
- (def !find-data-vector-reffer %%data-vector-reffers%%)
+ ;; Used by DO-VECTOR-DATA -- which in turn appears in DOSEQUENCE expansion,
+ ;; meaning we can have post-build dependences on this.
+ (def %find-data-vector-reffer %%data-vector-reffers%%)
(def !find-data-vector-reffer/check-bounds %%data-vector-reffers/check-bounds%%))
+;;; Like DOVECTOR, but more magical -- can't use this on host.
+(defmacro do-vector-data ((elt vector &optional result) &body body)
+ (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
+ (with-unique-names (index vec start end ref)
+ `(with-array-data ((,vec ,vector)
+ (,start)
+ (,end)
+ :check-fill-pointer t)
+ (let ((,ref (%find-data-vector-reffer ,vec)))
+ (do ((,index ,start (1+ ,index)))
+ ((>= ,index ,end)
+ (let ((,elt nil))
+ ,@(filter-dolist-declarations decls)
+ ,elt
+ ,result))
+ (let ((,elt (funcall ,ref ,vec ,index)))
+ ,@decls
+ (tagbody ,@forms))))))))
+
(macrolet ((%ref (accessor-getter extra-params)
`(funcall (,accessor-getter array) array index ,@extra-params))
(define (accessor-name slow-accessor-name accessor-getter
(declare (ignore end))
(,accessor-name vector index ,@extra-params)))))))
(define hairy-data-vector-ref slow-hairy-data-vector-ref
- !find-data-vector-reffer
+ %find-data-vector-reffer
nil (progn))
(define hairy-data-vector-set slow-hairy-data-vector-set
!find-data-vector-setter
;;;; array type dispatching
-;;; Store some saetp fields for DEFINE-ARRAY-DISPATCH since
-;;; sb!vm:*specialized-array-element-type-properties* is not always
-;;; available.
-(macrolet
- ((define-saetp-info ()
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (defglobal %%saetp-info%%
- ',(loop for saetp
- across sb!vm:*specialized-array-element-type-properties*
- collect `(,(sb!vm:saetp-typecode saetp)
- ,(sb!vm:saetp-specifier saetp)
- ,(sb!vm:saetp-primitive-type-name saetp)))))))
- (define-saetp-info))
-
;;; Given DISPATCH-FOO as the DISPATCH-NAME argument (unevaluated),
;;; defines the functions
;;;
:expected-type '(simple-array * (*)))))
(defglobal ,table-name (make-array ,(1+ sb!vm:widetag-mask)
:initial-element #',error-name))
- ,@(loop for (typecode specifier primitive-type-name) in %%saetp-info%%
+ ,@(loop for info across sb!vm:*specialized-array-element-type-properties*
+ for typecode = (sb!vm:saetp-typecode info)
+ for specifier = (sb!vm:saetp-specifier info)
+ for primitive-type-name = (sb!vm:saetp-primitive-type-name info)
collect (let ((fun-name (symbolicate (string dispatch-name)
"/" primitive-type-name)))
`(progn