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 e2cc150c999ac96fcc5f1d2cfe12180cb9a10755..d51326cd79c5ebaf14a8b361126aed45aa4d0f4d 100644 (file)
--- 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 ff7fc3a6ac493a7543739a6d265d5d1e2fb071b7..cbda74f045efdfa7f27fa426b539e58c312fa7ae 100644 (file)
--- 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))
 \f
@@ -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))
+\f
+(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)))))
 \f
 ;;;; Loading of Constants
 
@@ -193,8 +245,20 @@ MIT in each case. |#
 \f
 ;;;; 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))))
-
+\f
 ;; 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. |#
 \f
 ;;;; 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)))))
-
+\f
 (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 e3b820f8ed6969d840af562177619d7356baf61a..50837c24f06196177bba2ef173d33f87cabe1f57 100644 (file)
--- 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 <frame-size> 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 <frame-size> 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 a275bf58588cdd858c035ca54a66495cae4ad599..5346113d168de34814dbbd9eb8840a4019699d96 100644 (file)
--- 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)))
+\f
+(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))))))
 \f
 ;;;; Flonum Arithmetic
 

diff --git a/v7/src/compiler/machines/mips/rulrew.scm b/v7/src/compiler/machines/mips/rulrew.scm
index 8f12e5170d61ed730fe451b2c30aa79103047d99..741bc6b77a7bbe87457634ee37b6b7bf6f775739 100644 (file)
--- 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))))
 \f
-;;;; 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