*** empty log message ***

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index be691477adf4231ab72684e4bf12f70605c2bc87..4cf30089d7948e24541756c4275b47427239c58b 100644 (file)
--- a/v7/src/compiler/back/lapgn1.scm
+++ b/v7/src/compiler/back/lapgn1.scm
@@ -37,7 +37,7 @@
 
 ;;;; LAP Code Generation
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.21 1986/12/20 23:48:34 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.22 1986/12/21 14:52:04 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -57,19 +57,19 @@
                 (*code-object-label*)
                 (*code-object-entry*))
        (for-each (lambda (quotation)
-                  (cgen-cfg quotation quotation-rtl))
+                  (cgen-cfg quotation quotation-rtl-entry))
                 quotations)
        (for-each (lambda (procedure)
-                  (cgen-cfg procedure procedure-rtl))
+                  (cgen-cfg procedure procedure-rtl-entry))
                 procedures)
        (for-each (lambda (continuation)
-                  (cgen-cfg continuation continuation-rtl))
+                  (cgen-cfg continuation continuation-rtl-entry))
                 continuations)
        (receiver *interned-constants* *block-start-label*)))))
 
-(define (cgen-cfg object extract-cfg)
+(define (cgen-cfg object extract-entry)
   (set! *code-object-label* (code-object-label-initialize object))
-  (let ((rnode (cfg-entry-node (extract-cfg object))))
+  (let ((rnode (extract-entry object)))
     (set! *code-object-entry* rnode)
     (cgen-rnode rnode)))
 

diff --git a/v7/src/compiler/base/cfg1.scm b/v7/src/compiler/base/cfg1.scm
index 7210a51c5e172ace293a2ddf4c930571f2a647f4..efbdadf7e666bc4f91120714d962ff031c0272a1 100644 (file)
--- a/v7/src/compiler/base/cfg1.scm
+++ b/v7/src/compiler/base/cfg1.scm
@@ -37,7 +37,7 @@
 
 ;;;; Control Flow Graph Abstraction
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/cfg1.scm,v 1.144 1986/12/20 23:48:20 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/cfg1.scm,v 1.145 1986/12/21 14:51:38 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -161,13 +161,13 @@
   (let ((next (edge-right-node edge)))
     (edge-disconnect-right! edge)
     (edge-connect-right! edge snode)
-    (create-edge! snode set-snode-next! next)))
+    (create-edge! snode set-snode-next-edge! next)))
 
 (define (node-insert-snode! node snode)
   (let ((previous-edges (node-previous-edges node)))
     (edges-disconnect-right! previous-edges)
     (edges-connect-right! previous-edges snode)
-    (create-edge! snode set-snode-next! node)))
+    (create-edge! snode set-snode-next-edge! node)))
 \f
 ;;;; Previous Connections
 
@@ -240,12 +240,12 @@
   (let ((node (make-noop-node)))
     (make-pcfg node
               '()
-              (list (make-hook node set-snode-next!)))))
+              (list (make-hook node set-snode-next-edge!)))))
 
 (define (make-true-pcfg)
   (let ((node (make-noop-node)))
     (make-pcfg node
-              (list (make-hook node set-snode-next!))
+              (list (make-hook node set-snode-next-edge!))
               '())))
 \f
 ;;;; Miscellaneous
@@ -380,6 +380,11 @@
 \f
 ;;;; CFG Construction
 
+(define (cfg-entry-edge cfg)
+  (let ((edge (make-edge false false false)))
+    (edge-connect-right! edge (cfg-entry-node cfg))
+    edge))
+
 (define-integrable (scfg-next-connect! scfg cfg)
   (hooks-connect! (scfg-next-hooks scfg) (cfg-entry-node cfg)))
 

diff --git a/v7/src/compiler/base/ctypes.scm b/v7/src/compiler/base/ctypes.scm
index 91e1245450f457c5cedaafa013f0b6169fba302e..096d38d92ae725c237af5c93c7149daa5b531d48 100644 (file)
--- a/v7/src/compiler/base/ctypes.scm
+++ b/v7/src/compiler/base/ctypes.scm
@@ -37,7 +37,7 @@
 
 ;;;; Compiler CFG Datatypes
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/ctypes.scm,v 1.37 1986/12/20 22:51:33 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/ctypes.scm,v 1.38 1986/12/21 14:51:50 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -68,7 +68,7 @@
 
 (define-integrable (make-unbound-test block variable)
   (pnode->pcfg (make-pnode unbound-test-tag block variable)))
-
+\f
 (define-snode combination block compilation-type value operator operands
   procedures known-operator)
 (define *combinations*)
@@ -84,16 +84,19 @@
                             (cons combination (vnode-combinations value)))
     (snode->scfg combination)))
 
