From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Tue, 21 Aug 1990 02:24:33 +0000 (+0000)
Subject: Add next-continuation-offset field to rtl-procedures so that internal
X-Git-Tag: 20090517-FFI~11234
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=784757d82676004efefdc9cf8f7c9ea242a673c2;p=mit-scheme.git

Add next-continuation-offset field to rtl-procedures so that internal
procedures can be represented as return addresses for the debugger.
---

diff --git a/v7/src/compiler/rtlbase/rtlobj.scm b/v7/src/compiler/rtlbase/rtlobj.scm
index 2f539588a..3f2fa8c94 100644
--- a/v7/src/compiler/rtlbase/rtlobj.scm
+++ b/v7/src/compiler/rtlbase/rtlobj.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlobj.scm,v 4.8 1989/11/30 16:02:28 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlobj.scm,v 4.9 1990/08/21 02:24:08 jinx Rel $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -58,7 +58,8 @@ MIT in each case. |#
 				(rgraph label entry-edge name n-required
 					n-optional rest? closure?
 					dynamic-link? type
-					debugging-info))
+					debugging-info
+					next-continuation-offset))
 		   (print-procedure
 		    (standard-unparser (symbol->string 'RTL-PROCEDURE)
 		      (lambda (state procedure)
@@ -75,7 +76,9 @@ MIT in each case. |#
   (dynamic-link? false read-only true)
   (type false read-only true)
   (%external-label false)
-  (debugging-info false read-only true))
+  (debugging-info false read-only true)
+  (next-continuation-offset false read-only true))
+
 (define-integrable (rtl-procedure/entry-node procedure)
   (edge-right-node (rtl-procedure/entry-edge procedure)))
 
diff --git a/v7/src/compiler/rtlgen/rtlgen.scm b/v7/src/compiler/rtlgen/rtlgen.scm
index 490afe140..ab60bab63 100644
--- a/v7/src/compiler/rtlgen/rtlgen.scm
+++ b/v7/src/compiler/rtlgen/rtlgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rtlgen.scm,v 4.22 1989/11/30 16:03:27 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rtlgen.scm,v 4.23 1990/08/21 02:24:33 jinx Rel $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -124,7 +124,8 @@ MIT in each case. |#
 	      (stack-block/dynamic-link? block)
 	      true))
        (procedure/type procedure)
-       (procedure-debugging-info procedure)))))
+       (procedure-debugging-info procedure)
+       (block/next-continuation-offset (procedure-block procedure) 0)))))
 
 (define (generate/procedure-entry/inline procedure)
   (generate/procedure-header procedure
@@ -165,7 +166,7 @@ MIT in each case. |#
 	 rgraph
 	 label
 	 entry-edge
-	 (continuation/next-continuation-offset
+	 (block/next-continuation-offset
 	  (continuation/closing-block continuation)
 	  (continuation/offset continuation))
 	 (continuation/debugging-info continuation))))))
@@ -203,14 +204,14 @@ MIT in each case. |#
 		   *current-rgraph*
 		   label
 		   (cfg-entry-edge cleanup)
-		   (continuation/next-continuation-offset
+		   (block/next-continuation-offset
 		    closing-block
 		    (reference-context/offset context))
 		   (generated-dbg-continuation context label))
 		  *extra-continuations*))
       (values label setup cleanup))))
 
-(define (continuation/next-continuation-offset block offset)
+(define (block/next-continuation-offset block offset)
   (if (stack-block? block)
       (let ((popping-limit (block-popping-limit block)))
 	(and popping-limit
@@ -225,7 +226,8 @@ MIT in each case. |#
 			(continuation-block? stack-link)
 			(continuation/always-known-operator?
 			 (block-procedure stack-link)))
-		   (continuation/next-continuation-offset		    (block-parent stack-link)
+		   (block/next-continuation-offset
+		    (block-parent stack-link)
 		    offset)
 		   offset))))
       offset))