From eeb17c8af2c84254af44cb8998324f9dc239e2e9 Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Wed, 2 Feb 1994 01:49:03 +0000
Subject: [PATCH] Separate target-block field from initial-callees field in
 procedure objects.

The target-block field is useful in the debugging information, to be
able to walk the procedure chain when debugging.
---
 v7/src/compiler/base/infnew.scm | 14 ++++++++------
 v7/src/compiler/base/make.scm   |  4 ++--
 v7/src/compiler/base/proced.scm | 32 ++++++++++++++++++++++++--------
 3 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/v7/src/compiler/base/infnew.scm b/v7/src/compiler/base/infnew.scm
index 2b4583d31..1d60285eb 100644
--- a/v7/src/compiler/base/infnew.scm
+++ b/v7/src/compiler/base/infnew.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: infnew.scm,v 4.10 1993/10/12 07:27:38 cph Exp $
+$Id: infnew.scm,v 4.11 1994/02/02 01:48:39 gjr Exp $
 
-Copyright (c) 1988-93 Massachusetts Institute of Technology
+Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -130,10 +130,12 @@ MIT in each case. |#
 			   dbg-block-name/static-link)))
       (make-dbg-block 'STACK
 		      (block->dbg-block parent)
-		      (and (procedure/closure? procedure)
-			   (block->dbg-block
-			    (reference-context/block
-			     (procedure-closure-context procedure))))
+		      (if (procedure/closure? procedure)
+			  (block->dbg-block
+			   (reference-context/block
+			    (procedure-closure-context procedure)))
+			  (block->dbg-block
+			   (procedure-target-block procedure)))
 		      layout
 		      (block->dbg-block (block-stack-link block))))))
 
diff --git a/v7/src/compiler/base/make.scm b/v7/src/compiler/base/make.scm
index b1e282a79..51c2b7ba4 100644
--- a/v7/src/compiler/base/make.scm
+++ b/v7/src/compiler/base/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 4.104 1994/01/08 21:06:59 gjr Exp $
+$Id: make.scm,v 4.105 1994/02/02 01:49:03 gjr Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -54,5 +54,5 @@ MIT in each case. |#
     (initialize-package! '(COMPILER DECLARATIONS)))
   (add-system!
    (make-system (string-append "Liar (" architecture-name ")")
-		4 102
+		4 103
 		'())))
\ No newline at end of file
diff --git a/v7/src/compiler/base/proced.scm b/v7/src/compiler/base/proced.scm
index eb039454a..16613e97c 100644
--- a/v7/src/compiler/base/proced.scm
+++ b/v7/src/compiler/base/proced.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.17 1990/11/19 22:50:26 cph Rel $
+$Id: proced.scm,v 4.18 1994/02/02 01:48:25 gjr Exp $
 
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -58,8 +58,8 @@ MIT in each case. |#
   closure-offset	;for closure, offset of procedure in stack frame
   register		;for continuation, argument register
   closure-size		;for closure, virtual size of frame [integer or false]
-  (target-block		;where procedure is "really" closed [block]
-   initial-callees)	;procs. invoked by me directly
+  target-block		;where procedure is "really" closed [block]
+  initial-callees	;procs. invoked by me directly
   (free-callees		;procs. invoked by means of free variables (1)
    callees)		;procs. invoked by me (transitively)
   (free-callers		;procs. that invoke me by means of free variables (1)
@@ -71,7 +71,7 @@ MIT in each case. |#
   alist			;random bits of information [assq list]
   debugging-info	;[dbg-procedure or dbg-continuation]
   )
-
+
 ;; (1) The first meaning is used during closure analysis.
 ;;     The second meaning is used during side-effect analysis.
 
@@ -88,9 +88,25 @@ MIT in each case. |#
 		      (list-copy optional)
 		      (if (eq? type continuation-type/procedure)
 			  rest
-			  '())		;initial continuation/combinations
-		      (generate-label name) false false false false false
-		      false false false false false false '() '() '() false)))
+			  '())
+		      (generate-label name)	; label
+		      false			; applications
+		      false			; always-known-operator?
+		      false			; closure-cons
+		      false			; closure-context
+		      false			; closure-offset
+		      false			; register
+		      false			; closure-size
+		      false			; target-block
+		      false			; initial-callees
+		      false			; free-callees/callees
+		      false			; free-callers/callers
+		      false			; virtual-closure?
+		      '()			; closure-reasons
+		      '()			; variables/side-effects
+		      '()			; alist
+		      false			; debugging-info
+		      )))
     (set! *procedures* (cons procedure *procedures*))
     (set-block-procedure! block procedure)
     procedure))
-- 
2.25.1