handling closures while writing symbol table

This commit is contained in:
Blake Johnson 2010-08-24 17:28:00 -06:00 committed by Jay McCarthy
parent 893294674a
commit c2fee2a2f0

View File

@ -38,7 +38,7 @@
(define (shared-obj-pos v) (define (shared-obj-pos v)
(hash-ref shared v #f)) (hash-ref shared v #f))
(define (share! v) (define (share! v)
(or (hash-ref shared v #f) (or (shared-obj-pos v)
(let ([pos (add1 (hash-count shared))]) (let ([pos (add1 (hash-count shared))])
(hash-set! shared v pos) (hash-set! shared v pos)
pos))) pos)))
@ -70,8 +70,8 @@
(list* max-let-depth prefix (protect-quote form))])) (list* max-let-depth prefix (protect-quote form))]))
(out-anything ct (make-out outp shared-obj-pos wrapped)) (out-anything ct (make-out outp shared-obj-pos wrapped))
(file-position outp)) (file-position outp))
(define-values (symbol-table shared-obj-pos) (create-symbol-table out-compilation-top))
(define-values (symbol-table shared-obj-pos) (create-symbol-table out-compilation-top))
; vector output-port -> (listof number) number ; vector output-port -> (listof number) number
; writes symbol-table to outp ; writes symbol-table to outp
; returns the file positions of each value in the symbol table and the end of the symbol table ; returns the file positions of each value in the symbol table and the end of the symbol table
@ -79,7 +79,7 @@
(define (shared-obj-pos/modulo-v v) (define (shared-obj-pos/modulo-v v)
(define skip? #t) (define skip? #t)
(λ (v2) (λ (v2)
(if (and skip? (eq? v v2)) (if (and skip? (eq? v v2) (not (closure? v2)))
(begin (begin
(set! skip? #f) (set! skip? #f)
#f) #f)
@ -103,6 +103,7 @@
(write-bytes (bytes (bytes-length version-bs)) outp) (write-bytes (bytes (bytes-length version-bs)) outp)
(write-bytes version-bs outp) (write-bytes version-bs outp)
; Write the symbol table information (size, offsets) ; Write the symbol table information (size, offsets)
(define symtabsize (add1 (vector-length symbol-table))) (define symtabsize (add1 (vector-length symbol-table)))
(write-bytes (int->bytes symtabsize) outp) (write-bytes (int->bytes symtabsize) outp)