/[cmucl]/src/code/interr.lisp
ViewVC logotype

Diff of /src/code/interr.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.20 by ram, Tue Jan 21 17:25:01 1992 UTC revision 1.21 by ram, Tue Jan 21 23:41:15 1992 UTC
# Line 593  Line 593 
593              (numberp *current-error-depth*))              (numberp *current-error-depth*))
594         (let ((*current-error-depth* (1+ *current-error-depth*)))         (let ((*current-error-depth* (1+ *current-error-depth*)))
595           (if (> *current-error-depth* *maximum-error-depth*)           (if (> *current-error-depth* *maximum-error-depth*)
596               (error-error "Help! " *current-error-depth* " nested errors."               (error-error "Help! " *current-error-depth* " nested errors.  "
597                            "KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")                            "KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
598               (progn ,@forms)))               (progn ,@forms)))
599         (%primitive halt)))         (%primitive halt)))
# Line 636  Line 636 
636         (throw 'lisp::top-level-catcher nil)))         (throw 'lisp::top-level-catcher nil)))
637    
638      (with-standard-io-syntax      (with-standard-io-syntax
639        (dolist (item messages) (princ item *terminal-io*))        (let ((*print-readably* nil))
640        (debug:internal-debug))))          (dolist (item messages) (princ item *terminal-io*))
641            (debug:internal-debug)))))
642    
643    
644  ;;;; Fetching errorful function name.  ;;;; Fetching errorful function name.
# Line 645  Line 646 
646  ;;; Used to prevent infinite recursive lossage when we can't find the caller  ;;; Used to prevent infinite recursive lossage when we can't find the caller
647  ;;; for some reason.  ;;; for some reason.
648  ;;;  ;;;
649  (defvar *finding-caller* nil)  (defvar *finding-name* nil)
650    
651  ;;; FIND-CALLER-NAME  --  Internal  ;;; FIND-CALLER-NAME  --  Internal
652  ;;;  ;;;
653  (defun find-caller-name ()  (defun find-caller-name ()
654    (if *finding-caller*    (if *finding-name*
655        "<error finding name>"        "<error finding name>"
656        (handler-case        (handler-case
657            (let ((*finding-caller* t))            (let ((*finding-name* t))
658              (di:debug-function-name              (di:debug-function-name
659               (di:frame-debug-function               (di:frame-debug-function
660                (di:frame-down (di:frame-down (di:top-frame))))))                (di:frame-down (di:frame-down (di:top-frame))))))

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

  ViewVC Help
Powered by ViewVC 1.1.5