X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsysmacs.lisp;h=ab967520c956b268de93909bdf89d4b71e877412;hb=f4f18b9dcdaf1948947b1747f5bfa766a1a0ee4c;hp=34bcb94385311dce7332c77419fb53c25b2bd031;hpb=2c6b90e36a7c0377cd79625eb6c94d580f98cb93;p=sbcl.git diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp index 34bcb94..ab96752 100644 --- a/src/code/sysmacs.lisp +++ b/src/code/sysmacs.lisp @@ -10,47 +10,7 @@ ;;;; files for more information. (in-package "SB!IMPL") - -;;; This checks to see whether the array is simple and the start and -;;; end are in bounds. If so, it proceeds with those values. -;;; Otherwise, it calls %WITH-ARRAY-DATA. Note that %WITH-ARRAY-DATA -;;; may be further optimized. -;;; -;;; Given any ARRAY, bind DATA-VAR to the array's data vector and -;;; START-VAR and END-VAR to the start and end of the designated -;;; portion of the data vector. SVALUE and EVALUE are any start and -;;; end specified to the original operation, and are factored into the -;;; bindings of START-VAR and END-VAR. OFFSET-VAR is the cumulative -;;; offset of all displacements encountered, and does not include -;;; SVALUE. -(defmacro with-array-data (((data-var array &key offset-var) - (start-var &optional (svalue 0)) - (end-var &optional (evalue nil))) - &body forms) - (once-only ((n-array array) - (n-svalue `(the index ,svalue)) - (n-evalue `(the (or index null) ,evalue))) - `(multiple-value-bind (,data-var - ,start-var - ,end-var - ,@(when offset-var `(,offset-var))) - (if (not (array-header-p ,n-array)) - (let ((,n-array ,n-array)) - (declare (type (simple-array * (*)) ,n-array)) - ,(once-only ((n-len `(length ,n-array)) - (n-end `(or ,n-evalue ,n-len))) - `(if (<= ,n-svalue ,n-end ,n-len) - ;; success - (values ,n-array ,n-svalue ,n-end 0) - ;; failure: Make a NOTINLINE call to - ;; %WITH-ARRAY-DATA with our bad data - ;; to cause the error to be signalled. - (locally - (declare (notinline %with-array-data)) - (%with-array-data ,n-array ,n-svalue ,n-evalue))))) - (%with-array-data ,n-array ,n-svalue ,n-evalue)) - ,@forms))) - + #!-gengc (defmacro without-gcing (&rest body) #!+sb-doc