Changed format of OFFSET-ADDRESS, BYTE-OFFSET-ADDRESS, and

FLOAT-OFFSET-ADDRESS to allow indexing by either a REGISTER or a
MACHINE-CONSTANT, whereas it previously assumed MACHINE-CONSTANT only.

diff --git a/v7/src/compiler/machines/alpha/rules1.scm b/v7/src/compiler/machines/alpha/rules1.scm
index abd8ce10edbf1f6cc662fdce7b808f7c39940a6b..a2a5258e408ba027c9b96430f39878645131cd39 100644 (file)
--- a/v7/src/compiler/machines/alpha/rules1.scm
+++ b/v7/src/compiler/machines/alpha/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules1.scm,v 1.1 1992/08/29 13:51:30 jinx Exp $
+$Id: rules1.scm,v 1.2 1993/11/12 14:43:49 jmiller Exp $
 
 Copyright (c) 1992 Digital Equipment Corporation (D.E.C.)
 
@@ -101,11 +101,19 @@ case.
   ;; convert the contents of a register to an address
   (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source))))
   (standard-unary-conversion source target object->address))
+\f
+(define-rule statement
+  ;; add a distance (in longwords) to a register's contents
+  (ASSIGN (REGISTER (? target))
+         (OFFSET-ADDRESS (REGISTER (? source))
+                         (REGISTER (? offset))))
+  (address-add target source offset address-units-per-object))
 
 (define-rule statement
   ;; add a distance (in longwords) to a register's contents
   (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 (* address-units-per-object offset)
@@ -114,10 +122,65 @@ case.
 (define-rule statement
   ;; add a distance (in bytes) to a register's contents
   (ASSIGN (REGISTER (? target))
-         (BYTE-OFFSET-ADDRESS (REGISTER (? source)) (? offset)))
+         (BYTE-OFFSET-ADDRESS (REGISTER (? source))
+                              (REGISTER (? offset))))
+  (address-add target source offset 1))
+
+(define-rule statement
+  ;; add a distance (in bytes) to a register's contents
+  (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
+  ;; add a distance (in "size of floating point constants") to a
+  ;; register's contents.
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET-ADDRESS (REGISTER (? base))
+                               (REGISTER (? index))))
+  (address-add target base index address-units-per-float))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (FLOAT-OFFSET-ADDRESS (REGISTER (? source))
+                               (MACHINE-CONSTANT (? offset))))
+  (standard-unary-conversion source target
+    (lambda (source target)
+      (add-immediate (* address-units-per-float offset)
+                    source target))))
+
+(define (address-add target base index size-in-address-units)
+  (case size-in-address-units
+    ((1) (standard-binary-conversion base index target
+         (lambda (base index target)
+           (LAP (ADDQ ,index ,base ,target)))))
+    ((4) (standard-binary-conversion base index target
+         (lambda (base index target)
+           (LAP (S4ADDQ ,index ,base ,target)))))
+    ((8) (standard-binary-conversion base index target
+         (lambda (base index target)
+           (LAP (S8ADDQ ,index ,base ,target)))))
+    (else (error "address-add: size of object isn't 1, 4, or 8 bytes"
+                size-in-address-units))))
+
+(define (with-indexed-address base index size-in-address-units recvr)
+  (let ((base (standard-source! base))
+       (index (standard-source! index))
+       (temp (standard-temporary!)))
+    (case size-in-address-units
+      ((0) (LAP (ADDQ ,base ,index ,temp)
+               ,@(recvr temp)))
+      ((4) (LAP (S4ADDQ ,index ,base ,temp)
+               ,@(recvr temp)))
+      ((8) (LAP (S8ADDQ ,index ,base ,temp)
+               ,@(recvr temp)))
+      (else
+       (error
+       "with-indexed-address: size of object isn't 1, 4,or 8 bytes"
+       size-in-address-units)))))
 \f
 ;;;; Loading of Constants
 
@@ -205,11 +268,17 @@ case.
 
 (define-rule statement
   ;; read an object from memory
-  (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 (LDQ ,target
-               (OFFSET ,(* address-units-per-object offset) ,address))))))
+               (OFFSET ,(* address-units-per-object offset)
+                       ,address))))))
+
+;; Note: we don't seem to need
+;;  (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? base))
+;;                                       (REGISTER (? index))))
 
 (define-rule statement
   ;; Pop stack to register
@@ -223,13 +292,17 @@ case.
 
 (define-rule statement
   ;; store an object in memory
-  (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset)))
          (? source register-expression))
   (QUALIFIER (word-register? source))
   (LAP (STQ ,(standard-source! source)
            (OFFSET ,(* address-units-per-object offset)
                    ,(standard-source! address)))))
 
