common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

0.8.13.5:

Browse source 
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.
This commit is contained in:
Christophe Rhodes 2004-07-27 11:16:17 +00:00
parent 88bcaaccbc
commit a87f7ecb8b
7 changed files with 154 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
BUGS
View file

@ -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)

4
NEWS
View file

@ -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

65
src/code/debug-int.lisp
View file

@ -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
"~@<PC-OFFSET (~D) not in code object. Frame details:~
~2I~:@_PC: #X~X~:@_CODE: ~S~:@_CODE FUN: ~S~:@_LRA: ~
#X~X~:@_COMPUTED RETURN: #X~X.~:>"
: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.

7
src/code/ppc-vm.lisp
View file

@ -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))

7
src/runtime/ppc-assem.S
View file

@ -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)

75
tests/debug.impure.lisp
View file

@ -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)

2
version.lisp-expr
View file

@ -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"