X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=baf07fc24baa9c736c73b9e22005d05ebab0f6ff;hb=1217810e750e3e6b04641309fb8475eb5963e35e;hp=178f6b4cd391b91bd0cdcb983792f346f13f2c31;hpb=f1a74e4c149c396d265bfab79306429163d893e5;p=sbcl.git

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 178f6b4..baf07fc 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -50,7 +50,7 @@
 	  ((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)
+(deftransform hairy-data-vector-ref ((array index) (array t) *)
   "avoid runtime dispatch on array element type"
   (let ((element-ctype (extract-upgraded-element-type array))
 	(declared-element-ctype (extract-declared-element-type array)))
@@ -103,8 +103,7 @@
 
 (deftransform hairy-data-vector-set ((array index new-value)
 				     (array t t)
-				     *
-				     :important t)
+				     *)
   "avoid runtime dispatch on array element type"
   (let ((element-ctype (extract-upgraded-element-type array))
 	(declared-element-ctype (extract-declared-element-type array)))
@@ -153,8 +152,7 @@
 
 (deftransform %data-vector-and-index ((%array %index)
 				      (simple-array t)
-				      *
-				      :important t)
+				      *)
   ;; KLUDGE: why the percent signs?  Well, ARRAY and INDEX are
   ;; respectively exported from the CL and SB!INT packages, which
   ;; means that they're visible to all sorts of things.  If the
@@ -444,29 +442,20 @@
 (define-good-modular-fun logior)
 ;;; FIXME: XOR? ANDC1, ANDC2?  -- CSR, 2003-09-16
 
-#!-alpha
-(progn
-  (defknown #1=sb!vm::ash-left-mod32 (integer (integer 0)) (unsigned-byte 32)
-            (foldable flushable movable))
-  (define-modular-fun-optimizer ash ((integer count) :width width)
-    (when (and (<= width 32)
-               (constant-lvar-p count)  ; ?
-               (plusp (lvar-value count)))
-      (cut-to-width integer width)
-      '#1#))
-  (setf (gethash '#1# *modular-versions*) '(ash 32)))
-#!+alpha
-(progn
-  (defknown #1=sb!vm::ash-left-mod64 (integer (integer 0)) (unsigned-byte 64)
-            (foldable flushable movable))
-  (define-modular-fun-optimizer ash ((integer count) :width width)
-    (when (and (<= width 64)
-               (constant-lvar-p count)  ; ?
-               (plusp (lvar-value count)))
-      (cut-to-width integer width)
-      '#1#))
-  (setf (gethash '#1# *modular-versions*) '(ash 64)))
-
+(macrolet
+    ((def (name width)
+	 `(progn
+	    (defknown ,name (integer (integer 0)) (unsigned-byte ,width)
+		      (foldable flushable movable))
+	    (define-modular-fun-optimizer ash ((integer count) :width width)
+	      (when (and (<= width 32)
+			 (constant-lvar-p count) ;?
+			 (plusp (lvar-value count)))
+		(cut-to-width integer width)
+		',name))
+	    (setf (gethash ',name *modular-versions*) `(ash ,',width)))))
+  #!-alpha (def sb!vm::ash-left-mod32 32)
+  #!+alpha (def sb!vm::ash-left-mod64 64))
 
 ;;; There are two different ways the multiplier can be recoded. The
 ;;; more obvious is to shift X by the correct amount for each bit set