Changeset 626 for trunk/ccl/level-1/l1-readloop-lds.lisp
- Timestamp:
- Mar 7, 2004, 7:52:19 AM (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/level-1/l1-readloop-lds.lisp
r603 r626 365 365 (%break-message msg condition error-pointer) 366 366 (with-terminal-input 367 (restart-case (break-loop condition error-pointer *backtrace-on-break*)367 (restart-case (break-loop condition error-pointer) 368 368 (continue () :report (lambda (stream) (write-string cont-string stream)))) 369 369 (fresh-line *error-output*) … … 406 406 407 407 (defvar %last-continue% nil) 408 (defun break-loop (condition frame-pointer 409 &optional (backtracep *backtrace-on-break*)) 408 (defun break-loop (condition frame-pointer) 410 409 "Never returns" 411 410 (when (and (%i< (interrupt-level) 0) (not *break-loop-when-uninterruptable*)) 412 411 (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 414 423 (*break-frame* frame-pointer) 415 424 (*break-condition* condition) … … 427 436 (unwind-protect 428 437 (with-toplevel-commands :break 429 430 438 (if *continuablep* 439 (let* ((*print-circle* *error-print-circle*) 431 440 ;(*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))) 445 458 (setf (interrupt-level) level)))) 446 459
Note: See TracChangeset
for help on using the changeset viewer.