X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=9964063c1915c3314192dbe9b38bd45230033c7e;hb=77d94d36bcfd3d5eea73ad51e6ee621a8938f995;hp=d76fbe15ded7637e4d044a1c2da81c46b6d57195;hpb=771b864c8f32af7734bc0550aeaf1539fc4df194;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index d76fbe1..9964063 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -41,17 +41,6 @@
    "All DEBUG-CONDITIONs inherit from this type. These are serious conditions
     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)
-	     (fresh-line stream)
-	     (format stream
-		     "no debug information available for ~S~%"
-		     (no-debug-info-code-component condition)))))
-
 (define-condition no-debug-fun-returns (debug-condition)
   ((debug-fun :reader no-debug-fun-returns-debug-fun
 	      :initarg :debug-fun))
@@ -854,7 +843,6 @@
     (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
       (/noshow0 "at COND")
       (cond (code
-	     (/noshow0 "in CODE clause")
 	     ;; If it's escaped it may be a function end breakpoint trap.
 	     (when (and (code-component-p code)
 			(eq (%code-debug-info code) :bogus-lra))
@@ -863,16 +851,12 @@
 				code (1+ real-lra-slot)))
 	       (setq code (code-header-ref code real-lra-slot))
 	       (aver code)))
-	    (t
-	     (/noshow0 "in T clause")
-	     ;; not escaped
+	    ((not escaped)
 	     (multiple-value-setq (pc-offset code)
 	       (compute-lra-data-from-pc ra))
 	     (unless code
 	       (setf code :foreign-function
-		     pc-offset 0
-		     escaped nil))))
-
+		     pc-offset 0))))
       (let ((d-fun (case code
 		     (:undefined-function
 		      (make-bogus-debug-fun
@@ -1041,8 +1025,11 @@ register."
 (defun debug-fun-from-pc (component pc)
   (let ((info (%code-debug-info component)))
     (cond
-     ((not info)
-      (debug-signal 'no-debug-info :code-component component))
+      ((not info)
+       ;; FIXME: It seems that most of these (at least on x86) are
+       ;; actually assembler routines, and could be named by looking
+       ;; at the sb-fasl:*assembler-routines*.
+       (make-bogus-debug-fun "no debug information for frame"))
      ((eq info :bogus-lra)
       (make-bogus-debug-fun "function end breakpoint"))
      (t
@@ -2000,7 +1987,7 @@ register."
        (zerop (logand val 3))
        ;; character
        (and (zerop (logand val #xffff0000)) ; Top bits zero
-	    (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag
+	    (= (logand val #xff) sb!vm:character-widetag)) ; char tag
        ;; unbound marker
        (= val sb!vm:unbound-marker-widetag)
        ;; pointer
@@ -2055,7 +2042,7 @@ register."
        (sb!sys:without-gcing
         (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
                             
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (with-escaped-value (val)
          (code-char val)))
       (#.sb!vm:sap-reg-sc-number
@@ -2145,7 +2132,7 @@ register."
                                       sb!vm:n-word-bytes)))))
       (#.sb!vm:control-stack-sc-number
        (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (with-nfp (nfp)
          (code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
                                               sb!vm:n-word-bytes)))))
@@ -2190,7 +2177,7 @@ register."
        (without-gcing
 	(with-escaped-value (val)
 	  (make-valid-lisp-obj val))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (with-escaped-value (val)
 	 (code-char val)))
       (#.sb!vm:sap-reg-sc-number
@@ -2249,7 +2236,7 @@ register."
 			       sb!vm:n-word-bytes)))))
       (#.sb!vm:control-stack-sc-number
        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (code-char
 	(sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
 			     sb!vm:n-word-bytes)))))
@@ -2330,7 +2317,7 @@ register."
        (without-gcing
 	(set-escaped-value
 	  (get-lisp-obj-address value))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (set-escaped-value (char-code value)))
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
@@ -2429,7 +2416,7 @@ register."
 	       (the long-float (realpart value)))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (with-nfp (nfp)
 	 (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
 					 sb!vm:n-word-bytes))
@@ -2464,7 +2451,7 @@ register."
        (without-gcing
 	(set-escaped-value
 	  (get-lisp-obj-address value))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (set-escaped-value (char-code value)))
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
@@ -2528,7 +2515,7 @@ register."
 	     (imagpart (the (complex long-float) value))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
 					 sb!vm:n-word-bytes)))
 	     (char-code (the character value))))