From 7646587e7090612a619df86b6595d045a9ce5c17 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 25 Jan 1990 16:46:40 +0000 Subject: [PATCH] Initial revision --- v7/src/compiler/machines/spectrum/rulrew.scm | 215 +++++++++++++++++++ 1 file changed, 215 insertions(+) create mode 100644 v7/src/compiler/machines/spectrum/rulrew.scm diff --git a/v7/src/compiler/machines/spectrum/rulrew.scm b/v7/src/compiler/machines/spectrum/rulrew.scm new file mode 100644 index 000000000..c0af7cd37 --- /dev/null +++ b/v7/src/compiler/machines/spectrum/rulrew.scm @@ -0,0 +1,215 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/rulrew.scm,v 1.1 1990/01/25 16:46:40 jinx Exp $ +$MC68020-Header: rulrew.scm,v 1.1 90/01/18 22:48:52 GMT cph Exp $ + +Copyright (c) 1990 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. |# + +;;;; RTL Rewrite Rules + +(declare (usual-integrations)) + +;;;; Synthesized Data + +(define-rule rewriting + (CONS-POINTER (REGISTER (? type register-known-value)) + (REGISTER (? datum register-known-value))) + (QUALIFIER (and (rtl:machine-constant? type) + (rtl:machine-constant? datum))) + (rtl:make-cons-pointer type datum)) + +;; I've copied these rules from the MC68020. -- Jinx. + +(define-rule rewriting + (CONS-POINTER (REGISTER (? type register-known-value)) (? datum)) + (QUALIFIER + (and (rtl:object->type? type) + (rtl:constant? (rtl:object->type-expression type)))) + (rtl:make-cons-pointer + (rtl:make-machine-constant + (object-type (rtl:object->type-expression datum))) + datum)) + +(define-rule rewriting + (CONS-POINTER (? type) (REGISTER (? datum register-known-value))) + (QUALIFIER + (and (rtl:object->datum? datum) + (rtl:constant-non-pointer? (rtl:object->datum-expression datum)))) + (rtl:make-cons-pointer + type + (rtl:make-machine-constant + (careful-object-datum (rtl:object->datum-expression datum))))) + +(define-rule rewriting + (OBJECT->TYPE (REGISTER (? source register-known-value))) + (QUALIFIER (rtl:constant? source)) + (rtl:make-machine-constant (object-type source))) + +(define-rule rewriting + (OBJECT->DATUM (REGISTER (? source register-known-value))) + (QUALIFIER (rtl:constant-non-pointer? source)) + (rtl:make-machine-constant (careful-object-datum source))) + +(define (rtl:constant-non-pointer? expression) + (and (rtl:constant? expression) + (non-pointer-object? (rtl:constant-value expression)))) + +;; I've modified these rules from the MC68020. -- Jinx + +;;; These rules are losers because there's no abstract way to cons a +;;; statement or a predicate without also getting some CFG structure. + +(define-rule rewriting + ;; Use register 0, always 0. + (ASSIGN (? target) (REGISTER (? comparand register-known-value))) + (QUALIFIER (rtl:immediate-zero-constant? comparand)) + (list 'ASSIGN target (rtl:make-machine-constant 0))) + +(define-rule rewriting + ;; Compare to register 0, always 0. + (EQ-TEST (? source) (REGISTER (? comparand register-known-value))) + (QUALIFIER (rtl:immediate-zero-constant? comparand)) + (list 'EQ-TEST source (rtl:make-machine-constant 0))) + +(define-rule rewriting + ;; Compare to register 0, always 0. + (EQ-TEST (REGISTER (? comparand register-known-value)) (? source)) + (QUALIFIER (rtl:immediate-zero-constant? comparand)) + (list 'EQ-TEST source (rtl:make-machine-constant 0))) + +(define (rtl:immediate-zero-constant? expression) + (cond ((rtl:constant? expression) + (let ((value (rtl:constant-value expression))) + (and (non-pointer-object? value) + (zero? (object-type value)) + (zero? (careful-object-datum value))))) + ((rtl:cons-pointer? expression) + (and (let ((expression (rtl:cons-pointer-type expression))) + (and (rtl:machine-constant? expression) + (zero? (rtl:machine-constant-value expression)))) + (let ((expression (rtl:cons-pointer-datum expression))) + (and (rtl:machine-constant? expression) + (zero? (rtl:machine-constant-value expression)))))) + (else false))) + +;;;; Fixnums + +;; I've copied this rule from the MC68020. -- Jinx +;; It should probably be qualified to be in the immediate range. + +(define-rule rewriting + (OBJECT->FIXNUM (REGISTER (? source register-known-value))) + (QUALIFIER (rtl:constant-fixnum? source)) + (rtl:make-object->fixnum source)) + +(define-rule rewriting + (FIXNUM-2-ARGS MULTIPLY-FIXNUM + (REGISTER (? operand-1 register-known-value)) + (? operand-2) + #F) + (QUALIFIER (rtl:constant-fixnum-4? operand-1)) + (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 #F)) + +(define-rule rewriting + (FIXNUM-2-ARGS MULTIPLY-FIXNUM + (? operand-1) + (REGISTER (? operand-2 register-known-value)) + #F) + (QUALIFIER (rtl:constant-fixnum-4? operand-2)) + (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 #F)) + +(define-rule rewriting + (FIXNUM-2-ARGS MULTIPLY-FIXNUM + (REGISTER (? operand-1 register-known-value)) + (? operand-2) + #F) + (QUALIFIER + (and (rtl:object->fixnum-of-register? operand-1) + (rtl:constant-fixnum-4? operand-2))) + (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 #F)) + +(define-rule rewriting + (FIXNUM-2-ARGS MULTIPLY-FIXNUM + (? operand-1) + (REGISTER (? operand-2 register-known-value)) + #F) + (QUALIFIER + (and (rtl:constant-fixnum-4? operand-1) + (rtl:object->fixnum-of-register? operand-2))) + (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 #F)) + +(define (rtl:constant-fixnum? expression) + (and (rtl:constant? expression) + (fix:fixnum? (rtl:constant-value expression)))) + +(define (rtl:constant-fixnum-4? expression) + (and (rtl:object->fixnum? expression) + (let ((expression (rtl:object->fixnum-expression expression))) + (and (rtl:constant? expression) + (eqv? 4 (rtl:constant-value expression)))))) + +(define (rtl:object->fixnum-of-register? expression) + (and (rtl:object->fixnum? expression) + (rtl:register? (rtl:object->fixnum-expression expression)))) + +;;;; Closures and othe optimizations. + +;; These rules are Spectrum specific + +(define-rule rewriting + (CONS-POINTER (REGISTER (? type register-known-value)) + (REGISTER (? datum register-known-value))) + (QUALIFIER (and (rtl:machine-constant? type) + (= (rtl:machine-constant-value type) + (ucode-type compiled-entry)) + (or (rtl:entry:continuation? datum) + (rtl:entry:procedure? datum) + (rtl:cons-closure? datum)))) + (rtl:make-cons-pointer type datum)) + +#| +;; Not yet written. + +;; A type is compatible when a depi instruction can put it in assuming that +;; the datum has the quad bits set. +;; A register is a machine-address-register if it is a machine register and +;; always contains an address (ie. free pointer, stack pointer, or dlink register) + +(define-rule rewriting + (CONS-POINTER (REGISTER (? type register-known-value)) + (REGISTER (? datum machine-address-register))) + (QUALIFIER (and (rtl:machine-constant? type) + (spectrum-type-optimizable? (rtl:machine-constant-value type)))) + (rtl:make-cons-pointer type datum)) +|# + + + \ No newline at end of file -- 2.25.1