start scsh-toplevel by dump-scsh, scsh's init are not yet done

scheme/interfaces.scm

@@ -594,7 +594,7 @@
 
 (define-interface interrupts-interface
   (export initialize-interrupts!	;init.scm
-	  with-interrupts               ;JMG: For scsh
+;	  with-interrupts               ;JMG: no longer for scsh
 	  all-interrupts
 	  no-interrupts
 	  ;reset-timer-interrupts!
@@ -611,7 +611,7 @@
 	  call-after-gc!
 	  call-before-heap-overflow!
 	  (interrupt :syntax)
-	  interrupt-handlers-vector     ;JMG: blatantly for scsh.
+;	  interrupt-handlers-vector     ;JMG: blatantly for scsh.
 	  ))
 
 (define-interface writing-interface

scheme/more-interfaces.scm

@@ -13,7 +13,10 @@
 	  command-continuation
 	  command-threads
 	  command-loop
+
 	  real-command-loop ;JMG: for scsh
+	  command-loop-condition-handler
+
           command-level-condition
 	  command-processor
 	  error-form ;foo
@@ -31,7 +34,9 @@
 	  run-sentinels
 	  set-focus-object!
 	  showing-focus-object		;inspect
-	  with-new-session            ;scsh
+
+	  with-new-session            ;JMG:  for scsh
+
 	  start-command-processor
 	  restart-command-processor
 	  value->expression		;foo
@@ -64,7 +69,11 @@
 	  user-context-accessor
 	  user-context-modifier
 
-	  start-new-session ;JMG: for scsh
+	  start-new-session ;JMG: 4 for scsh
+  	  really-push-command-level   
+	  ignore-further-interrupts
+	  notify-on-interrupts
+
 	  push-command-levels?
 
 	  command-input

scsh/scsh-package.scm

@@ -78,6 +78,11 @@
 	  $current-error-port)
   (open ports i/o))
 
+(define-structure signal-handler signal-handler-interface
+  (open scheme
+	scsh
+	scsh-level-0)
+  (files (scsh sighandlers)))
 ;;; The scsh-level-0 package is for implementation convenience.
 ;;; The scsh startup and top-level modules need access to scsh
 ;;; procedures, but they export procedures that are themselves
@@ -125,7 +130,7 @@
   (open 
    ;scheme define-foreign-syntax defrec-package receiving ascii
         enumerated
-	externals
+	external-calls           ;JMG new FFI
 	structure-refs
 	cig-aux
 	receiving
@@ -162,9 +167,11 @@
 
 	scheme
 	
+	
 	i/o
 	i/o-internal
 	channels channel-i/o
+	low-channels
 	code-vectors
 	threads threads-internal locks placeholders
 	primitives
@@ -203,8 +210,8 @@
 	 pty			; New in release 0.4.
 	 sighandlers		; New in release 0.5.
 	 scsh
-	 re
+	; re
-	 rdelim
+	; rdelim
 	 ))
 
 (define-structure defrec-package (export (define-record :syntax))
@@ -233,6 +240,7 @@
 	command-processor	; command-output
 	filenames		; translate
 	usual-resumer           ; usual-resumer
+	fluids-internal            ; JMG: get-dynamic-env 
 	scsh-utilities
 	interrupts
 	primitives
@@ -249,6 +257,10 @@
 	evaluation
 	extended-ports
 	interfaces
+
+	fluids-internal            ; JMG: get-dynamic-env 
+	handle                     ; JMG: with-handler
+
 	interrupts
 	i/o
 	package-commands-internal
@@ -298,11 +310,12 @@
 (define-structure scsh
   (compound-interface (interface-of scsh-level-0)
 		      (interface-of scsh-startup-package)
-		      scsh-regexp-interface
+		      ;JMG scsh-regexp-interface
-		      scsh-field-reader-interface 	; new in 0.3
+		      ;JMG scsh-field-reader-interface 	; new in 0.3
 ;		      scsh-dbm-interface
 		      (export repl)
-		      awk-interface)
+		      ; JMG:awk-interface
+		      )
 
   (open structure-refs
 	scsh-level-0
@@ -310,8 +323,8 @@
 	scsh-regexp-package
 	scsh-startup-package
 ;	dbm
-	awk-package
+;	awk-package
-	field-reader-package
+;	field-reader-package
 	scheme)
 
   (access scsh-top-package)

scsh/startup.scm

@@ -8,6 +8,8 @@
 (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)
@@ -27,7 +29,8 @@
     (display (string-append "Writing " filename) (command-output))
     (newline (command-output))
     (set! holding-interrupt-handlers (copy-vector (interrupt-handlers-vector)))
-    (flush-the-symbol-table!)	;Gets restored at next use of string->symbol
+    ;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")
@@ -38,14 +41,21 @@
 ;;; 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))
