diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 5f1e454dff..fc38f94ff2 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "8.1.0.4") +(define version "8.1.0.5") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/module-reflect.scrbl b/pkgs/racket-doc/scribblings/reference/module-reflect.scrbl index c06ae1f159..f153c33a8b 100644 --- a/pkgs/racket-doc/scribblings/reference/module-reflect.scrbl +++ b/pkgs/racket-doc/scribblings/reference/module-reflect.scrbl @@ -532,7 +532,9 @@ phase}, if it is not yet @tech{instantiate}d. The current @tech{module name resolver} may load a module declaration to resolve @racket[mod] (see @racket[current-module-name-resolver]); the path is resolved relative to @racket[current-load-relative-directory] and/or -@racket[current-directory]. +@racket[current-directory]. Beware that concurrent @racket[dynamic-require]s +in namespaces that share a @tech{module registry} can create race +conditions; see also @racket[namespace-call-with-registry-lock]. If @racket[provided] is @racket[#f], then the result is @|void-const|, and the module is not @tech{visit}ed (see @secref["mod-parse"]) or diff --git a/pkgs/racket-doc/scribblings/reference/namespaces.scrbl b/pkgs/racket-doc/scribblings/reference/namespaces.scrbl index 92aff60a53..edc2c49a65 100644 --- a/pkgs/racket-doc/scribblings/reference/namespaces.scrbl +++ b/pkgs/racket-doc/scribblings/reference/namespaces.scrbl @@ -366,6 +366,21 @@ Returns the @tech{module registry} of the given namespace. This value is useful only for identification via @racket[eq?].} +@defproc[(namespace-call-with-registry-lock [namespace namespace?] + [thunk (-> any)]) + any]{ + +Calls @racket[thunk] while holding a reentrant lock for the namespace's +@tech{module registry}. + +Namespace functions do not automatically use the registry lock, but it +can be used via @racket[namespace-call-with-registry-lock] among +threads that load and instantiate modules to avoid internal race +conditions. On-demand @tech{instantiation} of @tech{available} modules +also takes the lock; see @secref["mod-parse"]. + +@history[#:added "8.1.0.5"]} + @defproc[(module->namespace [mod (or/c module-path? resolved-module-path? module-path-index?)] diff --git a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl index f5de4eb6cf..715fd5f749 100644 --- a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl +++ b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl @@ -919,7 +919,9 @@ are visited. More generally, initiating expansion at @tech{phase} @tech{visits} and @tech{instantiations} apply to @tech{available} modules in the enclosing @tech{namespace}'s @tech{module registry}; a per-registry lock prevents multiple threads from concurrently -instantiating and visiting available modules. +instantiating and visiting available modules. On-demand instantiation +of available modules uses the same reentrant lock as +@racket[namespace-call-with-registry-lock]. When the expander encounters @racket[require] and @racket[(require (for-syntax ....))] within a @tech{module context}, the resulting diff --git a/pkgs/racket-test-core/tests/racket/namespac.rktl b/pkgs/racket-test-core/tests/racket/namespac.rktl index 2d13360bad..9a6f1d2a21 100644 --- a/pkgs/racket-test-core/tests/racket/namespac.rktl +++ b/pkgs/racket-test-core/tests/racket/namespac.rktl @@ -208,6 +208,26 @@ ;; ---------------------------------------- +(test 'ok namespace-call-with-registry-lock (current-namespace) (lambda () 'ok)) +(test-values '(1 2 3) (lambda () (namespace-call-with-registry-lock (current-namespace) + (lambda () (values 1 2 3))))) + +(test 'rentrant namespace-call-with-registry-lock (current-namespace) + (lambda () + (namespace-call-with-registry-lock (current-namespace) + (lambda () 'rentrant)))) + +(test 'fine namespace-call-with-registry-lock (current-namespace) + (lambda () + (let ([result 'fine]) + (thread (lambda () + (namespace-call-with-registry-lock (current-namespace) + (lambda () (set! result 'lock-oops))))) + (sync (system-idle-evt)) + result))) + +;; ---------------------------------------- + (parameterize ([current-namespace (make-base-namespace)]) (eval '(define-namespace-anchor anchor)) (test 1 eval '(eval 1 (namespace-anchor->namespace anchor)))) diff --git a/racket/collects/racket/lazy-require.rkt b/racket/collects/racket/lazy-require.rkt index 89565ea7d5..a202f95f12 100644 --- a/racket/collects/racket/lazy-require.rkt +++ b/racket/collects/racket/lazy-require.rkt @@ -89,7 +89,10 @@ (define (get-sym sym) (parameterize ((current-namespace (variable-reference->namespace (#%variable-reference)))) (begin0 - (dynamic-require mpi-var sym) + (namespace-call-with-registry-lock + (current-namespace) + (lambda () + (dynamic-require mpi-var sym))) (do-registration (#%variable-reference) (quote modpath))))) (define aux-name (make-lazy-function 'exp-name 'bind-name get-sym)) ... (define-syntax bind-name diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 9486cb7b11..78cc291412 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -12930,7 +12930,10 @@ static const char *startup_source = " void" "(lambda()" "(if(box-cas! lock-box_0 v_0 lock_0)" -"(let-values()(begin(proc_0) void))" +"(let-values()" +"(call-with-values" +" proc_0" +"(lambda results_0(lambda()(apply values results_0)))))" "(let-values()(lambda()(loop_0)))))" "(lambda()(semaphore-post sema_0)))))))" "(if(eq?(current-thread)(weak-box-value(cdr v_0)))" @@ -50766,6 +50769,22 @@ static const char *startup_source = "(()(begin 'namespace-base-phase(namespace-base-phase_0 unsafe-undefined)))" "((ns38_0)(namespace-base-phase_0 ns38_0)))))" "(define-values" +"(1/namespace-call-with-registry-lock)" +"(lambda(ns_0 thunk_0)" +"(begin" +" 'namespace-call-with-registry-lock" +"(let-values()" +"(let-values()" +"(begin" +"(if(1/namespace? ns_0)" +"(void)" +" (let-values () (raise-argument-error 'namespace-call-with-registry-lock \"namespace?\" ns_0)))" +"(if((lambda(p_0)(if(procedure? p_0)(procedure-arity-includes? p_0 0) #f)) thunk_0)" +"(void)" +"(let-values()" +" (raise-argument-error 'namespace-call-with-registry-lock \"(procedure-arity-includes/c 0)\" thunk_0)))" +"(registry-call-with-lock(namespace-module-registry$1 ns_0) thunk_0)))))))" +"(define-values" "(1/eval)" "(let-values(((eval_0)" "(lambda(s3_0 ns1_0 compile2_0)" @@ -66784,6 +66803,8 @@ static const char *startup_source = " 1/namespace-mapped-symbols" " 'namespace-base-phase" " 1/namespace-base-phase" +" 'namespace-call-with-registry-lock" +" 1/namespace-call-with-registry-lock" " 'module-declared?" " 1/module-declared?" " 'module-predefined?" diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index 5be9137dd3..c67c7eae60 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -15494,7 +15494,10 @@ void (lambda () (if (unsafe-box*-cas! lock-box_0 v_0 lock_0) - (begin (|#%app| proc_0) void) + (|#%call-with-values| + proc_0 + (lambda results_0 + (lambda () (apply values results_0)))) (lambda () (loop_0)))) (lambda () (semaphore-post sema_0)))))) (if (let ((app_0 (current-thread))) @@ -57141,6 +57144,22 @@ (case-lambda (() (begin (namespace-base-phase_0 unsafe-undefined))) ((ns38_0) (namespace-base-phase_0 ns38_0)))))) +(define namespace-call-with-registry-lock + (lambda (ns_0 thunk_0) + (begin + (if (1/namespace? ns_0) + (void) + (raise-argument-error + 'namespace-call-with-registry-lock + "namespace?" + ns_0)) + (if (if (procedure? thunk_0) (procedure-arity-includes? thunk_0 0) #f) + (void) + (raise-argument-error + 'namespace-call-with-registry-lock + "(procedure-arity-includes/c 0)" + thunk_0)) + (registry-call-with-lock (namespace-module-registry$1 ns_0) thunk_0)))) (define 1/eval (let ((eval_0 (|#%name| @@ -74412,6 +74431,8 @@ 1/namespace-mapped-symbols 'namespace-base-phase 1/namespace-base-phase + 'namespace-call-with-registry-lock + namespace-call-with-registry-lock 'module-declared? 1/module-declared? 'module-predefined? diff --git a/racket/src/expander/boot/main-primitive.rkt b/racket/src/expander/boot/main-primitive.rkt index 574afeb6a4..f75fd8196b 100644 --- a/racket/src/expander/boot/main-primitive.rkt +++ b/racket/src/expander/boot/main-primitive.rkt @@ -77,7 +77,8 @@ 'namespace-set-variable-value! namespace-set-variable-value! 'namespace-undefine-variable! namespace-undefine-variable! 'namespace-mapped-symbols namespace-mapped-symbols - 'namespace-base-phase namespace-base-phase + 'namespace-base-phase namespace-base-phase + 'namespace-call-with-registry-lock namespace-call-with-registry-lock 'module-declared? module-declared? 'module-predefined? module-predefined? diff --git a/racket/src/expander/namespace/api.rkt b/racket/src/expander/namespace/api.rkt index e2de91ad7a..79f69053dd 100644 --- a/racket/src/expander/namespace/api.rkt +++ b/racket/src/expander/namespace/api.rkt @@ -9,6 +9,7 @@ "../syntax/mapped-name.rkt" "namespace.rkt" "module.rkt" + "registry.rkt" "attach.rkt" "core.rkt" "../common/set.rkt" @@ -41,7 +42,9 @@ namespace-mapped-symbols - namespace-base-phase) + namespace-base-phase + + namespace-call-with-registry-lock) (define (make-empty-namespace) (define current-ns (current-namespace)) @@ -258,3 +261,10 @@ (define/who (namespace-base-phase [ns (current-namespace)]) (check who namespace? ns) (namespace-phase ns)) + +(define/who (namespace-call-with-registry-lock ns thunk) + (check who namespace? ns) + (check who (procedure-arity-includes/c 0) thunk) + (registry-call-with-lock + (namespace-module-registry ns) + thunk)) diff --git a/racket/src/expander/namespace/registry.rkt b/racket/src/expander/namespace/registry.rkt index ae5cfa631f..f5fa1f8620 100644 --- a/racket/src/expander/namespace/registry.rkt +++ b/racket/src/expander/namespace/registry.rkt @@ -24,8 +24,10 @@ (lambda () (cond [(box-cas! lock-box v lock) - (proc) - void] + (call-with-values + proc + (lambda results + (lambda () (apply values results))))] [else ;; CAS failed; take it from the top (lambda () (loop))])) diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index f1ce28334f..4cf66d1046 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 8 #define MZSCHEME_VERSION_Y 1 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 4 +#define MZSCHEME_VERSION_W 5 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x