add use-compiled-file-check
Along with the `PLT_COMPILED_FILE_CHECK` environment variable, allows the timestamp check to be disabled when deciding whether to use a compiled bytecode file. In accomodating this change, `raco make` and `raco setup` in all modes check whether the SHA1 hash of a module source matches the one recorded in its ".dep" file, even if the timestamp on the bytecode file is newer. (If the compile-file check mode is 'exists, the timestamp is completely ignored.)
This commit is contained in:
parent
c65ad1efad
commit
fc345ed249
|
@ -12,7 +12,7 @@
|
||||||
|
|
||||||
(define collection 'multi)
|
(define collection 'multi)
|
||||||
|
|
||||||
(define version "6.6.0.2")
|
(define version "6.6.0.3")
|
||||||
|
|
||||||
(define deps `("racket-lib"
|
(define deps `("racket-lib"
|
||||||
["racket" #:version ,version]))
|
["racket" #:version ,version]))
|
||||||
|
|
|
@ -120,7 +120,10 @@ A subsequent
|
||||||
|
|
||||||
loads bytecode from the generated @filepath{.zo} files, paying
|
loads bytecode from the generated @filepath{.zo} files, paying
|
||||||
attention to the @filepath{.rkt} sources only to confirm that each
|
attention to the @filepath{.rkt} sources only to confirm that each
|
||||||
@filepath{.zo} file has a later timestamp.
|
@filepath{.zo} file has a later timestamp (unless the
|
||||||
|
@envvar{PLT_COMPILED_FILE_CHECK} environment variable is set to
|
||||||
|
@litchar{exists}, in which case the compiled file is used without
|
||||||
|
a timestamp check).
|
||||||
|
|
||||||
In contrast,
|
In contrast,
|
||||||
|
|
||||||
|
@ -151,7 +154,7 @@ section, the @exec{raco make} command creates
|
||||||
files. The @filepath{compiled/a_rkt.dep} file records the dependency
|
files. The @filepath{compiled/a_rkt.dep} file records the dependency
|
||||||
of @filepath{a.rkt} on @filepath{b.rkt}, @filepath{c.rkt} and the
|
of @filepath{a.rkt} on @filepath{b.rkt}, @filepath{c.rkt} and the
|
||||||
@racketmodname[racket] library. If the @filepath{b.rkt} file is
|
@racketmodname[racket] library. If the @filepath{b.rkt} file is
|
||||||
modified (so that its timestamp and SHA-1 hash changes), then running
|
modified (so that its SHA-1 hash changes), then running
|
||||||
|
|
||||||
@commandline{raco make a.rkt}
|
@commandline{raco make a.rkt}
|
||||||
|
|
||||||
|
@ -162,6 +165,11 @@ For module files that are within library collections, @exec{raco
|
||||||
setup} uses the same @filepath{.zo} and @filepath{.dep} conventions
|
setup} uses the same @filepath{.zo} and @filepath{.dep} conventions
|
||||||
and files as @exec{raco make}, so the two tools can be used together.
|
and files as @exec{raco make}, so the two tools can be used together.
|
||||||
|
|
||||||
|
As long as the @envvar{PLT_COMPILED_FILE_CHECK} environment variable
|
||||||
|
is not set or is set to @litchar{modify}, then @exec{raco make}
|
||||||
|
updates the timestamp on a compiled bytecode file if it is older than
|
||||||
|
the source, even if the file does not need to be recompiled.
|
||||||
|
|
||||||
@; ----------------------------------------------------------------------
|
@; ----------------------------------------------------------------------
|
||||||
|
|
||||||
@section{API for Making Bytecode}
|
@section{API for Making Bytecode}
|
||||||
|
@ -220,9 +228,15 @@ file if
|
||||||
@item{the version recorded in the @filepath{.dep} file does not
|
@item{the version recorded in the @filepath{.dep} file does not
|
||||||
match the result of @racket[(version)];}
|
match the result of @racket[(version)];}
|
||||||
|
|
||||||
|
@item{the source hash recorded in the @filepath{.dep} file does not
|
||||||
|
match the current source hash;}
|
||||||
|
|
||||||
@item{one of the files listed in the @filepath{.dep} file has a
|
@item{one of the files listed in the @filepath{.dep} file has a
|
||||||
@filepath{.zo} timestamp newer than the target @filepath{.zo},
|
@filepath{.zo} timestamp newer than the target @filepath{.zo}
|
||||||
and the combined hashes of the dependencies recorded in the
|
and @racket[use-compiled-file-check] is set to
|
||||||
|
@racket['modify-seconds];}
|
||||||
|
|
||||||
|
@item{the combined hashes of the dependencies recorded in the
|
||||||
@filepath{.dep} file does not match the combined hash recorded
|
@filepath{.dep} file does not match the combined hash recorded
|
||||||
in the @filepath{.dep} file.}
|
in the @filepath{.dep} file.}
|
||||||
|
|
||||||
|
@ -232,7 +246,8 @@ file if
|
||||||
|
|
||||||
If SHA-1 hashes override a timestamp-based decision to recompile the
|
If SHA-1 hashes override a timestamp-based decision to recompile the
|
||||||
file, then the target @filepath{.zo} file's timestamp is updated to
|
file, then the target @filepath{.zo} file's timestamp is updated to
|
||||||
the current time.
|
the current time, unless the @racket[use-compiled-file-check]
|
||||||
|
parameter is not set to @racket['modify-seconds].
|
||||||
|
|
||||||
After the handler procedure compiles a @filepath{.zo} file, it creates
|
After the handler procedure compiles a @filepath{.zo} file, it creates
|
||||||
a corresponding @filepath{.dep} file that lists the current version
|
a corresponding @filepath{.dep} file that lists the current version
|
||||||
|
@ -294,7 +309,10 @@ are @racket['locking], @racket['start-compile], @racket['finish-compile], and
|
||||||
@racket['already-done].
|
@racket['already-done].
|
||||||
|
|
||||||
@history[#:changed "6.1.1.8" @elem{Added identification of the compilation
|
@history[#:changed "6.1.1.8" @elem{Added identification of the compilation
|
||||||
context via @racket[managed-compiled-context-key].}]}
|
context via @racket[managed-compiled-context-key].}
|
||||||
|
#:changed "6.6.0.3" @elem{added check on a source's SHA1 hash to complement the
|
||||||
|
timestamp check, where the altter can be disabled
|
||||||
|
via @racket[use-compile-file-check].}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(managed-compile-zo [file path-string?]
|
@defproc[(managed-compile-zo [file path-string?]
|
||||||
|
|
|
@ -154,7 +154,9 @@ flags:
|
||||||
files to @filepath{.zo} files.}
|
files to @filepath{.zo} files.}
|
||||||
|
|
||||||
@item{@DFlag{trust-zos} --- fix timestamps on @filepath{.zo} files on
|
@item{@DFlag{trust-zos} --- fix timestamps on @filepath{.zo} files on
|
||||||
the assumption that they are already up-to-date.}
|
the assumption that they are already up-to-date (unless the
|
||||||
|
@envvar{PLT_COMPILED_FILE_CHECK} environment variable is set to
|
||||||
|
@litchar{exists}, in which case timestamps are ignored).}
|
||||||
|
|
||||||
@item{@DFlag{no-launcher} or @Flag{x} --- refrain from creating
|
@item{@DFlag{no-launcher} or @Flag{x} --- refrain from creating
|
||||||
executables or installing @tt{man} pages (as specified in
|
executables or installing @tt{man} pages (as specified in
|
||||||
|
@ -292,11 +294,18 @@ collections during an install:
|
||||||
|
|
||||||
@commandline{env PLT_SETUP_OPTIONS="-j 1" make install}
|
@commandline{env PLT_SETUP_OPTIONS="-j 1" make install}
|
||||||
|
|
||||||
|
Running @exec{raco setup} is sensitive to the
|
||||||
|
@envvar{PLT_COMPILED_FILE_CHECK} environment variable in the same way
|
||||||
|
as @exec{raco make}. Specifically, if @envvar{PLT_COMPILED_FILE_CHECK}
|
||||||
|
is set to @litchar{exists}, then @exec{raco make} does not attempt to
|
||||||
|
update a compiled file's timestamp if the file is not recompiled.
|
||||||
|
|
||||||
@history[#:changed "6.1" @elem{Added the @DFlag{pkgs},
|
@history[#:changed "6.1" @elem{Added the @DFlag{pkgs},
|
||||||
@DFlag{check-pkg-deps}, and
|
@DFlag{check-pkg-deps}, and
|
||||||
@DFlag{fail-fast} flags.}
|
@DFlag{fail-fast} flags.}
|
||||||
#:changed "6.1.1" @elem{Added the @DFlag{force-user-docs} flag.}
|
#:changed "6.1.1" @elem{Added the @DFlag{force-user-docs} flag.}
|
||||||
#:changed "6.1.1.6" @elem{Added the @DFlag{only-foreign-libs} flag.}]
|
#:changed "6.1.1.6" @elem{Added the @DFlag{only-foreign-libs} flag.}
|
||||||
|
#:changed "6.6.0.3" @elem{Added support for @envvar{PLT_COMPILED_FILE_CHECK}.}]
|
||||||
|
|
||||||
@; ------------------------------------------------------------------------
|
@; ------------------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -947,6 +956,9 @@ Runs @exec{raco setup} with various options:
|
||||||
The result is @racket[#t] if @exec{raco setup} completes without error,
|
The result is @racket[#t] if @exec{raco setup} completes without error,
|
||||||
@racket[#f] otherwise.
|
@racket[#f] otherwise.
|
||||||
|
|
||||||
|
Instead of using @envvar{PLT_COMPILED_FILE_CHECK}, @racket[setup] is
|
||||||
|
sensitive to the @racket[use-compiled-file-check] parameter.
|
||||||
|
|
||||||
@history[#:changed "6.1" @elem{Added the @racket[fail-fast?] argument.}
|
@history[#:changed "6.1" @elem{Added the @racket[fail-fast?] argument.}
|
||||||
#:changed "6.1.1" @elem{Added the @racket[force-user-docs?] argument.}]}
|
#:changed "6.1.1" @elem{Added the @racket[force-user-docs?] argument.}]}
|
||||||
|
|
||||||
|
|
|
@ -273,7 +273,10 @@ or a @filepath{.so}/@filepath{.dll}/@filepath{.dylib} version of the
|
||||||
file is loaded if it exists within a @filepath{native} subdirectory of
|
file is loaded if it exists within a @filepath{native} subdirectory of
|
||||||
a @racket[use-compiled-file-paths] directory, in an even deeper
|
a @racket[use-compiled-file-paths] directory, in an even deeper
|
||||||
subdirectory as named by @racket[system-library-subpath]. A compiled
|
subdirectory as named by @racket[system-library-subpath]. A compiled
|
||||||
file is loaded only if its modification date is not older than the
|
file is loaded only if it checks out according to
|
||||||
|
@racket[(use-compiled-file-check)]; with the default parameter value
|
||||||
|
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
|
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,
|
||||||
the @filepath{.so}/@filepath{.dll}/@filepath{.dylib} file is used. If
|
the @filepath{.so}/@filepath{.dll}/@filepath{.dylib} file is used. If
|
||||||
|
@ -358,6 +361,23 @@ command-line flag, it is parsed by first replacing any
|
||||||
initial value.}
|
initial value.}
|
||||||
|
|
||||||
|
|
||||||
|
@defparam[use-compiled-file-check check (or/c 'modify-seconds 'exists)]{
|
||||||
|
|
||||||
|
A @tech{parameter} that determines how a compiled file is checked
|
||||||
|
against its source to enable use of the compiled file. By default, the
|
||||||
|
file-check mode is @racket['modify-seconds], which uses a compiled
|
||||||
|
file when its filesystem modification date is at least as new as the
|
||||||
|
source file's. The @racket['exists] mode causes a compiled file to be
|
||||||
|
used in place of its source as long as the compiled file exists.
|
||||||
|
|
||||||
|
If the @indexed-envvar{PLT_COMPILE_FILE_CHECK} environment variable is
|
||||||
|
set to @litchar{modify-seconds} or @litchar{check}, then the
|
||||||
|
environment variable's value configures the parameter when Racket
|
||||||
|
starts.
|
||||||
|
|
||||||
|
@history[#:added "6.6.0.3"]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(read-eval-print-loop) any]{
|
@defproc[(read-eval-print-loop) any]{
|
||||||
|
|
||||||
Starts a new @deftech{REPL} using the current input, output, and error
|
Starts a new @deftech{REPL} using the current input, output, and error
|
||||||
|
|
|
@ -1042,11 +1042,15 @@
|
||||||
[info-out-time (for/fold ([t +inf.0]) ([info-out-file info-out-files])
|
[info-out-time (for/fold ([t +inf.0]) ([info-out-file info-out-files])
|
||||||
(and t
|
(and t
|
||||||
(let ([t2 (file-or-directory-modify-seconds info-out-file #f (lambda () #f))])
|
(let ([t2 (file-or-directory-modify-seconds info-out-file #f (lambda () #f))])
|
||||||
(and t2 (min t t2)))))]
|
(and t2 (if (not (eq? 'modify-seconds (use-compiled-file-check)))
|
||||||
|
0
|
||||||
|
(min t t2))))))]
|
||||||
[provides-time (for/fold ([t +inf.0]) ([info-out-file info-out-files])
|
[provides-time (for/fold ([t +inf.0]) ([info-out-file info-out-files])
|
||||||
(and t
|
(and t
|
||||||
(let ([t2 (and (file-exists? db-file)
|
(let ([t2 (and (file-exists? db-file)
|
||||||
(doc-db-get-provides-timestamp db-file info-out-file))])
|
(if (not (eq? 'modify-seconds (use-compiled-file-check)))
|
||||||
|
(doc-db-get-provides-timestamp db-file info-out-file)
|
||||||
|
0))])
|
||||||
(and t2 (min t t2)))))]
|
(and t2 (min t t2)))))]
|
||||||
[info-in-exists? (file-exists? info-in-file)]
|
[info-in-exists? (file-exists? info-in-file)]
|
||||||
[vers (send renderer get-serialize-version)]
|
[vers (send renderer get-serialize-version)]
|
||||||
|
|
|
@ -37,46 +37,60 @@
|
||||||
(build-path dir "compiled" (path-add-suffix (car f) #".zo"))
|
(build-path dir "compiled" (path-add-suffix (car f) #".zo"))
|
||||||
#f
|
#f
|
||||||
(lambda () -inf.0)))))])
|
(lambda () -inf.0)))))])
|
||||||
(for-each (lambda (recomp)
|
(for ([touch-mode '(touch-zo normal)])
|
||||||
(printf "pausing...\n")
|
(for-each (lambda (recomp)
|
||||||
(sleep 1) ;; timestamps have a 1-second granularity on most filesystems
|
(define (pause)
|
||||||
(let ([to-touch (list-ref recomp 0)]
|
(printf "pausing...\n")
|
||||||
[to-make (list-ref recomp 1)])
|
(sleep 1)) ;; timestamps have a 1-second granularity on most filesystems
|
||||||
(for-each (lambda (f)
|
(pause)
|
||||||
(printf "touching ~a\n" f)
|
(let ([to-touch (list-ref recomp 0)]
|
||||||
(with-output-to-file (build-path dir f)
|
[to-make (list-ref recomp 1)])
|
||||||
#:exists 'append
|
(for-each (lambda (f)
|
||||||
(lambda () (display " "))))
|
(printf "touching ~a\n" f)
|
||||||
to-touch)
|
(with-output-to-file (build-path dir f)
|
||||||
(for-each (lambda (f)
|
#:exists 'append
|
||||||
(let* ([d (build-path dir "compiled" (path-add-suffix f #".zo"))]
|
(lambda () (display " ")))
|
||||||
[ts (file-or-directory-modify-seconds d #f (lambda () #f))])
|
(when (eq? touch-mode 'touch-zo)
|
||||||
(when ts
|
;; Make sure a new typestamp on the bytecode file doesn't
|
||||||
(printf "mangling .zo for ~a\n" f)
|
;; prevent a recompile
|
||||||
(with-output-to-file d
|
(define d (build-path dir "compiled" (path-add-suffix f #".zo")))
|
||||||
#:exists 'truncate
|
(when (file-exists? d)
|
||||||
(lambda () (display "#~bad")))
|
(printf "touching .zo for ~a\n" f)
|
||||||
(file-or-directory-modify-seconds d ts))))
|
(file-or-directory-modify-seconds d (current-seconds))
|
||||||
(caddr recomp))
|
(hash-set! timestamps f (file-or-directory-modify-seconds d)))))
|
||||||
(for-each (lambda (f)
|
to-touch)
|
||||||
(printf "re-making ~a\n" f)
|
(for-each (lambda (f)
|
||||||
(managed-compile-zo (build-path dir f)))
|
(let* ([d (build-path dir "compiled" (path-add-suffix f #".zo"))]
|
||||||
to-make)
|
[ts (file-or-directory-modify-seconds d #f (lambda () #f))])
|
||||||
(for-each (lambda (f)
|
(when ts
|
||||||
(let ([ts (hash-ref timestamps f)]
|
(printf "mangling .zo for ~a\n" f)
|
||||||
[new-ts
|
(with-output-to-file d
|
||||||
(file-or-directory-modify-seconds
|
#:exists 'truncate
|
||||||
(build-path dir "compiled" (path-add-suffix f #".zo"))
|
(lambda () (display "#~bad")))
|
||||||
#f
|
(file-or-directory-modify-seconds d ts))))
|
||||||
(lambda () -inf.0))]
|
(caddr recomp))
|
||||||
[updated? (lambda (a b) a)])
|
(when (eq? touch-mode 'touch-zo)
|
||||||
(test (and (member f (caddr recomp)) #t)
|
(pause))
|
||||||
updated?
|
(for-each (lambda (f)
|
||||||
(new-ts . > . ts)
|
(printf "re-making ~a\n" f)
|
||||||
f)
|
(managed-compile-zo (build-path dir f)))
|
||||||
(hash-set! timestamps f new-ts)))
|
to-make)
|
||||||
(map car files))))
|
(for-each (lambda (f)
|
||||||
recomps)))
|
(let* ([d (build-path dir "compiled" (path-add-suffix f #".zo"))]
|
||||||
|
[ts (hash-ref timestamps f)]
|
||||||
|
[new-ts
|
||||||
|
(file-or-directory-modify-seconds
|
||||||
|
d
|
||||||
|
#f
|
||||||
|
(lambda () -inf.0))]
|
||||||
|
[updated? (lambda (a b) a)])
|
||||||
|
(test (and (member f (caddr recomp)) #t)
|
||||||
|
updated?
|
||||||
|
(new-ts . > . ts)
|
||||||
|
f)
|
||||||
|
(hash-set! timestamps f new-ts)))
|
||||||
|
(map car files))))
|
||||||
|
recomps))))
|
||||||
|
|
||||||
(try '(("a.rkt" "(module a scheme/base (require \"b.rkt\" \"d.rkt\" \"g.rkt\"))" #t)
|
(try '(("a.rkt" "(module a scheme/base (require \"b.rkt\" \"d.rkt\" \"g.rkt\"))" #t)
|
||||||
("b.rkt" "(module b scheme/base (require scheme/include) (include \"c.sch\"))" #t)
|
("b.rkt" "(module b scheme/base (require scheme/include) (include \"c.sch\"))" #t)
|
||||||
|
|
|
@ -80,6 +80,13 @@
|
||||||
(define (file-stamp-in-collection p)
|
(define (file-stamp-in-collection p)
|
||||||
(file-stamp-in-paths p (current-library-collection-paths)))
|
(file-stamp-in-paths p (current-library-collection-paths)))
|
||||||
|
|
||||||
|
(define (try-file-time p)
|
||||||
|
(let ([s (file-or-directory-modify-seconds p #f (lambda () #f))])
|
||||||
|
(and s
|
||||||
|
(if (eq? (use-compiled-file-check) 'modify-seconds)
|
||||||
|
s
|
||||||
|
0))))
|
||||||
|
|
||||||
(define (file-stamp-in-paths p paths)
|
(define (file-stamp-in-paths p paths)
|
||||||
(let ([p-eles (explode-path (simple-form-path p))])
|
(let ([p-eles (explode-path (simple-form-path p))])
|
||||||
(let c-loop ([paths paths])
|
(let c-loop ([paths paths])
|
||||||
|
@ -94,12 +101,9 @@
|
||||||
;; use the date of the original file (or the zo, whichever
|
;; use the date of the original file (or the zo, whichever
|
||||||
;; is newer).
|
;; is newer).
|
||||||
(let-values ([(base name dir) (split-path p)])
|
(let-values ([(base name dir) (split-path p)])
|
||||||
(let* ([p-date (file-or-directory-modify-seconds p #f (lambda () #f))]
|
(let* ([p-date (try-file-time p)]
|
||||||
[alt-date (and (not p-date)
|
[alt-date (and (not p-date)
|
||||||
(file-or-directory-modify-seconds
|
(try-file-time (rkt->ss p)))]
|
||||||
(rkt->ss p)
|
|
||||||
#f
|
|
||||||
(lambda () #f)))]
|
|
||||||
[date (or p-date alt-date)]
|
[date (or p-date alt-date)]
|
||||||
[get-path (lambda ()
|
[get-path (lambda ()
|
||||||
(if p-date
|
(if p-date
|
||||||
|
@ -112,13 +116,11 @@
|
||||||
(lambda (root)
|
(lambda (root)
|
||||||
(ormap
|
(ormap
|
||||||
(lambda (mode)
|
(lambda (mode)
|
||||||
(let ([v (file-or-directory-modify-seconds
|
(let ([v (try-file-time
|
||||||
(build-path
|
(build-path
|
||||||
(reroot-path* base root)
|
(reroot-path* base root)
|
||||||
mode
|
mode
|
||||||
(path-add-extension name #".zo"))
|
(path-add-extension name #".zo")))])
|
||||||
#f
|
|
||||||
(lambda () #f))])
|
|
||||||
(and v (list* v mode root))))
|
(and v (list* v mode root))))
|
||||||
modes))
|
modes))
|
||||||
roots))]
|
roots))]
|
||||||
|
@ -222,15 +224,13 @@
|
||||||
(build-path dir name)))
|
(build-path dir name)))
|
||||||
|
|
||||||
(define (touch path)
|
(define (touch path)
|
||||||
(with-compiler-security-guard
|
(when (eq? 'modify-seconds (use-compiled-file-check))
|
||||||
(file-or-directory-modify-seconds
|
(with-compiler-security-guard
|
||||||
path
|
(file-or-directory-modify-seconds
|
||||||
(current-seconds)
|
path
|
||||||
(lambda ()
|
(current-seconds)
|
||||||
(close-output-port (open-output-file path #:exists 'append))))))
|
(lambda ()
|
||||||
|
(close-output-port (open-output-file path #:exists 'append)))))))
|
||||||
(define (try-file-time path)
|
|
||||||
(file-or-directory-modify-seconds path #f (lambda () #f)))
|
|
||||||
|
|
||||||
(define (try-delete-file path [noisy? #t])
|
(define (try-delete-file path [noisy? #t])
|
||||||
;; Attempt to delete, but give up if it doesn't work:
|
;; Attempt to delete, but give up if it doesn't work:
|
||||||
|
@ -340,19 +340,20 @@
|
||||||
(date-hour d) (date-minute d) (date-second d))))
|
(date-hour d) (date-minute d) (date-second d))))
|
||||||
|
|
||||||
(define (verify-times ss-name zo-name)
|
(define (verify-times ss-name zo-name)
|
||||||
(define ss-sec (file-or-directory-modify-seconds ss-name))
|
(when (eq? 'modify-seconds (use-compiled-file-check))
|
||||||
(define zo-sec (try-file-time zo-name))
|
(define ss-sec (file-or-directory-modify-seconds ss-name))
|
||||||
(cond [(not ss-sec) (error 'compile-zo "internal error")]
|
(define zo-sec (try-file-time zo-name))
|
||||||
[(not zo-sec) (error 'compile-zo "failed to create .zo file (~a) for ~a"
|
(cond [(not ss-sec) (error 'compile-zo "internal error")]
|
||||||
zo-name ss-name)]
|
[(not zo-sec) (error 'compile-zo "failed to create .zo file (~a) for ~a"
|
||||||
[(< zo-sec ss-sec) (error 'compile-zo
|
zo-name ss-name)]
|
||||||
"date for newly created .zo file (~a @ ~a) ~
|
[(< zo-sec ss-sec) (error 'compile-zo
|
||||||
is before source-file date (~a @ ~a)~a"
|
"date for newly created .zo file (~a @ ~a) ~
|
||||||
zo-name (format-time zo-sec)
|
is before source-file date (~a @ ~a)~a"
|
||||||
ss-name (format-time ss-sec)
|
zo-name (format-time zo-sec)
|
||||||
(if (> ss-sec (current-seconds))
|
ss-name (format-time ss-sec)
|
||||||
", which appears to be in the future"
|
(if (> ss-sec (current-seconds))
|
||||||
""))]))
|
", which appears to be in the future"
|
||||||
|
""))])))
|
||||||
|
|
||||||
(define-struct ext-reader-guard (proc top)
|
(define-struct ext-reader-guard (proc top)
|
||||||
#:property prop:procedure (struct-field-index proc))
|
#:property prop:procedure (struct-field-index proc))
|
||||||
|
@ -617,6 +618,13 @@
|
||||||
dep-path)
|
dep-path)
|
||||||
"")))
|
"")))
|
||||||
|
|
||||||
|
(define (different-source-sha1-and-dep-recorded path deps)
|
||||||
|
(define src-hash (get-source-sha1 path))
|
||||||
|
(define recorded-hash (caadr deps))
|
||||||
|
(if (equal? src-hash recorded-hash)
|
||||||
|
#f
|
||||||
|
(list src-hash recorded-hash)))
|
||||||
|
|
||||||
(define (rkt->ss p)
|
(define (rkt->ss p)
|
||||||
(if (path-has-extension? p #".rkt")
|
(if (path-has-extension? p #".rkt")
|
||||||
(path-replace-extension p #".ss")
|
(path-replace-extension p #".ss")
|
||||||
|
@ -669,6 +677,11 @@
|
||||||
(trace-printf "newer src... ~a > ~a" path-time path-zo-time)
|
(trace-printf "newer src... ~a > ~a" path-time path-zo-time)
|
||||||
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
||||||
(maybe-compile-zo sha1-only? deps path->mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen)]
|
(maybe-compile-zo sha1-only? deps path->mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen)]
|
||||||
|
[(different-source-sha1-and-dep-recorded path deps)
|
||||||
|
=> (lambda (difference)
|
||||||
|
(trace-printf "different src hash... ~a" difference)
|
||||||
|
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
||||||
|
(maybe-compile-zo sha1-only? deps path->mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen))]
|
||||||
[(ormap-strict
|
[(ormap-strict
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(define ext? (external-dep? p))
|
(define ext? (external-dep? p))
|
||||||
|
|
|
@ -1556,7 +1556,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
|
||||||
else if ((s[0] == '1') || (s[0] == 'y') || (s[0] == 'Y'))
|
else if ((s[0] == '1') || (s[0] == 'y') || (s[0] == 'Y'))
|
||||||
scheme_incremental_garbage_collection(1);
|
scheme_incremental_garbage_collection(1);
|
||||||
else {
|
else {
|
||||||
PRINTF("%s: unrecognized value for PLT_INCREMENTAL_GC;\n"
|
PRINTF("%s: unrecognized value for PLT_INCREMENTAL_GC;\n"
|
||||||
" a value that starts \"1\", \"y\", or \"Y\" permanently enables incremental mode,\n"
|
" a value that starts \"1\", \"y\", or \"Y\" permanently enables incremental mode,\n"
|
||||||
" and a value that starts \"0\", \"n\", or \"N\" disables incremental mode,\n"
|
" and a value that starts \"0\", \"n\", or \"N\" disables incremental mode,\n"
|
||||||
" and the default enables incremental mode as requested via `collect-garbage'\n"
|
" and the default enables incremental mode as requested via `collect-garbage'\n"
|
||||||
|
@ -1565,6 +1565,22 @@ static int run_from_cmd_line(int argc, char *_argv[],
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
{
|
||||||
|
char *s;
|
||||||
|
s = getenv("PLT_COMPILED_FILE_CHECK");
|
||||||
|
if (s) {
|
||||||
|
if (!strcmp(s, "modify-seconds"))
|
||||||
|
scheme_set_compiled_file_check(SCHEME_COMPILED_FILE_CHECK_MODIFY_SECONDS);
|
||||||
|
else if (!strcmp(s, "exists"))
|
||||||
|
scheme_set_compiled_file_check(SCHEME_COMPILED_FILE_CHECK_EXISTS);
|
||||||
|
else {
|
||||||
|
PRINTF("%s: unrecognized value for PLT_COMPILED_FILE_CHECK;\n"
|
||||||
|
" recognized values are \"modify-seconds\" and \"exists\"\n"
|
||||||
|
" unrecognized value: %s\n",
|
||||||
|
prog, s);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
scheme_set_logging_spec(syslog_level, stderr_level);
|
scheme_set_logging_spec(syslog_level, stderr_level);
|
||||||
|
|
|
@ -1407,6 +1407,7 @@ enum {
|
||||||
MZCONFIG_USE_COMPILED_ROOTS,
|
MZCONFIG_USE_COMPILED_ROOTS,
|
||||||
MZCONFIG_USE_USER_PATHS,
|
MZCONFIG_USE_USER_PATHS,
|
||||||
MZCONFIG_USE_LINK_PATHS,
|
MZCONFIG_USE_LINK_PATHS,
|
||||||
|
MZCONFIG_USE_COMPILED_FILE_CHECK,
|
||||||
|
|
||||||
MZCONFIG_LOAD_DIRECTORY,
|
MZCONFIG_LOAD_DIRECTORY,
|
||||||
MZCONFIG_WRITE_DIRECTORY,
|
MZCONFIG_WRITE_DIRECTORY,
|
||||||
|
@ -1906,6 +1907,10 @@ MZ_EXTERN void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Objec
|
||||||
|
|
||||||
MZ_EXTERN int scheme_get_allow_set_undefined();
|
MZ_EXTERN int scheme_get_allow_set_undefined();
|
||||||
|
|
||||||
|
MZ_EXTERN void scheme_set_compiled_file_check(int);
|
||||||
|
#define SCHEME_COMPILED_FILE_CHECK_MODIFY_SECONDS 0
|
||||||
|
#define SCHEME_COMPILED_FILE_CHECK_EXISTS 1
|
||||||
|
|
||||||
#ifdef MZ_CAN_ACCESS_THREAD_LOCAL_DIRECTLY
|
#ifdef MZ_CAN_ACCESS_THREAD_LOCAL_DIRECTLY
|
||||||
THREAD_LOCAL_DECL(MZ_EXTERN Scheme_Thread *scheme_current_thread);
|
THREAD_LOCAL_DECL(MZ_EXTERN Scheme_Thread *scheme_current_thread);
|
||||||
THREAD_LOCAL_DECL(MZ_EXTERN Scheme_Thread *scheme_first_thread);
|
THREAD_LOCAL_DECL(MZ_EXTERN Scheme_Thread *scheme_first_thread);
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -299,6 +299,7 @@ Scheme_Env *scheme_engine_instance_init()
|
||||||
scheme_init_logging_once();
|
scheme_init_logging_once();
|
||||||
|
|
||||||
scheme_init_compenv_symbol();
|
scheme_init_compenv_symbol();
|
||||||
|
scheme_init_param_symbol();
|
||||||
|
|
||||||
#if defined(MZ_PLACES_WAITPID)
|
#if defined(MZ_PLACES_WAITPID)
|
||||||
scheme_places_start_child_signal_handler();
|
scheme_places_start_child_signal_handler();
|
||||||
|
|
|
@ -212,6 +212,7 @@ static Scheme_Object *use_compiled_kind(int, Scheme_Object *[]);
|
||||||
static Scheme_Object *compiled_file_roots(int, Scheme_Object *[]);
|
static Scheme_Object *compiled_file_roots(int, Scheme_Object *[]);
|
||||||
static Scheme_Object *use_user_paths(int, Scheme_Object *[]);
|
static Scheme_Object *use_user_paths(int, Scheme_Object *[]);
|
||||||
static Scheme_Object *use_link_paths(int, Scheme_Object *[]);
|
static Scheme_Object *use_link_paths(int, Scheme_Object *[]);
|
||||||
|
static Scheme_Object *use_compiled_file_check(int, Scheme_Object *[]);
|
||||||
static Scheme_Object *find_system_path(int argc, Scheme_Object **argv);
|
static Scheme_Object *find_system_path(int argc, Scheme_Object **argv);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -603,6 +604,11 @@ void scheme_init_file(Scheme_Env *env)
|
||||||
"use-collection-link-paths",
|
"use-collection-link-paths",
|
||||||
MZCONFIG_USE_LINK_PATHS),
|
MZCONFIG_USE_LINK_PATHS),
|
||||||
env);
|
env);
|
||||||
|
scheme_add_global_constant("use-compiled-file-check",
|
||||||
|
scheme_register_parameter(use_compiled_file_check,
|
||||||
|
"use-compiled-file-check",
|
||||||
|
MZCONFIG_USE_COMPILED_FILE_CHECK),
|
||||||
|
env);
|
||||||
|
|
||||||
#ifdef DOS_FILE_SYSTEM
|
#ifdef DOS_FILE_SYSTEM
|
||||||
{
|
{
|
||||||
|
@ -6642,6 +6648,29 @@ static Scheme_Object *use_link_paths(int argc, Scheme_Object *argv[])
|
||||||
-1, NULL, NULL, 1);
|
-1, NULL, NULL, 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Scheme_Object *compiled_file_check_p(int argc, Scheme_Object *argv[])
|
||||||
|
{
|
||||||
|
Scheme_Object *v = argv[0];
|
||||||
|
|
||||||
|
if (SCHEME_SYMBOLP(v)
|
||||||
|
&& !SCHEME_SYM_WEIRDP(v)
|
||||||
|
&& (((SCHEME_SYM_LEN(v) == 14)
|
||||||
|
&& !strcmp(SCHEME_SYM_VAL(v), "modify-seconds"))
|
||||||
|
|| ((SCHEME_SYM_LEN(v) == 6)
|
||||||
|
&& !strcmp(SCHEME_SYM_VAL(v), "exists"))))
|
||||||
|
return v;
|
||||||
|
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Scheme_Object *use_compiled_file_check(int argc, Scheme_Object *argv[])
|
||||||
|
{
|
||||||
|
return scheme_param_config2("use-compiled-file-check",
|
||||||
|
scheme_make_integer(MZCONFIG_USE_COMPILED_FILE_CHECK),
|
||||||
|
argc, argv,
|
||||||
|
-1, compiled_file_check_p, "(or/c 'modify-seconds 'exists)", 0);
|
||||||
|
}
|
||||||
|
|
||||||
/********************************************************************************/
|
/********************************************************************************/
|
||||||
|
|
||||||
#ifndef NO_FILE_SYSTEM_UTILS
|
#ifndef NO_FILE_SYSTEM_UTILS
|
||||||
|
|
|
@ -14,7 +14,7 @@
|
||||||
|
|
||||||
#define USE_COMPILED_STARTUP 1
|
#define USE_COMPILED_STARTUP 1
|
||||||
|
|
||||||
#define EXPECTED_PRIM_COUNT 1151
|
#define EXPECTED_PRIM_COUNT 1152
|
||||||
#define EXPECTED_UNSAFE_COUNT 126
|
#define EXPECTED_UNSAFE_COUNT 126
|
||||||
#define EXPECTED_FLFXNUM_COUNT 69
|
#define EXPECTED_FLFXNUM_COUNT 69
|
||||||
#define EXPECTED_EXTFL_COUNT 45
|
#define EXPECTED_EXTFL_COUNT 45
|
||||||
|
|
|
@ -387,6 +387,7 @@ void scheme_init_parameterization();
|
||||||
void scheme_init_getenv(void);
|
void scheme_init_getenv(void);
|
||||||
void scheme_init_inspector(void);
|
void scheme_init_inspector(void);
|
||||||
void scheme_init_compenv_symbol(void);
|
void scheme_init_compenv_symbol(void);
|
||||||
|
void scheme_init_param_symbol(void);
|
||||||
void scheme_init_longdouble_fixup(void);
|
void scheme_init_longdouble_fixup(void);
|
||||||
|
|
||||||
#ifndef DONT_USE_FOREIGN
|
#ifndef DONT_USE_FOREIGN
|
||||||
|
|
|
@ -13,12 +13,12 @@
|
||||||
consistently.)
|
consistently.)
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#define MZSCHEME_VERSION "6.6.0.2"
|
#define MZSCHEME_VERSION "6.6.0.3"
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_X 6
|
#define MZSCHEME_VERSION_X 6
|
||||||
#define MZSCHEME_VERSION_Y 6
|
#define MZSCHEME_VERSION_Y 6
|
||||||
#define MZSCHEME_VERSION_Z 0
|
#define MZSCHEME_VERSION_Z 0
|
||||||
#define MZSCHEME_VERSION_W 2
|
#define MZSCHEME_VERSION_W 3
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||||
|
|
|
@ -902,9 +902,10 @@
|
||||||
" s"
|
" s"
|
||||||
"(let((d(current-load-relative-directory)))"
|
"(let((d(current-load-relative-directory)))"
|
||||||
"(if d(path->complete-path s d) s)))))"
|
"(if d(path->complete-path s d) s)))))"
|
||||||
|
"(use-seconds?(eq?(use-compiled-file-check) 'modify-seconds))"
|
||||||
"(date-of-1(lambda(a)"
|
"(date-of-1(lambda(a)"
|
||||||
"(let((v(file-or-directory-modify-seconds a #f(lambda() #f))))"
|
"(let((v(file-or-directory-modify-seconds a #f(lambda() #f))))"
|
||||||
"(and v(cons a v)))))"
|
"(and v(cons a(if use-seconds? v 0))))))"
|
||||||
"(date-of(lambda(a modes roots)"
|
"(date-of(lambda(a modes roots)"
|
||||||
"(ormap(lambda(root-dir)"
|
"(ormap(lambda(root-dir)"
|
||||||
"(ormap"
|
"(ormap"
|
||||||
|
|
|
@ -1054,9 +1054,10 @@
|
||||||
s
|
s
|
||||||
(let ([d (current-load-relative-directory)])
|
(let ([d (current-load-relative-directory)])
|
||||||
(if d (path->complete-path s d) s))))]
|
(if d (path->complete-path s d) s))))]
|
||||||
|
[use-seconds? (eq? (use-compiled-file-check) 'modify-seconds)]
|
||||||
[date-of-1 (lambda (a)
|
[date-of-1 (lambda (a)
|
||||||
(let ([v (file-or-directory-modify-seconds a #f (lambda () #f))])
|
(let ([v (file-or-directory-modify-seconds a #f (lambda () #f))])
|
||||||
(and v (cons a v))))]
|
(and v (cons a (if use-seconds? v 0)))))]
|
||||||
[date-of (lambda (a modes roots)
|
[date-of (lambda (a modes roots)
|
||||||
(ormap (lambda (root-dir)
|
(ormap (lambda (root-dir)
|
||||||
(ormap
|
(ormap
|
||||||
|
|
|
@ -180,6 +180,7 @@ THREAD_LOCAL_DECL(static intptr_t process_time_at_swap);
|
||||||
THREAD_LOCAL_DECL(static intptr_t max_gc_pre_used_bytes);
|
THREAD_LOCAL_DECL(static intptr_t max_gc_pre_used_bytes);
|
||||||
|
|
||||||
SHARED_OK static int init_load_on_demand = 1;
|
SHARED_OK static int init_load_on_demand = 1;
|
||||||
|
SHARED_OK static int compiled_file_check = SCHEME_COMPILED_FILE_CHECK_MODIFY_SECONDS;
|
||||||
|
|
||||||
#ifdef RUNSTACK_IS_GLOBAL
|
#ifdef RUNSTACK_IS_GLOBAL
|
||||||
THREAD_LOCAL_DECL(Scheme_Object **scheme_current_runstack_start);
|
THREAD_LOCAL_DECL(Scheme_Object **scheme_current_runstack_start);
|
||||||
|
@ -244,6 +245,8 @@ ROSYM static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete
|
||||||
ROSYM static Scheme_Object *client_symbol, *server_symbol;
|
ROSYM static Scheme_Object *client_symbol, *server_symbol;
|
||||||
ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol;
|
ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol;
|
||||||
|
|
||||||
|
ROSYM static Scheme_Object *initial_compiled_file_check_symbol;
|
||||||
|
|
||||||
THREAD_LOCAL_DECL(static int do_atomic = 0);
|
THREAD_LOCAL_DECL(static int do_atomic = 0);
|
||||||
THREAD_LOCAL_DECL(static int missed_context_switch = 0);
|
THREAD_LOCAL_DECL(static int missed_context_switch = 0);
|
||||||
THREAD_LOCAL_DECL(static int have_activity = 0);
|
THREAD_LOCAL_DECL(static int have_activity = 0);
|
||||||
|
@ -645,6 +648,11 @@ void scheme_init_inspector() {
|
||||||
instances. */
|
instances. */
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void scheme_set_compiled_file_check(int c)
|
||||||
|
{
|
||||||
|
compiled_file_check = c;
|
||||||
|
}
|
||||||
|
|
||||||
Scheme_Object *scheme_get_current_inspector()
|
Scheme_Object *scheme_get_current_inspector()
|
||||||
XFORM_SKIP_PROC
|
XFORM_SKIP_PROC
|
||||||
{
|
{
|
||||||
|
@ -672,6 +680,15 @@ void scheme_init_parameterization()
|
||||||
scheme_break_enabled_key = scheme_make_symbol("break-on?");
|
scheme_break_enabled_key = scheme_make_symbol("break-on?");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void scheme_init_param_symbol()
|
||||||
|
{
|
||||||
|
REGISTER_SO(initial_compiled_file_check_symbol);
|
||||||
|
if (compiled_file_check == SCHEME_COMPILED_FILE_CHECK_MODIFY_SECONDS)
|
||||||
|
initial_compiled_file_check_symbol = scheme_intern_symbol("modify-seconds");
|
||||||
|
else
|
||||||
|
initial_compiled_file_check_symbol = scheme_intern_symbol("exists");
|
||||||
|
}
|
||||||
|
|
||||||
void scheme_init_paramz(Scheme_Env *env)
|
void scheme_init_paramz(Scheme_Env *env)
|
||||||
{
|
{
|
||||||
Scheme_Object *v;
|
Scheme_Object *v;
|
||||||
|
@ -7967,6 +7984,8 @@ static void make_initial_config(Scheme_Thread *p)
|
||||||
init_param(cells, paramz, MZCONFIG_COLLECTION_PATHS, scheme_null);
|
init_param(cells, paramz, MZCONFIG_COLLECTION_PATHS, scheme_null);
|
||||||
init_param(cells, paramz, MZCONFIG_COLLECTION_LINKS, scheme_null);
|
init_param(cells, paramz, MZCONFIG_COLLECTION_LINKS, scheme_null);
|
||||||
|
|
||||||
|
init_param(cells, paramz, MZCONFIG_USE_COMPILED_FILE_CHECK, initial_compiled_file_check_symbol);
|
||||||
|
|
||||||
{
|
{
|
||||||
Scheme_Security_Guard *sg;
|
Scheme_Security_Guard *sg;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user