Merge concepts of `address' and `fixnum' register into `non-object'

register.

diff --git a/v7/src/compiler/rtlbase/rgraph.scm b/v7/src/compiler/rtlbase/rgraph.scm
index 33fc6515b5d537b94d0ced10c830eeafefa23e49..387c53823fb9a70b5c976d08f7025af78cac2357 100644 (file)
--- a/v7/src/compiler/rtlbase/rgraph.scm
+++ b/v7/src/compiler/rtlbase/rgraph.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rgraph.scm,v 4.2 1988/04/25 21:34:43 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rgraph.scm,v 4.3 1988/08/29 23:00:52 cph Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -40,8 +40,7 @@ MIT in each case. |#
                          (copier false)
                          (constructor make-rgraph (n-registers)))
   n-registers
-  (address-registers (reverse initial-address-registers))
-  (fixnum-registers)
+  (non-object-registers (reverse initial-non-object-registers))
   entry-edges
   bblocks
   register-bblock
@@ -50,21 +49,16 @@ MIT in each case. |#
   register-live-length
   register-crosses-call?
   )
-(define (add-rgraph-address-register! rgraph register)
-  (set-rgraph-address-registers! rgraph
-                                (cons register
-                                      (rgraph-address-registers rgraph))))
+(define (add-rgraph-non-object-register! rgraph register)
+  (set-rgraph-non-object-registers!
+   rgraph
+   (cons register (rgraph-non-object-registers rgraph))))
 
 (define (add-rgraph-entry-node! rgraph node)
   (set-rgraph-entry-edges! rgraph
                           (cons (node->edge node)
                                 (rgraph-entry-edges rgraph))))
 
-(define (add-rgraph-fixnum-register! rgraph register)
-  (set-rgraph-fixnum-registers! rgraph
-                                (cons register
-                                      (rgraph-fixnum-registers rgraph))))
-
 (define-integrable rgraph-register-renumber rgraph-register-bblock)
 (define-integrable set-rgraph-register-renumber! set-rgraph-register-bblock!)
 (define *rgraphs*)

diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm
index 85f3251fb6562e616037fd48f98b4136ee3b088e..c0e2345f6615f3ebc9626a9b661119d7cd6d8da0 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlcon.scm
+++ b/v7/src/compiler/rtlbase/rtlcon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 4.10 1988/08/22 20:33:53 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 4.11 1988/08/29 23:02:07 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -43,25 +43,15 @@ MIT in each case. |#
     (lambda (expression)
       (locative-dereference-for-statement locative
        (lambda (address)
-         (if (rtl:pseudo-register-expression? address)
-             (cond ((rtl:address-valued-expression? expression)
-                    ;; We don't know for sure that this register is assigned
-                    ;; only once.  However, if it is assigned multiple
-                    ;; times, then all of those assignments should be
-                    ;; address valued expressions.  This constraint is not
-                    ;; enforced.
-                    (add-rgraph-address-register!
-                     *current-rgraph*
-                     (rtl:register-number address)))
-                   ((rtl:fixnum-valued-expression? expression)
-                    ;; We don't know for sure that this register is assigned
-                    ;; only once.  However, if it is assigned multiple
-                    ;; times, then all of those assignments should be
-                    ;; fixnum valued expressions.  This constraint is not
-                    ;; enforced.
-                    (add-rgraph-fixnum-register!
-                     *current-rgraph*
-                     (rtl:register-number address)))))
+         (if (and (rtl:pseudo-register-expression? address)
+                  (rtl:non-object-valued-expression? expression))
+             ;; We don't know for sure that this register is assigned
+             ;; only once.  However, if it is assigned multiple
+             ;; times, then all of those assignments should be
+             ;; non-object valued expressions.  This constraint is
+             ;; not enforced.
+             (add-rgraph-non-object-register! *current-rgraph*
+                                              (rtl:register-number address)))
          (%make-assign address expression))))))
 
 (define (rtl:make-eq-test expression-1 expression-2)
@@ -86,24 +76,18 @@ MIT in each case. |#
     (lambda (expression)
       (%make-unassigned-test expression))))
 
-
-(define (rtl:make-fixnum-pred-2-args predicate operand1 operand2)
-    (expression-simplify-for-predicate operand1
-      (lambda (s-operand1)
-       (expression-simplify-for-predicate operand2
-         (lambda (s-operand2)
-           (%make-fixnum-pred-2-args
-            predicate
-            s-operand1
-            s-operand2))))))
-
 (define (rtl:make-fixnum-pred-1-arg predicate operand)
-    (expression-simplify-for-predicate operand
-      (lambda (s-operand)
-       (%make-fixnum-pred-1-arg
-        predicate
-        s-operand))))
+  (expression-simplify-for-predicate operand
+    (lambda (operand)
+      (%make-fixnum-pred-1-arg predicate operand))))
 
