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

cs-bootstrap: fix size and offsets for double fields

Browse Source 
Although building with the wrong offsets is good enough to compile
the compiler to compile itself correctly, a broken intermediate
compilation can create confusion.
This commit is contained in:
Matthew Flatt 2020-06-29 06:39:41 -06:00
parent 5e9c6b31c0
commit 4f9c0779f8
2 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
racket/src/cs/bootstrap/constant.rkt
View File

@ -50,6 +50,7 @@
(define-constant (define-constant
ptr-bytes ptr-bytes
fixnum-bits fixnum-bits
max-float-alignment
annotation-debug annotation-debug
annotation-profile annotation-profile
visit-tag visit-tag

26
racket/src/cs/bootstrap/record.rkt
View File

@ -334,8 +334,15 @@
[(size) [(size)
(assert-accessor) (assert-accessor)
(lambda (rtd) (lambda (rtd)
(* (add1 (length ((csv7:record-field-accessor base-rtd 'flds) rtd))) (let loop ([flds ((csv7:record-field-accessor base-rtd 'flds) rtd)] [x ptr-bytes])
ptr-bytes))] (cond
[(null? flds) x]
[(eq? (fld-type (car flds)) 'double)
(let ([x (if (zero? (modulo x max-float-alignment))
x
(+ x (- 8 (modulo x max-float-alignment))))])
(loop (cdr flds) (+ x 8)))]
[else (loop (cdr flds) (+ x ptr-bytes))])))]
[(pm) [(pm)
(assert-accessor) (assert-accessor)
(lambda (rtd) (lambda (rtd)
@ -537,12 +544,21 @@
(void)) (void))
(define (fix-offsets flds) (define (fix-offsets flds)
(let loop ([flds flds] [offset (+ record-ptr-offset ptr-bytes)]) (let loop ([flds flds] [offset ptr-bytes])
(unless (null? flds) (unless (null? flds)
(set-fld-byte! (car flds) offset) (cond
(loop (cdr flds) (+ offset ptr-bytes)))) [(eq? (fld-type (car flds)) 'double)
(let ([offset (if (zero? (modulo offset max-float-alignment))
offset
(+ offset (- 8 (modulo offset max-float-alignment))))])
(set-fld-byte! (car flds) (+ record-ptr-offset offset))
(loop (cdr flds) (+ offset 8)))]
[else
(set-fld-byte! (car flds) (+ record-ptr-offset offset))
(loop (cdr flds) (+ offset ptr-bytes))])))
flds) flds)
;; assumes that `v` has only pointer-sized fields
(define ($object-ref type v offset) (define ($object-ref type v offset)
(cond (cond
[(flonum? v) [(flonum? v)