From 3b6789fdc1292dcb76149b0e8251606edbdbc133 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 17 Jun 1987 02:16:09 +0000 Subject: [PATCH] Initial revision --- v7/src/compiler/base/lvalue.scm | 75 +++++++++++++++ v7/src/compiler/base/rvalue.scm | 161 ++++++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+) create mode 100644 v7/src/compiler/base/lvalue.scm create mode 100644 v7/src/compiler/base/rvalue.scm diff --git a/v7/src/compiler/base/lvalue.scm b/v7/src/compiler/base/lvalue.scm new file mode 100644 index 000000000..572e8e12d --- /dev/null +++ b/v7/src/compiler/base/lvalue.scm @@ -0,0 +1,75 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/lvalue.scm,v 1.1 1987/06/17 02:16:09 cph Exp $ + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. |# + +;;;; Compiler DFG Datatypes: Variable Nodes + +(declare (usual-integrations)) + +(define-vnode variable block name assigned? in-cell? normal-offset) + +(define (make-variable block name) + (make-vnode variable-tag block name false false false)) + +(define variable-assoc + (association-procedure eq? variable-name)) + +(define (variable-offset block variable) + (if (closure-block? block) + (cdr (assq variable (block-closure-offsets block))) + (variable-normal-offset variable))) + +(define-unparser variable-tag + (lambda (variable) + (write-string "VARIABLE ") + (write (variable-name variable)))) + +(define-vnode access environment name) + +(define (make-access environment name) + (make-vnode access-tag environment name)) + +(define-vnode temporary type conflicts allocation) + +(define (make-temporary) + (make-vnode temporary-tag false '() false)) + +(define-vnode value-register) + +(define (make-value-register) + (make-vnode value-register-tag)) + +(define-vnode value-ignore) + +(define (make-value-ignore) + (make-vnode value-ignore-tag)) \ No newline at end of file diff --git a/v7/src/compiler/base/rvalue.scm b/v7/src/compiler/base/rvalue.scm new file mode 100644 index 000000000..d38e7da59 --- /dev/null +++ b/v7/src/compiler/base/rvalue.scm @@ -0,0 +1,161 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/rvalue.scm,v 1.1 1987/06/17 02:15:51 cph Exp $ + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. |# + +;;;; Compiler DFG Datatypes: Right (Hand Side) Values + +(declare (usual-integrations)) + +(define-rvalue constant value) +(define *constants*) + +(define (make-constant value) + (let ((entry (assv value *constants*))) + (if entry + (cdr entry) + (let ((constant (make-rvalue constant-tag value))) + (set! *constants* (cons (cons value constant) *constants*)) + constant)))) + +(define-unparser constant-tag + (lambda (constant) + (write-string "CONSTANT ") + (write (constant-value constant)))) + +(define-rvalue block parent children bound-variables free-variables procedure + declarations type closures combinations interned-variables closure-offsets) +(define *blocks*) + +(define (make-block parent) + (let ((block + (make-rvalue block-tag parent '() '() '() false + '() 'STACK '() '() '() '()))) + (if parent + (set-block-children! parent (cons block (block-children parent)))) + (set! *blocks* (cons block *blocks*)) + block)) + +(define-unparser block-tag + (lambda (block) + (write-string "BLOCK") + (let ((procedure (block-procedure block))) + (if procedure + (begin (write-string " ") + (write (procedure-label procedure))))))) + +(define-rvalue reference block variable safe?) + +(define (make-reference block variable) + (make-rvalue reference-tag block variable false)) + +(define (make-safe-reference block variable) + (make-rvalue reference-tag block variable true)) + +(define-unparser reference-tag + (lambda (reference) + (write-string "REFERENCE ") + (write (variable-name (reference-variable reference))))) + +(define-rvalue procedure block value fg-edge rtl-edge externally-visible? + closure-block label external-label name required optional rest + names values auxiliary original-parameters) +(define *procedures*) + +(define (make-procedure block subproblem name required optional rest + names values auxiliary) + (let ((procedure + (make-rvalue procedure-tag block (subproblem-value subproblem) + (cfg-entry-edge (subproblem-cfg subproblem)) false false + false (generate-label (variable-name name)) + (generate-label) name required optional rest + names values auxiliary + (vector required optional rest)))) + (set-block-procedure! block procedure) + (vnode-connect! name procedure) + (set! *procedures* (cons procedure *procedures*)) + (symbol-hash-table/insert! *label->object* + (procedure-label procedure) + procedure) + procedure)) + +(define-integrable (procedure-fg-entry procedure) + (edge-right-node (procedure-fg-edge procedure))) + +(define-integrable (unset-procedure-fg-entry! procedure) + (set-procedure-fg-edge! procedure false)) + +(define-integrable (procedure-rtl-entry procedure) + (edge-right-node (procedure-rtl-edge procedure))) + +(define-integrable (set-procedure-rtl-entry! procedure node) + (set-procedure-rtl-edge! procedure (node->edge node))) + +(define-integrable (procedure-original-required procedure) + (vector-ref (procedure-original-parameters procedure) 0)) + +(define-integrable (procedure-original-optional procedure) + (vector-ref (procedure-original-parameters procedure) 1)) + +(define-integrable (procedure-original-rest procedure) + (vector-ref (procedure-original-parameters procedure) 2)) + +(define-unparser procedure-tag + (lambda (procedure) + (write-string "PROCEDURE ") + (write (procedure-label procedure)))) + +(define-integrable (label->procedure label) + (symbol-hash-table/lookup *label->object* label)) + +(define-rvalue quotation block value fg-edge rtl-edge label) +(define *quotations*) + +(define (make-quotation block subproblem) + (let ((quotation + (make-rvalue quotation-tag block (subproblem-value subproblem) + (cfg-entry-edge (subproblem-cfg subproblem)) + false (generate-label 'QUOTATION)))) + (set! *quotations* (cons quotation *quotations*)) + quotation)) + +(define-integrable (quotation-fg-entry quotation) + (edge-right-node (quotation-fg-edge quotation))) + +(define-integrable (unset-quotation-fg-entry! quotation) + (set-quotation-fg-edge! quotation false)) + +(define-integrable (quotation-rtl-entry quotation) + (edge-right-node (quotation-rtl-edge quotation))) + +(define-integrable (set-quotation-rtl-entry! quotation node) + (set-quotation-rtl-edge! quotation (node->edge node))) \ No newline at end of file -- 2.25.1