From 11fb3588a4cf36bd8f3b5f2085e39f9d7855a4cb Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 17 Dec 1986 19:32:18 +0000 Subject: [PATCH] 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. --- v7/src/compiler/base/cfg1.scm | 46 +++++++++++++++++---------------- v7/src/compiler/base/ctypes.scm | 19 ++++---------- 2 files changed, 29 insertions(+), 36 deletions(-) diff --git a/v7/src/compiler/base/cfg1.scm b/v7/src/compiler/base/cfg1.scm index cda33fa62..10c5d7c89 100644 --- 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)))) (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 238de8483..49d4b413c 100644 --- 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) -- 2.25.1