Skip to content
Snippets Groups Projects
Commit 4590448a authored by ram's avatar ram
Browse files

Reimplemented WITH-ARRAY-DATA to pick off the simple case and call

%WITH-ARRAY-DATA in the hairy cases.  Now this macro checks that 
(<= start end length), to prevent bounds errors in unsafe code.
parent e4ae1805
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.8 1991/04/22 15:25:33 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.9 1991/04/24 23:39:34 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -19,28 +19,36 @@ ...@@ -19,28 +19,36 @@
(eval-when (compile) (eval-when (compile)
(setq lisp::*bootstrap-defmacro* t)) (setq lisp::*bootstrap-defmacro* t))
;;; WITH-ARRAY-DATA follows an arbitrarily long chain of displaced arrays ;;; WITH-ARRAY-DATA -- Interface
;;; binding data-var to the data vector, offset-var to the cumulative ;;;
;;; displacement offset, start-var to the actual start index in the data ;;; Checks to see if the array is simple and the start and end are in
;;; vector, and end-var to the actual end of the data vector. Put all the ;;; bounds. If so, it proceeds with those values. Otherwise, it calls
;;; bindings in the LET, so declarations can be made on the variables (for ;;; %WITH-ARRAY-DATA. Note that there is a derive-type method for
;;; example, declaring data-var to be a simple-string. ;;; %WITH-ARRAY-DATA.
;;;
(defmacro with-array-data (((data-var array &key (offset-var (gensym))) (defmacro with-array-data (((data-var array &key (offset-var (gensym)))
(start-var &optional (svalue 0)) (start-var &optional (svalue 0))
(end-var &optional (evalue nil))) (end-var &optional (evalue nil)))
&rest forms) &rest forms)
"Bind data-var to the data-vector eventually reached by following displacement "Given any Array, binds Data-Var to the array's data vector and Start-Var and
links from array, offset-var to a cumulative offset, start-var to the first End-Var to the start and end of the designated portion of the data vector.
index in the data vector, and end-var to the total length of the array plus Svalue and Evalue are any start and end specified to the original operation,
the cumulative offset. Offset-var, start-var, and end-var are declared to be and are factored into the bindings of Start-Var and End-Var. Offset-Var is
fixnums." the cumulative offset of all displacements encountered, and does not
`(multiple-value-bind (,data-var ,offset-var) include Svalue."
(find-data-vector ,array) (once-only ((n-array array)
(let* ((,data-var ,data-var) (n-svalue `(the index ,svalue))
(,offset-var ,offset-var) (n-evalue `(the (or index null) ,evalue)))
(,start-var (+ ,svalue ,offset-var)) `(multiple-value-bind
(,end-var (+ ,offset-var (or ,evalue (array-total-size ,array))))) (,data-var ,start-var ,end-var ,offset-var)
(declare (fixnum ,offset-var ,start-var ,end-var)) (if (typep ,n-array '(simple-array * (*)))
,(once-only ((n-len `(length ,n-array))
(n-end `(or ,n-evalue ,n-len)))
`(if (<= ,n-svalue ,n-end ,n-len)
(values ,n-array ,n-svalue ,n-end 0)
(%with-array-data ,n-array ,n-svalue ,n-evalue)))
(%with-array-data ,n-array ,n-svalue ,n-evalue))
(declare (ignorable ,offset-var))
,@forms))) ,@forms)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment