;;; 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))
    ;JMG: it is set to #f 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)
  (let ((context (user-context)))
  (really-dump-scsh-program (lambda (args)
			      (with-scsh-sighandlers 
			       #f
			       (lambda ()
				 (with-autoreaping
				  (lambda ()
				    (install-env)
				    (initialize-cwd)
				    (init-scsh-vars #f)	; Do it quietly.
				    (start-new-session context    
						       (current-input-port)
						       (current-output-port)
						       (current-error-port)
						       args
						       #f)
				    (with-interaction-environment     
				     (user-environment)
				     (lambda ()
				       (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-fdports!)
     (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 (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)