+  (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 #t)	; Do it quietly.
+			      (init-scsh-vars #f)	; Do it quietly.
 			      (start args))
 			    filename))
 
@@ -53,17 +63,22 @@
 (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-scsh-hindbrain #t)	; Whatever. Relink & install scsh's I/O system.
+     ;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))
+	       ((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))))

scsh/top.scm

@@ -1,5 +1,5 @@
 ;;; The scsh argv switch parser.
-;;; Copyright (c) 1995 by Olin Shivers.
+;;; Copyright (c) 1995 by Olin Shivers. See file COPYING.
 
 ;;; Imports:
 ;;;	COMMAND-PROCESSOR: set-batch-mode?! command-loop
@@ -28,11 +28,6 @@
     (cond ((structure? s) s)
 	  (else (error "not a structure" s struct-name)))))
 
-(define load-quietly
-  (lambda args
-    (let ((p (car args)))
-      (apply (if (string? p) load load-port) args))))
-
 ;;; The switches:
 ;;; 	-o <struct>		Open the structure in current package.
 ;;; 	-n <package>		Create new package, make it current package.
@@ -176,8 +171,7 @@
 	     (let ((struct-name (cdr switch))
 		   (cp (config-package)))
 	       ;; Should not be necessary to do this ensure-loaded, but it is.
-	       (silently (lambda ()
+	       (really-ensure-loaded #f (get-struct cp struct-name))
-			   (ensure-loaded (get-struct cp struct-name))))
 	       (package-open! (interaction-environment)
 			      (lambda () (get-struct cp struct-name)))
 ;	       (format #t "Opened ~s~%" struct-name)
@@ -200,7 +194,7 @@
 	       (let ((pack (structure-package struct)))
 ;		 (format #t "package ~s~%" pack)
 		 (set-interaction-environment! pack)
-		 (silently (lambda () (ensure-loaded struct)))
+		 (really-ensure-loaded #f struct)
 ;		 (format #t "Switched to ~s~%" pack)
 		 (lp switches script-loaded?))))
 
@@ -220,14 +214,39 @@
 (define (parse-switches-and-execute all-args context)
   (receive (switches term-switch term-val top-entry args)
            (parse-scsh-args (cdr all-args))
-    ((with-new-session context	; "Log in" user.
+	   (begin 
-		      (current-input-port) (current-output-port)
+	     
+   (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	; batch? (or interactive?)
+		      term-switch)
-       (lambda ()
+     (display "bye" (current-error-port))
-	 (with-interaction-environment (user-environment)
+     (display (config-package) (current-error-port))
-           (lambda ()
+     (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 
+       (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!
@@ -249,15 +268,26 @@
 				 (interaction-environment)))
 
 	       (cond ((not term-switch) ; -- interactive
+		      (display "scsh is up" (current-error-port))
+		      
 		;      (interrupt-before-heap-overflow!)
-;		      (command-loop #f))
+		      (let ((repl-data #f) ;no condition
-; Let's try this
+			    (repl-thunk real-command-loop)
-		      (start-command-processor
+			    (start-thunk (lambda ()
-		       #f context
+					   (display "i am start thunk"))))
-		       (lambda ()
+			(let ((thunk (really-push-command-level repl-thunk
-			 (display "Scsh ")
+								repl-data
-			 (display scsh-version-string)
+								(get-dynamic-env)
-			 (newline))))
+								'())))
+			  (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.
@@ -276,7 +306,7 @@
 		     ;; Otherwise, the script executed as it loaded,
 		     ;; so we're done.
 		     (else (exit 0))
-		     )))))))))
+		     ))))))))))))
 
 
 (define (read-exactly-one-sexp-from-string s)
@@ -287,7 +317,7 @@
 
 
 (define (bad-arg . msg)
-  (with-current-output-port (current-error-port)
+  (with-current-output-port (error-output-port)
     (for-each (lambda (x) (display x) (write-char #\space)) msg)
     (newline)
     (display "Useage: scsh [meta-arg] [switch ..] [end-option arg ...]
@@ -315,5 +345,5 @@ end-option:	-s <script>	Specify script.
 
 
 (define (repl)
-;  (lambda () (set-batch-mode?! #f))
+  (command-loop (lambda () (set-batch-mode?! #f))
-  (command-loop #f))
+		#f))