Changeset 7244 for branches/ia32/level-0

Timestamp:

Sep 17, 2007, 5:53:32 PM (13 years ago)

Author:

rme

Message:

Merged trunk changes r6975:7243

Location:

branches/ia32/level-0

Files:

• PPC/ppc-numbers.lisp (modified) (1 diff)
• l0-array.lisp (modified) (2 diffs)
• l0-numbers.lisp (modified) (3 diffs)

branches/ia32/level-0/PPC/ppc-numbers.lisp

@@ -313 +313 @@
     ab mod m = ((u + v) mod 2^n) + 1   :  u+v >= 2^n
 
-What we do is use 2b and 2n so we can do arithemetic mod 2^32 instead of
+What we do is use 2b and 2^n so we can do arithemetic mod 2^32 instead of
 2^31.  This reduces the whole generator to 5 instructions on the 680x0 or
 80x86, and 8 on the 60x.

branches/ia32/level-0/l0-array.lisp

@@ -484 +484 @@
     fill))
 
-; Could avoid potential memoization somehow
+;;; Could avoid potential memoization somehow
 (defun vector (&lexpr vals)
   "Construct a SIMPLE-VECTOR from the given objects."
@@ -492 +492 @@
     (dotimes (i n v) (setf (%svref v i) (%lexpr-ref vals n i)))))
 
+;;; CALL-ARGUMENTS-LIMIT.
+(defun list-to-vector (elts)
+  (let* ((n (length elts)))
+    (declare (fixnum n))
+    (if (< n (floor #x8000 target::node-size))
+      (apply #'vector elts)
+      (make-array n :initial-contents elts))))
+
+             
+    
 (defun %gvector (subtag &lexpr vals)
   (let* ((n (%lexpr-count vals))

branches/ia32/level-0/l0-numbers.lisp

@@ -1771 +1771 @@
     ab mod m = ((u + v) mod 2^n) + 1   :  u+v >= 2^n
 
-What we do is use 2b and 2n so we can do arithemetic mod 2^32 instead of
+What we do is use 2b and 2^n so we can do arithemetic mod 2^32 instead of
 2^31.  This reduces the whole generator to 5 instructions on the 680x0 or
 80x86, and 8 on the 60x.
@@ -1781 +1781 @@
 #+64-bit-target
 (defun %next-random-pair (high low)
-  (let* ((n (nth-value
-             1
-             (%multiply 42871 (dpb (ldb (byte 15 0) high)
-                                      (byte 16 16)
-                                      (ldb (byte 16 0) low ))))))
-    (values (ldb (byte 16 16) n)
+  (declare (type (unsigned-byte 16) high low))
+  (let* ((n0
+          (%i* 42871
+             (the  (unsigned-byte 31)
+               (logior (the (unsigned-byte 31)
+                         (ash (ldb (byte 15 0) high) 16))
+                       (the (unsigned-byte 16)
+                         (ldb (byte 16 0) low))))))
+         (n (fast-mod n0 (1- (expt 2 31)))))
+    (declare (fixnum n))
+    (values (ldb (byte 15 16) n)
             (ldb (byte 16 0) n))))
 
@@ -1792 +1797 @@
   (multiple-value-bind (high low) (%next-random-pair (%svref state 1)
                                                      (%svref state 2))
-    (setf (%svref state 1) (ldb (byte 15 0) high)
+    (declare (type (unsigned-byte 15) high)
+             (type (unsigned-byte 16) low))
+    (setf (%svref state 1) high
           (%svref state 2) low)
-    high
-    ))
+    (logior high (the fixnum (logand low (ash 1 15))))))