this should be the first working top-level

scsh/startup.scm

@@ -10,7 +10,6 @@
     (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
@@ -26,7 +25,6 @@
   (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
@@ -54,15 +52,11 @@
 (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 ()

scsh/top.scm

@@ -31,9 +31,7 @@
 ;;; ensure-loaded and load-into now write to noise-port anyway
 
 (define (load-quietly filename p)
-  (display "going to load now " (current-error-port))
+  (load-into filename p))
-  (load-into filename p)
-  (display "loaded " (current-error-port)))
 
 (define (really-ensure-loaded noise . structs)
   (apply ensure-loaded structs))
@@ -77,6 +75,7 @@
 	   (switches '())	; A list of handler thunks
 	   (top-entry #f)	; -t <entry>
 	   (need-script? #f))	; Found a -ds or -dm?
+    (display args    (current-output-port))
     (if (pair? args)
 	(let ((arg  (car args))
 	      (args (cdr args)))
@@ -159,21 +158,21 @@
 
 	    ((equal? switch "-ds")
 	     (load-quietly script-file (interaction-environment))
-	     (format #t "loaded script ~s~%" script-file)
+;	     (format #t "loaded script ~s~%" script-file)
 	     (lp switches #t))
 
 	    ((equal? switch "-dm")
 	     (load-quietly script-file (config-package))
-	     (format #t "loaded module ~s~%" script-file)
+;	     (format #t "loaded module ~s~%" script-file)
 	     (lp switches #t))
 
 	    ((string=? (car switch) "-l")
-	     (format #t "loading file ~s~%" (cdr switch))
+;	     (format #t "loading file ~s~%" (cdr switch))
 	     (load-quietly (cdr switch) (interaction-environment))
 	     (lp switches script-loaded?))
 
 	    ((string=? (car switch) "-lm")
-	     (format #t "loading module file ~s~%" (cdr switch))
+;	     (format #t "loading module file ~s~%" (cdr switch))
 	     (load-quietly (cdr switch) (config-package))
 	     (lp switches script-loaded?))
 
@@ -184,7 +183,7 @@
 	       (really-ensure-loaded #f (get-struct cp struct-name))
 	       (package-open! (interaction-environment)
 			      (lambda () (get-struct cp struct-name)))
-	       (format #t "Opened ~s~%" struct-name)
+;	       (format #t "Opened ~s~%" struct-name)
 	       (lp switches script-loaded?)))
 
 	    ((string=? (car switch) "-n")
@@ -198,14 +197,14 @@
 	       (lp switches script-loaded?)))
 
 	    ((string=? (car switch) "-m")
-	     (format #t "struct-name ~s~%" (cdr switch))
+;	     (format #t "struct-name ~s~%" (cdr switch))
 	     (let ((struct (get-struct (config-package) (cdr switch))))
-	       (format #t "struct-name ~s, struct ~s~%" (cdr switch) struct)
+;	       (format #t "struct-name ~s, struct ~s~%" (cdr switch) struct)
 	       (let ((pack (structure-package struct)))
-		 (format #t "package ~s~%" pack)
+;		 (format #t "package ~s~%" pack)
 		 (set-interaction-environment! pack)
 		 (really-ensure-loaded #f struct)
-		 (format #t "Switched to ~s~%" pack)
+;		 (format #t "Switched to ~s~%" pack)
 		 (lp switches script-loaded?))))
 
 	    (else (error "Impossible error in do-switches. Report to developers."))))
@@ -220,21 +219,23 @@
 		       (get-reflective-tower (user-environment)) ; ???
 		       name)) 
 
-
 (define (parse-switches-and-execute all-args context)
-  (receive (switches term-switch term-val top-entry args)
+   (receive (switches term-switch term-val top-entry args)
-           (parse-scsh-args (cdr all-args))
+	    (parse-scsh-args (cdr all-args))
    (begin 
-     (start-new-session context
+     ;;; restart-command-processor will provide one, but we need 
-			(current-input-port)
+     ;;; one already in do-switches
-			(current-output-port)
+    (start-new-session context    
-			(current-error-port)
+ 			(current-input-port)
-			args
+ 			(current-output-port)
-			term-switch)
+ 			(current-error-port)
-
+ 			args
-      (with-interaction-environment     ;useless ?????????
+ 			term-switch)
-       (user-environment)
+     (with-interaction-environment     ;useless ?????????
+      (environment-for-commands)
+       (lambda ()
        (begin
+	 (init-scsh-signal)
 	 ;; Have to do these before calling DO-SWITCHES, because actions
 	 ;; performed while processing the switches may use these guys.
 	 (set-command-line-args!
@@ -255,13 +256,14 @@
 				 (interaction-environment)))
 	   
 	   (cond ((not term-switch) ; -- interactive
-		  (init-scsh-vars #t) 
 		  (restart-command-processor 
 		   args 
 		   context 
-		   (lambda () (display "welcome to scsh-0.6 alpha " 
+		   (lambda () 
+		     (display "welcome to scsh-0.6 alpha " 
 				       (current-output-port))
-			   (in-package (user-environment) '()))))
+		     (newline (current-output-port))
+		     (in-package (user-environment) '()))))
 
 
 		     ((eq? term-switch 'c)
@@ -277,7 +279,7 @@
 
 		     ;; Otherwise, the script executed as it loaded,
 		     ;; so we're done.
-		     (else (exit 0)))))))))
+		     (else (exit 0))))))))))