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

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

View File

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

View File

@ -31,6 +31,15 @@
(prefix 0 empty empty)
(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
(compilation-top 0
(prefix 0 empty empty)