[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