Changeset 15062
- Timestamp:
- Nov 8, 2011, 7:11:31 PM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-readloop-lds.lisp
r14934 r15062 21 21 22 22 23 (defvar *read-loop-function* 'read-loop) 24 25 (defun run-read-loop (&rest args) 26 (declare (dynamic-extent args)) 27 (apply *read-loop-function* args)) 23 28 24 29 (defun toplevel-loop () 25 30 (loop 26 31 (if (eq (catch :toplevel 27 (r ead-loop :break-level 0 )) $xstkover)32 (run-read-loop :break-level 0 )) $xstkover) 28 33 (format t "~&;[Stacks reset due to overflow.]") 29 34 (when (eq *current-process* *initial-process*) … … 481 486 (#__exit -1)) 482 487 488 ;; Make these available to debugger hook 483 489 (defvar *top-error-frame* nil) 490 (defvar *break-loop-type* nil) ;; e.g. "Debug", "Signal", "Error". 484 491 485 492 (defun break-loop-handle-error (condition *top-error-frame*) … … 487 494 (dolist (x bogus-globals) 488 495 (set x (funcall (pop newvals)))) 489 (when (and *debugger-hook* *break-on-errors* (not *batch-flag*))490 (let ((hook *debugger-hook*)491 (*debugger-hook* nil))492 (funcall hook condition hook)))493 496 (let ((msg (if *batch-flag* ;; Give a little more info if exiting 494 497 (format nil "Error of type ~s" (type-of condition)) 495 498 "Error"))) 499 (when (and *debugger-hook* *break-on-errors* (not *batch-flag*)) 500 (let ((hook *debugger-hook*) 501 (*debugger-hook* nil) 502 (*break-loop-type* msg)) 503 (funcall hook condition hook))) 496 504 (%break-message msg condition)) 497 505 (let* ((s *error-output*)) … … 539 547 (defun invoke-debugger (condition &aux (*top-error-frame* (%get-frame-ptr))) 540 548 "Enter the debugger." 541 (let ((c (require-type condition 'condition))) 549 (let ((c (require-type condition 'condition)) 550 (msg "Debug")) 542 551 (when *debugger-hook* 543 552 (let ((hook *debugger-hook*) 544 (*debugger-hook* nil)) 553 (*debugger-hook* nil) 554 (*break-loop-type* msg)) 545 555 (funcall hook c hook))) 546 (%break-message "Debug"c)556 (%break-message msg c) 547 557 (break-loop c))) 548 558 … … 563 573 (sub (make-string-output-stream)) 564 574 (indent 0)) 565 (format s "~A ~A:" prefixchar msg)575 (format s "~A~@[ ~A:~] " prefixchar msg) 566 576 (setf (indenting-string-output-stream-indent s) (setq indent (column s))) 567 577 (decf (stream-line-length sub) indent) … … 587 597 (hook *break-hook*)) 588 598 (restart-case (progn 589 (when hook590 (let ((*break-hook* nil))591 (funcall hook condition hook))592 (setq hook nil))593 (%break-message msg condition)594 599 (when (and (eq (type-of condition) 'simple-condition) 595 600 (equal (simple-condition-format-control condition) "")) … … 597 602 :format-control "~a" 598 603 :format-arguments (list msg)))) 604 (when hook 605 (let ((*break-hook* nil) 606 (*break-loop-type* msg)) 607 (funcall hook condition hook)) 608 (setq hook nil)) 609 (%break-message msg condition) 599 610 (break-loop condition)) 600 611 (continue () :report (lambda (stream) (write-string cont-string stream)))) … … 649 660 ((eql count 1) (error "Error reporting error")) 650 661 (t (bug "Error reporting error"))))) 651 652 653 662 654 663 … … 693 702 (*print-level* *error-print-level*) 694 703 (*print-length* *error-print-length*) 695 704 ;(*print-pretty* nil) 696 705 (*print-array* nil)) 697 706 (format t (or (application-ui-operation *application* :break-options-string t) … … 711 720 (application-ui-operation *application* 712 721 :enter-backtrace-context context) 713 (r ead-loop :break-level (1+ *break-level*)714 :input-stream *debug-io*715 :output-stream *debug-io*))722 (run-read-loop :break-level (1+ *break-level*) 723 :input-stream *debug-io* 724 :output-stream *debug-io*)) 716 725 (application-ui-operation *application* :exit-backtrace-context 717 726 context)))))))
Note: See TracChangeset
for help on using the changeset viewer.