+;; Note: we don't seem to need
+;; (ASSIGN (OFFSET (REGISTER (? base)) (REGISTER (? index)))
+;;         (? source register-expression))
+
 (define-rule statement
   ;; Push an object register on the heap
   (ASSIGN (POST-INCREMENT (REGISTER (? Free)) 1)
@@ -250,24 +323,30 @@ case.
 
 ;; Cheaper, common patterns.
 
+;; We don't need 
+;;  (ASSIGN (OFFSET (REGISTER (? base)) (REGISTER (? index)))
+;;          (MACHINE-CONSTANT 0))
+;; since it simplifies to (... (OFFSET REGISTER MACHINE-CONSTANT) ...)
+
 (define-rule statement
-  (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (OFFSET (REGISTER (? address)) (MACHINE-CONSTANT (? offset)))
          (MACHINE-CONSTANT 0))
-  (LAP (STQ 31 (OFFSET ,(* address-units-per-object offset)
-                      ,(standard-source! address)))))
+  (LAP (STQ ,regnum:zero (OFFSET ,(* address-units-per-object offset)
+                                ,(standard-source! address)))))
 
 (define-rule statement
   ; Push NIL (or whatever is represented by a machine 0) on heap
   (ASSIGN (POST-INCREMENT (REGISTER (? free)) 1) (MACHINE-CONSTANT 0))
   (QUALIFIER (= free regnum:free))
-  (LAP (STQ 31 (OFFSET 0 ,regnum:free))
+  (LAP (STQ ,regnum:zero (OFFSET 0 ,regnum:free))
        (ADDQ ,regnum:free (& ,address-units-per-object) ,regnum:free)))
 
 (define-rule statement
   ; Ditto, but on stack
   (ASSIGN (PRE-INCREMENT (REGISTER (? stack)) -1) (MACHINE-CONSTANT 0))
   (QUALIFIER (= stack regnum:stack-pointer))
-  (LAP (SW 31 (OFFSET ,(- address-units-per-object) ,regnum:stack-pointer))
+  (LAP (STQ ,regnum:zero
+           (OFFSET ,(- address-units-per-object) ,regnum:stack-pointer))
        (SUBQ ,regnum:stack-pointer (& ,address-units-per-object)
             ,regnum:stack-pointer)))
 \f
@@ -283,7 +362,8 @@ case.
 
 (define-rule statement
   ;; store null byte in memory
-  (ASSIGN (BYTE-OFFSET (REGISTER (? source)) (? offset))
+  (ASSIGN (BYTE-OFFSET (REGISTER (? source))
+                      (MACHINE-CONSTANT (? offset)))
          (CHAR->ASCII (CONSTANT #\NUL)))
   (modify-byte (standard-source! source) offset
     (lambda (data-register offset-register)
@@ -294,12 +374,14 @@ case.
 (define-rule statement
   ;; load ASCII byte from memory
   (ASSIGN (REGISTER (? target))
-         (BYTE-OFFSET (REGISTER (? address)) (? offset)))
+         (BYTE-OFFSET (REGISTER (? address))
+                      (MACHINE-CONSTANT (? offset))))
   (load-byte address offset target))
 
 (define-rule statement
   ;; store ASCII byte in memory.  There may be a FIXNUM typecode.
-  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+  (ASSIGN (BYTE-OFFSET (REGISTER (? address))
+                      (MACHINE-CONSTANT (? offset)))
          (REGISTER (? source)))
   (let ((source (standard-source! source))
        (address (standard-source! address)))
@@ -308,7 +390,8 @@ case.
 (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))))
   (let ((source (standard-source! source))
        (address (standard-source! address)))

diff --git a/v7/src/compiler/machines/alpha/rules3.scm b/v7/src/compiler/machines/alpha/rules3.scm
index d7925b0a666dbe16f9c58f69d59c429aa9edee24..fcc471a1e026034a22ba50fa1c59844d38a1e828 100644 (file)
--- a/v7/src/compiler/machines/alpha/rules3.scm
+++ b/v7/src/compiler/machines/alpha/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 1.4 1993/02/15 21:44:43 gjr Exp $
+$Id: rules3.scm,v 1.5 1993/11/12 14:44:03 jmiller Exp $
 
 Copyright (c) 1992-1993 Digital Equipment Corporation (D.E.C.)
 
@@ -223,7 +223,8 @@ case.
 (define-rule statement
   ;; Move <frame-size> words back to SP+offset
   (INVOCATION-PREFIX:MOVE-FRAME-UP
-   (? frame-size) (OFFSET-ADDRESS (REGISTER (? stack)) (? offset)))
+   (? frame-size) (OFFSET-ADDRESS (REGISTER (? stack))
+                                 (MACHINE-CONSTANT (? offset))))
   (QUALIFIER (= stack regnum:stack-pointer))
   (let ((how-far (* 8 (- offset frame-size))))
     (cond ((zero? how-far)
@@ -256,8 +257,7 @@ 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)))
+   (OFFSET-ADDRESS (REGISTER (? base)) (MACHINE-CONSTANT (? offset))))
   (QUALIFIER (not (= base 20)))
   (generate/move-frame-up frame-size
     (lambda (reg)