X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=05e57ab33c496e9c0f4ca899d11b9963b2ce2898;hb=dfa55a883f94470267b626dae77ce7e7dfac3df6;hp=98d26dbf6ce3817dabb622aef4e790398fe9db85;hpb=2d195da5e29feadce7190ea1a68a2efa83a5e1c0;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 98d26db..05e57ab 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -11,10 +11,10 @@
 
 (in-package "SB!C")
 
-;;;; Derive-Type Optimizers
+;;;; DERIVE-TYPE optimizers
 
-;;; Array operations that use a specific number of indices implicitly assert
-;;; that the array is of that rank.
+;;; Array operations that use a specific number of indices implicitly
+;;; assert that the array is of that rank.
 (defun assert-array-rank (array rank)
   (assert-continuation-type
    array
@@ -45,8 +45,8 @@
       (assert-continuation-type new-value (array-type-element-type type))))
   (continuation-type new-value))
 
-;;; Return true if Arg is NIL, or is a constant-continuation whose value is
-;;; NIL, false otherwise.
+;;; Return true if Arg is NIL, or is a constant-continuation whose
+;;; value is NIL, false otherwise.
 (defun unsupplied-or-nil (arg)
   (declare (type (or continuation null) arg))
   (or (not arg)
@@ -108,7 +108,7 @@
 		     (unsupplied-or-nil fill-pointer))))
     (specifier-type
      `(,(if simple 'simple-array 'array)
-       ,(cond ((not element-type) 't)
+       ,(cond ((not element-type) t)
 	      ((constant-continuation-p element-type)
 	       (continuation-value element-type))
 	      (t
@@ -425,11 +425,62 @@
 
 ;;;; array accessors
 
-;;; SVREF, %SVSET, SCHAR, %SCHARSET, CHAR,
-;;; %CHARSET, SBIT, %SBITSET, BIT, %BITSET
-;;;   --  source transforms.
-;;;
-;;; We convert all typed array accessors into aref and %aset with type
+;;; FIXME: This was commented out in sbcl-0.6.9.21 since it was
+;;; causing a problem in a CHAR form in HEXSTR. It's still important
+;;; to be able to inline this, so something along these lines
+;;; will probably be back, but it might be different in detail, e.g.
+;;; (DECLAIM (MAYBE-INLINE %WITH-ARRAY-DATA)).
+#|
+;;; Handle the 1-dimensional case of %WITH-ARRAY-DATA specially. It's
+;;; important to do this efficiently if we want people to be able to
+;;; use vectors with fill pointers anywhere near inner loops, and
+;;; hence it's important to do this efficiently if we want people to
+;;; be able to use sequence functions anywhere near inner loops.
+(deftransform %with-array-data ((array start end)
+				(vector index (or index null))
+				*
+				:important t
+				:node node
+				:policy (> speed space))
+  "avoid full call to %WITH-ARRAY-DATA at runtime"
+  (let* ((element-ctype (extract-upgraded-element-type array))
+	 (element-type-specifier (type-specifier element-ctype))
+	 (simple-array-type `(simple-array ,element-type-specifier 1)))
+    (declare (type ctype element-ctype))
+    `(let* (;; FIXME: Instead of doing this hairy expression for SIZE,
+	    ;; it should just be (ARRAY-DIMENSION ARRAY 0), and there
+	    ;; should be a DEFTRANSFORM for ARRAY-DIMENSION which
+	    ;; expands that way.
+	    (size (if (array-header-p array)
+		      (%array-dimension array 0)
+		      (length (the ,simple-array-type array))))
+	    (end (if end
+		     (if (or ,(policy node (= safety 0))
+			     (<= (the index end) size))
+			 end
+			 (vector-data-start-out-of-range))
+		     size)))
+       (declare (type index end))
+       (unless (or ,(policy node (= safety 0))
+		   (<= start end))
+	 (vector-data-end-out-of-range))
+       (do (;; cumulative displacement
+	    (d 0 (truly-the index (+ d (%array-displacement array))))
+	    ;; eventually becomes bare data vector
+	    (v array (%array-data-vector v))) 
+	   ((not (array-header-p v))
+	    (values (the ,simple-array-type v)
+		    (truly-the index (+ d start))
+		    (truly-the index (+ d end))
+		    (the index d)))
+	 (declare (type index d))))))
+(defun vector-data-start-out-of-range ()
+  (error "The start of vector data was out of range."))
+(defun vector-data-end-out-of-range ()
+  (error "The end of vector data was out of range."))
+|#
+
+;;; We convert all typed array accessors into AREF and %ASET with type
 ;;; assertions on the array.
 (macrolet ((define-frob (reffer setter type)
 	     `(progn