suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: make "main.sps" work in script or boot mode

Browse Source 
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:
Matthew Flatt 2018-07-17 08:26:14 -06:00
parent d67cec6892
commit e1c2e5d4f4
1 changed files with 481 additions and 466 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
racket/src/cs/main.sps
View File

@ -40,15 +40,13 @@
(unless omit-debugging? (unless omit-debugging?
(compile-keep-source-locations! #t)) (compile-keep-source-locations! #t))
(define the-command-line-arguments (define-syntax seq (syntax-rules () [(_ expr ...) (define dummy (let () expr ... (void)))]))
(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 (run the-command-line-arguments)
(seq
(unless (>= (length the-command-line-arguments) 5) (unless (>= (length the-command-line-arguments) 5)
(error 'racket "expected `self`, `collects`, and `libs` paths plus `segment-offset` and `is-gui?` to start")) (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)]) (define init-collects-dir (let ([s (cadr the-command-line-arguments)])
(if (equal? s "") 'disable (string->path s)))) (if (equal? s "") 'disable (string->path s))))
(define init-config-dir (string->path (or (getenv "PLTCONFIGDIR") (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 segment-offset (#%string->number (list-ref the-command-line-arguments 3)))
(define gracket? (string=? "true" (list-ref the-command-line-arguments 4))) (define gracket? (string=? "true" (list-ref the-command-line-arguments 4)))
(seq
(when (foreign-entry? "racket_exit") (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 (|#%app| use-compiled-file-paths
(list (string->path (string-append "compiled/" (list (string->path (string-append "compiled/"
(cond (cond
@ -69,7 +69,7 @@
(error 'racket "PLT_ZO_PATH environment variable is not a valid path")) (error 'racket "PLT_ZO_PATH environment variable is not a valid path"))
s)] s)]
[platform-independent-zo-mode? "cs"] [platform-independent-zo-mode? "cs"]
[else (symbol->string (machine-type))]))))) [else (symbol->string (machine-type))]))))))
(define (see saw . args) (define (see saw . args)
(let loop ([saw saw] [args args]) (let loop ([saw saw] [args args])
@ -199,6 +199,7 @@
(let () body ...) (let () body ...)
(string-case arg rest ...))])) (string-case arg rest ...))]))
(seq
(let flags-loop ([args (list-tail the-command-line-arguments 5)] (let flags-loop ([args (list-tail the-command-line-arguments 5)]
[saw (hasheq)]) [saw (hasheq)])
;; An element of `args` can become `(cons _arg _within-arg)` ;; An element of `args` can become `(cons _arg _within-arg)`
@ -349,7 +350,7 @@
""))])] ""))])]
[else [else
;; Non-flag argument ;; Non-flag argument
(finish args saw)])])))) (finish args saw)])])))))
;; Set up GC logging ;; Set up GC logging
(define-values (struct:gc-info make-gc-info gc-info? gc-info-ref gc-info-set!) (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 major-gcs 0)
(define auto-gcs 0) (define auto-gcs 0)
(define peak-mem 0) (define peak-mem 0)
(seq
(set-garbage-collect-notify! (set-garbage-collect-notify!
(let ([root-logger (|#%app| current-logger)]) (let ([root-logger (|#%app| current-logger)])
;; This function can be called in any Chez Scheme thread ;; This function can be called in any Chez Scheme thread
@ -414,7 +416,8 @@
post-allocated post-allocated+overhead post-allocated post-allocated+overhead
pre-cpu-time post-cpu-time pre-cpu-time post-cpu-time
pre-time post-time) pre-time post-time)
#f)))))))) #f)))))))))
(seq
(|#%app| exit-handler (|#%app| exit-handler
(let ([orig (|#%app| exit-handler)] (let ([orig (|#%app| exit-handler)]
[root-logger (|#%app| current-logger)]) [root-logger (|#%app| current-logger)])
@ -431,7 +434,7 @@
(quotient (time-nanosecond t) 1000000)))) (quotient (time-nanosecond t) 1000000))))
#f)) #f))
(linklet-performance-report!) (linklet-performance-report!)
(|#%app| orig v)))) (|#%app| orig v)))))
(define stderr-logging (define stderr-logging
(or stderr-logging-arg (or stderr-logging-arg
@ -512,3 +515,15 @@
(|#%app| (|#%app| executable-yield-handler) exit-value) (|#%app| (|#%app| executable-yield-handler) exit-value)
(exit 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)))