fix module-code caching
Fixes a problem with c4508ad0d9
, which disabled module-code
caching too often. A symptom of the disabled cache was that
running "math/scribblings/math.scrbl" would use twice
as much memory.
This commit is contained in:
parent
65453037d5
commit
b942a21846
|
@ -1163,16 +1163,6 @@
|
|||
;; Check that module caching doesn't cause submodules
|
||||
;; to be loaded/declared too early
|
||||
|
||||
(let ()
|
||||
(define dir (find-system-path 'temp-dir))
|
||||
(define tmx (build-path dir "tmx.rkt"))
|
||||
(define e (compile '(module tmx racket/base
|
||||
(module s racket/base
|
||||
(provide x)
|
||||
(define x 1)))))
|
||||
(make-directory* (build-path dir "compiled"))
|
||||
(define zo-path (build-path dir "compiled" "tmx_rkt.zo"))
|
||||
|
||||
(define (install-module-hashes! s start len c)
|
||||
(define vlen (bytes-ref s (+ start 2)))
|
||||
(define mode (integer->char (bytes-ref s (+ start 3 vlen))))
|
||||
|
@ -1194,6 +1184,16 @@
|
|||
(void)]
|
||||
[else (error "unknown")]))
|
||||
|
||||
(let ()
|
||||
(define dir (find-system-path 'temp-dir))
|
||||
(define tmx (build-path dir "tmx.rkt"))
|
||||
(define e (compile '(module tmx racket/base
|
||||
(module s racket/base
|
||||
(provide x)
|
||||
(define x 1)))))
|
||||
(make-directory* (build-path dir "compiled"))
|
||||
(define zo-path (build-path dir "compiled" "tmx_rkt.zo"))
|
||||
|
||||
(define bstr
|
||||
(let ([b (open-output-bytes)])
|
||||
(write e b)
|
||||
|
@ -1216,6 +1216,45 @@
|
|||
(test 1 dynamic-require `(submod ,tmx s) 'x))
|
||||
(delete-file zo-path))
|
||||
|
||||
;; Check that module-code caching works
|
||||
(let ()
|
||||
(define dir (find-system-path 'temp-dir))
|
||||
(define tmx (build-path dir "tmx2.rkt"))
|
||||
(define e (compile '(module tmx2 racket/kernel
|
||||
(#%provide x)
|
||||
(define-values (x) 1))))
|
||||
(make-directory* (build-path dir "compiled"))
|
||||
(define zo-path (build-path dir "compiled" "tmx2_rkt.zo"))
|
||||
|
||||
(define bstr
|
||||
(let ([b (open-output-bytes)])
|
||||
(write e b)
|
||||
(let* ([s (get-output-bytes b)])
|
||||
(install-module-hashes! s 0 (bytes-length s) 100)
|
||||
s)))
|
||||
|
||||
(call-with-output-file zo-path
|
||||
#:exists 'truncate
|
||||
(lambda (o)
|
||||
(write-bytes bstr o)))
|
||||
(parameterize ([current-namespace (make-base-namespace)]
|
||||
[current-module-declare-name (make-resolved-module-path tmx)]
|
||||
[current-load-relative-directory dir])
|
||||
(eval (parameterize ([read-accept-compiled #t])
|
||||
(read (open-input-bytes bstr)))))
|
||||
|
||||
;; Mangle the bytecode file; cached variant should be used:
|
||||
(call-with-output-file zo-path
|
||||
#:exists 'update
|
||||
(lambda (o)
|
||||
(file-position o (- (file-size zo-path) 100))
|
||||
(write-bytes (make-bytes 100 (char->integer #\!)) o)))
|
||||
|
||||
(test 2 add1
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(dynamic-require tmx 'x)))
|
||||
(delete-file zo-path))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
@ -6497,7 +6497,9 @@ static Scheme_Object *do_module_execute(Scheme_Object *data, Scheme_Env *genv,
|
|||
m = MALLOC_ONE_TAGGED(Scheme_Module);
|
||||
memcpy(m, data, sizeof(Scheme_Module));
|
||||
|
||||
if (set_cache && m->code_key && !m->pre_submodules && !m->post_submodules) {
|
||||
if (set_cache && m->code_key
|
||||
&& (!m->pre_submodules || SCHEME_NULLP(m->pre_submodules))
|
||||
&& (!m->post_submodules || SCHEME_NULLP(m->post_submodules))) {
|
||||
if (!scheme_module_code_cache) {
|
||||
REGISTER_SO(scheme_module_code_cache);
|
||||
scheme_module_code_cache = scheme_make_weak_equal_table();
|
||||
|
|
Loading…
Reference in New Issue
Block a user