scsh-0.5/scsh/startup.scm

;;; 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))))


;;; 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))
    (flush-the-symbol-table!)	;Gets restored at next use of string->symbol
    (write-image filename
		 (scsh-stand-alone-resumer start)
		 "")
    #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 #t)	; 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.
     (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)
	 (with-handler (simple-condition-handler halt (error-output-port))
	   (lambda ()
	     (let ((exit-val (start (command-line))))
	       (if (integer? exit-val) exit-val 0))))))))) ; work around bug.

(define %vm-prog-args #f)