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" "gensym.rkt"
"format.rkt" "format.rkt"
"syntax-mode.rkt" "syntax-mode.rkt"
"constant.rkt"
"config.rkt" "config.rkt"
"rcd.rkt" "rcd.rkt"
(only-in "record.rkt" (only-in "record.rkt"
@ -798,18 +797,21 @@
(proc o) (proc o)
(get-output-bytes 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 low-fixnum (- (expt 2 (sub1 (fixnum-width)))))
(define high-fixnum (sub1 (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-positive-fixnum) high-fixnum)
(define (most-negative-fixnum) low-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 (make-compile-time-value v) v)
(define optimize-level (make-parameter optimize-level-init)) (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 make-record-constructor-descriptor
set-car! set-car!
set-cdr! set-cdr!
fixnum-width
most-positive-fixnum most-positive-fixnum
most-negative-fixnum) most-negative-fixnum)
(submod "r6rs-lang.rkt" hash-pair) (submod "r6rs-lang.rkt" hash-pair)
@ -824,7 +825,7 @@
(if (and (v . fx< . 0) (if (and (v . fx< . 0)
(amt . fx> . 0)) (amt . fx> . 0))
(bitwise-and (fxrshift v amt) (bitwise-and (fxrshift v amt)
(- (fxlshift 1 (- fixnum-bits amt)) 1)) (- (arithmetic-shift 1 (- (fixnum-width) amt)) 1))
(fxrshift v amt))) (fxrshift v amt)))
(define (fxbit-field fx1 fx2 fx3) (define (fxbit-field fx1 fx2 fx3)

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

@ -16507,12 +16507,15 @@
(define asm-rp-compact-header (define asm-rp-compact-header
(lambda (code* err? fs lpm func code-size) (lambda (code* err? fs lpm func code-size)
(let ([size (constant-case ptr-bits [(32) 'long] [(64) 'quad])]) (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? (if err?
(constant compact-header-values-error-mask) (constant compact-header-values-error-mask)
0) 0)
(fxsll fs (constant compact-frame-words-offset)) (bitwise-arithmetic-shift-left fs (constant compact-frame-words-offset))
(fxsll lpm (constant compact-frame-mask-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))) (aop-cons* `(asm "mrv pt:" (,lpm ,fs ,(if err? 'error 'continue)))
code*))] code*))]
[code* (cons* [code* (cons*