Hacked file-loading code so that we could load from ports. This to support

the new -s- switch.

bcomp/ctop.scm

@@ -38,6 +38,10 @@
 				 p filename run
 				 noisy?))
 
+(define (compile-and-run-port port p run noisy?)
+  (compile-and-run-scanned-forms (really-scan-port port p)
+				 p #f run noisy?))
+
 ; --------------------
 
 ; If non-noisy, this tail-recurs to last form.

bcomp/scan.scm

@@ -40,29 +40,40 @@
 (define (scan-file pathname p . env-option)
   (apply really-scan-file pathname p (current-output-port) env-option))
 
-(define (really-scan-file pathname p noise . env-option)
+(define (really-scan-port port p . env-option)	; For scsh
   (let* ((env (if (null? env-option)
 		  (package->environment p)
 		  (car env-option)))
-	 (filename (namestring pathname #f *scheme-file-type*))
-	 (truename (translate filename)))
+	 (reader (environment-reader env)))
+    (let recur ()
+      (let ((form (reader port)))
+	(if (eof-object? form)
+	    '()
+	    (append (scan-form form p env)
+		    (recur)))))))
+
+(define (really-scan-file pathname p noise . env-option)
+  (let* ((env (if (null? env-option)
+ 		  (package->environment p)
+ 		  (car env-option)))
+ 	 (filename (namestring pathname #f *scheme-file-type*))
+  	 (truename (translate filename)))
     (call-with-input-file truename
       (lambda (port)
-	(if filename ((fluid $note-file-package) filename p))
-	(let ((env (bind-source-file-name filename env))
-	      (reader (environment-reader env)))
-	  (cond (noise (display truename noise)
-		       (force-output noise)))
-	  (let ((result (let recur ()
-			  (let ((form (read port)))
-			    (if (eof-object? form)
-				'()
-				(append (scan-form form p env)
-					(recur)))))))
-	    (cond (noise (display #\space noise)
-			 (force-output noise)))
-	    result))))))
-
+ 	(if filename ((fluid $note-file-package) filename p))
+ 	(let ((env (bind-source-file-name filename env))
+ 	      (reader (environment-reader env)))
+ 	  (cond (noise (display truename noise)
+ 		       (force-output noise)))
+ 	  (let ((result (let recur ()
+ 			  (let ((form (read port)))
+ 			    (if (eof-object? form)
+ 				'()
+ 				(append (scan-form form p env)
+ 					(recur)))))))
+ 	    (cond (noise (display #\space noise)
+ 			 (force-output noise)))
+ 	    result))))))
 
 ; --------------------
 ; Process a list of forms.

debug/mini-eval.scm

@@ -85,7 +85,20 @@
 		 (eval form env)
 		 (loop))))))))
 
-(define load-quietly load-into)	; For scsh.
+;;; For scsh.
+;;; Identical to LOAD-INTO, but accepts either a filename or port.
+
+(define (load-quietly from env)
+  (let ((doit (lambda (port)
+		(let loop ()
+		  (let ((form (read port)))
+		    (cond ((eof-object? form))
+			  (else
+			   (eval form env)
+			   (loop))))))))
+    (if (input-port? from) (doit from)
+	(call-with-input-file from doit))))
+
 
 (define (eval-from-file forms env filename)
   (for-each (lambda (form) (eval form env)) forms))

debug/run.scm

@@ -245,11 +245,15 @@
 	      (package->environment package)
 	      filename))
 
-(define (load-quietly filename package)
-  (eval-nodes (really-scan-file filename package #f)	; No noise. For scsh.
-	      (package->environment package)
-	      filename))
-
+(define (load-quietly from package)			; No noise. For scsh.
+  (display from)
+  (if (string? from)
+      (eval-nodes (really-scan-file from package #f)
+		  (package->environment package)
+		  from)
+      (eval-nodes (really-scan-port from package)
+		  (package->environment package)
+		  #f)))
 
 (define (eval-from-file forms p file)	;Scheme 48 internal thing
   (eval-forms forms p file))

interfaces.scm

@@ -732,6 +732,7 @@
   (export scan-forms
 	  scan-file
 	  really-scan-file
+	  really-scan-port		; for scsh
 	  scan-structures		;load-package.scm, link/link.scm
 	  really-scan-structures
 	  scan-package
@@ -762,6 +763,7 @@
 (define-interface compiler-interface
   (export compile
 	  compile-and-run-file		;for LOAD
+	  compile-and-run-port		;for LOAD (in scsh)
 	  compile-and-run-forms		;for EVAL
 	  compile-and-run-scanned-forms ;for eval.scm / ensure-loaded
 	  compile-file			;link/link.scm

rts/eval.scm

@@ -25,11 +25,12 @@
 
 ; For scsh.
 
-(define (load-quietly filename p)
-  (compile-and-run-file filename p
-			(lambda (template)
-			  (invoke-template template p))
-			#f))
+(define (load-quietly from p)
+  ((if (string? from) compile-and-run-file compile-and-run-port)
+   from p
+   (lambda (template)
+     (invoke-template template p))
+   #f))
 
 ; Evaluate forms as if they came from the given file.
 

scsh/top.scm

@@ -45,6 +45,7 @@
 ;;;				Terminating switches:
 ;;; 	-c <exp>		Eval <exp>, then exit.
 ;;; 	-s <script>		Specify <script> to be loaded by a -ds or -dm.
+;;;	-s-			Script is standard input.
 ;;; 	--  			Interactive scsh.
 
 
@@ -53,8 +54,10 @@
 ;;; - We first expand out any initial \ <filename> meta-arg.
 ;;; - A switch-list elt is either "-ds", "-dm", or a (switch . arg) pair
 ;;;   for a -o, -n, -m, -l, or -lm switch.
-;;; - Terminating switch is one of {s, c, #f} for -s, -c, and -- respectively.
-;;; - Terminating arg is the <exp> arg to -c, the <script> arg to -s, otw #f.
+;;; - Terminating switch is one of {s, c, #f} for -s or -s-, -c, 
+;;;   and -- respectively.
+;;; - Terminating arg is the <exp> arg to -c, the <script> arg to -s, 
+;;;   the standard input port for -s-, otw #f.
 ;;; - top-entry is the <entry> arg to a -e; #f if none.
 ;;; - command-line args are what's left over after picking off the scsh
 ;;;   switches.
@@ -80,6 +83,10 @@
 		     (values (reverse switches) 's (car args)
 			     top-entry (cdr args))))
 
+		((string=? arg "-s-")
+		 (values (reverse switches) 's (current-input-port)
+			 top-entry args))
+
 		((string=? arg "--")
 		 (if need-script?
 		     (bad-arg "-ds or -dm switch requires -s <script>")
@@ -280,9 +287,10 @@ switch:	-e <entry-point>	Specify top-level entry point.
 	-ds 			Do script.
 	-dm			Do script module.
 
-end-option:	-s <script>
-		-c <exp>
-		--
+end-option:	-s <script>	Specify script.
+		-s-		Script is standard input.
+		-c <exp>	Evaluate expression.
+		--		Interactive session.
 "))
   (exit -1))