From a6bd87b6322f58e3741f86084c1305485e1f44cc Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 27 May 2010 12:20:16 -0600 Subject: [PATCH 1/5] Cyclic zo tests original commit: 612bd22bfe88dcfa27d133c6572a42cff406a6dd --- collects/tests/compiler/zo-exs.rkt | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 collects/tests/compiler/zo-exs.rkt diff --git a/collects/tests/compiler/zo-exs.rkt b/collects/tests/compiler/zo-exs.rkt new file mode 100644 index 0000000000..b8ab07e067 --- /dev/null +++ b/collects/tests/compiler/zo-exs.rkt @@ -0,0 +1,22 @@ +#lang racket +(require compiler/zo-parse + compiler/zo-marshal + tests/eli-tester) + +(define (roundtrip ct) + (define bs (zo-marshal ct)) + (test bs + (zo-parse (open-input-bytes bs)) => ct)) + +(test + (local [(define (hash-test make-hash-placeholder) + (roundtrip + (compilation-top 0 + (prefix 0 empty empty) + (local [(define ht-ph (make-placeholder #f)) + (define ht (make-hash-placeholder (list (cons 'g ht-ph))))] + (placeholder-set! ht-ph ht) + (make-reader-graph ht)))))] + (hash-test make-hash-placeholder) + (hash-test make-hasheq-placeholder) + (hash-test make-hasheqv-placeholder))) From cac230bc93c35bec160519212367f3c30cf98f1a Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 27 May 2010 11:59:41 -0600 Subject: [PATCH 2/5] Unifying some code original commit: 5833f7cba49dcf780684d5144ce152a948231bf9 --- collects/compiler/zo-parse.rkt | 90 ++++++++++++---------------------- 1 file changed, 30 insertions(+), 60 deletions(-) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index 6f1b338560..b6596c91b8 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -501,15 +501,9 @@ ;; ---------------------------------------- ;; Syntax unmarshaling - (define (decode-stx cp v) (if (integer? v) - (let-values ([(v2 decoded?) (unmarshal-stx-get cp v)]) - (if decoded? - v2 - (let ([v2 (decode-stx cp v2)]) - (unmarshal-stx-set! cp v v2) - v2))) + (unmarshal-stx-get/decode cp v decode-stx) (let loop ([v v]) (let-values ([(cert-marks v encoded-wraps) (match v @@ -569,24 +563,14 @@ (define (decode-wraps cp w) ; A wraps is either a indirect reference or a list of wrap-elems (from stxobj.c:252) (if (integer? w) - (let-values ([(w2 decoded?) (unmarshal-stx-get cp w)]) - (if decoded? - w2 - (let ([w2 (decode-wraps cp w2)]) - (unmarshal-stx-set! cp w w2) - w2))) + (unmarshal-stx-get/decode cp w decode-wraps) (map (lambda (a) (let aloop ([a a]) ; A wrap-elem is either (cond ; A reference [(integer? a) - (let-values ([(a2 decoded?) (unmarshal-stx-get cp a)]) - (if decoded? - a2 - (let ([a2 (aloop a2)]) - (unmarshal-stx-set! cp a a2) - a2)))] + (unmarshal-stx-get/decode cp a (lambda (cp v) (aloop v)))] ; A mark (not actually a number as the C says, but a (list ) [(and (pair? a) (null? (cdr a)) (number? (car a))) (make-wrap-mark (car a))] @@ -704,22 +688,15 @@ [module-path-index (make-simple-module-binding module-path-index)])))) -(define (unmarshal-stx-get cp pos) - (if (pos . >= . (vector-length (cport-symtab cp))) - (values `(#%bad-index ,pos) #t) - (let ([v (vector-ref (cport-symtab cp) pos)]) - (if (not-ready? v) - (let ([save-pos (cport-pos cp)]) - (set-cport-pos! cp (vector-ref (cport-shared-offsets cp) (sub1 pos))) - (let ([v (read-compact cp)]) - (vector-set! (cport-symtab cp) pos v) - (set-cport-pos! cp save-pos) - (values v #f))) - (values v (vector-ref (cport-decoded cp) pos)))))) - -(define (unmarshal-stx-set! cp pos v) - (vector-set! (cport-symtab cp) pos v) - (vector-set! (cport-decoded cp) pos #t)) +(define (unmarshal-stx-get/decode cp pos decode-stx) + (define v2 (read-sym cp pos)) + (define decoded? (vector-ref (cport-decoded cp) pos)) + (if decoded? + v2 + (let ([dv2 (decode-stx cp v2)]) + (vector-set! (cport-symtab cp) pos dv2) + (vector-set! (cport-decoded cp) pos #t) + dv2))) (define (parse-module-path-index cp s) s) @@ -738,15 +715,7 @@ (case cpt-tag [(delayed) (let ([pos (read-compact-number cp)]) - (let ([v (vector-ref (cport-symtab cp) pos)]) - (if (not-ready? v) - (let ([save-pos (cport-pos cp)]) - (set-cport-pos! cp (vector-ref (cport-shared-offsets cp) (sub1 pos))) - (let ([v (read-compact cp)]) - (vector-set! (cport-symtab cp) pos v) - (set-cport-pos! cp save-pos) - v)) - v)))] + (read-sym cp pos))] [(escape) (let* ([len (read-compact-number cp)] [s (cport-get-bytes cp len)]) @@ -894,16 +863,8 @@ (read-compact cp))))]) (read (open-input-bytes #"x")))))] [(symref) - (let* ([l (read-compact-number cp)] - [v (vector-ref (cport-symtab cp) l)]) - (if (not-ready? v) - (let ([pos (cport-pos cp)]) - (set-cport-pos! cp (vector-ref (cport-shared-offsets cp) (sub1 l))) - (let ([v (read-compact cp)]) - (set-cport-pos! cp pos) - (vector-set! (cport-symtab cp) l v) - v)) - v))] + (let* ([l (read-compact-number cp)]) + (read-sym cp l))] [(weird-symbol) (let ([uninterned (read-compact-number cp)] [str (read-compact-chars cp (read-compact-number cp))]) @@ -956,6 +917,17 @@ [else (cons v (loop (sub1 need-car) proper))])))) +(define (read-sym cp i) + (define symtab (cport-symtab cp)) + (define vv (vector-ref symtab i)) + (define save-pos (cport-pos cp)) + (when (not-ready? vv) + (set-cport-pos! cp (vector-ref (cport-shared-offsets cp) (sub1 i))) + (let ([v (read-compact cp)]) + (vector-set! symtab i v)) + (set-cport-pos! cp save-pos)) + (vector-ref symtab i)) + ;; path -> bytes ;; implementes read.c:read_compiled (define (zo-parse port) @@ -990,16 +962,14 @@ (unless (eof-object? (read-byte port)) (error 'zo-parse "File too big")) - (define symtab (make-vector symtabsize (make-not-ready))) + (define nr (make-not-ready)) + (define symtab + (make-vector symtabsize nr)) (define cp (make-cport 0 shared-size port size* rst-start symtab so* (make-vector symtabsize #f) (make-hash) (make-hash))) (for/list ([i (in-range 1 symtabsize)]) - (define vv (vector-ref symtab i)) - (when (not-ready? vv) - (set-cport-pos! cp (vector-ref so* (sub1 i))) - (let ([v (read-compact cp)]) - (vector-set! symtab i v)))) + (read-sym cp i)) (set-cport-pos! cp shared-size) (read-marshalled 'compilation-top-type cp))) From 2fd33535084366b88ae721a5e15e932bcb172480 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 27 May 2010 11:59:55 -0600 Subject: [PATCH 3/5] Dealing with cyclic hashes original commit: 40884483176778b26d6444100d1c997b9e8961cd --- collects/compiler/zo-marshal.rkt | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index 5fbf347c94..f3ee228f9d 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -228,6 +228,11 @@ (traverse-stx expr visit)] [(wrapped? expr) (traverse-wrapped expr visit)] + [(hash? expr) + (when (visit expr) + (for ([(k v) (in-hash expr)]) + (traverse-data k visit) + (traverse-data v visit)))] [else (void)])) @@ -987,16 +992,18 @@ (for ([v (in-vector expr)]) (out-data v out))] [(hash? expr) - (out-byte CPT_HASH_TABLE out) - (out-number (cond - [(hash-eqv? expr) 2] - [(hash-eq? expr) 0] - [else 1]) - out) - (out-number (hash-count expr) out) - (for ([(k v) (in-hash expr)]) - (out-data k out) - (out-data v out))] + (out-shared expr out + (lambda () + (out-byte CPT_HASH_TABLE out) + (out-number (cond + [(hash-eqv? expr) 2] + [(hash-eq? expr) 0] + [else 1]) + out) + (out-number (hash-count expr) out) + (for ([(k v) (in-hash expr)]) + (out-data k out) + (out-data v out))))] [(svector? expr) (let* ([vec (svector-vec expr)] [len (vector-length vec)]) From 7b264d5089735241cca597ab6db009029733e971 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 27 May 2010 12:13:13 -0600 Subject: [PATCH 4/5] Using placeholders in zo-parse for more cyclic datums original commit: 035ee93911901636d7dc87a83e991dd4290386e5 --- collects/compiler/zo-parse.rkt | 58 +++++++++++++++++--------------- collects/compiler/zo-structs.rkt | 4 +-- 2 files changed, 33 insertions(+), 29 deletions(-) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index b6596c91b8..4d97023a90 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -15,8 +15,6 @@ Lines 628, 630 seem to be only for debugging and should probably throw errors - unmarshal-stx-get also seems to be for debugging and should probably throw an error - vector and pair cases of decode-wraps seem to do different things from the corresponding C code Line 816: This should be an eqv placeholder (but they don't exist) @@ -29,8 +27,6 @@ collects/browser/compiled/browser_scrbl.zo (eg) contains a all-from-module that looks like: (# 0 (1363072) . #f) --- that doesn't seem to match the spec - We seem to leave placeholders for hash-tables in the structs - |# ;; ---------------------------------------- ;; Bytecode unmarshalers for various forms @@ -558,8 +554,6 @@ (map loop (cdr (vector->list (struct->vector v)))))))] [else (add-wrap v)])))))) - - (define (decode-wraps cp w) ; A wraps is either a indirect reference or a list of wrap-elems (from stxobj.c:252) (if (integer? w) @@ -688,16 +682,6 @@ [module-path-index (make-simple-module-binding module-path-index)])))) -(define (unmarshal-stx-get/decode cp pos decode-stx) - (define v2 (read-sym cp pos)) - (define decoded? (vector-ref (cport-decoded cp) pos)) - (if decoded? - v2 - (let ([dv2 (decode-stx cp v2)]) - (vector-set! (cport-symtab cp) pos dv2) - (vector-set! (cport-decoded cp) pos #t) - dv2))) - (define (parse-module-path-index cp s) s) ;; ---------------------------------------- @@ -895,7 +879,7 @@ [(closure) (let* ([l (read-compact-number cp)] [ind (make-indirect #f)]) - (vector-set! (cport-symtab cp) l ind) + (placeholder-set! (vector-ref (cport-symtab cp) l) ind) (let* ([v (read-compact cp)] [cl (make-closure v (gensym (let ([s (lam-name v)]) @@ -917,16 +901,35 @@ [else (cons v (loop (sub1 need-car) proper))])))) +(define (unmarshal-stx-get/decode cp pos decode-stx) + (define v2 (read-sym cp pos)) + (define decoded? (vector-ref (cport-decoded cp) pos)) + (if decoded? + v2 + (let ([dv2 (decode-stx cp v2)]) + (placeholder-set! (vector-ref (cport-symtab cp) pos) dv2) + (vector-set! (cport-decoded cp) pos #t) + dv2))) + +(require unstable/markparam) +(define read-sym-mark (mark-parameter)) (define (read-sym cp i) (define symtab (cport-symtab cp)) - (define vv (vector-ref symtab i)) - (define save-pos (cport-pos cp)) - (when (not-ready? vv) - (set-cport-pos! cp (vector-ref (cport-shared-offsets cp) (sub1 i))) - (let ([v (read-compact cp)]) - (vector-set! symtab i v)) - (set-cport-pos! cp save-pos)) - (vector-ref symtab i)) + (define ph (vector-ref symtab i)) + ; We are reading this already, so return the placeholder + (if (memq i (mark-parameter-all read-sym-mark)) + ph + ; Otherwise, try to read it and return the real thing + (local [(define vv (placeholder-get ph))] + (when (not-ready? vv) + (local [(define save-pos (cport-pos cp))] + (set-cport-pos! cp (vector-ref (cport-shared-offsets cp) (sub1 i))) + (mark-parameterize + ([read-sym-mark i]) + (let ([v (read-compact cp)]) + (placeholder-set! ph v))) + (set-cport-pos! cp save-pos))) + (placeholder-get ph)))) ;; path -> bytes ;; implementes read.c:read_compiled @@ -964,14 +967,15 @@ (define nr (make-not-ready)) (define symtab - (make-vector symtabsize nr)) + (build-vector symtabsize (λ (i) (make-placeholder nr)))) (define cp (make-cport 0 shared-size port size* rst-start symtab so* (make-vector symtabsize #f) (make-hash) (make-hash))) (for/list ([i (in-range 1 symtabsize)]) (read-sym cp i)) (set-cport-pos! cp shared-size) - (read-marshalled 'compilation-top-type cp))) + (make-reader-graph + (read-marshalled 'compilation-top-type cp)))) ;; ---------------------------------------- diff --git a/collects/compiler/zo-structs.rkt b/collects/compiler/zo-structs.rkt index 2d2413594d..7c3e317bd4 100644 --- a/collects/compiler/zo-structs.rkt +++ b/collects/compiler/zo-structs.rkt @@ -22,7 +22,7 @@ (define-syntax-rule (define-form-struct* id id+par ([field-id field-contract] ...)) (begin - (define-struct id+par (field-id ...) #:transparent) + (define-struct id+par (field-id ...) #:prefab) (provide/contract [struct id ([field-id field-contract] ...)]))) @@ -57,7 +57,7 @@ (define-form-struct (expr form) ()) ;; A static closure can refer directly to itself, creating a cycle -(define-struct indirect ([v #:mutable]) #:transparent) +(define-struct indirect ([v #:mutable]) #:prefab) (define-form-struct compilation-top ([max-let-depth exact-nonnegative-integer?] [prefix prefix?] [code (or/c form? indirect? any/c)])) ; compiled code always wrapped with this From 304e5247ed2b59ca1b85d1423861e6e59c29f5ad Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 27 May 2010 12:19:58 -0600 Subject: [PATCH 5/5] Documenting make-hasheqv and using it original commit: 7e485b8d28a43581c501c0f16e62e7b67f494324 --- collects/compiler/zo-parse.rkt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index 4d97023a90..c7f6670fc3 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -794,9 +794,8 @@ [len (read-compact-number cp)]) ((case eq [(0) make-hasheq-placeholder] - ; XXX One of these should be eqv [(1) make-hash-placeholder] - [(2) make-hash-placeholder]) + [(2) make-hasheqv-placeholder]) (for/list ([i (in-range len)]) (cons (read-compact cp) (read-compact cp)))))]