;;; 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) (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) 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) (set! %vm-prog-args (cons "scsh" args)) ; WRONG -- use image. (set-command-line-args! %vm-prog-args) (set! holding-interrupt-handlers #f) (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)