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