Change call-construction pass so that it uses special frame editing

procedures rather than modifying the CFGs and then attempting to write
them back into their frames.  This prevents attempts to relink them
before they have been unlinked from the holding frames.

diff --git a/v7/src/compiler/base/cfg1.scm b/v7/src/compiler/base/cfg1.scm
index cda33fa621c00889d045fbf83d15ed549f6c809b..10c5d7c890f89138047e4b2193ca0c99e69dc107 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.139 1986/12/17 07:56:20 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/cfg1.scm,v 1.140 1986/12/17 19:32:04 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -655,19 +655,20 @@
     (hooks-connect! (scfg-next-hooks scfg) next)
     (make-sframe entry next)))
 
-(define (sframe-replace-cfg! sframe scfg)
-  (let ((entry (frame-&entry sframe))
-       (next (sframe-&next sframe)))
-    (node-disconnect! entry (entry-holder-&next entry))
-    (hooks-disconnect! (node-previous next) next)
-    (entry-holder-connect! entry (cfg-entry-node scfg))
-    (hooks-connect! (scfg-next-hooks scfg) next)))
-
 (define (sframe->scfg sframe)
   (let ((entry (frame-entry-node sframe)))
     (if entry
        (make-scfg entry (sframe-next-hooks sframe))
        (make-null-cfg))))
+
+(define (sframe-edit! sframe procedure)
+  (let ((entry (frame-&entry sframe))
+       (next (sframe-&next sframe)))
+    (let ((scfg
+          (procedure (entry-holder-disconnect! entry)
+                     (node-previous-disconnect! next))))
+      (entry-holder-connect! entry (cfg-entry-node scfg))
+      (hooks-connect! (scfg-next-hooks scfg) next))))
 \f
 (define pframe-tag (make-vector-tag frame-tag 'PFRAME))
 (define-vector-slots pframe 2 &consequent &alternative)
@@ -696,25 +697,26 @@
     (hooks-connect! (pcfg-alternative-hooks pcfg) alternative)
     (make-pframe entry consequent alternative)))
 
-(define (pframe-replace-cfg! pframe pcfg)
-  (let ((entry (frame-&entry pframe))
-       (consequent (pframe-&consequent pframe))
-       (alternative (pframe-&alternative pframe)))
-    (node-disconnect! entry (entry-holder-&next entry))
-    (hooks-disconnect! (node-previous consequent) consequent)
-    (hooks-disconnect! (node-previous alternative) alternative)
-    (entry-holder-connect! entry (cfg-entry-node pcfg))
-    (hooks-connect! (pcfg-consequent-hooks pcfg) consequent)
-    (hooks-connect! (pcfg-alternative-hooks pcfg) alternative)))
-
-(define (pframe->scfg pframe)
+(define (pframe->pcfg pframe)
   (let ((entry (frame-entry-node pframe)))
     (if entry
-       (make-scfg entry
+       (make-pcfg entry
                   (pframe-consequent-hooks pframe)
                   (pframe-alternative-hooks pframe))
        (make-null-cfg))))
 
+(define (pframe-edit! pframe procedure)
+  (let ((entry (frame-&entry pframe))
+       (consequent (pframe-&consequent pframe))
+       (alternative (pframe-&alternative pframe)))
+    (let ((pcfg
+          (procedure (entry-holder-disconnect! entry)
+                     (node-previous-disconnect! consequent)
+                     (node-previous-disconnect! alternative))))
+      (entry-holder-connect! entry (cfg-entry-node pcfg))
+      (hooks-connect! (pcfg-consequent-hooks pcfg) consequent)
+      (hooks-connect! (pcfg-alternative-hooks pcfg) alternative))))
+
 ;;; end USING-SYNTAX
 )
 

diff --git a/v7/src/compiler/base/ctypes.scm b/v7/src/compiler/base/ctypes.scm
index 238de848344b631d075f7f31ca671d114161495a..49d4b413ce3e2c4819c439ecf19e655c36b6b978 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.34 1986/12/16 23:47:07 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/ctypes.scm,v 1.35 1986/12/17 19:32:18 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
@@ -94,7 +94,7 @@
                             (cons combination (vnode-combinations value)))
     (snode->scfg combination)))
 
-(define-snode continuation block &entry delta generator &rtl label)
+(define-snode continuation block entry delta generator rtl-frame label)
 (define *continuations*)
 
 (define-integrable (make-continuation block entry delta generator)
@@ -104,20 +104,11 @@
     (set! *continuations* (cons continuation *continuations*))
     continuation))
 
-(define-integrable (continuation-entry continuation)
-  (entry-holder-next (continuation-&entry continuation)))
-
-(define-integrable (set-continuation-entry! continuation entry)
-  (set-entry-holder-next! (continuation-&entry continuation) entry))
-
 (define-integrable (continuation-rtl continuation)
-  (sframe->scfg (continuation-&rtl continuation)))
+  (sframe->scfg (continuation-rtl-frame continuation)))
 
-(define (set-continuation-rtl! continuation rtl)
-  (let ((sframe (continuation-&rtl continuation)))
-    (if sframe
-       (sframe-replace-cfg! sframe rtl)
-       (set-continuation-&rtl! continuation (scfg->sframe rtl)))))
+(define-integrable (set-continuation-rtl! continuation rtl)
+  (set-continuation-rtl-frame! continuation (scfg->sframe rtl)))
 
 (define-unparser continuation-tag
   (lambda (continuation)