X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=d8f4d729c37a58a0606223c2dd73662adce07b40;hb=15ecd1ada227a60bcb3a660a4924c8d9449cb997;hp=2d960c7652d3836dc77d8042c6a494e6ce6ddf8b;hpb=70c579379283da66f97906a0d62c8a5fc34e4dab;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 2d960c7..d8f4d72 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -1750,27 +1750,11 @@ register."
 
 ;;; Return the CODE-LOCATION's DEBUG-SOURCE.
 (defun code-location-debug-source (code-location)
-  (etypecase code-location
-    (compiled-code-location
-     (let* ((info (compiled-debug-fun-debug-info
-		   (code-location-debug-fun code-location)))
-	    (sources (sb!c::compiled-debug-info-source info))
-	    (len (length sources)))
-       (declare (list sources))
-       (when (zerop len)
-	 (debug-signal 'no-debug-blocks :debug-fun
-		       (code-location-debug-fun code-location)))
-       (if (= len 1)
-	   (car sources)
-	   (do ((prev sources src)
-		(src (cdr sources) (cdr src))
-		(offset (code-location-toplevel-form-offset code-location)))
-	       ((null src) (car prev))
-	     (when (< offset (sb!c::debug-source-source-root (car src)))
-	       (return (car prev)))))))
-    ;; (There used to be more cases back before sbcl-0.7.0, when we
-    ;; did special tricks to debug the IR1 interpreter.)
-    ))
+  (let ((info (compiled-debug-fun-debug-info
+	       (code-location-debug-fun code-location))))
+    (or (sb!c::debug-info-source info)
+	(debug-signal 'no-debug-blocks :debug-fun
+		      (code-location-debug-fun code-location)))))
 
 ;;; Returns the number of top level forms before the one containing
 ;;; CODE-LOCATION as seen by the compiler in some compilation unit. (A
@@ -1993,6 +1977,9 @@ register."
   (if (or
        ;; fixnum
        (zerop (logand val sb!vm:fixnum-tag-mask))
+       ;; immediate single float, 64-bit only
+       #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
+       (= (logand val #xff) sb!vm:single-float-widetag)
        ;; character
        (and (zerop (logandc2 val #x1fffffff)) ; Top bits zero
 	    (= (logand val #xff) sb!vm:character-widetag)) ; char tag
@@ -2009,7 +1996,7 @@ register."
 		(< sb!vm:static-space-start val
 		   (* sb!vm:*static-space-free-pointer*
 		      sb!vm:n-word-bytes))
-		(< sb!vm:dynamic-space-start val
+		(< (current-dynamic-space-start) val
 		   (sap-int (dynamic-space-free-pointer))))))
       (make-lisp-obj val)
       :invalid-object))