[Sbcl-commits] CVS: sbcl/src/code array.lisp,1.27,1.28 cross-misc.lisp,1.6,1.7

[William H. N. <wn...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory usw-pr-cvs1:/tmp/cvs-serv16552/src/code

Modified Files:
	array.lisp cross-misc.lisp 
Log Message:
0.7.5.3:
	made BUGS entry for the DEFTRANSFORM gotcha referred to below
	tweak in runtime.c, should still work the same (trying to make 80-char lines:-)
	put CSR's current diff into the main CVS since he's gone for a
		while and I want to work with it now without thinking
		about merging later...
	...BUGS entry for FILL problem
	...fixed FIXME re. %DATA-VECTOR-AND-INDEX
	...defined a DEFTRANSFORM on %DATA-VECTOR-AND-INDEX so 
		things apparently go faster now
	...(didn't define another otherwise-reasonable DEFTRANSFORM on
		%DATA-VECTOR-AND-INDEX, for non-simple VECTORs,
		because it evidently tickles a bug in the DEFTRANSFORM
		system, as reported on sbcl-devel)


Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/array.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- array.lisp	26 Jun 2002 14:11:27 -0000	1.27
+++ array.lisp	2 Jul 2002 12:32:42 -0000	1.28
@@ -49,6 +49,11 @@
 (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.

Index: cross-misc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/cross-misc.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- cross-misc.lisp	13 Jun 2002 08:54:37 -0000	1.6
+++ cross-misc.lisp	2 Jul 2002 12:32:43 -0000	1.7
@@ -68,10 +68,11 @@
     nil))
 
 ;;; This seems to be the portable Common Lisp type test which
-;;; corresponds to the effect of the target SBCL implementation test..
+;;; corresponds to the effect of the target SBCL implementation test...
 (defun sb!kernel:array-header-p (x)
-  (and (typep x 'simple-array)
-       (= 1 (array-rank x))))
+  (and (typep x 'array)
+       (or (not (typep x 'simple-array))
+	   (/= (array-rank x) 1))))
 
 ;;; GENESIS needs these at cross-compile time. The target
 ;;; implementation of these is reasonably efficient by virtue of its