then requesting a BACKTRACE at the debugger prompt gives no information
about where in the user program the problem occurred.
+ (this is apparently mostly fixed on the SPARC and PPC architectures:
+ while giving the backtrace the system complains about "unknown
+ source location: using block start", but apart from that the
+ backtrace seems reasonable. See tests/debug.impure.lisp for a test
+ case)
+
64:
Using the pretty-printer from the command prompt gives funny
results, apparently because the pretty-printer doesn't know
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)
+
+346: alpha backtrace
+ In sbcl-0.8.13, all backtraces from errors caused by internal errors
+ on the alpha seem to have a "bogus stack frame".
(!def-vm-support-routine generate-call-sequence (name style vop)
(ecase style
- (:raw
+ ((:raw :none)
(values
`((inst li (make-fixup ',name :assembly-routine) temp)
(inst jsr lip-tn temp))
(:temporary (:scs (control-stack) :offset nfp-save-offset)
,nfp-save)
(:temporary (:scs (non-descriptor-reg)) temp1)
- (:save-p t)))))
- (:none
- (values
- `((inst li (make-fixup ',name :assembly-routine) temp)
- (inst jsr lip-tn temp (make-fixup ',name :assembly-routine)))
- '((:temporary (:scs (non-descriptor-reg)) temp))
- nil))))
+ (:save-p t)))))))
(!def-vm-support-routine generate-return-sequence (style)
(ecase style
:offset lra-offset)
lip-tn :offset 2)))
(:none)))
+
+(defun return-machine-address (scp)
+ (context-register scp lip-offset))
-(in-package "SB!VM")
+;;;; the machine-specific support routines needed by the file assembler
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+(in-package "SB!VM")
(!def-vm-support-routine generate-call-sequence (name style vop)
(ecase style
`((:temporary (:scs (any-reg) :from (:eval 0) :to (:eval 1))
,fixup)))))))
-
(!def-vm-support-routine generate-return-sequence (style)
(ecase style
(:raw
:offset lra-offset)
:offset 1)))
(:none)))
+
+(defun return-machine-address (scp)
+ (context-register scp lip-offset))
+;;;; the machine-specific support routines needed by the file assembler
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
(in-package "SB!VM")
(!def-vm-support-routine generate-call-sequence (name style vop)
(ecase style
- (:raw
+ ((:raw :none)
(values
`((inst jal (make-fixup ',name :assembly-routine))
(inst nop))
,lra)
(:temporary (:scs (control-stack) :offset nfp-save-offset)
,nfp-save)
- (:save-p t)))))
- (:none
- (values
- `((inst j (make-fixup ',name :assembly-routine))
- (inst nop))
- nil))))
-
+ (:save-p t)))))))
(!def-vm-support-routine generate-return-sequence (style)
(ecase style
:offset lra-offset)
lip-tn :offset 2)))
(:none)))
+
+(defun return-machine-address (scp)
+ (context-register scp lip-offset))
+;;;; the machine-specific support routines needed by the file assembler
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
(in-package "SB!VM")
(!def-vm-support-routine generate-call-sequence (name style vop)
(ecase style
- (:raw
+ ((:raw :none)
(values
`((inst bla (make-fixup ',name :assembly-routine)))
`()))
,lra)
(:temporary (:scs (control-stack) :offset nfp-save-offset)
,nfp-save)
- (:save-p :compute-only)))))
- (:none
- (values
- `((inst ba (make-fixup ',name :assembly-routine)))
- `()))))
+ (:save-p :compute-only)))))))
(!def-vm-support-routine generate-return-sequence (style)
(ecase style
:offset lip-offset)
:offset 2)))
(:none)))
+
+(defun return-machine-address (scp)
+ (sap-int (context-lr scp)))
(!def-vm-support-routine generate-call-sequence (name style vop)
(ecase style
- (:raw
+ ((:raw :none)
(let ((temp (make-symbol "TEMP"))
(lip (make-symbol "LIP")))
(values
,lra)
(:temporary (:scs (control-stack) :offset nfp-save-offset)
,nfp-save)
- (:save-p :compute-only)))))
- (:none
- (let ((temp (make-symbol "TEMP")))
- (values
- `((inst ji ,temp (make-fixup ',name :assembly-routine))
- (inst nop))
- `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1))
- ,temp)))))))
+ (:save-p :compute-only)))))))
(!def-vm-support-routine generate-return-sequence (style)
(ecase style
:offset lra-offset)
:offset 2)))
(:none)))
+
+(defun return-machine-address (scp)
+ (+ (context-register scp lip-offset) 8))
(!def-vm-support-routine generate-call-sequence (name style vop)
(ecase style
- (:raw
+ ((:raw :none)
(values
`((inst call (make-fixup ',name :assembly-routine)))
nil))
(inst call (make-fixup ',name :assembly-routine))
(note-this-location ,vop :single-value-return)
(move esp-tn ebx-tn))
- '((:save-p :compute-only))))
- (:none
- (values
- `((inst jmp (make-fixup ',name :assembly-routine)))
- nil))))
+ '((:save-p :compute-only))))))
(!def-vm-support-routine generate-return-sequence (style)
(ecase style
"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))
- #!+sparc (+ (sb!vm:context-register scp sb!vm::lip-offset) 8)
- #!-(or ppc sparc) (- (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)))
+ (let ((return-machine-address (sb!vm::return-machine-address scp))
+ (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
,@(when (and tagged-type (not arg-swap))
`((define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM")
fast-fixnum-c-binop)
+ (:args (x ,@(unless restore-fixnum-mask `(:target r))
+ :scs (any-reg)))
(:arg-types tagged-num (:constant ,tagged-type))
,@(when restore-fixnum-mask
`((:temporary (:sc non-descriptor-reg) temp)))
;;; 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
+#-(or alpha x86) ; bug 345
(progn
(flet ((test-function ()
(declare (optimize (speed 2) (debug 1))) ; tail call elimination
;;; 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 '/)))
+#-alpha ; bug 346
+(progn
+ (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 '/))))
-(flet ((test-function ()
- (declare (optimize (speed 1) (debug 2))) ; no tail call elimination
- (/ 42 0)))
- (assert (verify-backtrace #'test-function '/)))
+#-(or x86 alpha) ; bug 61
+(defun throw-test ()
+ (throw 'no-such-tag t))
+(assert (verify-backtrace #'throw-test 'throw-test))
;;; 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.16"
+"0.8.13.17"
projects / sbcl.git / commitdiff