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 2f539588a6a541b6527436ae051f7794421a1952..3f2fa8c94ab05f56ec1a36e8c7131ac8cd761911 100644 (file)
--- 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 490afe140908c76afc3dcd7740438f6532506a5a..ab60bab634b0d2809aa8736e4d5d2be28a28f277 100644 (file)
--- 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))