Add hooks for debugging info.

diff --git a/v7/src/compiler/base/blocks.scm b/v7/src/compiler/base/blocks.scm
index a6c9452228f13a038662c8096e585a2f3773788b..e6c961bd34dbd65fc5136245a9fd101d49e9f261 100644 (file)
--- a/v7/src/compiler/base/blocks.scm
+++ b/v7/src/compiler/base/blocks.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/blocks.scm,v 4.8 1988/12/15 17:17:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/blocks.scm,v 4.9 1988/12/16 13:35:15 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -83,7 +83,7 @@ from the continuation, and then "glued" into place afterwards.
   applications         ;list of applications lexically within this block
   interned-variables   ;alist of interned SCode variable objects
   closure-offsets      ;for closure block, alist of bound variable offsets
-  frame                        ;debugging information (???)
+  debugging-info       ;dbg-block, if used
   stack-link           ;for stack block, adjacent block on stack
   popping-limits       ;for stack block (see continuation analysis)
   popping-limit                ;for stack block (see continuation analysis)

diff --git a/v7/src/compiler/base/contin.scm b/v7/src/compiler/base/contin.scm
index 333494b88e70747c962988ffdc1608eb6e63ef3b..e42791b811d7ccbef25439dbba8fadc8beab5953 100644 (file)
--- a/v7/src/compiler/base/contin.scm
+++ b/v7/src/compiler/base/contin.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/contin.scm,v 4.6 1988/12/12 21:51:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/contin.scm,v 4.7 1988/12/16 13:36:57 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -74,6 +74,9 @@ MIT in each case. |#
 (define-integrable set-continuation/offset! set-procedure-closure-offset!)
 (define-integrable continuation/passed-out? procedure-passed-out?)
 (define-integrable set-continuation/passed-out?! set-procedure-passed-out?!)
+(define-integrable continuation/debugging-info procedure-debugging-info)
+(define-integrable set-continuation/debugging-info!
+  set-procedure-debugging-info!)
 
 (define (continuation/register continuation)
   (or (procedure-register continuation)

diff --git a/v7/src/compiler/base/proced.scm b/v7/src/compiler/base/proced.scm
index af0223dcbd469b9c77e6e016fb80b597fcea48de..ac00ce15ecbacee3bf41d4d2c08ea0937133d073 100644 (file)
--- a/v7/src/compiler/base/proced.scm
+++ b/v7/src/compiler/base/proced.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.9 1988/12/15 17:19:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.10 1988/12/16 13:35:34 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -68,6 +68,7 @@ MIT in each case. |#
   (variables           ;variables which may be bound to this procedure (1)
    side-effects)       ;classes of side-effects performed by this procedure
   properties           ;random bits of information [assq list]
+  debugging-info       ;[dbg-procedure or dbg-continuation]
   )
 
 ;; (1) The first meaning is used during closure analysis.
@@ -84,7 +85,7 @@ MIT in each case. |#
                      (node->edge (cfg-entry-node scfg))
                      (list-copy required) (list-copy optional) rest
                      (generate-label name) false false false false false
-                     false false false false false false '() '() false)))
+                     false false false false false false '() '() '() false)))
     (set! *procedures* (cons procedure *procedures*))
     (set-block-procedure! block procedure)
     procedure))

diff --git a/v7/src/compiler/base/rvalue.scm b/v7/src/compiler/base/rvalue.scm
index bfde4334dda9ffc0ee1a44bc8f5d5581d89a4138..a1ca4088a33345e4fe58e6b9a8d5851a73569423 100644 (file)
--- a/v7/src/compiler/base/rvalue.scm
+++ b/v7/src/compiler/base/rvalue.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/rvalue.scm,v 4.4 1988/12/12 21:51:30 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/rvalue.scm,v 4.5 1988/12/16 13:36:35 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -169,7 +169,8 @@ MIT in each case. |#
   block
   continuation
   entry-edge
-  label)
+  label
+  debugging-info)
 
 (define *expressions*)
 
