Changeset 658

Timestamp:

Mar 17, 2004, 7:26:54 AM (21 years ago)

Author:

Gary Byers

Message:

Backtrace/break-loop changes.

File:

• trunk/ccl/level-1/l1-readloop-lds.lisp (modified) (4 diffs)

trunk/ccl/level-1/l1-readloop-lds.lisp

@@ -389 +389 @@
 
 (defmacro new-backtrace-info (dialog youngest oldest tcr)
-  `(vector ,dialog ,youngest ,oldest ,tcr nil))
+  `(vector ,dialog ,youngest ,oldest ,tcr nil (%catch-top ,tcr)))
 
 (defun select-backtrace ()
@@ -410 +410 @@
   (when (and (%i< (interrupt-level) 0) (not *break-loop-when-uninterruptable*))
     (abort))
-  (let* ((context (new-backtrace-info nil
-                                      frame-pointer
-                                      (if *backtrace-contexts*
-                                        (or (child-frame
-                                             (bt.youngest (car *backtrace-contexts*))
-                                             (%current-tcr))
-                                            (last-frame-ptr))
-                                        (last-frame-ptr))
-                                      (%current-tcr)))
-         (*backtrace-contexts* (cons context *backtrace-contexts*))
-         (%handlers% (last %handlers%))         ; firewall
+  (let* ((%handlers% (last %handlers%))         ; firewall
          (*break-frame* frame-pointer)
          (*break-condition* condition)
@@ -435 +425 @@
          (*print-readably* nil))
     (unwind-protect
+         (let* ((context (new-backtrace-info nil
+                                      frame-pointer
+                                      (if *backtrace-contexts*
+                                        (or (child-frame
+                                             (bt.youngest (car *backtrace-contexts*))
+                                             (%current-tcr))
+                                            (last-frame-ptr))
+                                        (last-frame-ptr))
+                                      (%current-tcr)))
+                (*backtrace-contexts* (cons context *backtrace-contexts*)))
          (with-toplevel-commands :break
            (if *continuablep*
@@ -455 +455 @@
                   (read-loop :break-level (1+ *break-level*)))
              (application-ui-operation *application* :exit-backtrace-context
-                                       context)))
+                                       context))))
       (setf (interrupt-level) level))))