removing debugging information
This commit is contained in:
parent
407a36c9d2
commit
6338a97e0a
|
@ -24,10 +24,6 @@
|
||||||
(zo-marshal-to top bs)
|
(zo-marshal-to top bs)
|
||||||
(get-output-bytes bs))
|
(get-output-bytes bs))
|
||||||
|
|
||||||
(define (got-here n)
|
|
||||||
(void)
|
|
||||||
#;(printf "got here: ~a~n" n))
|
|
||||||
|
|
||||||
(define (zo-marshal-to top outp)
|
(define (zo-marshal-to top outp)
|
||||||
|
|
||||||
; XXX: wraps were encoded in traverse, now needs to be handled when writing
|
; XXX: wraps were encoded in traverse, now needs to be handled when writing
|
||||||
|
@ -60,14 +56,10 @@
|
||||||
(when (= how-many-encounters 1)
|
(when (= how-many-encounters 1)
|
||||||
(hash-set! encountered v 0)))
|
(hash-set! encountered v 0)))
|
||||||
(define (shared-obj-pos v #:error? [error? #f])
|
(define (shared-obj-pos v #:error? [error? #f])
|
||||||
(define pos
|
|
||||||
(hash-ref shared v
|
(hash-ref shared v
|
||||||
(if error?
|
(if error?
|
||||||
(λ () (error 'symref "~e not in symbol table" v))
|
(λ () (error 'symref "~e not in symbol table" v))
|
||||||
#f)))
|
#f)))
|
||||||
#;(when (closure? v)
|
|
||||||
(printf "Looking up ~a, got ~a\n" v pos))
|
|
||||||
pos)
|
|
||||||
(define (share! v) ; XXX this doesn't always set something, probably should be refactored
|
(define (share! v) ; XXX this doesn't always set something, probably should be refactored
|
||||||
(or (shared-obj-pos v)
|
(or (shared-obj-pos v)
|
||||||
(let ([pos (add1 (hash-count shared))])
|
(let ([pos (add1 (hash-count shared))])
|
||||||
|
@ -83,7 +75,7 @@
|
||||||
(if (encountered? v)
|
(if (encountered? v)
|
||||||
pos
|
pos
|
||||||
(encounter! v)))]
|
(encounter! v)))]
|
||||||
#;[error? ; If we would error if this were not present, then we must share it
|
[error? ; If we would error if this were not present, then we must share it
|
||||||
(encounter! v)
|
(encounter! v)
|
||||||
(share! v)]
|
(share! v)]
|
||||||
[(encountered? v)
|
[(encountered? v)
|
||||||
|
@ -98,14 +90,8 @@
|
||||||
(hash-map shared (λ (k v) (vector-set! symbol-table (sub1 v) k)))
|
(hash-map shared (λ (k v) (vector-set! symbol-table (sub1 v) k)))
|
||||||
(values symbol-table shared-obj-pos))
|
(values symbol-table shared-obj-pos))
|
||||||
|
|
||||||
(got-here 1)
|
|
||||||
(define-values (symbol-table shared-obj-pos)
|
(define-values (symbol-table shared-obj-pos)
|
||||||
(create-symbol-table))
|
(create-symbol-table))
|
||||||
(got-here 2)
|
|
||||||
|
|
||||||
#;(printf "symtab[998] = ~a\n" (vector-ref symbol-table 998))
|
|
||||||
#;(for ([v (in-vector symbol-table)])
|
|
||||||
(printf "v = ~a~n" v))
|
|
||||||
|
|
||||||
; vector output-port -> (listof number) number
|
; vector output-port -> (listof number) number
|
||||||
; writes symbol-table to outp
|
; writes symbol-table to outp
|
||||||
|
@ -125,16 +111,14 @@
|
||||||
[i (in-naturals)])
|
[i (in-naturals)])
|
||||||
(begin0
|
(begin0
|
||||||
(file-position outp)
|
(file-position outp)
|
||||||
#;(printf "Out ~a -->" i) #;(pretty-print v)
|
|
||||||
(out-anything v (make-out outp (shared-obj-pos/modulo-v v) void wrapped))))
|
(out-anything v (make-out outp (shared-obj-pos/modulo-v v) void wrapped))))
|
||||||
(file-position outp)))
|
(file-position outp)))
|
||||||
|
|
||||||
; Calculate file positions
|
; Calculate file positions
|
||||||
(define counting-port (open-output-nowhere))
|
(define counting-port (open-output-nowhere))
|
||||||
(define-values (offsets post-shared) (out-symbol-table symbol-table counting-port))
|
(define-values (offsets post-shared) (out-symbol-table symbol-table counting-port))
|
||||||
(got-here 3)
|
|
||||||
(define all-forms-length (out-compilation-top shared-obj-pos void counting-port))
|
(define all-forms-length (out-compilation-top shared-obj-pos void counting-port))
|
||||||
(got-here 4)
|
|
||||||
; Write the compiled form header
|
; Write the compiled form header
|
||||||
(write-bytes #"#~" outp)
|
(write-bytes #"#~" outp)
|
||||||
|
|
||||||
|
@ -155,12 +139,9 @@
|
||||||
(write-bytes (int->bytes post-shared) outp)
|
(write-bytes (int->bytes post-shared) outp)
|
||||||
; This is where the file should end
|
; This is where the file should end
|
||||||
(write-bytes (int->bytes all-forms-length) outp)
|
(write-bytes (int->bytes all-forms-length) outp)
|
||||||
(got-here 5)
|
|
||||||
; Actually write the zo
|
; Actually write the zo
|
||||||
(out-symbol-table symbol-table outp)
|
(out-symbol-table symbol-table outp)
|
||||||
(got-here 6)
|
|
||||||
(out-compilation-top shared-obj-pos void outp)
|
(out-compilation-top shared-obj-pos void outp)
|
||||||
(got-here 7)
|
|
||||||
(void))
|
(void))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
@ -700,7 +681,6 @@
|
||||||
(out-byte CPT_APPLICATION out)
|
(out-byte CPT_APPLICATION out)
|
||||||
(out-number len out)))
|
(out-number len out)))
|
||||||
(for-each (lambda (e)
|
(for-each (lambda (e)
|
||||||
#;(printf "here: ~a~n" e)
|
|
||||||
(out-anything (protect-quote e) out))
|
(out-anything (protect-quote e) out))
|
||||||
(cons rator rands)))]
|
(cons rator rands)))]
|
||||||
[(struct apply-values (proc args-expr))
|
[(struct apply-values (proc args-expr))
|
||||||
|
|
|
@ -32,8 +32,6 @@
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; Bytecode unmarshalers for various forms
|
;; Bytecode unmarshalers for various forms
|
||||||
|
|
||||||
(define debug-symrefs #f)
|
|
||||||
|
|
||||||
(define (read-toplevel v)
|
(define (read-toplevel v)
|
||||||
(define SCHEME_TOPLEVEL_CONST #x01)
|
(define SCHEME_TOPLEVEL_CONST #x01)
|
||||||
(define SCHEME_TOPLEVEL_READY #x02)
|
(define SCHEME_TOPLEVEL_READY #x02)
|
||||||
|
@ -981,8 +979,6 @@
|
||||||
(placeholder-set! (vector-ref (cport-symtab cp) i) v))
|
(placeholder-set! (vector-ref (cport-symtab cp) i) v))
|
||||||
|
|
||||||
(define (symtab-lookup cp i)
|
(define (symtab-lookup cp i)
|
||||||
(when (mark-parameter-first read-sym-mark)
|
|
||||||
(dict-update! debug-symrefs (mark-parameter-first read-sym-mark) (λ (last) (cons i last)) empty))
|
|
||||||
(vector-ref (cport-symtab cp) i))
|
(vector-ref (cport-symtab cp) i))
|
||||||
|
|
||||||
(require unstable/markparam)
|
(require unstable/markparam)
|
||||||
|
@ -1042,20 +1038,11 @@
|
||||||
(define symtab
|
(define symtab
|
||||||
(build-vector symtabsize (λ (i) (make-placeholder nr))))
|
(build-vector symtabsize (λ (i) (make-placeholder nr))))
|
||||||
|
|
||||||
(set! debug-symrefs (make-vector symtabsize empty))
|
|
||||||
|
|
||||||
(define cp (make-cport 0 shared-size port size* rst-start symtab so* (make-vector symtabsize #f) (make-hash) (make-hash)))
|
(define cp (make-cport 0 shared-size port size* rst-start symtab so* (make-vector symtabsize #f) (make-hash) (make-hash)))
|
||||||
|
|
||||||
(for ([i (in-range 1 symtabsize)])
|
(for ([i (in-range 1 symtabsize)])
|
||||||
(read-sym cp i))
|
(read-sym cp i))
|
||||||
|
|
||||||
#;(for ([i (in-naturals)]
|
|
||||||
[v (in-vector debug-symrefs)])
|
|
||||||
(printf "~a: ~a~n" i v))
|
|
||||||
#;(printf "SYMBOL TABLE(~a):~n~n" symtabsize)
|
|
||||||
#;(for ([i (in-naturals)]
|
|
||||||
[v (in-vector (cport-symtab cp))])
|
|
||||||
(printf "~a: ~s~n~n" i (placeholder-get v)))
|
|
||||||
(set-cport-pos! cp shared-size)
|
(set-cport-pos! cp shared-size)
|
||||||
(make-reader-graph
|
(make-reader-graph
|
||||||
(read-marshalled 'compilation-top-type cp))))
|
(read-marshalled 'compilation-top-type cp))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user