Ignore:
Timestamp:
Mar 7, 2004, 7:52:19 AM (16 years ago)
Author:
gb
Message:

BREAK-LOOP creates backtrace context, tells the application when it's valid.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-readloop-lds.lisp

    r603 r626  
    365365    (%break-message msg condition error-pointer)
    366366    (with-terminal-input
    367       (restart-case (break-loop condition error-pointer *backtrace-on-break*)
     367      (restart-case (break-loop condition error-pointer)
    368368                    (continue () :report (lambda (stream) (write-string cont-string stream))))
    369369      (fresh-line *error-output*)
     
    406406
    407407(defvar %last-continue% nil)
    408 (defun break-loop (condition frame-pointer
    409                              &optional (backtracep *backtrace-on-break*))
     408(defun break-loop (condition frame-pointer)
    410409  "Never returns"
    411410  (when (and (%i< (interrupt-level) 0) (not *break-loop-when-uninterruptable*))
    412411    (abort))
    413   (let* ((%handlers% (last %handlers%))         ; firewall
     412  (let* ((context (new-backtrace-info nil
     413                                      frame-pointer
     414                                      (if *backtrace-contexts*
     415                                        (or (child-frame
     416                                             (bt.youngest (car *backtrace-contexts*))
     417                                             (%current-tcr))
     418                                            (last-frame-ptr))
     419                                        (last-frame-ptr))
     420                                      (%current-tcr)))
     421         (*backtrace-contexts* (cons context *backtrace-contexts*))
     422         (%handlers% (last %handlers%))         ; firewall
    414423         (*break-frame* frame-pointer)
    415424         (*break-condition* condition)
     
    427436    (unwind-protect
    428437         (with-toplevel-commands :break
    429                (if *continuablep*
    430                 (let* ((*print-circle* *error-print-circle*)
     438           (if *continuablep*
     439            (let* ((*print-circle* *error-print-circle*)
    431440                                        ;(*print-pretty* nil)
    432                         (*print-array* nil))
    433                    (format t "~&> Type :GO to continue, :POP to abort.")
    434                    (format t "~&> If continued: ~A~%" continue))
    435                  (format t "~&> Type :POP to abort.~%"))
    436                (format t "~&Type :? for other options.")
    437                (terpri)
    438 
    439                (force-output)
    440                (when backtracep
    441                  (select-backtrace))
    442                (clear-input *debug-io*)
    443                (setq *error-reentry-count* 0) ; succesfully reported error
    444                (read-loop :break-level (1+ *break-level*)))
     441                    (*print-array* nil))
     442               (format t "~&> Type :GO to continue, :POP to abort.")
     443               (format t "~&> If continued: ~A~%" continue))
     444             (format t "~&> Type :POP to abort.~%"))
     445           (format t "~&Type :? for other options.")
     446           (terpri)
     447           (force-output)
     448
     449           (clear-input *debug-io*)
     450           (setq *error-reentry-count* 0) ; succesfully reported error
     451           (unwind-protect
     452                (progn
     453                  (application-ui-operation *application*
     454                                            :enter-backtrace-context context)
     455                  (read-loop :break-level (1+ *break-level*)))
     456             (application-ui-operation *application* :exit-backtrace-context
     457                                       context)))
    445458      (setf (interrupt-level) level))))
    446459
Note: See TracChangeset for help on using the changeset viewer.