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

compiler/zo-marshal: fix offsets in submodule search table

Browse Source
This commit is contained in:
Matthew Flatt 2015-01-03 09:58:08 -07:00
parent f092262df7
commit e4af0cac26
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler-test/tests/compiler/zo.rkt
View File

@ -2,7 +2,8 @@
(require racket/pretty (require racket/pretty
compiler/zo-parse compiler/zo-parse
compiler/zo-marshal compiler/zo-marshal
compiler/decompile) compiler/decompile
racket/file)
(define ex-mod1 (define ex-mod1
'(module m racket '(module m racket
@ -64,6 +65,12 @@
(write c o) (write c o)
(let ([p (zo-parse (open-input-bytes (get-output-bytes o)))]) (let ([p (zo-parse (open-input-bytes (get-output-bytes o)))])
(let ([b (zo-marshal p)]) (let ([b (zo-marshal p)])
;; Check that submodule table is ok:
(parameterize ([read-accept-compiled #t]
[current-output-port (open-output-bytes)])
(define f (make-temporary-file))
(call-with-output-file f #:exists 'truncate (lambda (f) (display b f)))
(dynamic-require f #f))
(let ([p2 (zo-parse (open-input-bytes b))] (let ([p2 (zo-parse (open-input-bytes b))]
[to-string (lambda (p) [to-string (lambda (p)
(let ([o (open-output-bytes)]) (let ([o (open-output-bytes)])

10
zo-lib/compiler/zo-marshal.rkt
View File

@ -85,9 +85,11 @@
(iloop (loop (car subm) accum) (cdr subm))))))) (iloop (loop (car subm) accum) (cdr subm)))))))
(write-bytes (int->bytes (length pre-mod-bytess)) outp) (write-bytes (int->bytes (length pre-mod-bytess)) outp)
;; Size of btree: ;; Size of btree:
(define btree-size (define header-size
(+ 8 (+ 8
(string-length (version)) (string-length (version))))
(define btree-size
(+ header-size
(apply + (for/list ([mb (in-list pre-mod-bytess)]) (apply + (for/list ([mb (in-list pre-mod-bytess)])
(+ (bytes-length (mod-bytes-name-bstr mb)) (+ (bytes-length (mod-bytes-name-bstr mb))
20))))) 20)))))
@ -99,7 +101,7 @@
(cons (mod-bytes (mod-bytes-code-bstr mb) (cons (mod-bytes (mod-bytes-code-bstr mb)
(mod-bytes-name-bstr mb) (mod-bytes-name-bstr mb)
offset) offset)
(loop (+ offset (loop (+ offset
(bytes-length (mod-bytes-code-bstr mb))) (bytes-length (mod-bytes-code-bstr mb)))
(cdr mod-bytess))))))) (cdr mod-bytess)))))))
;; Sort by name for btree order: ;; Sort by name for btree order:
@ -108,7 +110,7 @@
(define right-offsets (make-vector (vector-length sorted-mod-bytess) 0)) (define right-offsets (make-vector (vector-length sorted-mod-bytess) 0))
;; Write out btree or compute offsets: ;; Write out btree or compute offsets:
(define (write-btree write-bytes) (define (write-btree write-bytes)
(let loop ([lo 0] [hi (vector-length sorted-mod-bytess)] [pos 0]) (let loop ([lo 0] [hi (vector-length sorted-mod-bytess)] [pos header-size])
(define mid (quotient (+ lo hi) 2)) (define mid (quotient (+ lo hi) 2))
(define mb (vector-ref sorted-mod-bytess mid)) (define mb (vector-ref sorted-mod-bytess mid))
(define name-len (bytes-length (mod-bytes-name-bstr mb))) (define name-len (bytes-length (mod-bytes-name-bstr mb)))