177 lines
7.9 KiB
Racket
177 lines
7.9 KiB
Racket
|
|
;; Because Setup PLT is used to rebuild .zos, we may need to turn off
|
|
;; the use of compiled code or install cm before we do anything. This
|
|
;; startup stub parses the command line and either disables .zos or
|
|
;; installs cm for loading Setup PLT.
|
|
|
|
;; Note that this file is listed in "info.ss" so that it never gets a
|
|
;; .zo file. Do not `require' this module from anywhere, not even
|
|
;; `for-label', otherwise it could get a .zo anyway.
|
|
|
|
(module main '#%kernel
|
|
(#%require '#%min-stx
|
|
;; Need to make sure they're here:
|
|
'#%builtin)
|
|
|
|
(when (file-stream-port? (current-output-port))
|
|
(file-stream-buffer-mode (current-output-port) 'line))
|
|
|
|
(define-values (make-kernel-namespace)
|
|
(lambda ()
|
|
(let-values ([(ns) (make-empty-namespace)]
|
|
[(cns) (current-namespace)])
|
|
(namespace-attach-module cns ''#%builtin ns)
|
|
ns)))
|
|
|
|
(define-values (short-name long-names raco?)
|
|
;; Load the name module without using .zos, and in its own namespace to
|
|
;; avoid polluting the cm-managed namespace later
|
|
(parameterize ([use-compiled-file-paths null]
|
|
[current-namespace (make-kernel-namespace)])
|
|
((dynamic-require 'setup/private/command-name 'get-names))))
|
|
|
|
;; Poor-man's processing of the command-line flags to drop strings
|
|
;; that will not be parsed as flags by "parse-cmdline.rkt". We don't
|
|
;; want to load "parse-cmdline.rkt" because it takes a long time with
|
|
;; bytecode files disabled, and we're not yet sure whether to trust
|
|
;; bytecode ifes that do exist.
|
|
(define-values (filter-flags)
|
|
(lambda (flags)
|
|
(if (or (null? flags)
|
|
(not (regexp-match? #rx"^-" (car flags)))
|
|
(equal? "-l" (car flags)))
|
|
null
|
|
(if (equal? "-P" (car flags))
|
|
(if ((length flags) . > . 5)
|
|
(filter-flags (list-tail flags 5))
|
|
null)
|
|
(if (or (equal? "--mode" (car flags))
|
|
(equal? "--doc-pdf" (car flags)))
|
|
(if (pair? (cdr flags))
|
|
(filter-flags (cddr flags))
|
|
null)
|
|
(cons (car flags) (filter-flags (cdr flags))))))))
|
|
|
|
(define-values (flags) (filter-flags (vector->list (current-command-line-arguments))))
|
|
|
|
;; Checks whether a flag is present:
|
|
(define-values (on?)
|
|
(lambda (flag-name)
|
|
(member flag-name flags)))
|
|
|
|
(define-values (print-bootstrapping)
|
|
(lambda ()
|
|
(fprintf (current-output-port) "~a: bootstrapping from source...\n" short-name)))
|
|
|
|
(define-values (main-collects-relative->path)
|
|
(let ([main-collects #f])
|
|
(lambda (p)
|
|
;; At this point, it's safe to try to load 'setup/private/main-collects
|
|
(unless main-collects
|
|
(set! main-collects ((dynamic-require 'setup/private/main-collects 'find-main-collects))))
|
|
(if (and (pair? p)
|
|
(eq? 'collects (car p)))
|
|
(apply build-path main-collects
|
|
(map bytes->path (cdr p)))
|
|
p))))
|
|
|
|
(if (or (on? "--clean")
|
|
(on? "-c")
|
|
(on? "--no-zo")
|
|
(on? "-n"))
|
|
;; Don't use .zos, in case they're out of date, and don't load
|
|
;; cm:
|
|
(when (or (on? "--clean")
|
|
(on? "-c"))
|
|
(use-compiled-file-paths null)
|
|
(print-bootstrapping))
|
|
|
|
;; Load the cm instance to be installed while loading Setup PLT.
|
|
;; This has to be dynamic, so we get a chance to turn off compiled
|
|
;; file loading, and so it can be in a separate namespace.
|
|
(let-values ([(mk trust-zos)
|
|
;; Load cm.ss into its own namespace, so that cm compiles
|
|
;; itself and its required modules in the right order
|
|
;; (i.e., when some module requires cm or one of its
|
|
;; required modules)
|
|
;; Since cm.ss pulls in quite a lot of code itself, we
|
|
;; would like to load using .zo files. But if we discover
|
|
;; any date mismatch in the loading process, abort and
|
|
;; try again without .zo files. If .zo files are newer
|
|
;; than .ss files but a required file is newer than its
|
|
;; requring file, we won't notice, but that
|
|
;; shouldn't happen for a reaonsbaly maintained
|
|
;; tree, and there's always --clean to turn this
|
|
;; off. If an .so file is used, we give up using
|
|
;; compiled files.
|
|
(let loop ([skip-zo? (null? (use-compiled-file-paths))])
|
|
(when skip-zo?
|
|
(print-bootstrapping))
|
|
((call/ec
|
|
(lambda (escape)
|
|
;; Create a new namespace, and also install load handlers
|
|
;; to check file dates, if necessary.
|
|
(parameterize ([current-namespace (make-kernel-namespace)]
|
|
[use-compiled-file-paths
|
|
(if skip-zo?
|
|
null
|
|
(use-compiled-file-paths))]
|
|
[current-load
|
|
(let ([orig-load (current-load)])
|
|
(if skip-zo?
|
|
orig-load
|
|
(lambda (path modname)
|
|
(if (regexp-match #rx#"[.]zo$" (path->bytes path))
|
|
;; It's a .zo:
|
|
(begin0
|
|
(orig-load path modname)
|
|
;; Force loading of all dependencies, which ensures
|
|
;; a rebuild if a #lang reader changes. (Otherwise,
|
|
;; the dependencies should be loaded already.)
|
|
;; We do not currently support "external" dependencies
|
|
;; (via cm-accomplice) during bootstrap.
|
|
(let ([deps (with-input-from-file
|
|
(bytes->path (regexp-replace #"[.]zo$" (path->bytes path) #".dep"))
|
|
read)])
|
|
(for-each (lambda (dep)
|
|
(unless (and (pair? dep)
|
|
(eq? (car dep) 'ext))
|
|
(dynamic-require (main-collects-relative->path dep) #f)))
|
|
(cddr deps))))
|
|
;; Not a .zo! Don't use .zo files at all...
|
|
(escape (lambda ()
|
|
;; Try again without .zo
|
|
(loop #t)))))))]
|
|
[current-load-extension
|
|
(if skip-zo?
|
|
(current-load-extension)
|
|
(lambda (path modname)
|
|
(escape (lambda ()
|
|
;; Try again without .zo
|
|
(loop #t)))))])
|
|
;; Other things could go wrong, such as a version mismatch.
|
|
;; If something goes wrong, of course, give up on .zo files.
|
|
(parameterize ([uncaught-exception-handler
|
|
(lambda (exn)
|
|
(when (exn:break? exn) (exit 1))
|
|
(if skip-zo?
|
|
(escape
|
|
(lambda () (raise exn)))
|
|
(escape
|
|
(lambda () (loop #t)))))])
|
|
;; Here's the main dynamic load of "cm.ss":
|
|
(let ([mk
|
|
(dynamic-require 'compiler/cm
|
|
'make-compilation-manager-load/use-compiled-handler)]
|
|
[trust-zos
|
|
(dynamic-require 'compiler/cm 'trust-existing-zos)])
|
|
;; Return the two extracted functions:
|
|
(lambda () (values mk trust-zos)))))))))])
|
|
(when (on? "--trust-zos")
|
|
(trust-zos #t))
|
|
(current-load/use-compiled (mk))))
|
|
|
|
;; This has to be dynamic, so we get a chance to turn off
|
|
;; .zo use and turn on the compilation manager.
|
|
(dynamic-require 'setup/setup-go #f))
|