From 3916abf4d64c96edef8ccbff023698025c1ee961 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 21 Dec 1986 14:52:59 +0000 Subject: [PATCH] *** empty log message *** --- v7/src/compiler/back/lapgn1.scm | 12 ++++++------ v7/src/compiler/base/cfg1.scm | 15 ++++++++++----- v7/src/compiler/base/ctypes.scm | 11 +++++++---- v7/src/compiler/base/macros.scm | 6 +++--- v7/src/compiler/base/utils.scm | 3 ++- v7/src/compiler/rtlgen/rtlgen.scm | 6 +++--- 6 files changed, 31 insertions(+), 22 deletions(-) diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm index be691477a..4cf30089d 100644 --- 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 7210a51c5..efbdadf7e 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.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))) ;;;; 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!)) '()))) ;;;; Miscellaneous @@ -380,6 +380,11 @@ ;;;; 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 91e124545..096d38d92 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.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))) - + (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 7c38ac8ea..19c74be02 100644 --- 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)) @@ -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 6c89193a7..82ef2b239 100644 --- 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 e4c6575c4..b9d9c8b83 100644 --- 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)))) (define (generate:closure-procedure procedure cfg) (scfg-append! (if (or (not (null? (procedure-optional procedure))) -- 2.25.1