0.9.2.7:

[sbcl.git] / src / code / debug-int.lisp

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 0d52c97..d8f4d72 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -371,7 +371,7 @@
   ;; This is the byte offset into the component.
   (offset nil :type index)
   ;; The original instruction replaced by the breakpoint.
-  (instruction nil :type (or null (unsigned-byte 32)))
+  (instruction nil :type (or null sb!vm::word))
   ;; A list of user breakpoints at this location.
   (breakpoints nil :type list))
 (def!method print-object ((obj breakpoint-data) str)
@@ -1408,6 +1408,9 @@ register."
                 ;; optional. Stick the extra var in the result
                 ;; element representing the keyword or optional,
                 ;; which is the previous one.
+                 ;;
+                 ;; FIXME: NCONC used for side-effect: the effect is defined,
+                 ;; but this is bad style no matter what.
                 (nconc (car res)
                        (list (compiled-debug-fun-lambda-list-var
                               args (incf i) vars))))
@@ -1747,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
@@ -1990,13 +1977,16 @@ 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
        ;; unbound marker
        (= val sb!vm:unbound-marker-widetag)
        ;; pointer
-       (and (logand val 1)
+       (and (logbitp 0 val)
            ;; Check that the pointer is valid. XXX Could do a better
            ;; job. FIXME: e.g. by calling out to an is_valid_pointer
            ;; routine in the C runtime support code
@@ -2006,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))
@@ -3283,7 +3273,7 @@ register."
        (setf (code-header-ref code-object (1+ real-lra-slot)) offset))
      (setf (code-header-ref code-object known-return-p-slot)
           known-return-p)
-     (system-area-copy src-start 0 dst-start 0 (* length sb!vm:n-byte-bits))
+     (system-area-ub8-copy src-start 0 dst-start 0 length)
      (sb!vm:sanctify-for-execution code-object)
      #!+(or x86 x86-64)
      (values dst-start code-object (sap- trap-loc src-start))