From: Guillermo J. Rozas Date: Tue, 20 Jul 1993 00:52:26 +0000 (+0000) Subject: Update to match new RTL syntax, and add floating-point vector support. X-Git-Tag: 20090517-FFI~8186 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e78edfa09977b7ffe1c1b8489163d4f50786d47a;p=mit-scheme.git Update to match new RTL syntax, and add floating-point vector support. --- diff --git a/v7/src/compiler/machines/mips/machin.scm b/v7/src/compiler/machines/mips/machin.scm index e2cc150c9..d51326cd7 100644 --- a/v7/src/compiler/machines/mips/machin.scm +++ b/v7/src/compiler/machines/mips/machin.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: machin.scm,v 1.12 1993/06/29 22:25:51 gjr Exp $ +$Id: machin.scm,v 1.13 1993/07/20 00:52:23 gjr Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -289,12 +289,15 @@ MIT in each case. |# (= (rtl:register-number expression) regnum:dynamic-link))) (define-integrable (interpreter-environment-register) - (rtl:make-offset (interpreter-regs-pointer) 3)) + (rtl:make-offset (interpreter-regs-pointer) + (rtl:make-machine-constant 3))) (define (interpreter-environment-register? expression) (and (rtl:offset? expression) (interpreter-regs-pointer? (rtl:offset-base expression)) - (= 3 (rtl:offset-number expression)))) + (let ((offset (rtl:offset-offset expression))) + (rtl:machine-constant? offset) + (= 3 (rtl:machine-constant-value offset))))) (define-integrable (interpreter-register:access) (rtl:make-machine-register regnum:C-return-value)) @@ -375,8 +378,9 @@ MIT in each case. |# 3))) ((MACHINE-CONSTANT) (if-integer (rtl:machine-constant-value expression))) - ((ENTRY:PROCEDURE ENTRY:CONTINUATION ASSIGNMENT-CACHE VARIABLE-CACHE - OFFSET-ADDRESS) + ((ENTRY:PROCEDURE ENTRY:CONTINUATION + ASSIGNMENT-CACHE VARIABLE-CACHE + OFFSET-ADDRESS BYTE-OFFSET-ADDRESS FLOAT-OFFSET-ADDRESS) 3) ((CONS-NON-POINTER) (and (rtl:machine-constant? (rtl:cons-non-pointer-type expression)) @@ -394,8 +398,7 @@ MIT in each case. |# (define compiler:primitives-with-no-open-coding '(DIVIDE-FIXNUM GCD-FIXNUM FIXNUM-QUOTIENT FIXNUM-REMAINDER INTEGER-QUOTIENT INTEGER-REMAINDER &/ QUOTIENT REMAINDER - FLONUM-SIN FLONUM-COS FLONUM-TAN FLONUM-ASIN FLONUM-ACOS - FLONUM-ATAN FLONUM-EXP FLONUM-LOG FLONUM-TRUNCATE FLONUM-ROUND - FLONUM-REMAINDER FLONUM-SQRT - VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS - FLOATING-VECTOR-REF FLOATING-VECTOR-SET!)) \ No newline at end of file + FLONUM-SIN FLONUM-COS FLONUM-TAN FLONUM-ASIN FLONUM-ACOS FLONUM-ATAN2 + FLONUM-ATAN FLONUM-EXP FLONUM-LOG FLONUM-REMAINDER FLONUM-SQRT + FLONUM-TRUNCATE FLONUM-ROUND FLONUM-CEILING FLONUM-FLOOR + VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS)) \ No newline at end of file diff --git a/v7/src/compiler/machines/mips/rules1.scm b/v7/src/compiler/machines/mips/rules1.scm index ff7fc3a6a..cbda74f04 100644 --- a/v7/src/compiler/machines/mips/rules1.scm +++ b/v7/src/compiler/machines/mips/rules1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules1.scm,v 1.5 1991/10/25 00:13:22 cph Exp $ +$Id: rules1.scm,v 1.6 1993/07/20 00:52:24 gjr Exp $ -Copyright (c) 1989-91 Massachusetts Institute of Technology +Copyright (c) 1989-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -33,6 +33,7 @@ promotional, or sales literature without prior written consent from MIT in each case. |# ;;;; LAP Generation Rules: Data Transfers +;;; package: (compiler lap-syntaxer) (declare (usual-integrations)) @@ -92,20 +93,71 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source)))) (standard-unary-conversion source target object->address)) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (shifted-add target base index 2)) (define-rule statement (ASSIGN (REGISTER (? target)) - (OFFSET-ADDRESS (REGISTER (? source)) (? offset))) + (OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? offset)))) (standard-unary-conversion source target (lambda (source target) (add-immediate (* 4 offset) source target)))) (define-rule statement (ASSIGN (REGISTER (? target)) - (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? offset))) + (BYTE-OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (shifted-add target base index 0)) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (BYTE-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? offset)))) (standard-unary-conversion source target (lambda (source target) (add-immediate offset source target)))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET-ADDRESS (REGISTER (? base)) + (REGISTER (? index)))) + (shifted-add target base index 3)) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET-ADDRESS (REGISTER (? source)) + (MACHINE-CONSTANT (? offset)))) + (standard-unary-conversion source target + (lambda (source target) + (add-immediate (* 8 offset) source target)))) + +(define (shifted-add target base index shift) + (if (zero? shift) + (standard-binary-conversion base index target + (lambda (base index target) + (LAP (ADDU ,target ,base ,index)))) + (let ((base (standard-source! base)) + (index (standard-source! index)) + (temp (standard-temporary!))) + (let ((target (standard-target! target))) + (LAP (SLL ,temp ,index ,shift) + (ADDU ,target ,base ,temp)))))) + +(define (with-indexed-address base index shift recvr) + (let ((base (standard-source! base)) + (index (standard-source! index)) + (temp (standard-temporary!))) + (if (zero? shift) + (LAP (ADDU ,temp ,base ,index) + ,@(recvr temp)) + (LAP (SLL ,temp ,index ,shift) + (ADDU ,temp ,base ,temp) + ,@(recvr temp))))) ;;;; Loading of Constants @@ -193,8 +245,20 @@ MIT in each case. |# ;;;; Transfers from memory +#| +(define-rule statement + (ASSIGN (REGISTER (? target)) + (OFFSET (REGISTER (? base)) (REGISTER (? index)))) + (with-indexed-address base index 2 + (lambda (address) + (let ((target (standard-target! target))) + (LAP (LW ,target (OFFSET 0 ,address)) + (NOP)))))) +|# + (define-rule statement - (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset))) + (ASSIGN (REGISTER (? target)) + (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset)))) (standard-unary-conversion address target (lambda (address target) (LAP (LW ,target (OFFSET ,(* 4 offset) ,address)) @@ -207,9 +271,20 @@ MIT in each case. |# ;;;; Transfers to memory +#| (define-rule statement ;; store an object in memory - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (OFFSET (REGISTER (? base)) (REGISTER (? index))) + (? source register-expression)) + (QUALIFIER (word-register? source)) + (with-indexed-address base index 2 + (lambda (address) + (LAP (SW ,(standard-source! source) (OFFSET 0 ,address)))))) +|# + +(define-rule statement + ;; store an object in memory + (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset))) (? source register-expression)) (QUALIFIER (word-register? source)) (LAP (SW ,(standard-source! source) @@ -231,11 +306,20 @@ MIT in each case. |# (LAP (ADDI ,regnum:stack-pointer ,regnum:stack-pointer -4) (SW ,(standard-source! source) (OFFSET 0 ,regnum:stack-pointer)))) - + ;; Cheaper, common patterns. +#| (define-rule statement - (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (OFFSET (REGISTER (? base)) (REGISTER (? index))) + (MACHINE-CONSTANT 0)) + (with-indexed-address base index 2 + (lambda (address) + (LAP (SW 0 (OFFSET 0 ,address)))))) +|# + +(define-rule statement + (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset))) (MACHINE-CONSTANT 0)) (LAP (SW 0 (OFFSET ,(* 4 offset) ,(standard-source! address))))) @@ -253,10 +337,28 @@ MIT in each case. |# ;;;; CHAR->ASCII/BYTE-OFFSET +#| (define-rule statement ;; load char object from memory and convert to ASCII byte (ASSIGN (REGISTER (? target)) - (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset)))) + (CHAR->ASCII (OFFSET (REGISTER (? base)) + (REGISTER (? index))))) + (with-indexed-address base index 2 + (lambda (address) + (let ((target (standard-target! target))) + (LAP (LBU ,target + (OFFSET ,(if (eq? endianness 'LITTLE) + 0 + 3) + ,address)) + (NOP)))))) +|# + +(define-rule statement + ;; load char object from memory and convert to ASCII byte + (ASSIGN (REGISTER (? target)) + (CHAR->ASCII (OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset))))) (standard-unary-conversion address target (lambda (address target) (LAP (LBU ,target @@ -267,15 +369,29 @@ MIT in each case. |# ,address)) (NOP))))) +#| (define-rule statement ;; load ASCII byte from memory (ASSIGN (REGISTER (? target)) - (BYTE-OFFSET (REGISTER (? address)) (? offset))) + (BYTE-OFFSET (REGISTER (? base)) + (REGISTER (? index)))) + (with-indexed-address base index 0 + (lambda (address) + (let ((target (standard-target! target))) + (LAP (LBU ,target (OFFSET 0 ,address)) + (NOP)))))) +|# + +(define-rule statement + ;; load ASCII byte from memory + (ASSIGN (REGISTER (? target)) + (BYTE-OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset)))) (standard-unary-conversion address target (lambda (address target) (LAP (LBU ,target (OFFSET ,offset ,address)) (NOP))))) - + (define-rule statement ;; convert char object to ASCII byte ;; Missing optimization: If source is home and this is the last @@ -288,23 +404,59 @@ MIT in each case. |# (lambda (source target) (LAP (ANDI ,target ,source #xFF))))) +#| (define-rule statement ;; store null byte in memory - (ASSIGN (BYTE-OFFSET (REGISTER (? source)) (? offset)) + (ASSIGN (BYTE-OFFSET (REGISTER (? base)) + (REGISTER (? index))) + (CHAR->ASCII (CONSTANT #\NUL))) + (with-indexed-address base index 0 + (lambda (address) + (LAP (SB 0 (OFFSET 0 ,address)))))) +|# + +(define-rule statement + ;; store null byte in memory + (ASSIGN (BYTE-OFFSET (REGISTER (? source)) + (MACHINE-CONSTANT (? offset))) (CHAR->ASCII (CONSTANT #\NUL))) (LAP (SB 0 (OFFSET ,offset ,(standard-source! source))))) +#| +(define-rule statement + ;; store ASCII byte in memory + (ASSIGN (BYTE-OFFSET (REGISTER (? base)) + (REGISTER (? index))) + (REGISTER (? source))) + (with-indexed-address base index 0 + (lambda (address) + (LAP (SB ,(standard-source! source) (OFFSET 0 ,address)))))) +|# + (define-rule statement ;; store ASCII byte in memory - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (BYTE-OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset))) (REGISTER (? source))) (LAP (SB ,(standard-source! source) (OFFSET ,offset ,(standard-source! address))))) +#| +(define-rule statement + ;; convert char object to ASCII byte and store it in memory + ;; register + byte offset <- contents of register (clear top bits) + (ASSIGN (BYTE-OFFSET (REGISTER (? base)) (REGISTER (? index))) + (CHAR->ASCII (REGISTER (? source)))) + (with-indexed-address base index 0 + (lambda (address) + (LAP (SB ,(standard-source! source) (OFFSET 0 ,address)))))) +|# + (define-rule statement ;; convert char object to ASCII byte and store it in memory ;; register + byte offset <- contents of register (clear top bits) - (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset)) + (ASSIGN (BYTE-OFFSET (REGISTER (? address)) + (MACHINE-CONSTANT (? offset))) (CHAR->ASCII (REGISTER (? source)))) (LAP (SB ,(standard-source! source) (OFFSET ,offset ,(standard-source! address))))) \ No newline at end of file diff --git a/v7/src/compiler/machines/mips/rules3.scm b/v7/src/compiler/machines/mips/rules3.scm index e3b820f8e..50837c24f 100644 --- a/v7/src/compiler/machines/mips/rules3.scm +++ b/v7/src/compiler/machines/mips/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rules3.scm,v 1.16 1993/01/12 10:45:20 cph Exp $ +$Id: rules3.scm,v 1.17 1993/07/20 00:52:24 gjr Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -243,8 +243,10 @@ MIT in each case. |# (define-rule statement ;; Move words back to SP+offset - (INVOCATION-PREFIX:MOVE-FRAME-UP (? frame-size) - (OFFSET-ADDRESS (REGISTER 3) (? offset))) + (INVOCATION-PREFIX:MOVE-FRAME-UP + (? frame-size) + (OFFSET-ADDRESS (REGISTER 3) + (MACHINE-CONSTANT (? offset)))) (let ((how-far (* 4 (- offset frame-size)))) (cond ((zero? how-far) (LAP)) @@ -273,9 +275,10 @@ MIT in each case. |# (define-rule statement ;; Move words back to base virtual register + offset - (INVOCATION-PREFIX:MOVE-FRAME-UP (? frame-size) - (OFFSET-ADDRESS (REGISTER (? base)) - (? offset))) + (INVOCATION-PREFIX:MOVE-FRAME-UP + (? frame-size) + (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? offset)))) (QUALIFIER (not (= base 3))) (generate/move-frame-up frame-size (lambda (reg) diff --git a/v7/src/compiler/machines/mips/rulflo.scm b/v7/src/compiler/machines/mips/rulflo.scm index a275bf585..5346113d1 100644 --- a/v7/src/compiler/machines/mips/rulflo.scm +++ b/v7/src/compiler/machines/mips/rulflo.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rulflo.scm,v 1.6 1991/10/25 00:13:40 cph Exp $ +$Id: rulflo.scm,v 1.7 1993/07/20 00:52:26 gjr Exp $ -Copyright (c) 1989-91 Massachusetts Institute of Technology +Copyright (c) 1989-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -73,6 +73,79 @@ MIT in each case. |# (let ((target (fpr->float-register (flonum-target! target)))) (LAP ,@(object->address source source) ,@(fp-load-doubleword 4 source target #T))))) + +;; Floating-point vector support + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (REGISTER (? base)) + (MACHINE-CONSTANT (? offset)))) + (let* ((base (standard-source! base)) + (target (fpr->float-register (flonum-target! target)))) + (fp-load-doubleword (* 8 offset) base target #T))) + +(define-rule statement + (ASSIGN (FLOAT-OFFSET (REGISTER (? base)) + (MACHINE-CONSTANT (? offset))) + (REGISTER (? source))) + (let ((base (standard-source! base)) + (source (fpr->float-register (flonum-source! source)))) + (fp-store-doubleword (* 8 offset) base source))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (REGISTER (? base)) (REGISTER (? index)))) + (with-indexed-address base index 3 + (lambda (address) + (fp-load-doubleword 0 address + (fpr->float-register (flonum-target! target)) #T)))) + +(define-rule statement + (ASSIGN (FLOAT-OFFSET (REGISTER (? base)) (REGISTER (? index))) + (REGISTER (? source))) + (with-indexed-address base index 3 + (lambda (address) + (fp-store-doubleword 0 address + (fpr->float-register (flonum-source! source)))))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (MACHINE-CONSTANT (? f-offset)))) + (let* ((base (standard-source! base)) + (target (fpr->float-register (flonum-target! target)))) + (fp-load-doubleword (+ (* 4 w-offset) (* 8 f-offset)) base target #T))) + +(define-rule statement + (ASSIGN (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (MACHINE-CONSTANT (? f-offset))) + (REGISTER (? source))) + (let ((base (standard-source! base)) + (source (fpr->float-register (flonum-source! source)))) + (fp-store-doubleword (+ (* 4 w-offset) (* 8 f-offset)) base source))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (REGISTER (? index)))) + (with-indexed-address base index 3 + (lambda (address) + (fp-load-doubleword (* 4 w-offset) address + (fpr->float-register (flonum-target! target)) + #T)))) + +(define-rule statement + (ASSIGN (FLOAT-OFFSET (OFFSET-ADDRESS (REGISTER (? base)) + (MACHINE-CONSTANT (? w-offset))) + (REGISTER (? index))) + (REGISTER (? source))) + (with-indexed-address base index 3 + (lambda (address) + (fp-store-doubleword (* 4 w-offset) address + (fpr->float-register (flonum-source! source)))))) ;;;; Flonum Arithmetic diff --git a/v7/src/compiler/machines/mips/rulrew.scm b/v7/src/compiler/machines/mips/rulrew.scm index 8f12e5170..741bc6b77 100644 --- a/v7/src/compiler/machines/mips/rulrew.scm +++ b/v7/src/compiler/machines/mips/rulrew.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rulrew.scm,v 1.5 1993/01/08 00:04:50 cph Exp $ +$Id: rulrew.scm,v 1.6 1993/07/20 00:52:26 gjr Exp $ Copyright (c) 1990-93 Massachusetts Institute of Technology @@ -206,9 +206,7 @@ MIT in each case. |# (and (rtl:object->fixnum? expression) (rtl:register? (rtl:object->fixnum-expression expression)))) -;;;; Closures and othe optimizations. - -;; These rules are Spectrum specific +;;;; Closures and other optimizations. (define-rule rewriting (CONS-POINTER (REGISTER (? type register-known-value)) @@ -221,21 +219,16 @@ MIT in each case. |# (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)) -|# - + (FLOAT-OFFSET (REGISTER (? base register-known-value)) + (MACHINE-CONSTANT 0)) + (QUALIFIER (and (rtl:float-offset-address? base) + (rtl:simple-subexpressions? base))) + (rtl:make-float-offset (rtl:float-offset-address-base base) + (rtl:float-offset-address-offset base))) - \ No newline at end of file +(define (rtl:simple-subexpressions? expr) + (for-all? (cdr expr) + (lambda (sub) + (or (rtl:machine-constant? sub) + (rtl:register? sub))))) \ No newline at end of file