From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 9 May 1987 06:23:12 +0000 (+0000)
Subject: Add new rules for `eq-test', and change rule that pops into register
X-Git-Tag: 20090517-FFI~13533
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ec88190e9e188753f7a0fac631bcaec22344764e;p=mit-scheme.git

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 90b6ffd84..f23631587 100644
--- 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))))
 
+(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))))
+
 ;;;; Invocations
 
 (define-rule statement