+(define (rtl:make-fixnum-pred-2-args predicate operand1 operand2)
+  (expression-simplify-for-predicate operand1
+    (lambda (operand1)
+      (expression-simplify-for-predicate operand2
+       (lambda (operand2)
+         (%make-fixnum-pred-2-args predicate operand1 operand2))))))
+\f
 (define (rtl:make-pop locative)
   (locative-dereference-for-statement locative
     (lambda (locative)
@@ -117,7 +101,7 @@ MIT in each case. |#
 (define-integrable (rtl:make-address->environment address)
   (rtl:make-cons-pointer (rtl:make-constant (ucode-type stack-environment))
                         address))
-\f
+
 (define-integrable (rtl:make-push-return continuation)
   (rtl:make-push (rtl:make-entry:continuation continuation)))
 
@@ -275,7 +259,7 @@ MIT in each case. |#
                granularity))))
 
 (define (guarantee-address expression scfg-append! receiver)
-  (if (rtl:address-valued-expression? expression)
+  (if (rtl:non-object-valued-expression? expression)
       (receiver expression)
       (guarantee-register expression scfg-append!
        (lambda (register)
@@ -320,18 +304,15 @@ MIT in each case. |#
 
 (define (assign-to-temporary expression scfg-append! receiver)
   (let ((pseudo (rtl:make-pseudo-register)))
-    (if (rtl:address-valued-expression? expression)
-       (add-rgraph-address-register! *current-rgraph*
-                                     (rtl:register-number pseudo)))
-    (if (rtl:fixnum-valued-expression? expression)
-       (add-rgraph-fixnum-register! *current-rgraph*
-                                     (rtl:register-number pseudo)))
+    (if (rtl:non-object-valued-expression? expression)
+       (add-rgraph-non-object-register! *current-rgraph*
+                                        (rtl:register-number pseudo)))
     (scfg-append! (%make-assign pseudo expression) (receiver pseudo))))
 
 (define (assign-to-address-temporary expression scfg-append! receiver)
   (let ((pseudo (rtl:make-pseudo-register)))
-    (add-rgraph-address-register! *current-rgraph*
-                                 (rtl:register-number pseudo))
+    (add-rgraph-non-object-register! *current-rgraph*
+                                    (rtl:register-number pseudo))
     (scfg-append! (%make-assign pseudo (rtl:make-object->address expression))
                  (receiver pseudo))))
 
@@ -384,7 +365,7 @@ MIT in each case. |#
      (lambda (expression offset granularity)
        (if (zero? offset)
           (receiver
-           (if (rtl:address-valued-expression? expression)
+           (if (rtl:non-object-valued-expression? expression)
                (rtl:make-address->environment expression)
                expression))
           (generate-offset-address expression offset granularity scfg-append!
@@ -467,12 +448,10 @@ MIT in each case. |#
 (define-expression-method 'OBJECT->DATUM
   (lambda (receiver scfg-append! expression)
     (expression-simplify* expression scfg-append!
-      (lambda (s-expression)
-       (assign-to-temporary
-         (rtl:make-object->datum s-expression)
-         scfg-append!
-         (lambda (temporary)
-           (receiver temporary)))))))
+      (lambda (expression)
+       (assign-to-temporary (rtl:make-object->datum expression)
+                            scfg-append!
+                            receiver)))))
 
 (define-expression-method 'OBJECT->ADDRESS
   (object-selector rtl:make-object->address))
@@ -482,19 +461,13 @@ MIT in each case. |#
 
 (define-expression-method 'OBJECT->FIXNUM
   (lambda (receiver scfg-append! expression)
-    (cond ((or (rtl:fixnum-valued-expression? expression)
-              (rtl:constant? expression))
-          (expression-simplify* expression scfg-append!
-            (lambda (s-constant)
-              (receiver s-constant))))
-         (else
-          (expression-simplify* expression scfg-append!
-            (lambda (s-expression)
-              (assign-to-temporary
-               (rtl:make-object->fixnum s-expression)
-               scfg-append!
-               (lambda (temporary)
-                 (receiver temporary)))))))))
+    (expression-simplify* expression scfg-append!
+      (lambda (expression)
+       (if (rtl:non-object-valued-expression? expression)
+           (receiver expression)
+           (assign-to-temporary (rtl:make-object->fixnum expression)
+                                scfg-append!
+                                receiver))))))
 
 (define-expression-method 'CONS-POINTER
   (lambda (receiver scfg-append! type datum)

diff --git a/v7/src/compiler/rtlbase/rtlreg.scm b/v7/src/compiler/rtlbase/rtlreg.scm
index 743fc5f325a53f0fbca0a18204d563a2c6386c20..aac43b28941383dcb00adf3ff2fecfaca11cc5d9 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlreg.scm
+++ b/v7/src/compiler/rtlbase/rtlreg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlreg.scm,v 4.3 1988/04/25 21:45:08 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlreg.scm,v 4.4 1988/08/29 23:03:03 cph Rel $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -120,8 +120,5 @@ MIT in each case. |#
 (define-integrable (register-crosses-call! register)
   (bit-string-set! (rgraph-register-crosses-call? *current-rgraph*) register))
 
-(define-integrable (register-contains-address? register)
-  (memq register (rgraph-address-registers *current-rgraph*)))
-
-(define-integrable (register-contains-fixnum? register)
-  (memq register (rgraph-fixnum-registers *current-rgraph*)))
\ No newline at end of file
+(define-integrable (register-contains-non-object? register)
+  (memq register (rgraph-non-object-registers *current-rgraph*)))
\ No newline at end of file