X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=67d0a59933847b9d233c7ebde10e286cfea4326e;hb=129b26c117d41c21663f07e9017871b56fafa501;hp=320c7c3f5b15d971a8f19d36791c0995b467a4ab;hpb=78689792e8f8d20b3b931f508f3a9eca81b64f1f;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 320c7c3..67d0a59 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -64,8 +64,8 @@ (no-debug-fun-returns-debug-fun condition)))) (format stream "~&Cannot return values from ~:[frame~;~:*~S~] since ~ - the debug information lacks details about returning ~ - values here." + the debug information lacks details about returning ~ + values here." fun))))) (define-condition no-debug-blocks (debug-condition) @@ -780,10 +780,10 @@ (#.lra-save-offset (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value)))))) -(defun foreign-function-debug-name (sap) - (multiple-value-bind (name file base offset) (foreign-symbol-in-address sap) +(defun foreign-function-backtrace-name (sap) + (let ((name (foreign-symbol-in-address sap))) (if name - (format nil "foreign function: ~A [~A: #x~X + #x~X]" name file base offset) + (format nil "foreign function: ~A" name) (format nil "foreign function: #x~X" (sap-int sap))))) ;;; This returns a frame for the one existing in time immediately @@ -832,7 +832,8 @@ "undefined function")) (:foreign-function (make-bogus-debug-fun - (foreign-function-debug-name (int-sap (get-lisp-obj-address lra))))) + (foreign-function-backtrace-name + (int-sap (get-lisp-obj-address lra))))) ((nil) (make-bogus-debug-fun "bogus stack frame")) @@ -877,7 +878,8 @@ (make-bogus-debug-fun "undefined function")) (:foreign-function - (make-bogus-debug-fun (foreign-function-debug-name ra))) + (make-bogus-debug-fun + (foreign-function-backtrace-name ra))) ((nil) (make-bogus-debug-fun "bogus stack frame")) @@ -1998,7 +2000,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 @@ -2053,7 +2055,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 @@ -2143,7 +2145,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))))) @@ -2188,7 +2190,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 @@ -2247,7 +2249,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))))) @@ -2328,7 +2330,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))) @@ -2427,7 +2429,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)) @@ -2462,7 +2464,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))) @@ -2526,7 +2528,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)))) @@ -2814,7 +2816,7 @@ register." (compiled-debug-fun-compiler-debug-fun what)) :standard) (error ":FUN-END breakpoints are currently unsupported ~ - for the known return convention.")) + for the known return convention.")) (let* ((bpt (%make-breakpoint hook-fun what kind info)) (starter (compiled-debug-fun-end-starter what))) @@ -3265,6 +3267,8 @@ register." ;;; instruction. (defun make-bogus-lra (real-lra &optional known-return-p) (without-gcing + ;; These are really code labels, not variables: but this way we get + ;; their addresses. (let* ((src-start (foreign-symbol-address "fun_end_breakpoint_guts")) (src-end (foreign-symbol-address "fun_end_breakpoint_end")) (trap-loc (foreign-symbol-address "fun_end_breakpoint_trap"))