added channel-cell-ref to newports for the changed design in rts/channel-port.s, vm starts from dumped image now

scsh/newports.scm

@@ -43,7 +43,7 @@
 ;Hmm... these shouldn't be necessary.  But still.
 ;Fake defrec routines for backwards compatibility.
 (define (fdport-data:fd fdport*)
-  (channel-os-index (fdport-data:channel fdport*)))
+  (channel-os-index (channel-cell-ref (fdport-data:channel fdport*))))
 
 (define (fdport-data:closed? fdport*)
   (eq? (channel-status (fdport-data:channel fdport*)) 
@@ -63,7 +63,7 @@
 ;The two following routines are to build ports from stdin and stdout channels.
 (define (channel-port->input-fdport channel-port)
   (let ((p (make-input-port input-fdport-handler
-			    (make-fdport-data (port-data channel-port) 1)
+			    (make-fdport-data (channel-cell-ref (port-data channel-port)) 1)
 			    (make-code-vector buffer-size 0) 0 0)))
     (obtain-port-lock channel-port)
     (set-port-lock! p (port-lock channel-port))
@@ -74,7 +74,7 @@
 
 (define (channel-port->output-fdport channel-port)
   (let ((p (make-output-port output-fdport-handler
-			     (make-fdport-data (port-data channel-port) 1)
+			     (make-fdport-data  (channel-cell-ref(port-data channel-port)) 1)
 			     (make-code-vector buffer-size 0) 0 buffer-size)))
     (obtain-port-lock channel-port)
     (set-port-lock! p (port-lock channel-port))
@@ -278,6 +278,7 @@
       (set! old-errport (current-error-port)))
   (set-fluid! $current-input-port  (channel-port->input-fdport (current-input-port)))
   (set-fluid! $current-output-port (channel-port->output-fdport (current-output-port)))
+  
   (set-fluid! $current-error-port  (channel-port->output-fdport (current-error-port))))
 
 

scsh/scsh.scm

@@ -127,7 +127,7 @@
 
 	;; Main loop.
 	(let split ((i 0))
-	  (cond ((index clist #\: i) =>
+	  (cond ((string-index clist #\: i) =>
 		 (lambda (colon)
 		   (cons (substring clist i colon)
 			 (split (+ colon 1)))))
@@ -209,7 +209,7 @@
 
 (define (with-env* alist-delta thunk)
   (let* ((old-env #f)
-	 (new-env (reduce (lambda (alist key/val)
+	 (new-env (fold (lambda (key/val alist)
 			  (alist-update (car key/val) (cdr key/val) alist))
 			(env->alist)
 			alist-delta)))
@@ -437,12 +437,12 @@
 ;;; (port->list reader port)
 ;;;     Repeatedly applies READER to PORT, accumulating results into a list.
 ;;;     On EOF, returns the list of items thus collected.
-;;; (reduce-port port reader op . seeds)
+;;; (port-fold port reader op . seeds)
 ;;;     Repeatedly read things from PORT with READER. Each time you read
 ;;;     some value V, compute a new set of seeds with (apply OP V SEEDS).
 ;;;     (More than 1 seed means OP must return multiple values).
-;;;     On eof, return the seeds.
-;;;     PORT->LIST is just (REDUCE-PORT PORT READ CONS '())
+;;;     On eof, return the seeds: (apply value SEEDS).
+;;;     PORT->LIST is just (PORT-FOLD PORT READ CONS '())
 
 (define (run/port+proc* thunk)
   (receive (r w) (pipe)
@@ -507,13 +507,16 @@
 (define (port->string-list port)
   (port->list read-line port))
 
-(define (reduce-port port reader op . seeds)
-  (letrec ((reduce (lambda seeds
+(define (port-fold port reader op . seeds)
+  (letrec ((fold (lambda seeds
 		     (let ((x (reader port)))
 		       (if (eof-object? x) (apply values seeds)
 			   (call-with-values (lambda () (apply op x seeds))
-					     reduce))))))
-    (apply reduce seeds)))
+					     fold))))))
+    (apply fold seeds)))
+
+(define reduce-port
+  (deprecated-proc port-fold 'reduce-port "Use port-fold instead."))
 
 ;;; Not defined:
 ;;; (field-reader field-delims record-delims)
@@ -624,7 +627,7 @@
       (arg* arglist n)))
 
 (define (argv n . maybe-default)
-  (apply arg (cdr %command-line) n maybe-default))
+  (apply arg %command-line (+ n 1) maybe-default))
 
 (define (command-line) (append %command-line '()))
 
@@ -673,7 +676,7 @@
 (define (exec-path/env prog env . arglist)
   (flush-all-ports)
   (let ((prog (stringify prog)))
-    (if (index prog #\/)
+    (if (string-index prog #\/)
 
 	;; Contains a slash -- no path search.
 	(%exec prog (cons prog arglist) env)
@@ -736,7 +739,7 @@
 ;;; Low-level init absolutely required for any scsh program.
 
 (define (init-scsh-hindbrain relink-ff?)
-  (if relink-ff? (lookup-all-externals)) ; Re-link C calls.
+;  (if relink-ff? (lookup-all-externals)) ; Re-link C calls.
   (init-fdports!)
   (%install-unix-scsh-handlers))
 

scsh/startup.scm

@@ -63,6 +63,9 @@
 (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)

scsh/top.scm

@@ -269,18 +269,17 @@
 
 	       (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)
-			    (start-thunk (lambda ()
-					   (display "i am start thunk"))))
+			    (repl-thunk real-command-loop))
 			(let ((thunk (really-push-command-level repl-thunk
 								repl-data
 								(get-dynamic-env)
 								'())))
 			  (ignore-further-interrupts)
-			  (thunk))))
+			  thunk)))
 					;
  (command-loop 
 		       ;(lambda ()
@@ -294,7 +293,8 @@
 
 
 		     ((eq? term-switch 'c)
-		      (eval (read-exactly-one-sexp-from-string term-val)
+		      ;;; JMG eval now needs expr represented as data
+		      (eval '(read-exactly-one-sexp-from-string term-val)
 			    (interaction-environment))
 		      (exit 0))
 
@@ -317,7 +317,7 @@
 
 
 (define (bad-arg . msg)
-  (with-current-output-port (error-output-port)
+  (with-current-output-port (current-error-port)
     (for-each (lambda (x) (display x) (write-char #\space)) msg)
     (newline)
     (display "Useage: scsh [meta-arg] [switch ..] [end-option arg ...]