removed most of the hacks due to restart-command-processor

scsh/startup.scm

@@ -8,8 +8,6 @@
 (define (make-scsh-starter)
   (let ((context (user-context)))
     (lambda (args)
-      (display "off we go" (current-error-port))
-      (display context)
       (parse-switches-and-execute args context))))
 
 (define holding-interrupt-handlers #f)
@@ -41,14 +39,7 @@
 ;;; to decide whether to do the scsh-var inits quietly or with warnings.
 
 (define (dump-scsh fname)
-  (really-dump-scsh-program 
+  (really-dump-scsh-program (make-scsh-starter) fname))
-			     (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.
@@ -63,28 +54,20 @@
 (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))
+;     (display "start0" (current-error-port))
      (init-fdports!)
-     (display "start00" (current-error-port))
+;     (display "start00" (current-error-port))
   ;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 
-	 (with-handler (simple-condition-handler halt (current-error-port))
+	  (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)
+ 

scsh/top.scm

@@ -28,6 +28,16 @@
     (cond ((structure? s) s)
 	  (else (error "not a structure" s struct-name)))))
 
+;;; 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)
+  (display "loaded " (current-error-port)))
+
+(define (really-ensure-loaded noise . structs)
+  (apply ensure-loaded structs))
+		      
 ;;; The switches:
 ;;; 	-o <struct>		Open the structure in current package.
 ;;; 	-n <package>		Create new package, make it current package.
@@ -144,26 +154,26 @@
     (if (pair? switches)
 	(let ((switch (car switches))
 	      (switches (cdr switches)))
-;	  (format #t "Doing switch ~a~%" switch)
+	  (format #t "Doing switch ~a~%" switch)
 	  (cond
 
 	    ((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?))
 
@@ -174,7 +184,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")
@@ -188,14 +198,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."))))
@@ -215,37 +225,15 @@
   (receive (switches term-switch term-val top-entry args)
            (parse-scsh-args (cdr all-args))
    (begin 
-	     
-   (display "hey there.." (current-error-port))
-;   (display context (current-error-port))
- ;  (display (config-package))
- ;  (display (user-environment))
-   ((with-handler        ; taken from command.scm
-     command-loop-condition-handler
-     (lambda ()
-       (notify-on-interrupts (current-thread))
      (start-new-session context
 			(current-input-port)
 			(current-output-port)
 			(current-error-port)
 			args
 			term-switch)
-     (display "bye" (current-error-port))
-     (display (config-package) (current-error-port))
-     (display "ups" (current-error-port))
 
- ;  (let ((commands usual-commands)
+      (with-interaction-environment     ;useless ?????????
-;	 (build-in built-in-structures)
-;	 (meta-structs more-structures))
-;   (call-with-values 
-;    (lambda ()
-;      (make-user-envs commands build-in meta-structs))
-;    (lambda (env init-thunk)
-      (with-interaction-environment 
        (user-environment)
-       (display "okay, but now ?"  (current-error-port))
-       (begin
-					;(with-interaction-environment (user-environment) ; <-- from CONTEXT.
        (begin
 	 ;; Have to do these before calling DO-SWITCHES, because actions
 	 ;; performed while processing the switches may use these guys.
@@ -256,7 +244,6 @@
 			"file-descriptor-script"); -sfd <num>
 		    (car all-args))
 		args))
-
 	     ;; Set HOME-DIRECTORY and EXEC-PATH-LIST,
 	 ;; quietly if not running an interactive script.
 	 (init-scsh-vars term-switch)
@@ -268,28 +255,13 @@
 				 (interaction-environment)))
 	   
 	   (cond ((not term-switch) ; -- interactive
-		      (display "scsh is up" (current-error-port))
 		  (init-scsh-vars #t) 
-		      (display "fdports installed" (current-error-port))
+		  (restart-command-processor 
-		;      (interrupt-before-heap-overflow!)
+		   args 
-		      (let ((repl-data #f) ;no condition
+		   context 
-			    (repl-thunk real-command-loop))
+		   (lambda () (display "welcome to scsh-0.6 alpha " 
-			(let ((thunk (really-push-command-level repl-thunk
+				       (current-output-port))
-								repl-data
+			   (in-package (user-environment) '()))))
-								(get-dynamic-env)
-								'())))
-			  (ignore-further-interrupts)
-			  thunk)))
-					;
- (command-loop 
-		       ;(lambda ()
-					;	      (display "Scsh ")
-				;      (display scsh-version-string)
-				 ;     (newline))
-			;	    #f))
-		     ;; COMMAND-LOOP returns a continuation when it exits,
-		     ;; which gets invoked outside the W-N-S above. I.e.,
-		     ;; we "log out" and start over.
 
 
 		     ((eq? term-switch 'c)
@@ -305,8 +277,8 @@
 
 		     ;; Otherwise, the script executed as it loaded,
 		     ;; so we're done.
-		     (else (exit 0))
+		     (else (exit 0)))))))))
-		     ))))))))))))
+
 
 
 (define (read-exactly-one-sexp-from-string s)
@@ -340,7 +312,7 @@ end-option:	-s <script>	Specify script.
 		-sfd <num>	Script is on file descriptor <num>.
 		-c <exp>	Evaluate expression.
 		--		Interactive session.
-"))
+" (current-error-port)))
   (exit -1))