-(define-snode continuation rtl delta label)
+(define-snode continuation rtl-edge delta label)
 (define *continuations*)
 
 (define-integrable (make-continuation rtl delta)
   (let ((continuation
-        (make-snode continuation-tag rtl delta
+        (make-snode continuation-tag (cfg-entry-edge rtl) delta
                     (generate-label 'CONTINUATION))))
     (set! *continuations* (cons continuation *continuations*))
     continuation))
 
+(define-integrable (continuation-rtl-entry continuation)
+  (edge-right-node (continuation-rtl-edge continuation)))
+
 (define-unparser continuation-tag
   (lambda (continuation)
     (write (continuation-label continuation))))

diff --git a/v7/src/compiler/base/macros.scm b/v7/src/compiler/base/macros.scm
index 7c38ac8eacd03c1e465eaf441e6e42776587b59e..19c74be02a672e5f7e58b81a90168cadb6b2de35 100644 (file)
--- a/v7/src/compiler/base/macros.scm
+++ b/v7/src/compiler/base/macros.scm
@@ -37,7 +37,7 @@
 
 ;;;; Compiler Macros
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/macros.scm,v 1.53 1986/12/20 22:52:39 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/macros.scm,v 1.54 1986/12/21 14:52:26 cph Exp $
 
 (declare (usual-integrations))
 \f
@@ -84,11 +84,11 @@
                 ((symbol? (car pattern))
                  (if-lambda pattern body))
                 (else
-                 (error "Illegal name" parse-lambda-syntax (car pattern))))))
+                 (error "Illegal name" parse-define-syntax (car pattern))))))
        ((symbol? pattern)
         (if-variable pattern body))
        (else
-        (error "Illegal name" parse-lambda-syntax pattern))))
+        (error "Illegal name" parse-define-syntax pattern))))
 
 (define lambda-list->bound-names
   (let ((accumulate

diff --git a/v7/src/compiler/base/utils.scm b/v7/src/compiler/base/utils.scm
index 6c89193a7f3068d329e9fa7ac82e5b4ead45e35c..82ef2b239a0be95f968e9e71557eba90c840316b 100644 (file)
--- a/v7/src/compiler/base/utils.scm
+++ b/v7/src/compiler/base/utils.scm
@@ -37,7 +37,7 @@
 
 ;;;; Compiler Utilities
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 1.77 1986/12/20 22:54:13 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 1.78 1986/12/21 14:52:59 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -337,6 +337,7 @@
   (define-scode-operator in-package-components)
   (define-scode-operator lambda-components)
   (define-scode-operator lambda?)
+  (define-scode-operator make-access)
   (define-scode-operator make-combination)
   (define-scode-operator make-conditional)
   (define-scode-operator make-definition)

diff --git a/v7/src/compiler/rtlgen/rtlgen.scm b/v7/src/compiler/rtlgen/rtlgen.scm
index e4c6575c4915751deb2b752f93c1602a5ee00a80..b9d9c8b839c815151916f31380aa38b2af892a11 100644 (file)
--- a/v7/src/compiler/rtlgen/rtlgen.scm
+++ b/v7/src/compiler/rtlgen/rtlgen.scm
@@ -37,7 +37,7 @@
 
 ;;;; RTL Generation
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rtlgen.scm,v 1.1 1986/12/20 22:53:46 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rtlgen.scm,v 1.2 1986/12/21 14:52:34 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -79,7 +79,7 @@
 
 (define (generate:quotation quotation)
   (set-quotation-rtl! quotation
-                     (generate:cfg (quotation-cfg quotation) 0)))
+                     (generate:cfg (quotation-fg-entry quotation) 0)))
 
 (define (generate:procedure procedure)
   (set-procedure-rtl!
@@ -89,7 +89,7 @@
          ((stack-procedure? procedure) generate:stack-procedure)
          (else (error "Unknown procedure type" procedure)))
     procedure
-    (generate:cfg (procedure-cfg procedure) 0))))
+    (generate:cfg (procedure-fg-entry procedure) 0))))
 \f
 (define (generate:closure-procedure procedure cfg)
   (scfg-append! (if (or (not (null? (procedure-optional procedure)))