Skip to content
Snippets Groups Projects
Commit 689a3ff3 authored by wlott's avatar wlott
Browse files

Added code to find the function that was interrupted and pass it into

the error system so that the name comes out right.  Also, rewrote the
stuff to calc the pc of the break instruction so that doesn't hit the
load-tn bug.
parent b7616589
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.5 1990/06/06 20:56:52 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.6 1990/06/09 00:55:37 wlott Exp $
;;; ;;;
;;; Functions and macros to define and deal with internal errors (i.e. ;;; Functions and macros to define and deal with internal errors (i.e.
;;; problems that can be signaled from assembler code). ;;; problems that can be signaled from assembler code).
...@@ -381,6 +381,26 @@ ...@@ -381,6 +381,26 @@
#+new-compiler
(defvar *finding-name* nil)
#+new-compiler
(defun find-interrupted-name ()
(if *finding-name*
"<error finding name>"
(handler-case
(let ((*finding-name* t))
(do ((frame (di:top-frame) (di:frame-down frame)))
((or (null frame)
(di::frame-escaped frame))
(if frame
(di:debug-function-name
(di:frame-debug-function frame))
"<error finding name>"))))
(error () "<error finding name>")
(di:debug-condition () "<error finding name>"))))
#+new-compiler #+new-compiler
(defun internal-error (signal code scp) (defun internal-error (signal code scp)
(declare (ignore signal code)) (declare (ignore signal code))
...@@ -390,16 +410,16 @@ ...@@ -390,16 +410,16 @@
mach:sigcontext mach:sigcontext
t) t)
(regs (mach:sigcontext-regs (alien-value sc)) mach:int-array t)) (regs (mach:sigcontext-regs (alien-value sc)) mach:int-array t))
(let* ((pc (int-sap (+ (alien-access (let* ((pc (sap+ (alien-access
(mach:sigcontext-pc (mach:sigcontext-pc
(alien-value sc))) (alien-value sc)))
(if (logbitp 31 (if (logbitp 31
(alien-access (alien-access
(mach:sigcontext-cause (mach:sigcontext-cause
(alien-value sc)))) (alien-value sc))))
4 4
0)))) 0)))
(bad-inst (sap-ref-32 pc 0)) #+nil (bad-inst (sap-ref-32 pc 0))
(number (sap-ref-8 pc 4)) (number (sap-ref-8 pc 4))
(info (svref *internal-errors* number)) (info (svref *internal-errors* number))
(args nil)) (args nil))
...@@ -410,7 +430,11 @@ ...@@ -410,7 +430,11 @@
(alien-access (mach:int-array-ref (alien-value regs) (alien-access (mach:int-array-ref (alien-value regs)
(sap-ref-8 ptr 0)))) (sap-ref-8 ptr 0))))
args))) args)))
(error "~A [~D]:~{ ~S~}" (error 'simple-error
(if info (error-info-description info) "Unknown error") :format-string "~A [~D]:~{ ~S~}"
number :format-arguments (list (if info
(nreverse args))))) (error-info-description info)
"Unknown error")
number
(nreverse args))
:function-name (find-interrupted-name)))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment