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

[gz at clozure.com]

Author: gz
Date: Mon Feb 23 21:32:55 2009
New Revision: 11767

Log:
Propagate r11751 to trunk

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 Mon Feb 23 21:32:55 2009
@@ -471,8 +471,7 @@
             (format s "~s" oldval))
           (format s ", was reset to ~s ." (symbol-value bogusness)))))
     (if (and *break-on-errors* (not *batch-flag*))
-      (with-terminal-input
-          (break-loop condition error-pointer))
+      (break-loop condition error-pointer)
       (if *batch-flag*
         (abnormal-application-exit)
         (abort)))))
@@ -513,8 +512,7 @@
             (*debugger-hook* nil))
         (funcall hook c hook)))
     (%break-message "Debug" c fp)
-    (with-terminal-input
-	(break-loop c fp))))
+    (break-loop c fp)))
 =

 (defun %break-message (msg condition error-pointer &optional (prefixchar #=
\>))
   (let ((*print-circle* *error-print-circle*)
@@ -547,11 +545,10 @@
 (defun cbreak-loop (msg cont-string condition error-pointer)
   (let* ((*print-readably* nil))
     (%break-message msg condition error-pointer)
-    (with-terminal-input
-      (restart-case (break-loop condition error-pointer)
-		    (continue () :report (lambda (stream) (write-string cont-string stre=
am))))
-      (fresh-line *error-output*)
-      nil)))
+    (restart-case (break-loop condition error-pointer)
+      (continue () :report (lambda (stream) (write-string cont-string stre=
am))))
+    (fresh-line *error-output*)
+    nil))
 =

 (defun warn (condition-or-format-string &rest args)
   "Warn about a situation by signalling a condition formed by DATUM and
@@ -618,23 +615,24 @@
          (*standard-output* *debug-io*)
          (*signal-printing-errors* nil)
          (*read-suppress* nil)
-         (*print-readably* nil))
-    (let* ((context (new-backtrace-info nil
-                                        frame-pointer
-                                        (if *backtrace-contexts*
-                                          (or (child-frame
-                                               (bt.youngest (car *backtrac=
e-contexts*))
-                                               nil)
-                                              (last-frame-ptr))
-                                          (last-frame-ptr))
-                                        (%current-tcr)
-                                        condition
-                                        (%current-frame-ptr)
-                                        #+ppc-target *fake-stack-frames*
-                                        #+x86-target (%current-frame-ptr)
-                                        (db-link)
-                                        (1+ *break-level*)))
-           (*backtrace-contexts* (cons context *backtrace-contexts*)))
+         (*print-readably* nil)
+         (context (new-backtrace-info nil
+                                      frame-pointer
+                                      (if *backtrace-contexts*
+                                        (or (child-frame
+                                             (bt.youngest (car *backtrace-=
contexts*))
+                                             nil)
+                                            (last-frame-ptr))
+                                        (last-frame-ptr))
+                                      (%current-tcr)
+                                      condition
+                                      (%current-frame-ptr)
+                                      #+ppc-target *fake-stack-frames*
+                                      #+x86-target (%current-frame-ptr)
+                                      (db-link)
+                                      (1+ *break-level*)))
+         (*backtrace-contexts* (cons context *backtrace-contexts*)))
+    (with-terminal-input
       (with-toplevel-commands :break
         (if *continuablep*
           (let* ((*print-circle* *error-print-circle*)