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)
+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
(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
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.
(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))
.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
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)
(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)
;;; 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"
projects / sbcl.git / commitdiff