[Sbcl-commits] CVS: sbcl/src/compiler main.lisp,1.75,1.76 srctran.lisp,1.70,1.71

[Alexey D. <ade...@us...>]

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

Modified Files:
	main.lisp srctran.lisp 
Log Message:
0.8.2.26:
        * Fix bug in the portable implementation of SB-MD5::I;
        * add support for modular functions with argument number
          different from 2;
        * SB!C::CUT-TO-WIDTH: derive node type from the type
          declaration;
        * on x86 reimplement LOGNOT as a modular function and
          implement 32BIT-LOGICAL-NOT in terms of LOGNOT;
        ... remove optimization of LOGNOT with LOGAND dest.


Index: main.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/main.lisp,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -d -r1.75 -r1.76
--- main.lisp	17 Jul 2003 12:00:42 -0000	1.75
+++ main.lisp	13 Aug 2003 09:40:25 -0000	1.76
@@ -445,6 +445,7 @@
 	  (multiple-value-bind (code-length trace-table fixups)
 	      (generate-code component)
 
+            #-sb-xc-host
 	    (when *compiler-trace-output*
 	      (format *compiler-trace-output*
 		      "~|~%disassembly of code for ~S~2%" component)

Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -d -r1.70 -r1.71
--- srctran.lisp	12 Aug 2003 17:42:57 -0000	1.70
+++ srctran.lisp	13 Aug 2003 09:40:26 -0000	1.71
@@ -2441,8 +2441,12 @@
 	     (logand int (lognot mask)))))
 
 ;;; modular functions
+;;;
+;;; -- lower N bits of a result depend only on lower N bits of
+;;; arguments.
 
-;;; Try to cut all uses of the continuation CONT to WIDTH bits.
+;;; Try to recursively cut all uses of the continuation CONT to WIDTH
+;;; bits.
 (defun cut-to-width (cont width)
   (declare (type continuation cont) (type (integer 0) width))
   (labels ((cut-node (node)
@@ -2450,15 +2454,16 @@
                         (fun-info-p (basic-combination-kind node)))
                (let* ((fun-ref (continuation-use (combination-fun node)))
                       (fun-name (leaf-source-name (ref-leaf fun-ref)))
-                      (modular-fun-name (find-modular-version fun-name width)))
-                 (when modular-fun-name
+                      (modular-fun (find-modular-version fun-name width))
+                      (name (and modular-fun
+                                 (modular-fun-info-name modular-fun))))
+                 (when modular-fun
                    (change-ref-leaf fun-ref
-                                    (find-free-fun modular-fun-name
-                                                   "in a strange place"))
+                                    (find-free-fun name "in a strange place"))
                    (setf (combination-kind node) :full)
                    (setf (node-derived-type node)
-                         (values-specifier-type `(values (unsigned-byte ,width)
-                                                         &optional)))
+                         (fun-type-returns
+                          (info :function :type name)))
                    (setf (continuation-%derived-type (node-cont node)) nil)
                    (setf (node-reoptimize node) t)
                    (setf (block-reoptimize (node-block node)) t)