scsh-0.6/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)
      (display "off we go")
      (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.
     ;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)