Added support for floating-point vectors

diff --git a/v7/src/compiler/machines/alpha/rulflo.scm b/v7/src/compiler/machines/alpha/rulflo.scm
index 6d4be22846e2327236c303ba2f5cc74cde20ec4d..799f7bc83b199ec4e5422d205ad3c80fd924fd15 100644 (file)
--- a/v7/src/compiler/machines/alpha/rulflo.scm
+++ b/v7/src/compiler/machines/alpha/rulflo.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rulflo.scm,v 1.1 1992/08/29 13:51:34 jinx Exp $
+$Id: rulflo.scm,v 1.2 1993/11/12 14:58:20 jmiller Exp $
 
 Copyright (c) 1992 Digital Equipment Corporation (D.E.C.)
 
@@ -52,6 +52,9 @@ case.
 (define (flonum-temporary!)
   (float-register->fpr (allocate-temporary-register! 'FLOAT)))
 
+(define-integrable flonum-size
+  (quotient float-width scheme-object-width))
+
 (define-rule statement
   ;; convert a floating-point number to a flonum object
   (ASSIGN (REGISTER (? target))
@@ -81,6 +84,89 @@ case.
     (LAP ,@(object->address source temp)
         (LDT ,target (OFFSET ,address-units-per-object ,temp)))))
 \f
+;; Floating-point vector support
+
+(define-rule statement
+  ;; Load an unboxed  floating pointer number given a register and offset
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET (REGISTER (? base))
+                       (MACHINE-CONSTANT (? offset))))
+  (let* ((base (standard-source! base))
+        (target (fpr->float-register (flonum-target! target))))
+    (LAP (LDT ,target (OFFSET ,(* address-units-per-float offset)
+                             ,base)))))
+
+(define-rule statement
+  ;; Store an unboxed floating point number
+  (ASSIGN (FLOAT-OFFSET (REGISTER (? base))
+                       (MACHINE-CONSTANT (? offset)))
+         (REGISTER (? source)))
+  (let ((base (standard-source! base))
+       (source (fpr->float-register (flonum-source! source))))
+    (LAP (STT ,source (OFFSET ,(* address-units-per-float offset) ,base)))))
+
+#| ********** Code from the MIPS back-end
+
+This isn't needed (we assume) on the Alpha because the front-end
+(rtlgen/opncod) notices that on the Alpha a floating point number and
+the vector length header are the same size.
+
+(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))))))
+************************ MIPS |#
+\f
 ;;;; Flonum Arithmetic
 
 (define-rule statement