scsh-0.6/scsh/startup.scm

91 lines
3.3 KiB
Scheme

;;; Scsh start-up code.
;;; Copyright (c) 1995 by Olin Shivers.
;;; A scsh starter takes the command line args, parses them,
;;; initialises the scsh system, and either starts up a repl loop
;;; or executes the -s script.
(define (make-scsh-starter)
(let ((context (user-context)))
(lambda (args)
(display "off we go" (current-error-port))
(display context)
(parse-switches-and-execute args context))))
(define holding-interrupt-handlers #f)
;;; Had to define these as the ones in s48's build.scm do not properly
;;; initialise ERROR-OUTPUT-PORT to stderr -- this is a bug in the vm's
;;; handoff to the very first Scheme form (it passes two ports -- not three).
;;; Until Kelsey fixes these, we hack it with these replacements, which
;;; invoke INIT-SCSH-HINDBRAIN, which re-initialises the I/O system to be
;;; what you wanted.
;;; WRITE-IMAGE calls the starter after installing a fatal top-level
;;; error handler. MAKE-SCSH-STARTER shadows it in the interactive case.
(define (really-dump-scsh-program start filename)
(let ((filename (translate filename)))
(display (string-append "Writing " filename) (command-output))
(newline (command-output))
(set! holding-interrupt-handlers (copy-vector (interrupt-handlers-vector)))
;JMG: it is set to # in the vm, so I omit it now
;;;(flush-the-symbol-table!) ;Gets restored at next use of string->symbol
(write-image filename
(scsh-stand-alone-resumer start)
"Scsh 0.6")
#t))
;;; This one relies on the scsh top-level command-line switch parser
;;; to decide whether to do the scsh-var inits quietly or with warnings.
(define (dump-scsh fname)
(really-dump-scsh-program
(make-scsh-starter)
; (display "hiii")
; (let ((d (make-scsh-starter)))
; (display "hiiiiiiiiiiii")
; d)
fname))
;;; Init the scsh run-time's vars quietly before running the program.
;;; This is what we export to the user for his programs.
(define (dump-scsh-program start filename)
(really-dump-scsh-program (lambda (args)
(init-scsh-vars #f) ; Do it quietly.
(start args))
filename))
(define (scsh-stand-alone-resumer start)
(usual-resumer ;sets up exceptions, interrupts, and current input & output
(lambda (args) ; VM gives us our args, but not our program.
(display "start0" (current-error-port))
(init-fdports!)
(display "start00" (current-error-port))
;JMG (init-scsh-hindbrain #t) ; Whatever. Relink & install scsh's I/O system.
(call-with-current-continuation
(lambda (halt)
(display "start" (current-error-port))
(set! %vm-prog-args (cons "scsh" args)) ; WRONG -- use image.
(display "start1" (current-error-port))
(set-command-line-args! %vm-prog-args)
(display "start2" (current-error-port))
(let ((len (vector-length holding-interrupt-handlers)))
(do ((i 0 (+ i 1)))
((eq? i (- len 1)))
(set-interrupt-handler
i (vector-ref holding-interrupt-handlers i))))
(display "start3" (current-error-port))
(set! holding-interrupt-handlers #f)
(display "start4" (current-error-port))
(with-handler (simple-condition-handler halt (current-error-port))
(lambda ()
(let ((exit-val (start (command-line))))
(if (integer? exit-val) exit-val 0))))))))) ; work around bug.
(define %vm-prog-args #f)