X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=d8f4d729c37a58a0606223c2dd73662adce07b40;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=f3062a0a36c61c57e2e863137b8759ebf4567ae5;hpb=5bad55941fafc315116f6fcf2c8c2cce8af7ed9a;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index f3062a0..d8f4d72 100644 --- 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) @@ -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))