[Sbcl-commits] CVS: sbcl/src/code target-random.lisp,1.12,1.13 numbers.lisp,1.41,1.42

[Juho S. <js...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16174/src/code

Modified Files:
	target-random.lisp numbers.lisp 
Log Message:
0.8.18.31:
	Some number-related x86-64 fixes.
	* Fix backend bug in negative counts for ASH. (Patch by Lutz Euler
          on sbcl-devel, 2005-01-09). Add some more ASH tests.
        * Cargo-cult signed modular arithmetic changes from the x86 
          backend.
        * Remove optimization of constant multiplication to shifts, adds
          and leas (except for the simple cases of 2^x, 3, 5, 9) from
          the x86-64 backend. It was a lot of code that's not really
          of any use on any existing x86-64 processor.
	* Fix 32-bit assumptions in deftransform of RANDOM for word-sized
          integers.


Index: target-random.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-random.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- target-random.lisp	6 Jan 2005 12:47:59 -0000	1.12
+++ target-random.lisp	14 Jan 2005 06:47:32 -0000	1.13
@@ -164,6 +164,13 @@
 (defun random-chunk (state)
   (declare (type random-state state))
   (sb!vm::random-mt19937 (random-state-state state)))
+
+#!-sb-fluid (declaim (inline big-random-chunk))
+(defun big-random-chunk (state)
+  (declare (type random-state state))
+  (logand (1- (expt 2 64))
+	  (logior (ash (random-chunk state) 32)
+		  (random-chunk state))))
 
 ;;; Handle the single or double float case of RANDOM. We generate a
 ;;; float between 0.0 and 1.0 by clobbering the significand of 1.0

Index: numbers.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- numbers.lisp	6 Jan 2005 12:47:58 -0000	1.41
+++ numbers.lisp	14 Jan 2005 06:47:32 -0000	1.42
@@ -1472,3 +1472,9 @@
   (etypecase integer
     ((signed-byte 30) (sb!c::mask-signed-field 30 (ash integer amount)))
     (integer (sb!c::mask-signed-field 30 (ash (sb!c::mask-signed-field 30 integer) amount)))))
+
+#!+x86-64
+(defun sb!vm::ash-left-smod61 (integer amount)
+  (etypecase integer
+    ((signed-byte 61) (sb!c::mask-signed-field 61 (ash integer amount)))
+    (integer (sb!c::mask-signed-field 61 (ash (sb!c::mask-signed-field 61 integer) amount)))))