cs: make "main.sps" work in script or boot mode
Now that Chez Scheme supports libraries in boot files, make "racket.so" work when it is converted to a boot file. Loading it as a boot file can save around 20ms on every major GC, since the "racket.so" code will be in the static generation. For now, however, `racketcs` is not set up to use "racket.so" in boot form.
This commit is contained in:
parent
d67cec6892
commit
e1c2e5d4f4
|
@ -40,15 +40,13 @@
|
|||
(unless omit-debugging?
|
||||
(compile-keep-source-locations! #t))
|
||||
|
||||
(define the-command-line-arguments
|
||||
(or (and (top-level-bound? 'bytes-command-line-arguments)
|
||||
(map (lambda (s) (bytes->string/locale s #\?))
|
||||
(top-level-value 'bytes-command-line-arguments)))
|
||||
(command-line-arguments)))
|
||||
(define-syntax seq (syntax-rules () [(_ expr ...) (define dummy (let () expr ... (void)))]))
|
||||
|
||||
(define (run the-command-line-arguments)
|
||||
(seq
|
||||
(unless (>= (length the-command-line-arguments) 5)
|
||||
(error 'racket "expected `self`, `collects`, and `libs` paths plus `segment-offset` and `is-gui?` to start"))
|
||||
(set-exec-file! (path->complete-path (car the-command-line-arguments)))
|
||||
(set-exec-file! (path->complete-path (car the-command-line-arguments))))
|
||||
(define init-collects-dir (let ([s (cadr the-command-line-arguments)])
|
||||
(if (equal? s "") 'disable (string->path s))))
|
||||
(define init-config-dir (string->path (or (getenv "PLTCONFIGDIR")
|
||||
|
@ -56,9 +54,11 @@
|
|||
(define segment-offset (#%string->number (list-ref the-command-line-arguments 3)))
|
||||
(define gracket? (string=? "true" (list-ref the-command-line-arguments 4)))
|
||||
|
||||
(seq
|
||||
(when (foreign-entry? "racket_exit")
|
||||
(#%exit-handler (foreign-procedure "racket_exit" (int) void)))
|
||||
(#%exit-handler (foreign-procedure "racket_exit" (int) void))))
|
||||
|
||||
(seq
|
||||
(|#%app| use-compiled-file-paths
|
||||
(list (string->path (string-append "compiled/"
|
||||
(cond
|
||||
|
@ -69,7 +69,7 @@
|
|||
(error 'racket "PLT_ZO_PATH environment variable is not a valid path"))
|
||||
s)]
|
||||
[platform-independent-zo-mode? "cs"]
|
||||
[else (symbol->string (machine-type))])))))
|
||||
[else (symbol->string (machine-type))]))))))
|
||||
|
||||
(define (see saw . args)
|
||||
(let loop ([saw saw] [args args])
|
||||
|
@ -199,6 +199,7 @@
|
|||
(let () body ...)
|
||||
(string-case arg rest ...))]))
|
||||
|
||||
(seq
|
||||
(let flags-loop ([args (list-tail the-command-line-arguments 5)]
|
||||
[saw (hasheq)])
|
||||
;; An element of `args` can become `(cons _arg _within-arg)`
|
||||
|
@ -349,7 +350,7 @@
|
|||
""))])]
|
||||
[else
|
||||
;; Non-flag argument
|
||||
(finish args saw)])]))))
|
||||
(finish args saw)])])))))
|
||||
|
||||
;; Set up GC logging
|
||||
(define-values (struct:gc-info make-gc-info gc-info? gc-info-ref gc-info-set!)
|
||||
|
@ -388,6 +389,7 @@
|
|||
(define major-gcs 0)
|
||||
(define auto-gcs 0)
|
||||
(define peak-mem 0)
|
||||
(seq
|
||||
(set-garbage-collect-notify!
|
||||
(let ([root-logger (|#%app| current-logger)])
|
||||
;; This function can be called in any Chez Scheme thread
|
||||
|
@ -414,7 +416,8 @@
|
|||
post-allocated post-allocated+overhead
|
||||
pre-cpu-time post-cpu-time
|
||||
pre-time post-time)
|
||||
#f))))))))
|
||||
#f)))))))))
|
||||
(seq
|
||||
(|#%app| exit-handler
|
||||
(let ([orig (|#%app| exit-handler)]
|
||||
[root-logger (|#%app| current-logger)])
|
||||
|
@ -431,7 +434,7 @@
|
|||
(quotient (time-nanosecond t) 1000000))))
|
||||
#f))
|
||||
(linklet-performance-report!)
|
||||
(|#%app| orig v))))
|
||||
(|#%app| orig v)))))
|
||||
|
||||
(define stderr-logging
|
||||
(or stderr-logging-arg
|
||||
|
@ -512,3 +515,15 @@
|
|||
(|#%app| (|#%app| executable-yield-handler) exit-value)
|
||||
|
||||
(exit exit-value))))
|
||||
|
||||
(define the-command-line-arguments
|
||||
(or (and (top-level-bound? 'bytes-command-line-arguments)
|
||||
(map (lambda (s) (bytes->string/locale s #\?))
|
||||
(top-level-value 'bytes-command-line-arguments)))
|
||||
(command-line-arguments)))
|
||||
|
||||
(if (null? the-command-line-arguments)
|
||||
;; Assume that we're running as a boot file
|
||||
(scheme-start (lambda args (run args)))
|
||||
;; Assume that we're running as a script
|
||||
(run the-command-line-arguments)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user