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

fix zo-marshal' for #f toplevel-map in lam'

Browse Source 
original commit: 87a4132b40
This commit is contained in:
Matthew Flatt 2011-05-03 14:28:51 -06:00
parent 1955c935ff
commit 805b8627f3
2 changed files with 20 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/compiler/zo-marshal.rkt
View File

@ -1002,8 +1002,9 @@
[l (if any-refs? [l (if any-refs?
(cons (vector-length closure-map) l) (cons (vector-length closure-map) l)
l)] l)]
[tl-map (for/fold ([v 0]) ([i (in-set toplevel-map)]) [tl-map (and toplevel-map
(bitwise-ior v (arithmetic-shift 1 i)))]) (for/fold ([v 0]) ([i (in-set toplevel-map)])
(bitwise-ior v (arithmetic-shift 1 i))))])
(out-marshaled unclosed-procedure-type-num (out-marshaled unclosed-procedure-type-num
(list* (list*
(+ (if rest? CLOS_HAS_REST 0) (+ (if rest? CLOS_HAS_REST 0)
@ -1014,13 +1015,14 @@
(if (memq 'single-result flags) CLOS_SINGLE_RESULT 0)) (if (memq 'single-result flags) CLOS_SINGLE_RESULT 0))
num-all-params num-all-params
max-let-depth max-let-depth
(if (tl-map . < . #x7FFFFFFF) (and tl-map
tl-map (if (tl-map . < . #x7FFFFFFF)
;; Encode as an even-sized vector of 16-bit integers: tl-map
(let ([len (* 2 (quotient (+ (integer-length tl-map) 31) 32))]) ;; Encode as an even-sized vector of 16-bit integers:
(for/vector ([i (in-range len)]) (let ([len (* 2 (quotient (+ (integer-length tl-map) 31) 32))])
(let ([s (* i 16)]) (for/vector ([i (in-range len)])
(bitwise-bit-field tl-map s (+ s 16)))))) (let ([s (* i 16)])
(bitwise-bit-field tl-map s (+ s 16)))))))
name name
l) l)
out))])) out))]))

9
collects/tests/compiler/zo-exs.rkt
View File

@ -31,6 +31,15 @@
(prefix 0 empty empty) (prefix 0 empty empty)
(list 1 (list 2 3) (list 2 3) 4 5))) (list 1 (list 2 3) (list 2 3) 4 5)))
(roundtrip
(compilation-top 0
(prefix 1 empty empty)
(list (lam 'proc null 0 null #f #(0) '(val/ref) (set 0) 3 1))))
(roundtrip
(compilation-top 0
(prefix 1 empty empty)
(list (lam 'proc null 0 null #f #(0) '(val/ref) #f 3 1))))
#;(roundtrip #;(roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)