@@ -177,7 +178,7 @@ MIT in each case. |#
   (let ((expression
         (make-rvalue expression-tag block continuation
                      (node->edge (cfg-entry-node scfg))
-                     (generate-label 'EXPRESSION))))
+                     (generate-label 'EXPRESSION) false)))
     (set! *expressions* (cons expression *expressions*))
     (set-block-procedure! block expression)
     expression))

diff --git a/v7/src/compiler/rtlbase/rtlobj.scm b/v7/src/compiler/rtlbase/rtlobj.scm
index efdd0cdf7ea796eff8a3174c863be3ae744f8469..ef7c76d3deff4f9ddec9f3549b6b85908890b46d 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.3 1988/06/14 08:37:16 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlobj.scm,v 4.4 1988/12/16 13:36:19 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -38,30 +38,26 @@ MIT in each case. |#
 \f
 (define-structure (rtl-expr
                   (conc-name rtl-expr/)
-                  (constructor make-rtl-expr (rgraph label entry-edge))
+                  (constructor make-rtl-expr
+                               (rgraph label entry-edge debugging-info))
                   (print-procedure
                    (standard-unparser "RTL-EXPR"
                      (lambda (state expression)
                        (unparse-object state (rtl-expr/label expression))))))
   (rgraph false read-only true)
   (label false read-only true)
-  (entry-edge false read-only true))
-
-(set-type-object-description!
- rtl-expr
- (lambda (expression)
-   `((RTL-EXPR/RGRAPH ,(rtl-expr/rgraph expression))
-     (RTL-EXPR/LABEL ,(rtl-expr/label expression))
-     (RTL-EXPR/ENTRY-EDGE ,(rtl-expr/entry-edge expression)))))
+  (entry-edge false read-only true)
+  (debugging-info false read-only true))
 
 (define-integrable (rtl-expr/entry-node expression)
   (edge-right-node (rtl-expr/entry-edge expression)))
-\f
+
 (define-structure (rtl-procedure
                   (conc-name rtl-procedure/)
                   (constructor make-rtl-procedure
                                (rgraph label entry-edge name n-required
-                                       n-optional rest? closure? type))
+                                       n-optional rest? closure? type
+                                       debugging-info))
                   (print-procedure
                    (standard-unparser "RTL-PROCEDURE"
                      (lambda (state procedure)
@@ -76,23 +72,8 @@ MIT in each case. |#
   (rest? false read-only true)
   (closure? false read-only true)
   (type false read-only true)
-  (%external-label false))
-
-(set-type-object-description!
- rtl-procedure
- (lambda (procedure)
-   `((RTL-PROCEDURE/RGRAPH ,(rtl-procedure/rgraph procedure))
-     (RTL-PROCEDURE/LABEL ,(rtl-procedure/label procedure))
-     (RTL-PROCEDURE/ENTRY-EDGE ,(rtl-procedure/entry-edge procedure))
-     (RTL-PROCEDURE/NAME ,(rtl-procedure/name procedure))
-     (RTL-PROCEDURE/N-REQUIRED ,(rtl-procedure/n-required procedure))
-     (RTL-PROCEDURE/N-OPTIONAL ,(rtl-procedure/n-optional procedure))
-     (RTL-PROCEDURE/REST? ,(rtl-procedure/rest? procedure))
-     (RTL-PROCEDURE/CLOSURE? ,(rtl-procedure/closure? procedure))
-     (RTL-PROCEDURE/TYPE ,(rtl-procedure/type procedure))
-     (RTL-PROCEDURE/%EXTERNAL-LABEL
-      ,(rtl-procedure/%external-label procedure)))))
-
+  (%external-label false)
+  (debugging-info false read-only true))
 (define-integrable (rtl-procedure/entry-node procedure)
   (edge-right-node (rtl-procedure/entry-edge procedure)))
 
@@ -101,11 +82,11 @@ MIT in each case. |#
       (let ((label (generate-label (rtl-procedure/name procedure))))
        (set-rtl-procedure/%external-label! procedure label)
        label)))
-\f
+
 (define-structure (rtl-continuation
                   (conc-name rtl-continuation/)
                   (constructor make-rtl-continuation
-                               (rgraph label entry-edge))
+                               (rgraph label entry-edge debugging-info))
                   (print-procedure
                    (standard-unparser "RTL-CONTINUATION"                     (lambda (state continuation)
                        (unparse-object
@@ -113,15 +94,8 @@ MIT in each case. |#
                         (rtl-continuation/label continuation))))))
   (rgraph false read-only true)
   (label false read-only true)
-  (entry-edge false read-only true))
-
-(set-type-object-description!
- rtl-continuation
- (lambda (continuation)
-   `((RTL-CONTINUATION/RGRAPH ,(rtl-continuation/rgraph continuation))
-     (RTL-CONTINUATION/LABEL ,(rtl-continuation/label continuation))
-     (RTL-CONTINUATION/ENTRY-EDGE
-      ,(rtl-continuation/entry-edge continuation)))))
+  (entry-edge false read-only true)
+  (debugging-info false read-only true))
 
 (define-integrable (rtl-continuation/entry-node continuation)
   (edge-right-node (rtl-continuation/entry-edge continuation)))

diff --git a/v7/src/compiler/rtlgen/rtlgen.scm b/v7/src/compiler/rtlgen/rtlgen.scm
index f347240b60333af819a4a6c30242fcf4e0a95426..c2d9e2072137c17b9c30e14c84529ed4e5534d1c 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.13 1988/12/15 17:26:09 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rtlgen.scm,v 4.14 1988/12/16 13:37:12 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -82,20 +82,22 @@ MIT in each case. |#
              (cons continuation *queued-continuations*)))))
 \f
 (define (generate/expression expression)
-  (transmit-values
-      (generate/rgraph (expression-entry-node expression) generate/node)
+  (with-values
+      (lambda ()
+       (generate/rgraph (expression-entry-node expression) generate/node))
     (lambda (rgraph entry-edge)
-      (make-rtl-expr rgraph (expression-label expression) entry-edge))))
+      (make-rtl-expr rgraph
+                    (expression-label expression)
+                    entry-edge
+                    (expression-debugging-info expression)))))
 
 (define (generate/procedure procedure)
-  (transmit-values
-      (generate/rgraph
-       (procedure-entry-node procedure)
-       (lambda (node)
-        (generate/procedure-header
-         procedure
-         (generate/node node)
-         false)))
+  (with-values
+      (lambda ()
+       (generate/rgraph
+        (procedure-entry-node procedure)
+        (lambda (node)
+          (generate/procedure-header procedure (generate/node node) false))))
     (lambda (rgraph entry-edge)
       (make-rtl-procedure
        rgraph
@@ -106,7 +108,8 @@ MIT in each case. |#
        (length (procedure-original-optional procedure))
        (and (procedure-original-rest procedure) true)
        (and (procedure/closure? procedure) true)
-       (procedure/type procedure)))))
+       (procedure/type procedure)
+       (procedure-debugging-info procedure)))))
 
 (define (generate/procedure-entry/inline procedure)
   (generate/procedure-header procedure
@@ -129,34 +132,38 @@ MIT in each case. |#
 
 (define (generate/continuation continuation)
   (let ((label (continuation/label continuation)))
-    (transmit-values
-       (generate/rgraph
-        (continuation/entry-node continuation)
-        (lambda (node)
-          (scfg-append!
-           (if (continuation/avoid-check? continuation)
-               (rtl:make-continuation-entry label)
-               (rtl:make-continuation-header label))
-           (generate/continuation-entry/pop-extra continuation)
-           (enumeration-case continuation-type
-               (continuation/type continuation)
-             ((PUSH)
-              (rtl:make-push (rtl:make-fetch register:value)))
-             ((REGISTER)
-              (rtl:make-assignment (continuation/register continuation)
-                                   (rtl:make-fetch register:value)))
-             ((VALUE PREDICATE)
-              (if (continuation/ever-known-operator? continuation)
-                  (rtl:make-assignment (continuation/register continuation)
-                                       (rtl:make-fetch register:value))
-                  (make-null-cfg)))
-             ((EFFECT)
-              (make-null-cfg))
-             (else
-              (error "Illegal continuation type" continuation)))
-           (generate/node node))))
+    (with-values
+       (lambda ()
+         (generate/rgraph
+          (continuation/entry-node continuation)
+          (lambda (node)
+            (scfg-append!
+             (if (continuation/avoid-check? continuation)
+                 (rtl:make-continuation-entry label)
+                 (rtl:make-continuation-header label))
+             (generate/continuation-entry/pop-extra continuation)
+             (enumeration-case continuation-type
+                 (continuation/type continuation)
+               ((PUSH)
+                (rtl:make-push (rtl:make-fetch register:value)))
+               ((REGISTER)
+                (rtl:make-assignment (continuation/register continuation)
+                                     (rtl:make-fetch register:value)))
+               ((VALUE PREDICATE)
+                (if (continuation/ever-known-operator? continuation)
+                    (rtl:make-assignment (continuation/register continuation)
+                                         (rtl:make-fetch register:value))
+                    (make-null-cfg)))
+               ((EFFECT)
+                (make-null-cfg))
+               (else
+                (error "Illegal continuation type" continuation)))
+             (generate/node node)))))
       (lambda (rgraph entry-edge)
-       (make-rtl-continuation rgraph label entry-edge)))))
+       (make-rtl-continuation rgraph
+                              label
+                              entry-edge
+                              (continuation/debugging-info continuation))))))
 
 (define (generate/continuation-entry/pop-extra continuation)
   (let ((block (continuation/closing-block continuation)))
@@ -222,7 +229,7 @@ MIT in each case. |#
             (fluid-let ((*current-rgraph* rgraph))
               (with-new-node-marks (lambda () (generator node))))))))
       (add-rgraph-entry-edge! rgraph entry-edge)
-      (return-2 rgraph entry-edge))))
+      (values rgraph entry-edge))))
 
 (define (node->rgraph node)
   (let ((color