From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 12 Nov 2018 07:01:46 +0000 (-0800)
Subject: Fix bug: couldn't compile random.scm on a 32-bit system.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~107
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d37fcb8eab5e819042b8b14ba68b2abf4b725e70;p=mit-scheme.git

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 f79374b78..71d165105 100644
--- 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.
 
 ;;;; 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))))))
+)
 
 ;;;; 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))))))
+)
 
 ;;;; 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)