To present a list with the actual number of passed arguments in the
backtrace, clean-xep used the arg-count register and added missing
arguments in the form of #<unknown>, but if the register is
overwritten by other code, it could cons very large lists, exhausting
heap. Do such arg-list clean up only upon INVALID-ARG-COUNT-ERROR.
Fixes lp#1192929.
or double float precision on x87.
* bug fix: Known-safe vector access on x86oids should not fail spuriously
when the index is of the form (+ x constant-positive-integer).
or double float precision on x87.
* bug fix: Known-safe vector access on x86oids should not fail spuriously
when the index is of the form (+ x constant-positive-integer).
- * bug fix: Remove GPL-licensed files from source distribution. (lp#1185668)
+ * bug fix: Remove GPL-licensed files from source distribution. (lp#1185668)
+ * bug fix: backtrace printer no longer tries to create very large lists when
+ the arg-count register is clobberred by other code. (lp#1192929)
changes in sbcl-1.1.8 relative to sbcl-1.1.7:
* notice: The implementation of MAP-ALLOCATED-OBJECTS (the heart of
changes in sbcl-1.1.8 relative to sbcl-1.1.7:
* notice: The implementation of MAP-ALLOCATED-OBJECTS (the heart of
(sb!di:lambda-list-unavailable ()
(make-unprintable-object "unavailable lambda list"))))
(sb!di:lambda-list-unavailable ()
(make-unprintable-object "unavailable lambda list"))))
-(defun clean-xep (name args info)
+(defun interrupted-frame-error (frame)
+ (when (and (sb!di::compiled-frame-p frame)
+ (sb!di::compiled-frame-escaped frame))
+ (let ((error-number (sb!vm:internal-error-args
+ (sb!di::compiled-frame-escaped frame))))
+ (when (array-in-bounds-p sb!c:*backend-internal-errors* error-number)
+ (car (svref sb!c:*backend-internal-errors* error-number))))))
+
+(defun clean-xep (frame name args info)
(values (second name)
(if (consp args)
(let* ((count (first args))
(real-args (rest args)))
(values (second name)
(if (consp args)
(let* ((count (first args))
(real-args (rest args)))
+ (if (and (integerp count)
+ (eq (interrupted-frame-error frame)
+ 'invalid-arg-count-error))
;; So, this is a cheap trick -- but makes backtraces for
;; too-many-arguments-errors much, much easier to to
;; understand. FIXME: For :EXTERNAL frames at least we
;; So, this is a cheap trick -- but makes backtraces for
;; too-many-arguments-errors much, much easier to to
;; understand. FIXME: For :EXTERNAL frames at least we
(values name args)))
(values cname cargs (cons :fast-method info))))
(values name args)))
(values cname cargs (cons :fast-method info))))
-(defun clean-frame-call (name args method-frame-style info)
- (if (consp name)
- (case (first name)
- ((sb!c::xep sb!c::tl-xep)
- (clean-xep name args info))
- ((sb!c::&more-processor)
- (clean-&more-processor name args info))
- ((sb!c::&optional-processor)
- (clean-frame-call (second name) args method-frame-style
- info))
- ((sb!pcl::fast-method)
- (clean-fast-method name args method-frame-style info))
- (t
- (values name args info)))
- (values name args info)))
+(defun clean-frame-call (frame name method-frame-style info)
+ (let ((args (frame-args-as-list frame)))
+ (if (consp name)
+ (case (first name)
+ ((sb!c::xep sb!c::tl-xep)
+ (clean-xep frame name args info))
+ ((sb!c::&more-processor)
+ (clean-&more-processor name args info))
+ ((sb!c::&optional-processor)
+ (clean-frame-call frame (second name) method-frame-style
+ info))
+ ((sb!pcl::fast-method)
+ (clean-fast-method name args method-frame-style info))
+ (t
+ (values name args info)))
+ (values name args info))))
(defun frame-call (frame &key (method-frame-style *method-frame-style*)
replace-dynamic-extent-objects)
(defun frame-call (frame &key (method-frame-style *method-frame-style*)
replace-dynamic-extent-objects)
(let* ((debug-fun (sb!di:frame-debug-fun frame))
(kind (sb!di:debug-fun-kind debug-fun)))
(multiple-value-bind (name args info)
(let* ((debug-fun (sb!di:frame-debug-fun frame))
(kind (sb!di:debug-fun-kind debug-fun)))
(multiple-value-bind (name args info)
- (clean-frame-call (sb!di:debug-fun-name debug-fun)
- (frame-args-as-list frame)
+ (clean-frame-call frame
+ (sb!di:debug-fun-name debug-fun)
method-frame-style
(when kind (list kind)))
(let ((args (if (and (consp args) replace-dynamic-extent-objects)
method-frame-style
(when kind (list kind)))
(let ((args (if (and (consp args) replace-dynamic-extent-objects)
(assert (verify-backtrace (lambda () (gf-dispatch-test/f 42))
'(((sb-pcl::gf-dispatch gf-dispatch-test/gf) 42)))))
(assert (verify-backtrace (lambda () (gf-dispatch-test/f 42))
'(((sb-pcl::gf-dispatch gf-dispatch-test/gf) 42)))))
+(with-test (:name (:xep-arglist-clean-up :bug-1192929))
+ (assert
+ (block nil
+ (handler-bind ((error (lambda (e)
+ (declare (ignore e))
+ (return (< (length (car (sb-debug:backtrace-as-list 1))) 10)))))
+ (funcall (compile nil `(lambda (i) (declare ((mod 65536) i)) i)) nil)))))
+
(write-line "/debug.impure.lisp done")
(write-line "/debug.impure.lisp done")