Fix bug: couldn't compile random.scm on a 32-bit system.

The problem is that it was trying to represent the constant #x55555555 as a
fixnum, which won't work.  I added more selective macro-expansion to enable only
those parts of the code relevant for the different word sizes.

diff --git a/src/runtime/random.scm b/src/runtime/random.scm
index f79374b78aa18ef4a72ed0bfd2ea8aba55426267..71d1651058c202a675778ab671b16c7acbb38afd 100644 (file)
--- a/src/runtime/random.scm
+++ b/src/runtime/random.scm
@@ -297,34 +297,36 @@ USA.
 
 (define-integrable high-fixnum-byte-mask #x1)
 
-(define (%random-nonnegative-fixnum-32 state)
-  (let ((bv (random-bytevector 4 state)))
-    (let ((b0 (bytevector-u8-ref bv 0))
-         (b1 (bytevector-u8-ref bv 1))
-         (b2 (bytevector-u8-ref bv 2))
-         (b3 (fix:and (bytevector-u8-ref bv 3) high-fixnum-byte-mask)))
-      (declare (integrate b0 b1 b2 b3))
-      (begin0 (fix:or (fix:or b0 (fix:lsh b1 8))
-                     (fix:or (fix:lsh b2 16) (fix:lsh b3 24)))
-       (bytevector-zero-explicit! bv)))))
-
-(define (%random-nonnegative-fixnum-64 state)
-  (let ((bv (random-bytevector 8 state)))
-    (let ((b0 (bytevector-u8-ref bv 0))
-         (b1 (bytevector-u8-ref bv 1))
-         (b2 (bytevector-u8-ref bv 2))
-         (b3 (bytevector-u8-ref bv 3))
-         (b4 (bytevector-u8-ref bv 4))
-         (b5 (bytevector-u8-ref bv 5))
-         (b6 (bytevector-u8-ref bv 6))
-         (b7 (fix:and (bytevector-u8-ref bv 7) high-fixnum-byte-mask)))
-      (declare (integrate b0 b1 b2 b3 b4 b5 b6 b7))
-      (begin0 (fix:or
-              (fix:or (fix:or b0 (fix:lsh b1 8))
+(select-on-bytes-per-word
+ ;; 4
+ (define (%random-nonnegative-fixnum state)
+   (let ((bv (random-bytevector 4 state)))
+     (let ((b0 (bytevector-u8-ref bv 0))
+          (b1 (bytevector-u8-ref bv 1))
+          (b2 (bytevector-u8-ref bv 2))
+          (b3 (fix:and (bytevector-u8-ref bv 3) high-fixnum-byte-mask)))
+       (declare (integrate b0 b1 b2 b3))
+       (begin0 (fix:or (fix:or b0 (fix:lsh b1 8))
                       (fix:or (fix:lsh b2 16) (fix:lsh b3 24)))
-              (fix:or (fix:or (fix:lsh b4 32) (fix:lsh b5 40))
-                      (fix:or (fix:lsh b6 48) (fix:lsh b7 56))))
-       (bytevector-zero-explicit! bv)))))
+        (bytevector-zero-explicit! bv)))))
+ ;; 8
+ (define (%random-nonnegative-fixnum state)
+   (let ((bv (random-bytevector 8 state)))
+     (let ((b0 (bytevector-u8-ref bv 0))
+          (b1 (bytevector-u8-ref bv 1))
+          (b2 (bytevector-u8-ref bv 2))
+          (b3 (bytevector-u8-ref bv 3))
+          (b4 (bytevector-u8-ref bv 4))
+          (b5 (bytevector-u8-ref bv 5))
+          (b6 (bytevector-u8-ref bv 6))
+          (b7 (fix:and (bytevector-u8-ref bv 7) high-fixnum-byte-mask)))
+       (declare (integrate b0 b1 b2 b3 b4 b5 b6 b7))
+       (begin0 (fix:or
+               (fix:or (fix:or b0 (fix:lsh b1 8))
+                       (fix:or (fix:lsh b2 16) (fix:lsh b3 24)))
+               (fix:or (fix:or (fix:lsh b4 32) (fix:lsh b5 40))
+                       (fix:or (fix:lsh b6 48) (fix:lsh b7 56))))
+        (bytevector-zero-explicit! bv))))))
 
 (define (%random-integer-of-length-in-bytes nbytes state)
   (let ((bv (random-bytevector nbytes state)))
@@ -336,156 +338,164 @@ USA.
 \f
 ;;;; Count leading zeros in 16-bit and 32-bit words
 
-(declare (integrate-operator fix:bitcount16))
-(define (fix:bitcount16 x)
-  (let* ((x1 (fix:- x (fix:and (fix:lsh x -1) #x5555)))
-        (x2 (fix:+ (fix:and (fix:lsh x1 -2) #x3333) (fix:and x1 #x3333)))
-        (x3 (fix:and (fix:+ x2 (fix:lsh x2 4)) #x0f0f))
-        (c0 x3)
-        (c1 (fix:lsh x3 -8))
-        (s (fix:+ c0 c1)))
-    (declare (integrate x1 x2 x3 x4 c0 c1 s))
-    (fix:and s #xf)))
-
-(declare (integrate-operator fix:clz16))
-(define (fix:clz16 x)
-  (let* ((x2 (fix:or x (fix:lsh x -1)))
-        (x4 (fix:or x2 (fix:lsh x2 -2)))
-        (x8 (fix:or x4 (fix:lsh x4 -4)))
-        (x16 (fix:or x8 (fix:lsh x8 -8))))
-    (declare (integrate x2 x4 x8 x16))
-    (fix:- 16 (fix:bitcount16 x16))))
-
-(declare (integrate-operator fix:bitcount32))
-(define (fix:bitcount32 x)
-  (let* ((x1 (fix:- x (fix:and (fix:lsh x -1) #x55555555)))
-        (x2
-         (fix:+ (fix:and (fix:lsh x1 -2) #x33333333) (fix:and x1 #x33333333)))
-        (x3 (fix:and (fix:+ x2 (fix:lsh x2 -4)) #x0f0f0f0f))
-        (c0 x3)
-        (c1 (fix:lsh x3 -8))
-        (c2 (fix:lsh x3 -16))
-        (c3 (fix:lsh x3 -24))
-        (s (fix:+ (fix:+ c0 c1) (fix:+ c2 c3))))
-    (declare (integrate x1 x2 x3 x4 c0 c1 c2 c3 s))
-    (fix:and s #xff)))
-
-(declare (integrate-operator fix:clz32))
-(define (fix:clz32 x)
-  (let* ((x2 (fix:or x (fix:lsh x -1)))
-        (x4 (fix:or x2 (fix:lsh x2 -2)))
-        (x8 (fix:or x4 (fix:lsh x4 -4)))
-        (x16 (fix:or x8 (fix:lsh x8 -8)))
-        (x32 (fix:or x16 (fix:lsh x16 -8))))
-    (declare (integrate x2 x4 x8 x16 x32))
-    (fix:- 32 (fix:bitcount32 x32))))
-
-(define (%random-16 state)
-  (let ((bv (random-bytevector 2 state)))
-    (let ((b0 (bytevector-u8-ref bv 0))
-         (b1 (bytevector-u8-ref bv 1)))
-      (declare (integrate b0 b1))
-      (begin0 (fix:or b0 (fix:lsh b1 8))
-       (bytevector-zero-explicit! bv)))))
-
-(define (%random-32 state)
-  (let ((bv (random-bytevector 4 state)))
-    (let ((b0 (bytevector-u8-ref bv 0))
-         (b1 (bytevector-u8-ref bv 1))
-         (b2 (bytevector-u8-ref bv 2))
-         (b3 (bytevector-u8-ref bv 3)))
-      (declare (integrate b0 b1 b2 b3))
-      (begin0 (fix:or (fix:or b0 (fix:lsh b1 8))
-                     (fix:or (fix:lsh b2 16) (fix:lsh b3 24)))
-       (bytevector-zero-explicit! bv)))))
+(select-on-bytes-per-word
+ ;; 4
+ (begin
+   (declare (integrate-operator fix:bitcount16))
+   (define (fix:bitcount16 x)
+     (let* ((x1 (fix:- x (fix:and (fix:lsh x -1) #x5555)))
+           (x2 (fix:+ (fix:and (fix:lsh x1 -2) #x3333) (fix:and x1 #x3333)))
+           (x3 (fix:and (fix:+ x2 (fix:lsh x2 4)) #x0f0f))
+           (c0 x3)
+           (c1 (fix:lsh x3 -8))
+           (s (fix:+ c0 c1)))
+       (declare (integrate x1 x2 x3 x4 c0 c1 s))
+       (fix:and s #xf)))
+
+   (declare (integrate-operator fix:clz16))
+   (define (fix:clz16 x)
+     (let* ((x2 (fix:or x (fix:lsh x -1)))
+           (x4 (fix:or x2 (fix:lsh x2 -2)))
+           (x8 (fix:or x4 (fix:lsh x4 -4)))
+           (x16 (fix:or x8 (fix:lsh x8 -8))))
+       (declare (integrate x2 x4 x8 x16))
+       (fix:- 16 (fix:bitcount16 x16))))
+
+   (define (%random-16 state)
+     (let ((bv (random-bytevector 2 state)))
+       (let ((b0 (bytevector-u8-ref bv 0))
+            (b1 (bytevector-u8-ref bv 1)))
+        (declare (integrate b0 b1))
+        (begin0 (fix:or b0 (fix:lsh b1 8))
+          (bytevector-zero-explicit! bv))))))
+
+ ;; 8
+ (begin
+   (declare (integrate-operator fix:bitcount32))
+   (define (fix:bitcount32 x)
+     (let* ((x1 (fix:- x (fix:and (fix:lsh x -1) #x55555555)))
+           (x2
+            (fix:+ (fix:and (fix:lsh x1 -2) #x33333333) (fix:and x1 #x33333333)))
+           (x3 (fix:and (fix:+ x2 (fix:lsh x2 -4)) #x0f0f0f0f))
+           (c0 x3)
+           (c1 (fix:lsh x3 -8))
+           (c2 (fix:lsh x3 -16))
+           (c3 (fix:lsh x3 -24))
+           (s (fix:+ (fix:+ c0 c1) (fix:+ c2 c3))))
+       (declare (integrate x1 x2 x3 x4 c0 c1 c2 c3 s))
+       (fix:and s #xff)))
+
+   (declare (integrate-operator fix:clz32))
+   (define (fix:clz32 x)
+     (let* ((x2 (fix:or x (fix:lsh x -1)))
+           (x4 (fix:or x2 (fix:lsh x2 -2)))
+           (x8 (fix:or x4 (fix:lsh x4 -4)))
+           (x16 (fix:or x8 (fix:lsh x8 -8)))
+           (x32 (fix:or x16 (fix:lsh x16 -8))))
+       (declare (integrate x2 x4 x8 x16 x32))
+       (fix:- 32 (fix:bitcount32 x32))))
+
+   (define (%random-32 state)
+     (let ((bv (random-bytevector 4 state)))
+       (let ((b0 (bytevector-u8-ref bv 0))
+            (b1 (bytevector-u8-ref bv 1))
+            (b2 (bytevector-u8-ref bv 2))
+            (b3 (bytevector-u8-ref bv 3)))
+        (declare (integrate b0 b1 b2 b3))
+        (begin0 (fix:or (fix:or b0 (fix:lsh b1 8))
+                        (fix:or (fix:lsh b2 16) (fix:lsh b3 24)))
+          (bytevector-zero-explicit! bv))))))
+)
 \f
 ;;;; Uniform [0,1] sampler and uniform (2^{emin - p - 1}, 1 - ulp(1)/4) sampler
 
-(define (flo:random-unit-closed-32 state)
-  (define (exponent)
-    (let loop ((z 0))
-      (if (fix:>= z 1088)
-         z
-         (let ((x (%random-16 state)))
-           (if (fix:= x 0)
-               (loop (fix:+ z 16))
-               (fix:+ z (fix:clz16 x)))))))
-  (define (significand-64)
-    (let ((s0 (int:->flonum (fix:or (%random-16 state) #x0001)))
-         (s1 (int:->flonum (%random-16 state)))
-         (s2 (int:->flonum (%random-16 state)))
-         (s3 (int:->flonum (fix:or (%random-16 state) #x8000))))
-      (let ((lo (flo:+ (flo:* 65536. s1) s0))
-           (hi (flo:+ (flo:* 65536. s3) s2)))
-       (declare (integrate lo hi))
-       (flo:+ (flo:* 4294967296. hi) lo))))
-  (flo:ldexp (significand-64) (fix:- -64 (exponent))))
-
-(define (flo:random-unit-closed-64 state)
-  (define (exponent)
-    (let loop ((z 0))
-      (if (fix:>= z 1088)
-         z
-         (let ((x (%random-32 state)))
-           (if (fix:= x 0)
-               (loop (fix:+ z 32))
-               (fix:+ z (fix:clz32 x)))))))
-  (define (significand-64)
-    (let ((lo (int:->flonum (fix:or (%random-32 state) #x00000001)))
-         (hi (int:->flonum (fix:or (%random-32 state) #x80000000))))
-      (flo:+ (flo:* 4294967296. hi) lo)))
-  (flo:ldexp (significand-64) (fix:- -64 (exponent))))
-
-(define (flo:random-unit-open-32 state)
-  (define (exponent)
-    (let loop ((z 0))
-      (if (fix:>= z 1088)
-         z
-         (let ((x (%random-16 state)))
-           (if (fix:= x 0)
-               (loop (fix:+ z 16))
-               (fix:+ z (fix:clz16 x)))))))
-  (define (significand-53)
-    (let ((s0 (int:->flonum (%random-16 state)))
-         (s1 (int:->flonum (%random-16 state)))
-         (s2 (int:->flonum (%random-16 state)))
-         (s3 (int:->flonum (fix:and (%random-16 state) #xf))))
-      (let ((lo (flo:+ (flo:* 65536. s1) s0))
-           (hi (flo:+ (flo:* 65536. s3) s2)))
-       (declare (integrate lo hi))
-       (flo:+ (flo:* 4294967296. hi) lo))))
-  (flo:max
-   flo:smallest-positive-subnormal     ;paranoia
-   (flo:ldexp (significand-53) (fix:- -53 (exponent)))))
-
-(define (flo:random-unit-open-64 state)
-  (define (exponent)
-    (let loop ((z 0))
-      (if (fix:>= z 1088)
-         z
-         (let ((x (%random-32 state)))
-           (if (fix:= x 0)
-               (loop (fix:+ z 32))
-               (fix:+ z (fix:clz32 x)))))))
-  (define (significand-53)
-    (let ((lo (int:->flonum (%random-32 state)))
-         (hi
-          (int:->flonum
-           (fix:or #x100000 (fix:and (%random-32 state) #xfffff)))))
-      (flo:+ (flo:* 4294967296. hi) lo)))
-  (flo:max
-   flo:smallest-positive-subnormal     ;paranoia
-   (flo:ldexp (significand-53) (fix:- -53 (exponent)))))
+(select-on-bytes-per-word
+ ;; 4
+ (begin
+   (define (flo:random-unit-closed state)
+     (define (exponent)
+       (let loop ((z 0))
+        (if (fix:>= z 1088)
+            z
+            (let ((x (%random-16 state)))
+              (if (fix:= x 0)
+                  (loop (fix:+ z 16))
+                  (fix:+ z (fix:clz16 x)))))))
+     (define (significand-64)
+       (let ((s0 (int:->flonum (fix:or (%random-16 state) #x0001)))
+            (s1 (int:->flonum (%random-16 state)))
+            (s2 (int:->flonum (%random-16 state)))
+            (s3 (int:->flonum (fix:or (%random-16 state) #x8000))))
+        (let ((lo (flo:+ (flo:* 65536. s1) s0))
+              (hi (flo:+ (flo:* 65536. s3) s2)))
+          (declare (integrate lo hi))
+          (flo:+ (flo:* 4294967296. hi) lo))))
+     (flo:ldexp (significand-64) (fix:- -64 (exponent))))
+
+   (define (flo:random-unit-open state)
+     (define (exponent)
+       (let loop ((z 0))
+        (if (fix:>= z 1088)
+            z
+            (let ((x (%random-16 state)))
+              (if (fix:= x 0)
+                  (loop (fix:+ z 16))
+                  (fix:+ z (fix:clz16 x)))))))
+     (define (significand-53)
+       (let ((s0 (int:->flonum (%random-16 state)))
+            (s1 (int:->flonum (%random-16 state)))
+            (s2 (int:->flonum (%random-16 state)))
+            (s3 (int:->flonum (fix:and (%random-16 state) #xf))))
+        (let ((lo (flo:+ (flo:* 65536. s1) s0))
+              (hi (flo:+ (flo:* 65536. s3) s2)))
+          (declare (integrate lo hi))
+          (flo:+ (flo:* 4294967296. hi) lo))))
+     (flo:max
+      flo:smallest-positive-subnormal  ;paranoia
+      (flo:ldexp (significand-53) (fix:- -53 (exponent))))))
+
+ ;; 8
+ (begin
+   (define (flo:random-unit-closed state)
+     (define (exponent)
+       (let loop ((z 0))
+        (if (fix:>= z 1088)
+            z
+            (let ((x (%random-32 state)))
+              (if (fix:= x 0)
+                  (loop (fix:+ z 32))
+                  (fix:+ z (fix:clz32 x)))))))
+     (define (significand-64)
+       (let ((lo (int:->flonum (fix:or (%random-32 state) #x00000001)))
+            (hi (int:->flonum (fix:or (%random-32 state) #x80000000))))
+        (flo:+ (flo:* 4294967296. hi) lo)))
+     (flo:ldexp (significand-64) (fix:- -64 (exponent))))
+
+   (define (flo:random-unit-open state)
+     (define (exponent)
+       (let loop ((z 0))
+        (if (fix:>= z 1088)
+            z
+            (let ((x (%random-32 state)))
+              (if (fix:= x 0)
+                  (loop (fix:+ z 32))
+                  (fix:+ z (fix:clz32 x)))))))
+     (define (significand-53)
+       (let ((lo (int:->flonum (%random-32 state)))
+            (hi
+             (int:->flonum
+              (fix:or #x100000 (fix:and (%random-32 state) #xfffff)))))
+        (flo:+ (flo:* 4294967296. hi) lo)))
+     (flo:max
+      flo:smallest-positive-subnormal  ;paranoia
+      (flo:ldexp (significand-53) (fix:- -53 (exponent))))))
+)
 \f
 ;;;; Initialization
 
-(define %random-nonnegative-fixnum)
 (define *random-state* #f)
 (define default-random-source)
 (define default-random-source-mutex)
-(define flo:random-unit-closed)
-(define flo:random-unit-open)
-(define flo:random-unit)
 (define random-integer)
 (define random-real)
 (define zero16)
@@ -493,16 +503,6 @@ USA.
 
 (define (initialize-package!)
   (set! zero16 (make-bytevector 16 0))
-  (set! %random-nonnegative-fixnum
-       (select-on-bytes-per-word %random-nonnegative-fixnum-32
-                                 %random-nonnegative-fixnum-64))
-  (set! flo:random-unit-open
-       (select-on-bytes-per-word flo:random-unit-open-32
-                                 flo:random-unit-open-64))
-  (set! flo:random-unit-closed
-       (select-on-bytes-per-word flo:random-unit-closed-32
-                                 flo:random-unit-closed-64))
-  (set! flo:random-unit flo:random-unit-open) ;deprecated
   (set! default-random-source-mutex (make-thread-mutex))
   (set! default-random-source (make-random-source))
   (random-source-randomize! default-random-source)