Add new rules for `eq-test', and change rule that pops into register

so that it uses machine registers.

diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index 90b6ffd84f48cca033d8b5955f8156d34ce4410c..f2363158745066d203fdec49bf7fb2e2c227d0a3 100644 (file)
--- a/v7/src/compiler/machines/bobcat/lapgen.scm
+++ b/v7/src/compiler/machines/bobcat/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.159 1987/05/07 04:40:16 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.160 1987/05/09 06:23:12 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -115,6 +115,13 @@ MIT in each case. |#
       `(TST B ,expression)
       `(CMP B (& ,n) ,expression)))
 
+(define (test-constant constant expression)
+  (if (non-pointer-object? constant)
+      (test-non-pointer (primitive-type constant)
+                       (primitive-datum constant)
+                       expression)
+      `(CMP L (@PCR ,(constant->label constant)) ,expression)))
+
 (define (test-non-pointer type datum expression)
   (if (and (zero? type) (zero? datum) (TSTable-expression? expression))
       `(TST L ,expression)
@@ -302,9 +309,9 @@ MIT in each case. |#
   (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 15) 1))
   (QUALIFIER (pseudo-register? target))
   (record-pop!)
-  (let ((target* (coerce->any target)))
-    (delete-dead-registers!)
-    `((MOVE L (@A+ 7) ,target*))))
+  (delete-dead-registers!)
+  `((MOVE L (@A+ 7)
+         ,(register-reference (allocate-alias-register! target 'DATA)))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
@@ -466,6 +473,58 @@ MIT in each case. |#
   `(,(test-non-pointer (ucode-type unassigned) 0
                       (indirect-reference! register offset))))
 \f
+(define-rule predicate
+  (EQ-TEST (REGISTER (? register)) (CONSTANT (? constant)))
+  (QUALIFIER (pseudo-register? register))
+  (set-standard-branches! 'EQ)
+  `(,(test-constant constant (coerce->any register))))
+
+(define-rule predicate
+  (EQ-TEST (CONSTANT (? constant)) (REGISTER (? register)))
+  (QUALIFIER (pseudo-register? register))
+  (set-standard-branches! 'EQ)
+  `(,(test-constant constant (coerce->any register))))
+
+(define-rule predicate
+  (EQ-TEST (OFFSET (REGISTER (? register)) (? offset)) (CONSTANT (? constant)))
+  (set-standard-branches! 'EQ)
+  `(,(test-constant constant (indirect-reference! register))))
+
+(define-rule predicate
+  (EQ-TEST (CONSTANT (? constant)) (OFFSET (REGISTER (? register)) (? offset)))
+  (set-standard-branches! 'EQ)
+  `(,(test-constant constant (indirect-reference! register))))
+
+(define-rule predicate
+  (EQ-TEST (REGISTER (? register-1)) (REGISTER (? register-2)))
+  (QUALIFIER (pseudo-register? register-1) (pseudo-register? register-2))
+  (set-standard-branches! 'EQ)
+  `((CMP L ,(coerce->any register-1) ,(coerce->any register-2))))
+
+(define-rule predicate
+  (EQ-TEST (OFFSET (REGISTER (? register-1)) (? offset-1))
+          (REGISTER (? register-2)))
+  (QUALIFIER (pseudo-register? register-2))
+  (set-standard-branches! 'EQ)
+  (let ((expression-1 (indirect-reference! register-1 offset-1)))
+    `((CMP L ,expression-1 ,(coerce->any register-2)))))
+
+(define-rule predicate
+  (EQ-TEST (REGISTER (? register-1))
+          (OFFSET (REGISTER (? register-2)) (? offset-2)))
+  (QUALIFIER (pseudo-register? register-1))
+  (set-standard-branches! 'EQ)
+  (let ((expression-2 (indirect-reference! register-2 offset-2)))
+    `((CMP L ,(coerce->any register-1) ,expression-2))))
+
+(define-rule predicate
+  (EQ-TEST (OFFSET (REGISTER (? register-1)) (? offset-1))
+          (OFFSET (REGISTER (? register-2)) (? offset-2)))
+  (set-standard-branches! 'EQ)
+  `((CMP L
+        ,(indirect-reference! register-1 offset-1)
+        ,(indirect-reference! register-2 offset-2))))
+\f
 ;;;; Invocations
 
 (define-rule statement