From 62104ee12b185ed8ceb57de5e4d3c04fdedbab46 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Thu, 24 Aug 2000 19:55:29 +0000
Subject: [PATCH] o Based on suggestions from Martin Cracauer, flush commonly
 used output   streams during the processing of command line switches and upon
 exit.   This is a convenience for typical usage, and not all output streams  
 are flushed, so important streams should still be flushed but user code.

o Add a new function finish-standard-output-streams to finish output on
  the commonly used output streams. Called after the processing
  of each command line switch, and before the %end-of-the-world.

o Extend the eval switch to process multiple forms, flushing the common
  output streams between each.
---
 code/commandline.lisp | 15 ++++++--
 code/save.lisp        | 79 +++++++++++++++++++++++--------------------
 code/stream.lisp      | 15 +++++++-
 3 files changed, 68 insertions(+), 41 deletions(-)

diff --git a/code/commandline.lisp b/code/commandline.lisp
index 6e9154316..fc2bf0985 100644
--- a/code/commandline.lisp
+++ b/code/commandline.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/commandline.lisp,v 1.6 1996/05/08 02:03:08 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/commandline.lisp,v 1.7 2000/08/24 19:55:29 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -155,7 +155,8 @@
       (cond (demon (funcall demon switch))
 	    ((or (member name *legal-cmd-line-switches* :test #'string-equal)
 		 (not *complain-about-illegal-switches*)))
-	    (t (warn "~S is an illegal switch" switch))))))
+	    (t (warn "~S is an illegal switch" switch)))
+      (lisp::finish-standard-output-streams))))
 
 (defmacro defswitch (name &optional function)
   "Associates function with the switch name in *command-switch-demons*.  Name
@@ -175,7 +176,15 @@
 
 
 (defun eval-switch-demon (switch)
-  (eval (read-from-string (cmd-switch-arg switch))))
+  (let ((cmds (cmd-switch-arg switch)))
+    (do ((length (length cmds))
+	 (start 0))
+	((>= start length))
+      (multiple-value-bind (form next)
+	  (read-from-string cmds nil nil :start start)
+	(eval form)
+	(lisp::finish-standard-output-streams)
+	(setf start next)))))
 (defswitch "eval" #'eval-switch-demon)
 
 (defun load-switch-demon (switch)
diff --git a/code/save.lisp b/code/save.lisp
index de8f32528..8261a16cb 100644
--- a/code/save.lisp
+++ b/code/save.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.36 1998/06/24 20:30:36 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.37 2000/08/24 19:55:29 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -160,46 +160,51 @@
       ((restart-lisp ()
 	 (unix:unix-exit
 	  (catch '%end-of-the-world
-	    (with-simple-restart (abort "Skip remaining initializations.")
-	      (catch 'top-level-catcher
-		(reinit)
-		(environment-init)
-		(dolist (f *after-save-initializations*) (funcall f))
-		(when process-command-line
-		  (ext::process-command-strings))
-		(setf *editor-lisp-p* nil)
-		(macrolet ((find-switch (name)
-			     `(find ,name *command-line-switches*
+	    (unwind-protect
+	       (progn
+		 (with-simple-restart (abort "Skip remaining initializations.")
+		   (catch 'top-level-catcher
+		     (reinit)
+		     (environment-init)
+		     (dolist (f *after-save-initializations*) (funcall f))
+		     (when process-command-line
+		       (ext::process-command-strings))
+		     (setf *editor-lisp-p* nil)
+		     (macrolet ((find-switch (name)
+				  `(find ,name *command-line-switches*
 				    :key #'cmd-switch-name
 				    :test #'(lambda (x y)
 					      (declare (simple-string x y))
 					      (string-equal x y)))))
-		  (when site-init
-		    (load site-init :if-does-not-exist nil :verbose nil))
-		  (when (and process-command-line (find-switch "edit"))
-		    (setf *editor-lisp-p* t))
-		  (when (and load-init-file
-			     (not (and process-command-line
-				       (find-switch "noinit"))))
-		    (let* ((cl-switch (find-switch "init"))
-			   (name (and cl-switch
-				      (or (cmd-switch-value cl-switch)
-					  (car (cmd-switch-words
-						cl-switch))))))
-		      (if name
-			  (load (merge-pathnames name #p"home:")
-				:if-does-not-exist nil)
-			  (or (load "home:init" :if-does-not-exist nil)
-			      (load "home:.cmucl-init"
-				    :if-does-not-exist nil))))))
-		(when process-command-line
-		  (ext::invoke-switch-demons *command-line-switches*
-					     *command-switch-demons*))
-		(when print-herald
-		  (print-herald))))
-	    (funcall (if (and *batch-mode* (eq init-function #'%top-level))
-			 #'%handled-top-level
-			 init-function))))))
+		       (when site-init
+			 (load site-init :if-does-not-exist nil :verbose nil))
+		       (when (and process-command-line (find-switch "edit"))
+			 (setf *editor-lisp-p* t))
+		       (when (and load-init-file
+				  (not (and process-command-line
+					    (find-switch "noinit"))))
+			 (let* ((cl-switch (find-switch "init"))
+				(name (and cl-switch
+					   (or (cmd-switch-value cl-switch)
+					       (car (cmd-switch-words
+						     cl-switch))))))
+			   (if name
+			       (load (merge-pathnames name #p"home:")
+				     :if-does-not-exist nil)
+			       (or (load "home:init" :if-does-not-exist nil)
+				   (load "home:.cmucl-init"
+					 :if-does-not-exist nil))))))
+		     (when process-command-line
+		       (ext::invoke-switch-demons *command-line-switches*
+						  *command-switch-demons*))
+		     (when print-herald
+		       (print-herald))))
+		 (funcall (if (and *batch-mode*
+				   (eq init-function #'%top-level))
+			      #'%handled-top-level
+			      init-function)))
+	      (finish-standard-output-streams))))))
+
 
     (let ((initial-function (get-lisp-obj-address #'restart-lisp)))
       (without-gcing
diff --git a/code/stream.lisp b/code/stream.lisp
index 47246cff1..f806213fa 100644
--- a/code/stream.lisp
+++ b/code/stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.43 2000/07/23 14:59:43 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.44 2000/08/24 19:55:29 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1745,3 +1745,16 @@
 	     ((>= i end) seq)
 	   (declare (type index i))
 	   (funcall write-function (aref seq i) stream)))))))
+
+
+
+;;; finish-standard-output-streams  --  Public
+;;;
+;;; Finish output on some of the standard output streams.
+;;;
+(defun finish-standard-output-streams ()
+  (dolist (stream '(*standard-output* *error-output* *trace-output*))
+    (when (boundp stream)
+      (let ((stream (symbol-value stream)))
+	(when (and (streamp stream) (open-stream-p stream))
+	  (finish-output stream))))))
-- 
GitLab