From ed18d662d473336285e2594ad21239afe1bca105 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Fri, 17 May 2013 15:25:50 -0400 Subject: [PATCH] Recover full backtraces with generic arithmetic on x86 and x86-64 * Errors in generic arithmetic (or comparisons) used to hide the caller in the backtrace: it was replaced with a frame in the anonymous assembly stub. * Regression since 1.0.24.35, fixes lp#800343. * Also remove a misleading FIXME in typed-accessor-definitions (reported by Matt Novenstern in lp#1171646). --- NEWS | 2 ++ src/assembly/x86-64/arith.lisp | 9 +++++++++ src/assembly/x86/arith.lisp | 9 +++++++++ src/code/defstruct.lisp | 4 ---- tests/debug.impure.lisp | 38 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 58 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 1cb0834..884f06e 100644 --- a/NEWS +++ b/NEWS @@ -35,6 +35,8 @@ changes relative to sbcl-1.1.7: * bug fix: some LOOP statements couldn't be compiled. (lp#1178989) * bug fix: sb-sequence:dosequence works on literal vectors. + * bug fix: errors in generic arithmetic show the assembly routine's + caller on x86 and x86-64. (lp#800343) * optimization: faster ISQRT on fixnums and small bignums * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64. * optimization: On x86-64, the number of multi-byte NOP instructions used diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp index 684d16e..c816bdf 100644 --- a/src/assembly/x86-64/arith.lisp +++ b/src/assembly/x86-64/arith.lisp @@ -176,6 +176,8 @@ (inst ret) DO-STATIC-FUN + (inst push rbp-tn) + (inst mov rbp-tn rsp-tn) (inst sub rsp-tn (* n-word-bytes 3)) (inst mov (make-ea :qword :base rsp-tn :disp (frame-byte-offset @@ -198,6 +200,7 @@ (:l `((inst mov y (1+ nil-value)) (inst cmp y x))) (:g `((inst cmp x (1+ nil-value))))) + (inst pop rbp-tn) (inst ret)) #-sb-assembling `(define-vop (,name) @@ -246,6 +249,8 @@ (inst ret) DO-STATIC-FUN + (inst push rbp-tn) + (inst mov rbp-tn rsp-tn) (inst sub rsp-tn (* n-word-bytes 3)) (inst mov (make-ea :qword :base rsp-tn :disp (frame-byte-offset @@ -263,6 +268,7 @@ :disp (+ nil-value (static-fun-offset 'eql)))) (load-symbol y t) (inst cmp x y) + (inst pop rbp-tn) (inst ret)) #-sb-assembling @@ -308,6 +314,8 @@ (inst ret) DO-STATIC-FUN + (inst push rbp-tn) + (inst mov rbp-tn rsp-tn) (inst sub rsp-tn (* n-word-bytes 3)) (inst mov (make-ea :qword :base rsp-tn :disp (frame-byte-offset @@ -326,6 +334,7 @@ :disp (+ nil-value (static-fun-offset 'two-arg-=)))) (load-symbol y t) (inst cmp x y) + (inst pop rbp-tn) (inst ret)) #-sb-assembling diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp index 53ba95e..52b3efc 100644 --- a/src/assembly/x86/arith.lisp +++ b/src/assembly/x86/arith.lisp @@ -170,6 +170,8 @@ (inst ret) DO-STATIC-FUN + (inst push ebp-tn) + (inst mov ebp-tn esp-tn) (inst sub esp-tn (fixnumize 3)) (inst mov (make-ea :dword :base esp-tn :disp (frame-byte-offset @@ -192,6 +194,7 @@ (:l `((inst mov y (1+ nil-value)) (inst cmp y x))) (:g `((inst cmp x (1+ nil-value))))) + (inst pop ebp-tn) (inst ret)) #-sb-assembling `(define-vop (,name) @@ -239,6 +242,8 @@ (inst cmp x y) (inst jmp :e RET) + (inst push ebp-tn) + (inst mov ebp-tn esp-tn) (inst sub esp-tn (fixnumize 3)) (inst mov (make-ea :dword :base esp-tn :disp (frame-byte-offset @@ -256,6 +261,7 @@ :disp (+ nil-value (static-fun-offset 'eql)))) (load-symbol y t) (inst cmp x y) + (inst pop ebp-tn) (inst ret)) #-sb-assembling @@ -296,6 +302,8 @@ (inst ret) DO-STATIC-FUN + (inst push ebp-tn) + (inst mov ebp-tn esp-tn) (inst sub esp-tn (fixnumize 3)) (inst mov (make-ea :dword :base esp-tn :disp (frame-byte-offset @@ -313,6 +321,7 @@ :disp (+ nil-value (static-fun-offset 'two-arg-=)))) (load-symbol y t) (inst cmp x y) + (inst pop ebp-tn) (inst ret)) #-sb-assembling diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 9ff1cb9..a2ee93a 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -527,10 +527,6 @@ ((not inherited) (stuff `(declaim (inline ,name ,@(unless (dsd-read-only slot) `((setf ,name)))))) - ;; FIXME: The arguments in the next two DEFUNs should - ;; be gensyms. (Otherwise e.g. if NEW-VALUE happened to - ;; be the name of a special variable, things could get - ;; weird.) (stuff `(defun ,name (structure) (declare (type ,ltype structure)) (the ,slot-type (elt structure ,index)))) diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index cfa16d6..1804a08 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -273,6 +273,44 @@ '(((flet bar :in bug-308926) 13) (bug-308926 &rest t))))) +;;; Test backtrace through assembly routines +;;; :bug-800343 +(macrolet ((test (predicate fun + &optional (two-arg + (find-symbol (format nil "TWO-ARG-~A" fun) + "SB-KERNEL"))) + (let ((test-name (make-symbol (format nil "TEST-~A" fun)))) + `(flet ((,test-name (x y) + ;; make sure it's not in tail position + (list (,fun x y)))) + (with-test (:name (:bug-800343 ,fun)) + (assert (verify-backtrace + (lambda () + (eval `(funcall ,#',test-name 42 t))) + '((,two-arg 42 t) + #+(or x86 x86-64) + ,@(and predicate + '(("no debug information for frame"))) + ((flet ,test-name :in ,*p*) 42 t)))))))) + (test-predicates (&rest functions) + `(progn ,@(mapcar (lambda (function) + (if (consp function) + `(test t ,@function) + `(test t ,function))) + functions))) + (test-functions (&rest functions) + `(progn ,@(mapcar (lambda (function) + (if (consp function) + `(test nil ,@function) + `(test nil ,function))) + functions)))) + (test-predicates = < >) + (test-functions + - * / + gcd lcm + (logand sb-kernel:two-arg-and) + (logior sb-kernel:two-arg-ior) + (logxor sb-kernel:two-arg-xor))) + ;;; test entry point handling in backtraces (defun oops () -- 1.7.10.4