From ed301f8a7c84d5308cef99d503efff5f7358c2da Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 29 Jan 2019 15:18:16 -0700 Subject: [PATCH] cs: skip check for module as an extension The "extension" module protocol predates the modern FFI and depends on the C API. Since it's not supported on Racket CS, skip the check for extension modules. Skipping the check can reduce load time considerably. We should consider depracting the extension protocol for traditional Racket. --- .../scribblings/reference/eval.scrbl | 25 ++++++++++++----- .../collects/compiler/private/cm-minimal.rkt | 18 +++++++------ racket/src/expander/boot/handler.rkt | 27 ++++++++++--------- 3 files changed, 43 insertions(+), 27 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/eval.scrbl b/pkgs/racket-doc/scribblings/reference/eval.scrbl index bcf9271b99..9faa9f3f9a 100644 --- a/pkgs/racket-doc/scribblings/reference/eval.scrbl +++ b/pkgs/racket-doc/scribblings/reference/eval.scrbl @@ -223,19 +223,28 @@ An @tech{extension-load handler} takes the same arguments as a (Mac OS). The file is loaded using internal, OS-specific primitives. See @other-manual['(lib "scribblings/inside/inside.scrbl")] for more information on -@tech{dynamic extensions}.} +@tech{dynamic extensions}. + +Extensions are supported only when @racket[(system-type 'vm)] returns +@racket['racket].} @defproc[(load-extension [file path-string?]) any]{ Sets @racket[current-load-relative-directory] like @racket[load], and -calls the @tech{extension-load handler} in tail position.} +calls the @tech{extension-load handler} in tail position. + +Extensions are supported only when @racket[(system-type 'vm)] returns +@racket['racket].} @defproc[(load-relative-extension [file path-string?]) any]{ Like @racket[load-extension], but resolves @racket[file] using -@racket[current-load-relative-directory] like @racket[load-relative].} +@racket[current-load-relative-directory] like @racket[load-relative]. + +Extensions are supported only when @racket[(system-type 'vm)] returns +@racket['racket].} @defparam[current-load/use-compiled proc (path? (or/c #f @@ -261,8 +270,8 @@ The protocol for a @tech{compiled-load handler} is the same as for the the default @tech{compiled-load handler} checks for a @filepath{.ss} file.} @item{The default @tech{compiled-load handler} checks for the opportunity - to load from @filepath{.zo} (bytecode) files and - @filepath{.so} (native Unix), @filepath{.dll} (native Windows), + to load from @filepath{.zo} (bytecode) files and, when @racket[(system-type 'vm)] + returns @racket['racket], for @filepath{.so} (native Unix), @filepath{.dll} (native Windows), or @filepath{.dylib} (native Mac OS) files.} @item{When the default @tech{compiled-load handler} needs to load from @@ -290,7 +299,8 @@ order, and the subdirectories are checked in order within each root. A @filepath{.zo} version of the file (whose name is formed by passing @racket[_file] and @racket[#".zo"] to @racket[path-add-extension]) is loaded if it exists directly in one of the indicated subdirectories, -or a @filepath{.so}/@filepath{.dll}/@filepath{.dylib} version of the +or when @racket[(system-type 'vm)] returns +@racket['racket], then a @filepath{.so}/@filepath{.dll}/@filepath{.dylib} version of the file is loaded if it exists within a @filepath{native} subdirectory of a @racket[use-compiled-file-paths] directory, in an even deeper subdirectory as named by @racket[system-library-subpath]. A compiled @@ -299,7 +309,8 @@ file is loaded only if it checks out according to of @racket['modify-seconds], a compiled file is used only if its modification date is not older than the date for @racket[_file]. If both @filepath{.zo} and -@filepath{.so}/@filepath{.dll}/@filepath{.dylib} files are available, +@filepath{.so}/@filepath{.dll}/@filepath{.dylib} files are available +when @racket[(system-type 'vm)] returns @racket['racket], the @filepath{.so}/@filepath{.dll}/@filepath{.dylib} file is used. If @racket[_file] ends with @filepath{.rkt}, no such file exists, the handler's second argument is a symbol, and a @filepath{.ss} file diff --git a/racket/collects/compiler/private/cm-minimal.rkt b/racket/collects/compiler/private/cm-minimal.rkt index d13252f677..26ebda46e4 100644 --- a/racket/collects/compiler/private/cm-minimal.rkt +++ b/racket/collects/compiler/private/cm-minimal.rkt @@ -840,9 +840,10 @@ (define (get-compiled-time path->mode roots path) (define-values (dir name) (get-compilation-dir+name path #:modes (list (path->mode path)) #:roots roots)) - (or (try-file-time (build-path dir "native" (system-library-subpath) - (path-add-extension name (system-type - 'so-suffix)))) + (or (and (eq? 'racket (system-type 'vm)) + (try-file-time (build-path dir "native" (system-library-subpath) + (path-add-extension name (system-type + 'so-suffix))))) (try-file-time (build-path dir (path-add-extension name #".zo"))))) ;; Gets a multi-sha1 string that represents the compiled code @@ -895,11 +896,12 @@ (cadr roots) (car roots)))) (let ([dep-path (build-path dir (path-add-extension name #".dep"))]) - (or (try-file-sha1 (build-path dir "native" (system-library-subpath) - (path-add-extension name (system-type - 'so-suffix))) - dep-path - roots) + (or (and (eq? 'racket (system-type 'vm)) + (try-file-sha1 (build-path dir "native" (system-library-subpath) + (path-add-extension name (system-type + 'so-suffix))) + dep-path + roots)) (try-file-sha1 (build-path dir (path-add-extension name #".zo")) dep-path roots) diff --git a/racket/src/expander/boot/handler.rkt b/racket/src/expander/boot/handler.rkt index a4d66beff3..20faab9e52 100644 --- a/racket/src/expander/boot/handler.rkt +++ b/racket/src/expander/boot/handler.rkt @@ -111,16 +111,17 @@ (date-of-1 alt-path))] [path-d (or main-path-d alt-path-d)] [get-so (lambda (file rep-sfx?) - (lambda (root-dir compiled-dir) - (build-path (reroot base root-dir) - compiled-dir - "native" - (system-library-subpath) - (if rep-sfx? - (path-add-extension - file - dll-suffix) - file))))] + (and (eq? 'racket (system-type 'vm)) + (lambda (root-dir compiled-dir) + (build-path (reroot base root-dir) + compiled-dir + "native" + (system-library-subpath) + (if rep-sfx? + (path-add-extension + file + dll-suffix) + file)))))] [zo (lambda (root-dir compiled-dir) (build-path (reroot base root-dir) compiled-dir @@ -135,12 +136,14 @@ [try-alt? (and alt-file (or alt-path-d (not main-path-d)))] [with-dir (lambda (t) (with-dir* base t))]) (cond - [(and try-main? + [(and so + try-main? (date>=? modes roots so path-d)) => (lambda (so-d) (parameterize ([current-module-declare-source #f]) (with-dir (lambda () ((current-load-extension) (car so-d) expect-module)))))] - [(and try-alt? + [(and alt-so + try-alt? (date>=? modes roots alt-so alt-path-d)) => (lambda (so-d) (parameterize ([current-module-declare-source alt-path])