From 4c01f60d5660c66bc0bff8c2b5549cfe5f5f2c29 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 13 Jun 2019 16:43:47 -0600 Subject: [PATCH] module name resolver: adjust resolver cache The default module name resolver uses a cache to map module names to resolved-path information. The cache was weak in a way that turns out to be much weaker on Racket CS, essentially because Chez Scheme is tuned to fire a minor GC more frequently. The new cache cuts 45 minutes(!) from a 2h15m single-process distribution build of Racket CS on Linux. That brings it under a factor of 1.5 of the non-CS build time, instead of over a factor of 2. Thanks to Caner and Sam for pointing out LONG ago (maybe a year ago) that the cache works badly for Pycket. Since the cache doesn't make a big difference for `racketcs -cl racket`, though, it took me this long to understand that it can be such a big deal for Racket CS when performing a distribution build. --- racket/src/expander/boot/handler.rkt | 54 +++--- racket/src/racket/src/startup.inc | 237 ++------------------------- 2 files changed, 43 insertions(+), 248 deletions(-) diff --git a/racket/src/expander/boot/handler.rkt b/racket/src/expander/boot/handler.rkt index a7ceba57ab..3efd18f20f 100644 --- a/racket/src/expander/boot/handler.rkt +++ b/racket/src/expander/boot/handler.rkt @@ -194,25 +194,28 @@ reg (make-ephemeron reg v))) -;; weak map from `lib' path + current-library-paths to symbols: -;; We'd like to use a weak `equal?'-based hash table here, -;; but that's not kill-safe. Instead, we use a non-thread-safe -;; custom hash table; a race could lose cache entries, but -;; that's ok. -(define CACHE-N 512) -(define-place-local -path-cache (make-vector CACHE-N #f)) -(define (path-cache-get p) - (let* ([i (modulo (abs (equal-hash-code p)) CACHE-N)] - [w (vector-ref -path-cache i)] - [l (and w (weak-box-value w))]) - (and l - (let ([a (assoc p l)]) - (and a (cdr a)))))) -(define (path-cache-set! p v) - (let* ([i (modulo (abs (equal-hash-code p)) CACHE-N)] - [w (vector-ref -path-cache i)] - [l (and w (weak-box-value w))]) - (vector-set! -path-cache i (make-weak-box (cons (cons p v) (or l null)))))) +;; Weak map from a module registries to a cache that maps module +;; references to resolved-module information. The idea behind mapping +;; from a registry is that changes made to the collection mapping +;; (e.g., by installing a package) reliably take effect when changing +;; namespaces, so using the same namespace may not see the change. +;; Also, we only cache on successful loads, so changing the mapping +;; for that namespace probably doesn't make sense, anyway, for +;; anything that was successfully loaded. +(define-place-local path-caches (make-weak-hasheq)) + +(define (path-cache-get p reg) + (define cache (hash-ref path-caches reg #hash())) + (hash-ref cache p #f)) + +(define (path-cache-set! p reg v) + (define current-cache (hash-ref path-caches reg #hash())) + ;; Limit cache memory use by flushing the whole thing when it + ;; reaches a maximum size: + (define cache (if (= (hash-count current-cache) 1024) + #hash() + current-cache)) + (hash-set! path-caches reg (hash-set cache p v))) (define -loading-filename (gensym)) (define -loading-prompt-tag (make-continuation-prompt-tag 'module-loading)) @@ -459,7 +462,7 @@ ;; collection (cond [(symbol? s) - (or (path-cache-get (cons s (get-reg))) + (or (path-cache-get s (get-reg)) (let-values ([(cols file) (split-relative-string (symbol->string s) #f)]) (let* ([f-file (if (null? cols) "main.rkt" @@ -478,7 +481,7 @@ #t))))] [(string? s) (let* ([dir (get-dir)]) - (or (path-cache-get (cons s dir)) + (or (path-cache-get (cons s dir) #f) (let-values ([(cols file) (split-relative-string s #f)]) (if (null? cols) (build-path dir (ss->rkt file)) @@ -498,7 +501,7 @@ s (path->complete-path s (get-dir)))))] [(eq? (car s) 'lib) - (or (path-cache-get (cons s (get-reg))) + (or (path-cache-get s (get-reg)) (let*-values ([(cols file) (split-relative-string (cadr s) #f)] [(old-style?) (if (null? (cddr s)) (and (null? cols) @@ -650,7 +653,10 @@ (eq? (car s) 'lib)))) (path-cache-set! (if (string? s) (cons s (get-dir)) - (cons s (get-reg))) + s) + (if (string? s) + #f + (get-reg)) (vector filename normal-filename name @@ -687,7 +693,7 @@ (define (boot) (set! -module-hash-table-table (make-weak-hasheq)) - (set! -path-cache (make-vector CACHE-N #f)) + (set! path-caches (make-weak-hasheq)) (seal) (current-module-name-resolver standard-module-name-resolver) (current-load/use-compiled default-load/use-compiled) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index eaa3f90a81..e6f012fa3b 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -2406,210 +2406,6 @@ static const char *startup_source = "(void))" "(if getkey_0(sort lst_0 less?_0 getkey_0 cache-keys?_0)(sort lst_0 less?_0)))))))))))" "(define-values" -"(bad-list)" -" (lambda (who_0 orig-l_0) (begin (raise-mismatch-error who_0 \"not a proper list: \" orig-l_0))))" -"(define-values" -"(bad-item)" -" (lambda (who_0 a_0 orig-l_0) (begin (raise-mismatch-error who_0 \"non-pair found in list: \" a_0 \" in \" orig-l_0))))" -"(define-values" -"(1/assq 1/assv 1/assoc assf)" -"(let-values()" -"(let-values()" -"(let-values(((assq_0)" -"(lambda(x_0 l_0)" -"(begin" -" 'assq" -"((letrec-values(((loop_0)" -"(lambda(l_1 t_0)" -"(begin" -" 'loop" -"(if(pair? l_1)" -"(let-values()" -"(let-values(((a_0)(unsafe-car l_1)))" -"(if(pair? a_0)" -"(if(eq? x_0(unsafe-car a_0))" -" a_0" -"(let-values(((l_2)(unsafe-cdr l_1)))" -"(if(pair? l_2)" -"(let-values()" -"(let-values(((a_1)(unsafe-car l_2)))" -"(if(pair? a_1)" -"(if(eq? x_0(unsafe-car a_1))" -" a_1" -"(let-values(((t_1)(unsafe-cdr t_0))" -"((l_3)(unsafe-cdr l_2)))" -"(if(eq? l_3 t_1)" -"(bad-list 'assq l_0)" -"(loop_0 l_3 t_1))))" -"(bad-item 'assq a_1 l_0))))" -"(if(null? l_2)" -"(let-values() #f)" -"(let-values()(bad-list 'assq l_0))))))" -"(bad-item 'assq a_0 l_0))))" -"(if(null? l_1)" -"(let-values() #f)" -"(let-values()(bad-list 'assq l_0))))))))" -" loop_0)" -" l_0" -" l_0))))" -"((assv_0)" -"(lambda(x_0 l_0)" -"(begin" -" 'assv" -"((letrec-values(((loop_0)" -"(lambda(l_1 t_0)" -"(begin" -" 'loop" -"(if(pair? l_1)" -"(let-values()" -"(let-values(((a_0)(unsafe-car l_1)))" -"(if(pair? a_0)" -"(if(eqv? x_0(unsafe-car a_0))" -" a_0" -"(let-values(((l_2)(unsafe-cdr l_1)))" -"(if(pair? l_2)" -"(let-values()" -"(let-values(((a_1)(unsafe-car l_2)))" -"(if(pair? a_1)" -"(if(eqv? x_0(unsafe-car a_1))" -" a_1" -"(let-values(((t_1)(unsafe-cdr t_0))" -"((l_3)(unsafe-cdr l_2)))" -"(if(eq? l_3 t_1)" -"(bad-list 'assv l_0)" -"(loop_0 l_3 t_1))))" -"(bad-item 'assv a_1 l_0))))" -"(if(null? l_2)" -"(let-values() #f)" -"(let-values()(bad-list 'assv l_0))))))" -"(bad-item 'assv a_0 l_0))))" -"(if(null? l_1)" -"(let-values() #f)" -"(let-values()(bad-list 'assv l_0))))))))" -" loop_0)" -" l_0" -" l_0))))" -"((assoc_0)" -"(case-lambda" -"((x_0 l_0)" -"(begin" -" 'assoc" -"((letrec-values(((loop_0)" -"(lambda(l_1 t_0)" -"(begin" -" 'loop" -"(if(pair? l_1)" -"(let-values()" -"(let-values(((a_0)(unsafe-car l_1)))" -"(if(pair? a_0)" -"(if(equal? x_0(unsafe-car a_0))" -" a_0" -"(let-values(((l_2)(unsafe-cdr l_1)))" -"(if(pair? l_2)" -"(let-values()" -"(let-values(((a_1)(unsafe-car l_2)))" -"(if(pair? a_1)" -"(if(equal? x_0(unsafe-car a_1))" -" a_1" -"(let-values(((t_1)(unsafe-cdr t_0))" -"((l_3)(unsafe-cdr l_2)))" -"(if(eq? l_3 t_1)" -"(bad-list 'assoc l_0)" -"(loop_0 l_3 t_1))))" -"(bad-item 'assoc a_1 l_0))))" -"(if(null? l_2)" -"(let-values() #f)" -"(let-values()(bad-list 'assoc l_0))))))" -"(bad-item 'assoc a_0 l_0))))" -"(if(null? l_1)" -"(let-values() #f)" -"(let-values()(bad-list 'assoc l_0))))))))" -" loop_0)" -" l_0" -" l_0)))" -"((x_0 l_0 is-equal?_0)" -"(begin" -"(if(if(procedure? is-equal?_0)(procedure-arity-includes? is-equal?_0 2) #f)" -"(void)" -" (let-values () (raise-argument-error 'assoc \"(any/c any/c . -> . any/c)\" is-equal?_0)))" -"((letrec-values(((loop_0)" -"(lambda(l_1 t_0)" -"(begin" -" 'loop" -"(if(pair? l_1)" -"(let-values()" -"(let-values(((a_0)(unsafe-car l_1)))" -"(if(pair? a_0)" -"(if(is-equal?_0 x_0(unsafe-car a_0))" -" a_0" -"(let-values(((l_2)(unsafe-cdr l_1)))" -"(if(pair? l_2)" -"(let-values()" -"(let-values(((a_1)(unsafe-car l_2)))" -"(if(pair? a_1)" -"(if(is-equal?_0 x_0(unsafe-car a_1))" -" a_1" -"(let-values(((t_1)(unsafe-cdr t_0))" -"((l_3)(unsafe-cdr l_2)))" -"(if(eq? l_3 t_1)" -"(bad-list 'assoc l_0)" -"(loop_0 l_3 t_1))))" -"(bad-item 'assoc a_1 l_0))))" -"(if(null? l_2)" -"(let-values() #f)" -"(let-values()(bad-list 'assoc l_0))))))" -"(bad-item 'assoc a_0 l_0))))" -"(if(null? l_1)" -"(let-values() #f)" -"(let-values()(bad-list 'assoc l_0))))))))" -" loop_0)" -" l_0" -" l_0)))))" -"((assf_0)" -"(lambda(f_0 l_0)" -"(begin" -" 'assf" -"(begin" -"(if(if(procedure? f_0)(procedure-arity-includes? f_0 1) #f)" -"(void)" -" (let-values () (raise-argument-error 'assf \"(any/c . -> . any/c)\" f_0)))" -"((letrec-values(((loop_0)" -"(lambda(l_1 t_0)" -"(begin" -" 'loop" -"(if(pair? l_1)" -"(let-values()" -"(let-values(((a_0)(unsafe-car l_1)))" -"(if(pair? a_0)" -"(if((lambda(__0 a_1)(f_0 a_1)) #f(unsafe-car a_0))" -" a_0" -"(let-values(((l_2)(unsafe-cdr l_1)))" -"(if(pair? l_2)" -"(let-values()" -"(let-values(((a_1)(unsafe-car l_2)))" -"(if(pair? a_1)" -"(if((lambda(__0 a_2)(f_0 a_2))" -" #f" -"(unsafe-car a_1))" -" a_1" -"(let-values(((t_1)(unsafe-cdr t_0))" -"((l_3)(unsafe-cdr l_2)))" -"(if(eq? l_3 t_1)" -"(bad-list 'assf l_0)" -"(loop_0 l_3 t_1))))" -"(bad-item 'assf a_1 l_0))))" -"(if(null? l_2)" -"(let-values() #f)" -"(let-values()(bad-list 'assf l_0))))))" -"(bad-item 'assf a_0 l_0))))" -"(if(null? l_1)" -"(let-values() #f)" -"(let-values()(bad-list 'assf l_0))))))))" -" loop_0)" -" l_0" -" l_0))))))" -"(values assq_0 assv_0 assoc_0 assf_0)))))" -"(define-values" "(filter)" "(lambda(f_0 list_0)" "(begin" @@ -65228,27 +65024,19 @@ static const char *startup_source = "(define-values" "(registry-table-set!)" "(lambda(reg_0 v_0)(begin(hash-set!(unsafe-place-local-ref cell.1) reg_0(make-ephemeron reg_0 v_0)))))" -"(define-values(CACHE-N) 512)" -"(define-values(cell.2)(unsafe-make-place-local(make-vector CACHE-N #f)))" +"(define-values(cell.2)(unsafe-make-place-local(make-weak-hasheq)))" "(define-values" "(path-cache-get)" -"(lambda(p_0)" +"(lambda(p_0 reg_0)" "(begin" -"(let-values(((i_0)(modulo(abs(equal-hash-code p_0)) CACHE-N)))" -"(let-values(((w_0)(vector-ref(unsafe-place-local-ref cell.2) i_0)))" -"(let-values(((l_0)(if w_0(weak-box-value w_0) #f)))" -"(if l_0(let-values(((a_0)(1/assoc p_0 l_0)))(if a_0(cdr a_0) #f)) #f)))))))" +"(let-values(((cache_0)(hash-ref(unsafe-place-local-ref cell.2) reg_0 '#hash())))(hash-ref cache_0 p_0 #f)))))" "(define-values" "(path-cache-set!)" -"(lambda(p_0 v_0)" +"(lambda(p_0 reg_0 v_0)" "(begin" -"(let-values(((i_0)(modulo(abs(equal-hash-code p_0)) CACHE-N)))" -"(let-values(((w_0)(vector-ref(unsafe-place-local-ref cell.2) i_0)))" -"(let-values(((l_0)(if w_0(weak-box-value w_0) #f)))" -"(vector-set!" -"(unsafe-place-local-ref cell.2)" -" i_0" -"(make-weak-box(cons(cons p_0 v_0)(let-values(((or-part_0) l_0))(if or-part_0 or-part_0 null)))))))))))" +"(let-values(((current-cache_0)(hash-ref(unsafe-place-local-ref cell.2) reg_0 '#hash())))" +"(let-values(((cache_0)(if(=(hash-count current-cache_0) 1024) '#hash() current-cache_0)))" +"(hash-set!(unsafe-place-local-ref cell.2) reg_0(hash-set cache_0 p_0 v_0)))))))" "(define-values(-loading-filename)(gensym))" "(define-values(-loading-prompt-tag)(make-continuation-prompt-tag 'module-loading))" "(define-values(cell.3)(unsafe-make-place-local #f))" @@ -65579,7 +65367,7 @@ static const char *startup_source = "(let-values(((s-parsed_0)" "(if(symbol? s_1)" "(let-values()" -"(let-values(((or-part_0)(path-cache-get(cons s_1(get-reg_0)))))" +"(let-values(((or-part_0)(path-cache-get s_1(get-reg_0))))" "(if or-part_0" " or-part_0" "(let-values(((cols_0 file_0)" @@ -65605,7 +65393,7 @@ static const char *startup_source = "(if(string? s_1)" "(let-values()" "(let-values(((dir_0)(get-dir_0)))" -"(let-values(((or-part_0)(path-cache-get(cons s_1 dir_0))))" +"(let-values(((or-part_0)(path-cache-get(cons s_1 dir_0) #f)))" "(if or-part_0" " or-part_0" "(let-values(((cols_0 file_0)(split-relative-string s_1 #f)))" @@ -65631,7 +65419,7 @@ static const char *startup_source = "(if(complete-path? s_1) s_1(path->complete-path s_1(get-dir_0))))))" "(if(eq?(car s_1) 'lib)" "(let-values()" -"(let-values(((or-part_0)(path-cache-get(cons s_1(get-reg_0)))))" +"(let-values(((or-part_0)(path-cache-get s_1(get-reg_0))))" "(if or-part_0" " or-part_0" "(let-values(((cols_0 file_0)" @@ -65833,7 +65621,8 @@ static const char *startup_source = " #f)" "(let-values()" "(path-cache-set!" -"(if(string? s_1)(cons s_1(get-dir_0))(cons s_1(get-reg_0)))" +"(if(string? s_1)(cons s_1(get-dir_0)) s_1)" +"(if(string? s_1) #f(get-reg_0))" "(vector" " filename_0" " normal-filename_0" @@ -65883,7 +65672,7 @@ static const char *startup_source = "(begin" "(begin" "(unsafe-place-local-set! cell.1(make-weak-hasheq))" -"(unsafe-place-local-set! cell.2(make-vector CACHE-N #f))" +"(unsafe-place-local-set! cell.2(make-weak-hasheq))" "(seal)" "(1/current-module-name-resolver standard-module-name-resolver)" "(1/current-load/use-compiled default-load/use-compiled)"