[Openmcl-cvs-notifications] r11594 - /trunk/source/level-1/l1-readloop-lds.lisp

gb at clozure.com gb at clozure.com
Wed Jan 7 04:29:16 EST 2009


Author: gb
Date: Wed Jan  7 04:29:16 2009
New Revision: 11594

Log:
Define *CONSECUTIVE-EOF-LIMIT* (2) - if a particular READ-LOOP invocation
receives more than *CONSECUTIVE-EOF-LIMIT* consecutive EOFs, do an
abrupt exit.

(The intent is to avoid scenarios where a thread in the IDE enters =

a break loop when the standard input is open to /dev/null or similar.
If this happens during IDE initialization, there may not be a better
alternative to abrupt exit; filling logfiles with break loop prompts
is an extrememly bad alternative.)

Modified:
    trunk/source/level-1/l1-readloop-lds.lisp

Modified: trunk/source/level-1/l1-readloop-lds.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-readloop-lds.lisp (original)
+++ trunk/source/level-1/l1-readloop-lds.lisp Wed Jan  7 04:29:16 2009
@@ -272,6 +272,8 @@
 =

 (defparameter *quit-on-eof* nil)
 =

+(defparameter *consecutive-eof-limit* 2 "max number of consecutive EOFs at=
 a given break level, before we give up and abruptly exit.")
+
 (defmethod stream-eof-transient-p (stream)
   (let ((fd (stream-device stream :input)))
     (and fd (eof-transient-p fd))))
@@ -292,6 +294,7 @@
          *in-read-loop*
          *** ** * +++ ++ + /// // / -
          (eof-value (cons nil nil))
+         (eof-count 0)
          (*show-available-restarts* (and *show-restarts-on-break* *break-c=
ondition*)))
     (declare (dynamic-extent eof-value))
     (loop
@@ -308,16 +311,21 @@
                                  :prompt-function prompt-function
                                  :eof-value eof-value)
                 (if (eq form eof-value)
-                  (if (and (not *batch-flag*)
-                           (not *quit-on-eof*)
-                           (stream-eof-transient-p input-stream))
-                    (progn
-                      (stream-clear-input input-stream)
-                      (abort-break))
-                    (exit-interactive-process *current-process*))
+                  (progn
+                    (when (> (incf eof-count) *consecutive-eof-limit*)
+                      (#_ _exit 0))
+                    (if (and (not *batch-flag*)
+                             (not *quit-on-eof*)
+                             (stream-eof-transient-p input-stream))
+                      (progn
+                        (stream-clear-input input-stream)
+                        (abort-break))
+                      (exit-interactive-process *current-process*)))
+                  (progn
+                    (setq eof-count 0)
                     (or (check-toplevel-command form)
                         (let* ((values (toplevel-eval form env)))
-                          (if print-result (toplevel-print values))))))))
+                          (if print-result (toplevel-print values)))))))))
            (format *terminal-io* "~&Cancelled")))
        (abort () :report (lambda (stream)
                            (if (eq break-level 0)



More information about the Openmcl-cvs-notifications mailing list