From c7aefa5f3135ed481488dd3a6e6890a1a02a978b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 17 Apr 1987 10:55:42 +0000 Subject: [PATCH] *** empty log message *** --- v7/src/compiler/back/lapgn1.scm | 11 ++- v7/src/compiler/base/macros.scm | 36 +++++---- v7/src/compiler/base/pmlook.scm | 78 ++++++++++--------- v7/src/compiler/machines/bobcat/decls.scm | 24 +++--- .../compiler/machines/bobcat/make.scm-68040 | 9 ++- 5 files changed, 91 insertions(+), 67 deletions(-) diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm index 82c6691c6..c1f0a7d7e 100644 --- a/v7/src/compiler/back/lapgn1.scm +++ b/v7/src/compiler/back/lapgn1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.26 1987/03/19 00:50:04 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.27 1987/04/17 10:54:13 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -192,6 +192,15 @@ MIT in each case. |# (set! *register-map* map) (prefix-instructions! instructions) alias) + +(define-integrable (reference-alias-register! register type) + (register-reference (allocate-alias-register! register type))) + +(define-integrable (reference-assignment-alias! register type) + (register-reference (allocate-assignment-alias! register type))) + +(define-integrable (reference-temporary-register! register type) + (register-reference (allocate-temporary-register! register type))) (define (move-to-alias-register! source type target) (reuse-pseudo-register-alias! source type diff --git a/v7/src/compiler/base/macros.scm b/v7/src/compiler/base/macros.scm index 1d6a4aa25..bb89b99a9 100644 --- a/v7/src/compiler/base/macros.scm +++ b/v7/src/compiler/base/macros.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/macros.scm,v 1.56 1987/03/19 00:33:44 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/macros.scm,v 1.57 1987/04/17 10:51:08 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -70,6 +70,9 @@ MIT in each case. |# '())))) (cdr expression))))) +(define enable-integration-declarations + true) + (let () (define (parse-define-syntax pattern body if-variable if-lambda) @@ -117,22 +120,21 @@ MIT in each case. |# (syntax-table-define compiler-syntax-table 'DEFINE-INTEGRABLE (macro (pattern . body) -#| - (parse-define-syntax pattern body - (lambda (name body) - `(BEGIN (DECLARE (INTEGRATE ,pattern)) - (DEFINE ,pattern ,@body))) - (lambda (pattern body) - `(BEGIN (DECLARE (INTEGRATE-OPERATOR ,(car pattern))) - (DEFINE ,pattern - ,@(if (list? (cdr pattern)) - `(DECLARE - (INTEGRATE - ,@(lambda-list->bound-names (cdr pattern)))) - '()) - ,@body)))) -|# - `(DEFINE ,pattern ,@body))) + (if enable-integration-declarations + (parse-define-syntax pattern body + (lambda (name body) + `(BEGIN (DECLARE (INTEGRATE ,pattern)) + (DEFINE ,pattern ,@body))) + (lambda (pattern body) + `(BEGIN (DECLARE (INTEGRATE-OPERATOR ,(car pattern))) + (DEFINE ,pattern + ,@(if (list? (cdr pattern)) + `((DECLARE + (INTEGRATE + ,@(lambda-list->bound-names (cdr pattern))))) + '()) + ,@body)))) + `(DEFINE ,pattern ,@body)))) ) diff --git a/v7/src/compiler/base/pmlook.scm b/v7/src/compiler/base/pmlook.scm index cb178305e..9c879561f 100644 --- a/v7/src/compiler/base/pmlook.scm +++ b/v7/src/compiler/base/pmlook.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/pmlook.scm,v 1.1 1987/04/17 07:59:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/pmlook.scm,v 1.2 1987/04/17 10:51:17 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -36,47 +36,53 @@ MIT in each case. |# (declare (usual-integrations)) -(package (pattern-lookup pattern-variables make-pattern-variable) +(define pattern-lookup) +(define pattern-variables) +(define make-pattern-variable) +(let () ;;; PATTERN-LOOKUP returns either false or a pair whose car is the ;;; item matched and whose cdr is the list of variable values. Use ;;; PATTERN-VARIABLES to get a list of names that is in the same order ;;; as the list of values. -(define (pattern-lookup entries instance) - (define (lookup-loop entries values) - (define (match pattern instance) - (if (pair? pattern) - (if (eq? (car pattern) pattern-variable-tag) - (let ((entry (memq (cdr pattern) values))) - (if entry - (eqv? (cdr entry) instance) - (begin (set! values (cons instance values)) - true))) - (and (pair? instance) - (match (car pattern) (car instance)) - (match (cdr pattern) (cdr instance)))) - (eqv? pattern instance))) - (and (not (null? entries)) - (or (and (match (caar entries) instance) - (apply (cdar entries) values)) - (lookup-loop (cdr entries) '())))) - (lookup-loop entries '())) - -(define (pattern-variables pattern) - (let ((variables '())) - (define (loop pattern) - (if (pair? pattern) - (if (eq? (car pattern) pattern-variable-tag) - (if (not (memq (cdr pattern) variables)) - (set! variables (cons (cdr pattern) variables))) - (begin (loop (car pattern)) - (loop (cdr pattern)))))) - (loop pattern) - variables)) - -(define (make-pattern-variable name) - (cons pattern-variable-tag name)) +(set! pattern-lookup + (named-lambda (pattern-lookup entries instance) + (define (lookup-loop entries values) + (define (match pattern instance) + (if (pair? pattern) + (if (eq? (car pattern) pattern-variable-tag) + (let ((entry (memq (cdr pattern) values))) + (if entry + (eqv? (cdr entry) instance) + (begin (set! values (cons instance values)) + true))) + (and (pair? instance) + (match (car pattern) (car instance)) + (match (cdr pattern) (cdr instance)))) + (eqv? pattern instance))) + (and (not (null? entries)) + (or (and (match (caar entries) instance) + (apply (cdar entries) values)) + (lookup-loop (cdr entries) '())))) + (lookup-loop entries '()))) + +(set! pattern-variables + (named-lambda (pattern-variables pattern) + (let ((variables '())) + (define (loop pattern) + (if (pair? pattern) + (if (eq? (car pattern) pattern-variable-tag) + (if (not (memq (cdr pattern) variables)) + (set! variables (cons (cdr pattern) variables))) + (begin (loop (car pattern)) + (loop (cdr pattern)))))) + (loop pattern) + variables))) + +(set! make-pattern-variable + (named-lambda (make-pattern-variable name) + (cons pattern-variable-tag name))) (define pattern-variable-tag (make-named-tag "Pattern Variable")) diff --git a/v7/src/compiler/machines/bobcat/decls.scm b/v7/src/compiler/machines/bobcat/decls.scm index 6c6e81af2..67b138e4e 100644 --- a/v7/src/compiler/machines/bobcat/decls.scm +++ b/v7/src/compiler/machines/bobcat/decls.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 1.1 1987/03/19 00:44:26 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/decls.scm,v 1.2 1987/04/17 10:50:59 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -41,16 +41,19 @@ MIT in each case. |# (begin (file-dependency/integration/make (car filenames) (cdr filenames)) (file-dependency/integration/chain (cdr filenames))))) -(define (file-dependency/integration/join filenames dependency) +(define (file-dependency/integration/join filenames dependencies) (for-each (lambda (filename) - (file-dependency/integration/make filename dependency)) + (file-dependency/integration/make filename dependencies)) filenames)) -(define (file-dependency/integration/make filename dependency) -#| - (sf/add-file-declarations! filename `((INTEGRATE-EXTERNAL ,@dependency))) -|# - 'DONE) +(define (file-dependency/integration/make filename dependencies) + (if enable-integration-declarations + (sf/add-file-declarations! + filename + `((INTEGRATE-EXTERNAL + ,@(map (lambda (dependency) + (pathname->absolute-pathname (->pathname dependency))) + dependencies)))))) (define (filename/append directory . names) (map (lambda (name) @@ -74,7 +77,8 @@ MIT in each case. |# (append (filename/append "base" "linear") (filename/append "alpha" "dflow" "graphc") (filename/append "front-end" - "ralloc" "rcsesa" "rgcomb" "rlife" "rtlgen") + "ralloc" "rcsesa" "rdeath" "rdebug" "rgcomb" "rlife" + "rtlgen") (filename/append "back-end" "lapgen"))) (file-dependency/integration/chain @@ -93,7 +97,7 @@ MIT in each case. |# (filename/append "alpha" "dflow" "graphc") (filename/append "front-end" "ralloc" "rcse" "rcseep" "rcseht" "rcserq" "rcsesa" - "rcsesr" "rgcomb" "rlife" "rtlgen") + "rcsesr" "rdeath" "rdebug" "rgcomb" "rlife" "rtlgen") (filename/append "back-end" "asmmac" "block" "lapgen" "laptop" "regmap" "symtab") (filename/append "machines/bobcat" "insmac" "machin")) diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index e0cffc2e1..39e5aae54 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.12 1987/03/20 05:29:33 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.13 1987/04/17 10:55:42 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -72,7 +72,8 @@ MIT in each case. |# "base/rtlcfg" ;RTL: CFG types "base/emodel" ;environment model "base/rtypes" ;RTL analyzer datatypes - "base/nmatch" ;simple pattern matcher + "base/pmlook" ;pattern matcher: lookup + "base/pmpars" ;pattern matcher: parser ) (CONVERTER-PACKAGE @@ -100,6 +101,8 @@ MIT in each case. |# (RTL-ANALYZER-PACKAGE "front-end/rlife" ;RTL register lifetime analyzer + "front-end/rdeath" ;RTL dead code eliminations + "front-end/rdebug" ;RTL optimizer debugging output "front-end/ralloc" ;RTL register allocator ) @@ -136,7 +139,7 @@ MIT in each case. |# (define :version) (define :modification) - (parse-rcs-header "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.12 1987/03/20 05:29:33 cph Exp $" + (parse-rcs-header "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.13 1987/04/17 10:55:42 cph Exp $" (lambda (filename version date time author state) (set! :version (car version)) (set! :modification (cadr version)))))) -- 2.25.1