From ae92588569e6cad92152eeb27c005dc41b839491 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Fri, 15 Feb 1991 00:40:13 +0000 Subject: [PATCH] Initial revision --- v7/src/compiler/machines/vax/rulrew.scm | 194 ++++++++++++++++++++++++ 1 file changed, 194 insertions(+) create mode 100644 v7/src/compiler/machines/vax/rulrew.scm diff --git a/v7/src/compiler/machines/vax/rulrew.scm b/v7/src/compiler/machines/vax/rulrew.scm new file mode 100644 index 000000000..bb4650579 --- /dev/null +++ b/v7/src/compiler/machines/vax/rulrew.scm @@ -0,0 +1,194 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rulrew.scm,v 1.1 1991/02/15 00:40:13 jinx Exp $ +$MC68020-Header: rulrew.scm,v 1.3 90/05/03 15:17:42 GMT jinx Exp $ + +Copyright (c) 1990, 1991 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 +;;; package: (compiler lap-syntaxer) + +(declare (usual-integrations)) + +;;;; Synthesized Data + +(define-rule rewriting + (CONS-POINTER (REGISTER (? type register-known-value)) (? datum)) + (QUALIFIER (rtl:machine-constant? type)) + (rtl:make-cons-pointer type datum)) + +(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:constant-value (rtl:object->type-expression datum)))) + datum)) + +(define-rule rewriting + (CONS-POINTER (? type) (REGISTER (? datum register-known-value))) + (QUALIFIER (rtl:machine-constant? datum)) + (rtl:make-cons-pointer type 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:constant-value (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 (rtl:constant-value source)))) + +(define-rule rewriting + (OBJECT->DATUM (REGISTER (? source register-known-value))) + (QUALIFIER (rtl:constant-non-pointer? source)) + (rtl:make-machine-constant + (careful-object-datum (rtl:constant-value source)))) + +(define (rtl:constant-non-pointer? expression) + (and (rtl:constant? expression) + (non-pointer-object? (rtl:constant-value expression)))) + +;;; These rules are losers because there's no abstract way to cons a +;;; statement or a predicate without also getting some CFG structure. + +;;; Shouldn't these rules use (rtl:make-machine-constant 0) +;;; rather than comparand? Of course, there would have to +;;; be more translation rules, but... -- Jinx + +(define-rule rewriting + ;; CLR instruction + (ASSIGN (? target) (REGISTER (? comparand register-known-value))) + (QUALIFIER (rtl:immediate-zero-constant? comparand)) + (list 'ASSIGN target comparand)) + +(define-rule rewriting + ;; TST instruction + (EQ-TEST (? source) (REGISTER (? comparand register-known-value))) + (QUALIFIER (rtl:immediate-zero-constant? comparand)) + (list 'EQ-TEST source comparand)) + +(define-rule rewriting + ;; TSTL instruction + (EQ-TEST (REGISTER (? comparand register-known-value)) (? source)) + (QUALIFIER (rtl:immediate-zero-constant? comparand)) + (list 'EQ-TEST source comparand)) + +(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 + +(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) + (? overflow?)) + (QUALIFIER + (rtl:constant-fixnum-test operand-1 + (lambda (n) + (or (zero? n) + (integer-power-of-2? n))))) + (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 overflow?)) + +(define-rule rewriting + (FIXNUM-2-ARGS MULTIPLY-FIXNUM + (? operand-1) + (REGISTER (? operand-2 register-known-value)) + (? overflow?)) + (QUALIFIER + (rtl:constant-fixnum-test operand-2 + (lambda (n) + (or (zero? n) + (= -1 n) + (integer-power-of-2? n))))) + (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 overflow?)) + +(define-rule rewriting + (FIXNUM-2-ARGS (? operator) + (? operand-1) + (REGISTER (? operand-2 register-known-value)) + (? overflow?)) + (QUALIFIER + (and (memq operator '(PLUS-FIXNUM MINUS-FIXNUM)) + (rtl:constant-fixnum-test operand-2 zero?))) + (rtl:make-fixnum-2-args operator operand-1 operand-2 overflow?)) + +(define-rule rewriting + (FIXNUM-2-ARGS (? operator) + (? operand-1) + (REGISTER (? operand-2 register-known-value)) + (? overflow?)) + (QUALIFIER + (and (memq operator '(FIXNUM-QUOTIENT FIXNUM-REMAINDER)) + (rtl:constant-fixnum-test operand-2 + (lambda (n) + (or (= -1 n) + (integer-power-of-2? n)))))) + (rtl:make-fixnum-2-args operator operand-1 operand-2 overflow?)) + +(define (rtl:constant-fixnum? expression) + (and (rtl:constant? expression) + (fix:fixnum? (rtl:constant-value expression)))) + +(define (rtl:constant-fixnum-test expression predicate) + (and (rtl:object->fixnum? expression) + (let ((expression (rtl:object->fixnum-expression expression))) + (and (rtl:constant? expression) + (let ((n (rtl:constant-value expression))) + (and (fix:fixnum? n) + (predicate n))))))) \ No newline at end of file -- 2.25.1