From f74a7020035d7d4c52c02735f8cdd5522b95f5c8 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Fri, 9 Feb 1990 12:55:40 +0000
Subject: [PATCH] Changed ASSIGN-LAMBDA-VAR-TNS to make environment-live TNs
 for non-let variables unless (= SPEED 3).  This ensures that argument values
 are available for backtrace, etc.

---
 compiler/gtn.lisp | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/compiler/gtn.lisp b/compiler/gtn.lisp
index 30d00409d..042435a0c 100644
--- a/compiler/gtn.lisp
+++ b/compiler/gtn.lisp
@@ -30,9 +30,9 @@
   (setf (component-info component) (make-ir2-component))
   (let ((funs (component-lambdas component)))
     (dolist (fun funs)
-      (assign-lambda-var-tns fun)
+      (assign-lambda-var-tns fun nil)
       (dolist (let (lambda-lets fun))
-	(assign-lambda-var-tns let)))
+	(assign-lambda-var-tns let t)))
     (dolist (fun funs)
       (assign-ir2-environment fun)
       (assign-return-locations fun)
@@ -44,15 +44,22 @@
 ;;;
 ;;;    We have to allocate the home TNs for variables before we can call
 ;;; Assign-IR2-Environment so that we can close over TNs that haven't had their
-;;; home environment assigned yet.
+;;; home environment assigned yet.  Let-P indicates whether this variable is
+;;; for a let or a "real argument".  In the latter case, we allocate the TNs
+;;; environment-live unless SPEED is 3 so that the values are always available
+;;; in the debugger.
 ;;;
-(defun assign-lambda-var-tns (fun)
+(defun assign-lambda-var-tns (fun let-p)
   (declare (type clambda fun))
   (dolist (var (lambda-vars fun))
     (when (leaf-refs var)
-      (let ((res (make-normal-tn (if (lambda-var-indirect var)
-				     *any-primitive-type*
-				     (primitive-type (leaf-type var))))))
+      (let* ((type (if (lambda-var-indirect var)
+		       *any-primitive-type*
+		       (primitive-type (leaf-type var))))
+	     (res (if (or let-p
+			  (policy (lambda-bind fun) (= speed 3)))
+		      (make-normal-tn type)
+		      (make-environment-tn type))))
 	(setf (tn-leaf res) var)
 	(setf (leaf-info var) res))))
   (undefined-value))
-- 
GitLab