From: Christophe Rhodes Date: Tue, 27 Jul 2004 11:16:17 +0000 (+0000) Subject: 0.8.13.5: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a87f7ecb8beedbb3c1a225b7bc84dc6b51622cd9;p=sbcl.git 0.8.13.5: Fix backtrace on ppc. (Brian Downing sbcl-devel 2004-07-19) ... use BUG to report breakdown in logic; ... some tests fail on x86, so comment them out; ... untested as yet on non-x86 non-ppc. --- diff --git a/BUGS b/BUGS index 09fe1a7..c04e31c 100644 --- a/BUGS +++ b/BUGS @@ -1569,3 +1569,15 @@ WORKAROUND: it; this time around (before sbcl-0.8.13 release) I (WHN) just commented out the SB!VM:MEMORY-USAGE calls until someone figures out how to make them work reliably with the rest of the GC. + + (Note: there's at least one dubious thing in room.lisp: see the + comment in VALID-OBJ) + +345: backtrace on x86 undefined function + In sbcl-0.8.13 (and probably earlier versions), code of the form + (flet ((test () (#:undefined-fun 42))) + (funcall #'test)) + yields the debugger with a poorly-functioning backtrace. Brian + Downing fixed most of the problems on non-x86 architectures, but on + the x86 the backtrace from this evaluation does not reveal anything + about the problem. (See tests in debug.impure.lisp) diff --git a/NEWS b/NEWS index 9c5c417..e513fd3 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +changes in sbcl-0.8.14 relative to sbcl-0.8.13: + * bug fix: backtraces involving undefined functions or assembly + routines are more informative. (thanks to Brian Downing) + changes in sbcl-0.8.13 relative to sbcl-0.8.12: * new feature: SB-PACKAGE-LOCKS. See the "Package Locks" section of the manual for details; for now, package locks can be disabled by diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index eb0a395..7134607 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -948,24 +948,42 @@ (let* ((code-header-len (* (get-header-data code) sb!vm:n-word-bytes)) (pc-offset - (- (sap-int (sb!vm:context-pc scp)) - (- (get-lisp-obj-address code) - sb!vm:other-pointer-lowtag) - code-header-len))) + (- (sap-int (sb!vm:context-pc scp)) + (- (get-lisp-obj-address code) + sb!vm:other-pointer-lowtag) + code-header-len))) ;; Check to see whether we were executing in a branch ;; delay slot. - #!+(or pmax sgi) ; pmax only (and broken anyway) + #!+(or pmax sgi) ; pmax only (and broken anyway) (when (logbitp 31 (sb!alien:slot scp '%mips::sc-cause)) (incf pc-offset sb!vm:n-word-bytes)) - (unless (<= 0 pc-offset - (* (code-header-ref code sb!vm:code-code-size-slot) - sb!vm:n-word-bytes)) - ;; We were in an assembly routine. Therefore, use the - ;; LRA as the pc. - (setf pc-offset - (- (sb!vm:context-register scp sb!vm::lra-offset) - (get-lisp-obj-address code) - code-header-len))) + (let ((code-size (* (code-header-ref code + sb!vm:code-code-size-slot) + sb!vm:n-word-bytes))) + (unless (<= 0 pc-offset code-size) + ;; We were in an assembly routine. + (multiple-value-bind (new-pc-offset computed-return) + (find-pc-from-assembly-fun code scp) + (setf pc-offset new-pc-offset) + (unless (<= 0 pc-offset code-size) + (cerror + "Set PC-OFFSET to zero and continue backtrace." + 'bug + :format-control + "~@" + :format-arguments + (list pc-offset + (sap-int (sb!vm:context-pc scp)) + code + (%code-entry-points code) + (sb!vm:context-register scp sb!vm::lra-offset) + computed-return)) + ;; We failed to pinpoint where PC is, but set + ;; pc-offset to 0 to keep the backtrace from + ;; exploding. + (setf pc-offset 0))))) (return (if (eq (%code-debug-info code) :bogus-lra) (let ((real-lra (code-header-ref code @@ -975,6 +993,25 @@ nil)) (values code pc-offset scp)))))))))) +#!-x86 +(defun find-pc-from-assembly-fun (code scp) + "Finds the PC for the return from an assembly routine properly. +For some architectures (such as PPC) this will not be the $LRA +register." + (let ((return-machine-address + ;; This conditional logic should probably go into + ;; architecture specific files somehow. + #!+ppc (sap-int (sb!vm::context-lr scp)) + #!-(or ppc) (- (sb!vm:context-register scp sb!vm::lra-offset) + sb!vm:other-pointer-lowtag)) + (code-header-len (* (get-header-data code) + sb!vm:n-word-bytes))) + (values (- return-machine-address + (- (get-lisp-obj-address code) + sb!vm:other-pointer-lowtag) + code-header-len) + return-machine-address))) + ;;; Find the code object corresponding to the object represented by ;;; bits and return it. We assume bogus functions correspond to the ;;; undefined-function. diff --git a/src/code/ppc-vm.lisp b/src/code/ppc-vm.lisp index 627599e..8788587 100644 --- a/src/code/ppc-vm.lisp +++ b/src/code/ppc-vm.lisp @@ -86,6 +86,13 @@ (declare (type (alien (* os-context-t)) context)) (deref (context-register-addr context index))) +(define-alien-routine ("os_context_lr_addr" context-lr-addr) (* unsigned-long) + (context (* os-context-t))) + +(defun context-lr (context) + (declare (type (alien (* os-context-t)) context)) + (int-sap (deref (context-lr-addr context)))) + (defun %set-context-register (context index new) (declare (type (alien (* os-context-t)) context)) (setf (deref (context-register-addr context index)) diff --git a/src/runtime/ppc-assem.S b/src/runtime/ppc-assem.S index afd0b1c..53e8cad 100644 --- a/src/runtime/ppc-assem.S +++ b/src/runtime/ppc-assem.S @@ -515,12 +515,11 @@ lra: .byte 0,0,0,SIMPLE_FUN_HEADER_WIDETAG .byte 18<<2 CSYMBOL(undefined_tramp): - .byte 0,0,24 + .byte 0,0,48 .long CSYMBOL(undefined_tramp) .long NIL .long NIL .long NIL - .long NIL twllei reg_ZERO,trap_Cerror .byte 4 .byte UNDEFINED_FUN_ERROR @@ -530,7 +529,9 @@ CSYMBOL(undefined_tramp): la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE) mtctr reg_LIP bctr - + mr reg_CSP,reg_CFP + b 1b + SET_SIZE(xundefined_tramp) GFUNCDEF(xclosure_tramp) diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index 96916bb..7759cd4 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -58,5 +58,80 @@ (assert (eql &rest-sym '&rest)) (assert (symbolp format-args-sym))) +;;; Check for backtraces generally being correct. Ensure that the +;;; actual backtrace finishes (doesn't signal any errors on its own), +;;; and that it contains the frames we expect, doesn't contain any +;;; "bogus stack frame"s, and contains the appropriate toplevel call +;;; and hasn't been cut off anywhere. +(defun verify-backtrace (test-function frame-name + &key (key #'first) (test #'eql) + (allow-bogus-frames nil)) + (let ((result nil) + (return-value nil)) + (block outer-handler + (handler-bind + ((error #'(lambda (condition) + (let ((backtrace (ignore-errors + (sb-debug:backtrace-as-list)))) + ;; Make sure we find what we're looking for. + (when (member frame-name backtrace + :key key :test test) + (setf result (list :error condition))) + ;; Make sure there's no bogus stack frames + ;; unless they're explicitly allowed. + (when (and (not allow-bogus-frames) + (member "bogus stack frame" backtrace + :key #'first :test #'equal)) + (setf result nil)) + ;; Make sure the backtrace isn't stunted in + ;; any way. (Depends on running in the main + ;; thread.) + (unless (member 'sb-impl::toplevel-init backtrace + :key #'first :test #'equal) + (setf result nil))) + (return-from outer-handler)))) + (funcall test-function))) + (values result return-value))) + +;;; Test for "undefined function" (undefined_tramp) working properly. +;;; Try it with and without tail call elimination, since they can have +;;; different effects. (Specifically, if undefined_tramp is incorrect +;;; a stunted stack can result from the tail call variant.) +#-x86 ; bug 345 +(progn + (flet ((test-function () + (declare (optimize (speed 2) (debug 1))) ; tail call elimination + (#:undefined-function 42))) + (assert (verify-backtrace #'test-function "undefined function" + :test #'equal))) + + (flet ((test-function () + (declare (optimize (speed 1) (debug 2))) ; no tail call elimination + (#:undefined-function 42))) + (assert (verify-backtrace #'test-function "undefined function" + :test #'equal)))) + +;;; Division by zero was a common error on PPC. It depended on the +;;; return function either being before INTEGER-/-INTEGER in memory, +;;; or more than MOST-POSITIVE-FIXNUM bytes ahead. It also depends on +;;; INTEGER-/-INTEGER calling SIGNED-TRUNCATE. I believe Raymond Toy +;;; says that the Sparc backend (at least for CMUCL) inlines this, so +;;; if SBCL does the same this test is probably not good for the +;;; Sparc. +;;; +;;; Disabling tail call elimination on this will probably ensure that +;;; the return value (to the flet or the enclosing top level form) is +;;; more than MOST-POSITIVE-FIXNUM with the current spaces on OS X. +;;; Enabling it might catch other problems, so do it anyway. +(flet ((test-function () + (declare (optimize (speed 1) (debug 2))) ; tail call elimination + (/ 42 0))) + (assert (verify-backtrace #'test-function '/))) + +(flet ((test-function () + (declare (optimize (speed 1) (debug 2))) ; no tail call elimination + (/ 42 0))) + (assert (verify-backtrace #'test-function '/))) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 13a8269..df5aec8 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.13.4" +"0.8.13.5"