From 3b90774a1ea68bf42579594c872de16fb33f1454 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Thu, 11 Jan 2007 19:46:40 +0000 Subject: [PATCH] 1.0.1.18: Fix bug introduced in 1.0.1.7, where bogus debug variables generated for closure variables whose value cell had not yet been allocated could cause segfaults and gc crashes (reported by Cyrus Harmon and Attila Lendvai on sbcl-devel) --- src/compiler/debug-dump.lisp | 26 +++++++++++++++++++------- version.lisp-expr | 2 +- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 6c3d34701..a2288b8d8 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -323,6 +323,16 @@ (make-sc-offset (sc-number (tn-sc tn)) (tn-offset tn))) +(defun lambda-ancestor-p (maybe-ancestor maybe-descendant) + (declare (type clambda maybe-ancestor) + (type (or clambda null) maybe-descendant)) + (loop + (when (eq maybe-ancestor maybe-descendant) + (return t)) + (setf maybe-descendant (lambda-parent maybe-descendant)) + (when (null maybe-descendant) + (return nil)))) + ;;; Dump info to represent VAR's location being TN. ID is an integer ;;; that makes VAR's name unique in the function. BUFFER is the vector ;;; we stick the result in. If MINIMAL, we suppress name dumping, and @@ -332,8 +342,9 @@ ;;; environment live and is an argument. If a :DEBUG-ENVIRONMENT TN, ;;; then we also exclude set variables, since the variable is not ;;; guaranteed to be live everywhere in that case. -(defun dump-1-var (var tn id minimal buffer) - (declare (type lambda-var var) (type (or tn null) tn) (type index id)) +(defun dump-1-var (fun var tn id minimal buffer) + (declare (type lambda-var var) (type (or tn null) tn) (type index id) + (type clambda fun)) (let* ((name (leaf-debug-name var)) (save-tn (and tn (tn-save-tn tn))) (kind (and tn (tn-kind tn))) @@ -347,7 +358,8 @@ (and (eq kind :debug-environment) (null (basic-var-sets var)))) (not (gethash tn (ir2-component-spilled-tns - (component-info *component-being-compiled*))))) + (component-info *component-being-compiled*)))) + (lambda-ancestor-p (lambda-var-home var) fun)) (setq flags (logior flags compiled-debug-var-environment-live))) (when save-tn (setq flags (logior flags compiled-debug-var-save-loc-p))) @@ -407,9 +419,9 @@ (incf id)) (t (setq id 0 prev-name name))) - (dump-1-var var (cdr x) id nil buffer) - (setf (gethash var var-locs) i)) - (incf i)) + (dump-1-var fun var (cdr x) id nil buffer) + (setf (gethash var var-locs) i) + (incf i))) (coerce buffer 'simple-vector)))) ;;; Return a vector suitable for use as the DEBUG-FUN-VARS of @@ -418,7 +430,7 @@ (declare (type clambda fun)) (let ((buffer (make-array 0 :fill-pointer 0 :adjustable t))) (dolist (var (lambda-vars fun)) - (dump-1-var var (leaf-info var) 0 t buffer)) + (dump-1-var fun var (leaf-info var) 0 t buffer)) (coerce buffer 'simple-vector))) ;;; Return VAR's relative position in the function's variables (determined diff --git a/version.lisp-expr b/version.lisp-expr index ca3111cbe..9eb8468fc 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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".) -"1.0.1.17" +"1.0.1.18" -- 2.11.4.GIT