X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=ae9439d3b830dd11f09241e7bd8fe650336c6a9a;hb=b1de52969f584c63d43fb35da4a8a6a4e0e619f0;hp=f4b204410ed035bfb3b56700244b1c34e599c226;hpb=a30fb4f28fb891abc98eee8fdf99c2dbed2129de;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index f4b2044..ae9439d 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -42,13 +42,16 @@
     that must be handled, but they are not programmer errors."))
 
 (define-condition no-debug-info (debug-condition)
-  ()
+  ((code-component :reader no-debug-info-code-component
+		   :initarg :code-component))
   #!+sb-doc
   (:documentation "There is no usable debugging information available.")
   (:report (lambda (condition stream)
 	     (declare (ignore condition))
 	     (fresh-line stream)
-	     (write-line "no debugging information available" stream))))
+	     (format stream
+		     "no debug information available for ~S~%"
+		     (no-debug-info-code-component condition)))))
 
 (define-condition no-debug-function-returns (debug-condition)
   ((debug-function :reader no-debug-function-returns-debug-function
@@ -127,11 +130,11 @@
    "All programmer errors from using the interface for building debugging
     tools inherit from this type."))
 
-(define-condition unhandled-condition (debug-error)
-  ((condition :reader unhandled-condition-condition :initarg :condition))
+(define-condition unhandled-debug-condition (debug-error)
+  ((condition :reader unhandled-debug-condition-condition :initarg :condition))
   (:report (lambda (condition stream)
 	     (format stream "~&unhandled DEBUG-CONDITION:~%~A"
-		     (unhandled-condition-condition condition)))))
+		     (unhandled-debug-condition-condition condition)))))
 
 (define-condition unknown-code-location (debug-error)
   ((code-location :reader unknown-code-location-code-location
@@ -162,20 +165,21 @@
    (frame :reader frame-function-mismatch-frame :initarg :frame)
    (form :reader frame-function-mismatch-form :initarg :form))
   (:report (lambda (condition stream)
-	     (format stream
-		     "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
-		     (frame-function-mismatch-code-location condition)
-		     (frame-function-mismatch-frame condition)
-		     (frame-function-mismatch-form condition)))))
-
-;;; This signals debug-conditions. If they go unhandled, then signal an
-;;; unhandled-condition error.
+	     (format
+	      stream
+	      "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
+	      (frame-function-mismatch-code-location condition)
+	      (frame-function-mismatch-frame condition)
+	      (frame-function-mismatch-form condition)))))
+
+;;; This signals debug-conditions. If they go unhandled, then signal
+;;; an UNHANDLED-DEBUG-CONDITION error.
 ;;;
 ;;; ??? Get SIGNAL in the right package!
 (defmacro debug-signal (datum &rest arguments)
   `(let ((condition (make-condition ,datum ,@arguments)))
      (signal condition)
-     (error 'unhandled-condition :condition condition)))
+     (error 'unhandled-debug-condition :condition condition)))
 
 ;;;; structures
 ;;;;
@@ -1187,7 +1191,7 @@
   (let ((info (%code-debug-info component)))
     (cond
      ((not info)
-      (debug-signal 'no-debug-info))
+      (debug-signal 'no-debug-info :code-component component))
      ((eq info :bogus-lra)
       (make-bogus-debug-function "function end breakpoint"))
      (t
@@ -1809,7 +1813,7 @@
 	      (let* ((locations
 		      (dotimes (k (sb!c::read-var-integer blocks i)
 				  (result locations-buffer))
-			(let ((kind (svref sb!c::compiled-code-location-kinds
+			(let ((kind (svref sb!c::*compiled-code-location-kinds*
 					   (aref+ blocks i)))
 			      (pc (+ last-pc
 				     (sb!c::read-var-integer blocks i)))
@@ -1999,7 +2003,7 @@
       (if (logtest flags sb!c::minimal-debug-function-setf-bit)
 	  `(setf ,base)
 	  base))
-    :kind (svref sb!c::minimal-debug-function-kinds
+    :kind (svref sb!c::*minimal-debug-function-kinds*
 		 (ldb sb!c::minimal-debug-function-kind-byte options))
     :variables
     (when vars-p
@@ -3618,7 +3622,7 @@
 			#!+x86 sb!vm::ebx-offset)))
 	(nargs (make-lisp-obj
 		(sb!vm:context-register scp sb!vm::nargs-offset)))
- 	(reg-arg-offsets '#.sb!vm::register-arg-offsets)
+ 	(reg-arg-offsets '#.sb!vm::*register-arg-offsets*)
 	(results nil))
     (without-gcing
      (dotimes (arg-num nargs)