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 
-			     (make-scsh-starter)
-;			     (display "hiii")
-;			     (let ((d (make-scsh-starter)))
-;			       (display "hiiiiiiiiiiii")
-;			       d)
-			     
-			      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.
@@ -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 (simple-condition-handler halt (current-error-port))
-	   (lambda ()
-	     (let ((exit-val (start (command-line))))
-	       (if (integer? exit-val) exit-val 0))))))))) ; work around bug.
+	 (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)
+ 

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."))))
@@ -208,88 +218,50 @@
 (define (new-empty-package name)
   (make-simple-package '() #t
 		       (get-reflective-tower (user-environment)) ; ???
-		       name))
+		       name)) 
 
 
 (define (parse-switches-and-execute all-args context)
   (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)
-;	 (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 
+   (begin 
+     (start-new-session context
+			(current-input-port)
+			(current-output-port)
+			(current-error-port)
+			args
+			term-switch)
+
+      (with-interaction-environment     ;useless ?????????
        (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.
-	     (set-command-line-args!
-	         (cons (if (eq? term-switch 's)
-			   (if (string? term-val)
-			       term-val			; Script file.
-			       "file-descriptor-script"); -sfd <num>
-			   (car all-args))
-		       args))
-
+	 ;; Have to do these before calling DO-SWITCHES, because actions
+	 ;; performed while processing the switches may use these guys.
+	 (set-command-line-args!
+	  (cons (if (eq? term-switch 's)
+		    (if (string? term-val)
+			term-val			; Script file.
+			"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)
-
-	     (let* ((script-loaded? (do-switches switches term-val)))
-	       (if (and (not script-loaded?)	; There wasn't a -ds or -dm,
-			(eq? term-switch 's))	; but there is a script,
-		   (load-quietly term-val	; so load it now.
+	 ;; quietly if not running an interactive script.
+	 (init-scsh-vars term-switch)
+	 
+	 (let* ((script-loaded?  (do-switches switches term-val)))
+	   (if (and (not script-loaded?)	; There wasn't a -ds or -dm,
+		    (eq? term-switch 's))	; but there is a script,
+	       (load-quietly term-val	; so load it now.
 				 (interaction-environment)))
-
-	       (cond ((not term-switch) ; -- interactive
-		      (display "scsh is up" (current-error-port))
-		      (init-scsh-vars #t)
-		      (display "fdports installed" (current-error-port))
-		;      (interrupt-before-heap-overflow!)
-		      (let ((repl-data #f) ;no condition
-			    (repl-thunk real-command-loop))
-			(let ((thunk (really-push-command-level repl-thunk
-								repl-data
-								(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.
+	   
+	   (cond ((not term-switch) ; -- interactive
+		  (init-scsh-vars #t) 
+		  (restart-command-processor 
+		   args 
+		   context 
+		   (lambda () (display "welcome to scsh-0.6 alpha " 
+				       (current-output-port))
+			   (in-package (user-environment) '()))))
 
 
 		     ((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))