From 5cc04d13894fd1014a2d23a95be5855ac141257b Mon Sep 17 00:00:00 2001
From: Jim Miller <edu/mit/csail/zurich/jmiller>
Date: Fri, 12 Nov 1993 14:58:20 +0000
Subject: [PATCH] Added support for floating-point vectors

---
 v7/src/compiler/machines/alpha/rulflo.scm | 88 ++++++++++++++++++++++-
 1 file changed, 87 insertions(+), 1 deletion(-)

diff --git a/v7/src/compiler/machines/alpha/rulflo.scm b/v7/src/compiler/machines/alpha/rulflo.scm
index 6d4be2284..799f7bc83 100644
--- 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)))))
 
+;; 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 |#
+
 ;;;; Flonum Arithmetic
 
 (define-rule statement
-- 
2.25.1