projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.7.6.3:
[sbcl.git]
/
src
/
code
/
array.lisp
diff --git
a/src/code/array.lisp
b/src/code/array.lisp
index
0770723
..
360514d
100644
(file)
--- a/
src/code/array.lisp
+++ b/
src/code/array.lisp
@@
-49,6
+49,11
@@
(defun %with-array-data (array start end)
(%with-array-data-macro array start end :fail-inline? t))
(defun %with-array-data (array start end)
(%with-array-data-macro array start end :fail-inline? t))
+(defun %data-vector-and-index (array index)
+ (if (array-header-p array)
+ (%with-array-data array index nil)
+ (values array index)))
+
;;; It'd waste space to expand copies of error handling in every
;;; inline %WITH-ARRAY-DATA, so we have them call this function
;;; instead. This is just a wrapper which is known never to return.
;;; It'd waste space to expand copies of error handling in every
;;; inline %WITH-ARRAY-DATA, so we have them call this function
;;; instead. This is just a wrapper which is known never to return.
@@
-330,7
+335,7
@@
(defun hairy-data-vector-set (array index new-value)
(with-array-data ((vector array) (index index) (end))
(defun hairy-data-vector-set (array index new-value)
(with-array-data ((vector array) (index index) (end))
- (declare (ignore end) (optimize))
+ (declare (ignore end))
(etypecase vector .
#.(mapcar (lambda (type)
(let ((atype `(simple-array ,type (*))))
(etypecase vector .
#.(mapcar (lambda (type)
(let ((atype `(simple-array ,type (*))))
@@
-338,7
+343,13
@@
(data-vector-set (the ,atype vector)
index
(the ,type
(data-vector-set (the ,atype vector)
index
(the ,type
- new-value)))))
+ new-value))
+ ;; For specialized arrays, the return
+ ;; from data-vector-set would have to
+ ;; be reboxed to be a (Lisp) return
+ ;; value; instead, we use the
+ ;; already-boxed value as the return.
+ new-value)))
*specialized-array-element-types*))))
(defun %array-row-major-index (array subscripts
*specialized-array-element-types*))))
(defun %array-row-major-index (array subscripts