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

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

View File

@ -2,7 +2,8 @@
(require racket/pretty
compiler/zo-parse
compiler/zo-marshal
compiler/decompile)
compiler/decompile
racket/file)
(define ex-mod1
'(module m racket
@ -64,6 +65,12 @@
(write c o)
(let ([p (zo-parse (open-input-bytes (get-output-bytes o)))])
(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))]
[to-string (lambda (p)
(let ([o (open-output-bytes)])

View File

@ -85,9 +85,11 @@
(iloop (loop (car subm) accum) (cdr subm)))))))
(write-bytes (int->bytes (length pre-mod-bytess)) outp)
;; Size of btree:
(define btree-size
(define header-size
(+ 8
(string-length (version))
(string-length (version))))
(define btree-size
(+ header-size
(apply + (for/list ([mb (in-list pre-mod-bytess)])
(+ (bytes-length (mod-bytes-name-bstr mb))
20)))))
@ -108,7 +110,7 @@
(define right-offsets (make-vector (vector-length sorted-mod-bytess) 0))
;; Write out btree or compute offsets:
(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 mb (vector-ref sorted-mod-bytess mid))
(define name-len (bytes-length (mod-bytes-name-bstr mb)))