[Sbcl-commits] CVS: sbcl/src/compiler srctran.lisp,1.97,1.98

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

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

Modified Files:
	srctran.lisp 
Log Message:
0.8.4.12:
        I'm not proud of this.

        HEALTH WARNING: this may not work.  It does for me, on Linux/PPC.
		If your sourceforge-fu is strong, please try it.
        HEALTH WARNING: this is ugly as sin.  Unexported symbols, special
                assumptions, KLUDGEs thrown in with gay abandon.

        In partial mitigation, it does fix a bug :-)

        Fix for lying-to-the-compiler bug in 
                UB32-STRENGTH-REDUCE-CONSTANT-MULTIPLY
        ... turn TRULY-THEs into suitable LOGANDs
                (inefficient in compile-time space; we only need one
                LOGAND wrapping the resulting form)
        ... likewise in x86 OPTIMIZE-MULTIPLY
                (even less efficient: constant mask is first :-)
        but that would be slow at runtime if we just left it there, so
        ... add - as a modular function (that was easy)
        ... add preliminary support for ASH as a modular function
                (for constant right shifts):
        ... delete ASH-RIGHT-[UN]SIGNED from the sparc backend
                (will be restored eventually, fear not, probably more
		cross-platformly)
        ... hack in special knowledge about ASH into CUT-TO-WIDTH
        ... ensure that all backends have a suitable VOP for translation
                of new ASH function
        ... (alpha version is 64bit, oh yes)
        ... don't forget out-of-line version (for xc also!)
                (aside: might we not need out-of-line versions of
                other modular functions in the xc?)


Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.97
retrieving revision 1.98
diff -u -d -r1.97 -r1.98
--- srctran.lisp	3 Oct 2003 10:20:31 -0000	1.97
+++ srctran.lisp	9 Oct 2003 11:05:11 -0000	1.98
@@ -2539,23 +2539,52 @@
                       (modular-fun (find-modular-version fun-name width))
                       (name (and (modular-fun-info-p modular-fun)
                                  (modular-fun-info-name modular-fun))))
-                 (when (and modular-fun
-                            (not (and (eq name 'logand)
-                                      (csubtypep
-                                       (single-value-type (node-derived-type node))
-                                       (specifier-type `(unsigned-byte ,width))))))
-                   (unless (eq modular-fun :good)
-                     (setq did-something t)
-                     (change-ref-leaf
-                        fun-ref
-                        (find-free-fun name "in a strange place"))
-                       (setf (combination-kind node) :full))
-                   (dolist (arg (basic-combination-args node))
-                     (when (cut-lvar arg)
-                       (setq did-something t)))
-                   (when did-something
-                     (reoptimize-node node fun-name))
-                   did-something))))
+		 (cond
+		   ((and modular-fun
+			 (not (and (eq name 'logand)
+				   (csubtypep
+				    (single-value-type (node-derived-type node))
+				    (specifier-type `(unsigned-byte ,width))))))
+		    (unless (eq modular-fun :good)
+		      (setq did-something t)
+		      (change-ref-leaf
+		       fun-ref
+		       (find-free-fun name "in a strange place"))
+		      (setf (combination-kind node) :full))
+		    (dolist (arg (basic-combination-args node))
+		      (when (cut-lvar arg)
+			(setq did-something t)))
+		    (when did-something
+		      (reoptimize-node node fun-name))
+		    did-something)
+		   ;; FIXME: This clause is a workaround for a fairly
+		   ;; critical bug.  Prior to this, strength reduction
+		   ;; of constant (unsigned-byte 32) multiplication
+		   ;; achieved modular arithmetic by lying to the
+		   ;; compiler with TRULY-THE.  Since we now have an
+		   ;; understanding of modular arithmetic, we can stop
+		   ;; lying to the compiler, at the cost of
+		   ;; uglification of this code.  Probably we want to
+		   ;; generalize the modular arithmetic mechanism to
+		   ;; be able to deal with more complex operands (ASH,
+		   ;; EXPT, ...?)  -- CSR, 2003-10-09
+		   ((and 
+		     (eq fun-name 'ash)
+		     ;; FIXME: only constants for now, but this
+		     ;; complicates implementation of the out of line
+		     ;; version of modular ASH.  -- CSR, 2003-10-09
+		     (constant-lvar-p (second (basic-combination-args node)))
+		     (> (lvar-value (second (basic-combination-args node))) 0))
+		    (setq did-something t)
+		    (change-ref-leaf
+		     fun-ref
+		     (find-free-fun 
+		      #!-alpha 'sb!vm::ash-left-constant-mod32
+		      #!+alpha 'sb!vm::ash-left-constant-mod64
+		      "in a strange place"))
+		    (setf (combination-kind node) :full)
+		    (cut-lvar (first (basic-combination-args node)))
+		    (reoptimize-node node 'ash))))))
            (cut-lvar (lvar &aux did-something)
              (do-uses (node lvar)
                (when (cut-node node)