From 31d0c07d3754c0e190a45a3000329a89b8d35d08 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 23 Nov 2020 09:35:41 -0700
Subject: [PATCH] rktboot: fix confusion between compile-time and run-time
 fixnums

---
 racket/src/ChezScheme/rktboot/r6rs-lang.rkt   | 14 ++++++++------
 racket/src/ChezScheme/rktboot/scheme-lang.rkt |  3 ++-
 racket/src/ChezScheme/s/cpnanopass.ss         | 15 +++++++++------
 3 files changed, 19 insertions(+), 13 deletions(-)

diff --git a/racket/src/ChezScheme/rktboot/r6rs-lang.rkt b/racket/src/ChezScheme/rktboot/r6rs-lang.rkt
index 89861e11f0..050c15b2df 100644
--- a/racket/src/ChezScheme/rktboot/r6rs-lang.rkt
+++ b/racket/src/ChezScheme/rktboot/r6rs-lang.rkt
@@ -11,7 +11,6 @@
          "gensym.rkt"
          "format.rkt"
          "syntax-mode.rkt"
-         "constant.rkt"
          "config.rkt"
          "rcd.rkt"
          (only-in "record.rkt"
@@ -798,18 +797,21 @@
   (proc o)
   (get-output-bytes o))
 
-(define (fixnum-width) (or fixnum-bits 63))
+;; Note: fixnums here are compile-time fixnums, so "config.rkt" is not needed
 
+(define 64-bit? (= (system-type 'word) 64))
+
+(define (fixnum-width) (if (eq? 'racket (system-type 'vm))
+                           (if 64-bit? 63 31)
+                           (if 64-bit? 61 30)))
 (define low-fixnum (- (expt 2 (sub1 (fixnum-width)))))
 (define high-fixnum (sub1 (expt 2 (sub1 (fixnum-width)))))
 
+(define s:fixnum? fixnum?)
+
 (define (most-positive-fixnum) high-fixnum)
 (define (most-negative-fixnum) low-fixnum)
 
-(define (s:fixnum? x)
-  (and (fixnum? x)
-       (<= low-fixnum x high-fixnum)))
-
 (define (make-compile-time-value v) v)
 
 (define optimize-level (make-parameter optimize-level-init))
diff --git a/racket/src/ChezScheme/rktboot/scheme-lang.rkt b/racket/src/ChezScheme/rktboot/scheme-lang.rkt
index 97cdbb0c6e..e52789c766 100644
--- a/racket/src/ChezScheme/rktboot/scheme-lang.rkt
+++ b/racket/src/ChezScheme/rktboot/scheme-lang.rkt
@@ -26,6 +26,7 @@
                   make-record-constructor-descriptor
                   set-car!
                   set-cdr!
+                  fixnum-width
                   most-positive-fixnum
                   most-negative-fixnum)
          (submod "r6rs-lang.rkt" hash-pair)
@@ -824,7 +825,7 @@
   (if (and (v . fx< . 0)
            (amt . fx> . 0))
       (bitwise-and (fxrshift v amt)
-                   (- (fxlshift 1 (- fixnum-bits amt)) 1))
+                   (- (arithmetic-shift 1 (- (fixnum-width) amt)) 1))
       (fxrshift v amt)))
 
 (define (fxbit-field fx1 fx2 fx3)
diff --git a/racket/src/ChezScheme/s/cpnanopass.ss b/racket/src/ChezScheme/s/cpnanopass.ss
index f9c0fdecc7..c42d4bc4aa 100644
--- a/racket/src/ChezScheme/s/cpnanopass.ss
+++ b/racket/src/ChezScheme/s/cpnanopass.ss
@@ -16507,12 +16507,15 @@
       (define asm-rp-compact-header
         (lambda (code* err? fs lpm func code-size)
           (let ([size (constant-case ptr-bits [(32) 'long] [(64) 'quad])])
-            (let* ([code* (cons* `(,size . ,(fxior (constant compact-header-mask)
-                                                   (if err?
-                                                       (constant compact-header-values-error-mask)
-                                                       0)
-                                                   (fxsll fs (constant compact-frame-words-offset))
-                                                   (fxsll lpm (constant compact-frame-mask-offset))))
+            (let* ([code* (cons* `(,size . ,(let ([v (bitwise-ior
+                                                      (constant compact-header-mask)
+                                                      (if err?
+                                                          (constant compact-header-values-error-mask)
+                                                          0)
+                                                      (bitwise-arithmetic-shift-left fs (constant compact-frame-words-offset))
+                                                      (bitwise-arithmetic-shift-left lpm (constant compact-frame-mask-offset)))])
+                                              (safe-assert (target-fixnum? v))
+                                              v))
                                  (aop-cons* `(asm "mrv pt:" (,lpm ,fs ,(if err? 'error 'continue)))
                                             code*))]
                    [code* (cons*