[Sbcl-commits] CVS: sbcl/src/compiler/generic vm-tran.lisp,1.27,1.27.2.1

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory sc8-pr-cvs1:/tmp/cvs-serv19921/src/compiler/generic

Modified Files:
      Tag: vector_nil_string_branch
	vm-tran.lisp 
Log Message:
0.8.0.78.vector-nil-string.3:
	Fix most of the performance problem
	... transforms for HAIRY-DATA-VECTOR-{REF,SET} on SIMPLE-STRING

Right.  The all-important "compile sbcl" benchmark is now back to about 
where it was (57 minutes on my laptop).  There are still correctness 
issues to deal with, not least 
  (sxhash (make-array 5 :element-type nil)) 
but this path isn't proving ridiculously expensive.


Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.27
retrieving revision 1.27.2.1
diff -u -d -r1.27 -r1.27.2.1
--- vm-tran.lisp	10 Jun 2003 11:08:13 -0000	1.27
+++ vm-tran.lisp	23 Jun 2003 08:46:05 -0000	1.27.2.1
@@ -41,6 +41,15 @@
 
 ;;;; simplifying HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET
 
+(deftransform hairy-data-vector-ref ((string index) (simple-string t))
+  (let ((ctype (continuation-type string)))
+    (if (array-type-p ctype)
+	;; the other transform will kick in, so that's OK
+	(give-up-ir1-transform)
+	`(typecase string
+	  ((simple-array character (*)) (data-vector-ref string index))
+	  ((simple-array nil (*)) (data-vector-ref string index))))))
+
 (deftransform hairy-data-vector-ref ((array index) (array t) * :important t)
   "avoid runtime dispatch on array element type"
   (let ((element-ctype (extract-upgraded-element-type array)))
@@ -93,6 +102,18 @@
 	 (data-vector-set array
 			  index
 			  new-value)))))
+
+(deftransform hairy-data-vector-set ((string index new-value)
+				     (simple-string t t))
+  (let ((ctype (continuation-type string)))
+    (if (array-type-p ctype)
+	;; the other transform will kick in, so that's OK
+	(give-up-ir1-transform)
+	`(typecase string
+	  ((simple-array character (*))
+	   (data-vector-set string index new-value))
+	  ((simple-array nil (*))
+	   (data-vector-set string index new-value))))))
 
 (deftransform data-vector-set ((array index new-value)
                                (simple-array t t))