suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

rktboot: fix confusion between compile-time and run-time fixnums

Browse Source
This commit is contained in:
Matthew Flatt 2020-11-23 09:35:41 -07:00
parent 318d3e0a9f
commit 31d0c07d37
3 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
racket/src/ChezScheme/rktboot/r6rs-lang.rkt
View File

@ -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))

3
racket/src/ChezScheme/rktboot/scheme-lang.rkt
View File

@ -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)

9
racket/src/ChezScheme/s/cpnanopass.ss
View File

@ -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)
(let* ([code* (cons* `(,size . ,(let ([v (bitwise-ior
(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))))
(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*