From 9ac23386d852384a89c97a6b2aa151fd1400a61f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 29 Aug 1988 22:49:54 +0000
Subject: [PATCH] Many many changes.

---
 v7/src/compiler/machines/bobcat/rules1.scm | 560 ++++++++++-----------
 v7/src/compiler/machines/bobcat/rules2.scm | 458 ++++++++---------
 2 files changed, 490 insertions(+), 528 deletions(-)

diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm
index ebd445a0d..c9ff53e0c 100644
--- a/v7/src/compiler/machines/bobcat/rules1.scm
+++ b/v7/src/compiler/machines/bobcat/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.13 1988/06/14 08:48:22 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.14 1988/08/29 22:47:55 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -40,7 +40,7 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (REGISTER 15) (REGISTER (? source)))
-  (LAP (MOV L ,(coerce->any source) (A 7))))
+  (LAP (MOV L ,(standard-register-reference source false) (A 7))))
 
 (define-rule statement
   (ASSIGN (REGISTER 15) (OFFSET-ADDRESS (REGISTER (? source)) (? offset)))
@@ -64,56 +64,51 @@ MIT in each case. |#
   (QUALIFIER (pseudo-register? source))
   (LAP (LEA ,(indirect-reference! source offset) (A 4))))
 
-;;; The following rule always occurs immediately after an instruction
-;;; of the form
-;;;
-;;; (ASSIGN (REGISTER (? source)) (POST-INCREMENT (REGISTER 15) 1))
-;;;
-;;; in which case it could be implemented very efficiently using the
-;;; sequence
-;;;
-;;; (LAP (CLR (@A 7)) (MOV L (@A+ 7) (A 4)))
-;;;
-;;; but unfortunately we have no mechanism to take advantage of this.
-
 (define-rule statement
   (ASSIGN (REGISTER 12) (OBJECT->ADDRESS (REGISTER (? source))))
   (QUALIFIER (pseudo-register? source))
-  (reuse-pseudo-register-alias! source 'DATA
-    (lambda (reusable-alias)
-      (let ((source (register-reference reusable-alias)))
-	(LAP (AND L ,mask-reference ,source)
-	     (MOV L ,source (A 4)))))
-    (lambda ()
-      (let ((temp (reference-temporary-register! 'DATA)))
-	(LAP (MOV L ,(coerce->any source) ,temp)
-	     (AND L ,mask-reference ,temp)
-	     (MOV L ,temp (A 4)))))))
+  (let ((temp (move-to-temporary-register! source 'DATA)))
+    (LAP (AND L ,mask-reference ,temp)
+	 (MOV L ,temp (A 4)))))
+
+(define-rule statement
+  (ASSIGN (REGISTER 12) (OBJECT->ADDRESS (POST-INCREMENT (REGISTER 15) 1)))
+  (let ((temp (reference-temporary-register! 'DATA)))
+    (LAP (MOV L (@A+ 7) ,temp)
+	 (AND L ,mask-reference ,temp)
+	 (MOV L ,temp (A 4)))))
 
 ;;; All assignments to pseudo registers are required to delete the
-;;; dead registers BEFORE performing the assignment.  This is because
-;;; the register being assigned may be PSEUDO-REGISTER=? to one of the
-;;; dead registers, and thus would be flushed if the deletions
-;;; happened after the assignment.
+;;; dead registers BEFORE performing the assignment.  However, it is
+;;; necessary to derive the effective address of the source
+;;; expression(s) before deleting the dead registers.  Otherwise any
+;;; source expression containing dead registers might refer to aliases
+;;; which have been reused.
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n)))
-  (QUALIFIER (pseudo-register? target))
+  (QUALIFIER (and (pseudo-register? target) (machine-register? source)))
+  (let ((source (indirect-reference! source n)))
+    (delete-dead-registers!)
+    (LAP (LEA ,source ,(reference-target-alias! target 'ADDRESS)))))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n)))
+  (QUALIFIER (and (pseudo-register? target) (pseudo-register? source)))
   (reuse-pseudo-register-alias! source 'DATA
     (lambda (reusable-alias)
-      (add-pseudo-register-alias! target reusable-alias false)
+      (delete-dead-registers!)
+      (add-pseudo-register-alias! target reusable-alias)
       (increment-machine-register reusable-alias n))
     (lambda ()
       (let ((source (indirect-reference! source n)))
 	(delete-dead-registers!)
-	(LAP (LEA ,source
-		  ,(register-reference
-		    (allocate-alias-register! target 'ADDRESS))))))))
+	(LAP (LEA ,source ,(reference-target-alias! target 'ADDRESS)))))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (CONSTANT (? source)))
   (QUALIFIER (pseudo-register? target))
-  (LAP ,(load-constant source (coerce->any target))))
+  (LAP ,(load-constant source (standard-target-reference target))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (VARIABLE-CACHE (? name)))
@@ -121,8 +116,7 @@ MIT in each case. |#
   (delete-dead-registers!)
   (LAP (MOV L
 	    (@PCR ,(free-reference-label name))
-	    ,(register-reference
-	      (allocate-alias-register! target 'ADDRESS)))))
+	    ,(reference-target-alias! target 'ADDRESS))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (ASSIGNMENT-CACHE (? name)))
@@ -130,8 +124,7 @@ MIT in each case. |#
   (delete-dead-registers!)
   (LAP (MOV L
 	    (@PCR ,(free-assignment-label name))
-	    ,(register-reference
-	      (allocate-alias-register! target 'ADDRESS)))))
+	    ,(reference-target-alias! target 'ADDRESS))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (REGISTER (? source)))
@@ -146,41 +139,20 @@ MIT in each case. |#
     (LAP (RO L L (& 8) ,target))))
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (CONSTANT (? source))))
-  (QUALIFIER (pseudo-register? target))
-  (let ((target (reference-assignment-alias! target 'DATA)))
-    (LAP ,(load-constant source target)
-	 (AND L ,mask-reference ,target))))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source))))
-  (QUALIFIER (pseudo-register? target))
-  (let ((target (move-to-alias-register! source 'DATA target)))
-    (LAP (AND L ,mask-reference ,target))))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target))
-	  (OBJECT->ADDRESS (OFFSET (REGISTER (? address)) (? offset))))
-  (QUALIFIER (pseudo-register? target))
-  (let ((source (indirect-reference! address offset)))
-    (delete-dead-registers!)
-    (let ((target-ref
-	   (register-reference (allocate-alias-register! target 'DATA))))
-      (LAP (MOV L ,source ,target-ref)))))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (CONSTANT (? datum))))
+  (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (CONSTANT (? constant))))
   (QUALIFIER (pseudo-register? target))
   (delete-dead-registers!)
-  (let ((target-ref
-	 (register-reference (allocate-alias-register! target 'DATA))))
-    (load-constant-datum datum target-ref)))
+  (let ((target (reference-target-alias! target 'DATA)))
+    (if (non-pointer-object? constant)
+	(LAP ,(load-non-pointer 0 (object-datum constant) target))
+	(LAP ,(load-constant constant target)
+	     (AND L ,mask-reference ,target)))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (REGISTER (? source))))
   (QUALIFIER (pseudo-register? target))
-  (let ((target-ref (move-to-alias-register! source 'DATA target)))
-    (LAP ,(scheme-object->datum target-ref))))
+  (let ((target (move-to-alias-register! source 'DATA target)))
+    (LAP (AND L ,mask-reference ,target))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
@@ -188,72 +160,61 @@ MIT in each case. |#
   (QUALIFIER (pseudo-register? target))
   (let ((source (indirect-reference! address offset)))
     (delete-dead-registers!)
-    (let ((target-ref
-	   (register-reference (allocate-alias-register! target 'DATA))))
-      (LAP (MOV L ,source ,target-ref)
-	   ,(scheme-object->datum target-ref)))))
+    (let ((target (reference-target-alias! target 'DATA)))
+      (LAP (MOV L ,source ,target)
+	   (AND L ,mask-reference ,target)))))
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (CONSTANT (? datum))))
+  (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (CONSTANT (? constant))))
   (QUALIFIER (pseudo-register? target))
   (delete-dead-registers!)
-  (let ((target-ref
-	 (register-reference (allocate-alias-register! target 'DATA))))
-    (load-fixnum-constant datum target-ref)))
+  (let ((target (reference-target-alias! target 'DATA)))
+    (if (non-pointer-object? constant)
+	(LAP ,(load-non-pointer 0 (object-datum constant) target))
+	(LAP ,(load-constant constant target)
+	     (AND L ,mask-reference ,target)))))
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (REGISTER (? source))))
+  (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source))))
   (QUALIFIER (pseudo-register? target))
-  (let ((target-ref (move-to-alias-register! source 'DATA target)))
-    (LAP ,(remove-type-from-fixnum target-ref))))
+  (let ((target (move-to-alias-register! source 'DATA target)))
+    (LAP (AND L ,mask-reference ,target))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
-	  (OBJECT->FIXNUM (OFFSET (REGISTER (? address)) (? offset))))
+	  (OBJECT->ADDRESS (OFFSET (REGISTER (? address)) (? offset))))
   (QUALIFIER (pseudo-register? target))
   (let ((source (indirect-reference! address offset)))
     (delete-dead-registers!)
-    (let ((target-ref
-	   (register-reference (allocate-alias-register! target 'DATA))))
-      (LAP (MOV L ,source ,target-ref)
-	   ,(remove-type-from-fixnum target-ref)))))
+    (let ((target (reference-target-alias! target 'DATA)))
+      (LAP (MOV L ,source ,target)
+	   (AND L ,mask-reference ,target)))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset)))
   (QUALIFIER (pseudo-register? target))
   (let ((source (indirect-reference! address offset)))
-    (delete-dead-registers!)
-    ;; The fact that the target register here is a data register is a
-    ;; heuristic that works reasonably well since if the value is a
-    ;; pointer, we will probably want to dereference it, which
-    ;; requires that we first mask it.
-    (LAP (MOV L
-	      ,source
-	      ,(register-reference
-		(allocate-alias-register! target 'DATA))))))
+    (LAP (MOV L ,source ,(standard-target-reference target)))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 15) 1))
   (QUALIFIER (pseudo-register? target))
-  (delete-dead-registers!)
-  (LAP (MOV L
-	    (@A+ 7)
-	    ,(register-reference
-	      (allocate-alias-register! target 'DATA)))))
+  (LAP (MOV L (@A+ 7) ,(standard-target-reference target))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
 	  (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
-  (QUALIFIER (pseudo-register? target))
-  (let ((datum (coerce->any datum)))
-    (delete-dead-registers!)
-    (let ((target* (coerce->any target)))
-      (if (register-effective-address? target*)
-	  (LAP (MOV L ,datum ,reg:temp)
-	       (MOV B (& ,type) ,reg:temp)
-	       (MOV L ,reg:temp ,target*))
-	  (LAP (MOV L ,datum ,target*)
-	       (MOV B (& ,type) ,target*))))))
+  (QUALIFIER (and (pseudo-register? target) (machine-register? datum)))
+  (let ((target (reference-target-alias! target 'DATA)))
+    (LAP (MOV L ,(register-reference datum) ,target)
+	 (OR L (& ,(make-non-pointer-literal type 0)) ,target))))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+	  (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
+  (QUALIFIER (and (pseudo-register? target) (pseudo-register? datum)))
+  (let ((target (move-to-alias-register! datum 'DATA target)))
+    (LAP (OR L (& ,(make-non-pointer-literal type 0)) ,target))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
@@ -261,129 +222,48 @@ MIT in each case. |#
   (QUALIFIER (pseudo-register? target))
   (let ((temp (reference-temporary-register! 'ADDRESS)))
     (delete-dead-registers!)
-    (let ((target* (coerce->any target)))
-      (if (register-effective-address? target*)
-	  (LAP
-	   (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
-		,temp)
-	   (MOV L ,temp ,reg:temp)
-	   (MOV B (& ,type) ,reg:temp)
-	   (MOV L ,reg:temp ,target*))
-	  (LAP
-	   (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
+    (let ((target (reference-target-alias! target 'DATA)))
+      (LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
 		,temp)
-	   (MOV L ,temp ,target*)
-	   (MOV B (& ,type) ,target*))))))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target)) (FIXNUM->OBJECT (REGISTER (? source))))
-  (QUALIFIER (pseudo-register? target))
-  (let ((target-ref (move-to-alias-register! source 'DATA target)))
-    (LAP ,(put-type-in-ea (ucode-type fixnum) target-ref))))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target))
-	  (FIXNUM->OBJECT
-	    (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2))))
-  (QUALIFIER (pseudo-register? target))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (let ((operation
-	   (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
-		,@(put-type-in-ea (ucode-type fixnum) temp-reg))))
-      (delete-dead-registers!)
-      (add-pseudo-register-alias! target temp-reg false)
-      operation)))
+	   (MOV L ,temp ,target)
+	   (OR L (& ,(make-non-pointer-literal type 0)) ,target)))))
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target))
-	  (FIXNUM->OBJECT
-	   (FIXNUM-1-ARG (? operator) (? operand))))
+  (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (CONSTANT (? constant))))
   (QUALIFIER (pseudo-register? target))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (let ((operation
-	   (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
-		,@(put-type-in-ea (ucode-type fixnum) temp-reg))))
-      (delete-dead-registers!)
-      (add-pseudo-register-alias! target temp-reg false)
-      operation)))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target))
-	  (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
-  (QUALIFIER (pseudo-register? target))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (let ((operation
-	   (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg))))
-      (delete-dead-registers!)
-      (add-pseudo-register-alias! target temp-reg false)
-      operation)))
+  (delete-dead-registers!)
+  (load-fixnum-constant constant (reference-target-alias! target 'DATA)))
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target))
-	  (FIXNUM-1-ARG (? operator) (? operand)))
+  (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (REGISTER (? source))))
   (QUALIFIER (pseudo-register? target))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (let ((operation
-	   (LAP ,@(fixnum-do-1-arg! operator operand temp-reg))))
-      (delete-dead-registers!)
-      (add-pseudo-register-alias! target temp-reg false)
-      operation)))
-
-;;;; CHAR->ASCII/BYTE-OFFSET
+  (reuse-alias-deleting-dead-registers! source 'DATA
+    (lambda (alias)
+      (add-pseudo-register-alias! target alias)
+      (let ((reference (register-reference alias)))
+	(object->fixnum reference reference)))
+    (lambda (source)
+      (object->fixnum source (reference-target-alias! target 'DATA)))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
-	  (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset))))
-  (QUALIFIER (pseudo-register? target))
-  (byte-offset->register (indirect-char/ascii-reference! address offset)
-			 (indirect-register address)
-			 target))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target)) (CHAR->ASCII (REGISTER (? source))))
+	  (OBJECT->FIXNUM (OFFSET (REGISTER (? address)) (? offset))))
   (QUALIFIER (pseudo-register? target))
-  (let ((machine-register (if (machine-register? source)
-			      source
-			      (register-alias source false))))
-    (if machine-register
-	(let ((source-ref (register-reference machine-register)))
-	  (delete-dead-registers!)
-	  (let ((target-ref
-		 (register-reference (allocate-alias-register! target 'DATA))))
-	    (LAP (BFEXTU ,source-ref (& 24) (& 8) ,target-ref))))
-	(byte-offset->register
-	 (indirect-char/ascii-reference! regnum:regs-pointer
-					 (pseudo-register-offset source))
-	 (indirect-register regnum:regs-pointer)
-	 target))))
-
-(define-rule statement
-  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
-	  (CHAR->ASCII (REGISTER (? source))))
-  (let ((source (coerce->any/byte-reference source)))
-    (let ((target (indirect-byte-reference! address offset)))
-      (LAP (MOV B ,source ,target)))))
-
-(define-rule statement
-  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
-	  (CHAR->ASCII (CONSTANT (? character))))
-  (LAP (MOV B (& ,(char->signed-8-bit-immediate character))
-	    ,(indirect-byte-reference! address offset))))
+  (let ((source (indirect-reference! address offset)))
+    (delete-dead-registers!)
+    (object->fixnum source (reference-target-alias! target 'DATA))))
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target))
-	  (BYTE-OFFSET (REGISTER (? address)) (? offset)))
+  (ASSIGN (REGISTER (? target)) (FIXNUM->OBJECT (REGISTER (? source))))
   (QUALIFIER (pseudo-register? target))
-  (byte-offset->register (indirect-byte-reference! address offset)
-			 (indirect-register address)
-			 target))
+  (fixnum->object (move-to-alias-register! source 'DATA target)))
 
 (define-rule statement
-  (ASSIGN (BYTE-OFFSET (REGISTER (? target)) (? target-offset))
-	  (CHAR->ASCII (OFFSET (REGISTER (? source)) (? source-offset))))
-  (let ((source (indirect-char/ascii-reference! source source-offset)))
-    (LAP (MOV B ,source ,(indirect-byte-reference! target target-offset)))))
-
+  (ASSIGN (OFFSET (REGISTER (? a)) (? n))
+	  (FIXNUM->OBJECT (REGISTER (? source))))
+  (let ((target (indirect-reference! a n)))
+    (LAP (MOV L ,(standard-register-reference source false) ,target)
+	 ,@(fixnum->object target))))
 
 ;;;; Transfers to Memory
 
@@ -403,28 +283,26 @@ MIT in each case. |#
   (ASSIGN (OFFSET (REGISTER (? a)) (? n))
 	  (REGISTER (? r)))
   (LAP (MOV L
-	    ,(coerce->any r)
+	    ,(standard-register-reference r false)
 	    ,(indirect-reference! a n))))
 
 (define-rule statement
   (ASSIGN (OFFSET (REGISTER (? a)) (? n))
 	  (POST-INCREMENT (REGISTER 15) 1))
-  (LAP (MOV L
-	    (@A+ 7)
-	    ,(indirect-reference! a n))))
+  (LAP (MOV L (@A+ 7) ,(indirect-reference! a n))))
 
 (define-rule statement
-  (ASSIGN (OFFSET (REGISTER (? a)) (? n))
-	  (CONS-POINTER (CONSTANT (? type)) (REGISTER (? r))))
-  (let ((target (indirect-reference! a n)))
-    (LAP (MOV L ,(coerce->any r) ,target)
+  (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
+	  (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
+  (let ((target (indirect-reference! address offset)))
+    (LAP (MOV L ,(standard-register-reference datum 'DATA) ,target)
 	 (MOV B (& ,type) ,target))))
 
 (define-rule statement
-  (ASSIGN (OFFSET (REGISTER (? a)) (? n))
+  (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
 	  (CONS-POINTER (CONSTANT (? type)) (ENTRY:PROCEDURE (? label))))
-  (let* ((target (indirect-reference! a n))
-	 (temp (reference-temporary-register! 'ADDRESS)))
+  (let ((temp (reference-temporary-register! 'ADDRESS))
+	(target (indirect-reference! address offset)))
     (LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
 	      ,temp)
 	 (MOV L ,temp ,target)
@@ -434,33 +312,7 @@ MIT in each case. |#
   (ASSIGN (OFFSET (REGISTER (? a0)) (? n0))
 	  (OFFSET (REGISTER (? a1)) (? n1)))
   (let ((source (indirect-reference! a1 n1)))
-    (LAP (MOV L
-	      ,source
-	      ,(indirect-reference! a0 n0)))))
-
-(define-rule statement
-  (ASSIGN (OFFSET (REGISTER (? a)) (? n))
-	  (FIXNUM->OBJECT (REGISTER (? r))))
-  (let ((target (indirect-reference! a n)))
-    (LAP (MOV L ,(coerce->any r) ,target)
-	 ,@(put-type-in-ea (ucode-type fixnum) target))))
-
-(define-rule statement
-  (ASSIGN (OFFSET (REGISTER (? a)) (? n))
-	  (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
-  (let ((temp-reg (allocate-temporary-register! 'DATA))
-	(target-ref (indirect-reference! a n)))
-    (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
-	 (MOV L ,(register-reference temp-reg) ,target-ref))))
-
-
-(define-rule statement
-  (ASSIGN (OFFSET (REGISTER (? a)) (? n))
-	  (FIXNUM-1-ARG (? operator) (? operand)))
-  (let ((temp-reg (allocate-temporary-register! 'DATA))
-	(target-ref (indirect-reference! a n)))
-    (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
-	 (MOV L ,(register-reference temp-reg) ,target-ref))))
+    (LAP (MOV L ,source ,(indirect-reference! a0 n0)))))
 
 ;;;; Consing
 
@@ -479,7 +331,7 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (POST-INCREMENT (REGISTER 13) 1) (REGISTER (? r)))
-  (LAP (MOV L ,(coerce->any r) (@A+ 5))))
+  (LAP (MOV L ,(standard-register-reference r false) (@A+ 5))))
 
 (define-rule statement
   (ASSIGN (POST-INCREMENT (REGISTER 13) 1) (OFFSET (REGISTER (? r)) (? n)))
@@ -488,26 +340,11 @@ MIT in each case. |#
 (define-rule statement
   (ASSIGN (POST-INCREMENT (REGISTER 13) 1)
 	  (FIXNUM->OBJECT (REGISTER (? r))))
-  (LAP (MOV L ,(coerce->any r) (@A+ 5))
-       ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 5)))))
-
-(define-rule statement
-  (ASSIGN (POST-INCREMENT (REGISTER 13) 1)
-	  (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
-	 (MOV L ,(register-reference temp-reg) (@A+ 5)))))
-
-(define-rule statement
-  (ASSIGN (POST-INCREMENT (REGISTER 13) 1)
-	  (FIXNUM-1-ARG (? operator) (? operand)))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
-	 (MOV L ,(register-reference temp-reg) (@A+ 5)))))
-
-;; This pops the top of stack into the heap
+  (LAP (MOV L ,(standard-register-reference r false) (@A+ 5))
+       ,@(fixnum->object  (INST-EA (@A 5)))))
 
 (define-rule statement
+  ;; This pops the top of stack into the heap
   (ASSIGN (POST-INCREMENT (REGISTER 13) 1) (POST-INCREMENT (REGISTER 15) 1))
   (LAP (MOV L (@A+ 7) (@A+ 5))))
 
@@ -523,12 +360,12 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (REGISTER (? r)))
-  (LAP (MOV L ,(coerce->any r) (@-A 7))))
+  (LAP (MOV L ,(standard-register-reference r false) (@-A 7))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
-	  (CONS-POINTER (CONSTANT (? type)) (REGISTER (? r))))
-  (LAP (MOV L ,(coerce->any r) (@-A 7))
+	  (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
+  (LAP (MOV L ,(standard-register-reference datum 'DATA) (@-A 7))
        (MOV B (& ,type) (@A 7))))
 
 (define-rule statement
@@ -549,19 +386,170 @@ MIT in each case. |#
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
 	  (FIXNUM->OBJECT (REGISTER (? r))))
-  (LAP (MOV L ,(coerce->any r) (@-A 7))
-       ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 7)))))
+  (LAP (MOV L ,(standard-register-reference r false) (@-A 7))
+       ,@(fixnum->object (INST-EA (@A 7)))))
+
+;;;; Fixnum Operations
+
+(define-rule statement
+  (ASSIGN (? target) (FIXNUM-1-ARG (? operator) (REGISTER (? source))))
+  (QUALIFIER (and (fixnum-operation-target? target) (pseudo-register? source)))
+  (reuse-and-load-fixnum-target! target
+				 source
+				 (fixnum-1-arg/operate operator)))
+
+(define-rule statement
+  (ASSIGN (? target)
+	  (FIXNUM-2-ARGS (? operator)
+			 (REGISTER (? source))
+			 (OBJECT->FIXNUM (CONSTANT (? constant)))))
+  (QUALIFIER (and (fixnum-operation-target? target) (pseudo-register? source)))
+  (fixnum-2-args/register*constant operator target source constant))
+
+(define-rule statement
+  (ASSIGN (? target)
+	  (FIXNUM-2-ARGS (? operator)
+			 (OBJECT->FIXNUM (CONSTANT (? constant)))
+			 (REGISTER (? source))))
+  (QUALIFIER (and (fixnum-operation-target? target) (pseudo-register? source)))
+  (if (fixnum-2-args/commutative? operator)
+      (fixnum-2-args/register*constant operator target source constant)
+      (fixnum-2-args/constant*register operator target constant source)))
+
+(define (fixnum-2-args/register*constant operator target source constant)
+  (reuse-and-load-fixnum-target! target source
+    (lambda (target)
+      ((fixnum-2-args/operate-constant operator) target constant))))
+
+(define (fixnum-2-args/constant*register operator target constant source)
+  (let ((operate-on-target
+	 (lambda (target)
+	   (LAP ,@(load-fixnum-constant constant target)
+		,@((fixnum-2-args/operate operator)
+		   target
+		   (if (eq? operator 'MULTIPLY-FIXNUM)
+		       (standard-multiply-source source)
+		       (standard-register-reference source 'DATA)))))))
+    (reuse-fixnum-target! target
+      (lambda (target)
+	(operate-on-target (reference-target-alias! target 'DATA)))
+      operate-on-target)))
+
+(define-rule statement
+  (ASSIGN (? target)
+	  (FIXNUM-2-ARGS (? operator)
+			 (REGISTER (? source1))
+			 (REGISTER (? source2))))
+  (QUALIFIER (and (fixnum-operation-target? target)
+		  (pseudo-register? source1)
+		  (pseudo-register? source2)))
+  (let ((worst-case
+	 (lambda (target source1 source2)
+	   (LAP (MOV L ,source1 ,target)
+		,@((fixnum-2-args/operate operator) target source2))))
+	(source-reference
+	 (if (eq? operator 'MULTIPLY-FIXNUM)
+	     standard-multiply-source
+	     (lambda (source) (standard-register-reference source 'DATA)))))
+    (reuse-fixnum-target! target
+      (lambda (target)
+	(reuse-pseudo-register-alias! source1 'DATA
+	  (lambda (alias)
+	    (let ((source2 (source-reference source2)))
+	      (delete-dead-registers!)
+	      (add-pseudo-register-alias! target alias)
+	      ((fixnum-2-args/operate operator) (register-reference alias)
+						source2)))
+	  (lambda ()
+	    (let ((new-target-alias!
+		   (lambda (source1 source2)
+		     (delete-dead-registers!)
+		     (worst-case (reference-target-alias! target 'DATA)
+				 source1
+				 source2))))
+	      (reuse-pseudo-register-alias source2 'DATA
+		(lambda (alias)
+		  (let ((source1 (source-reference source1))
+			(source2 (register-reference alias)))
+		    (let ((use-source2-alias!
+			   (lambda ()
+			     (delete-machine-register! alias)
+			     (delete-dead-registers!)
+			     (add-pseudo-register-alias! target alias)
+			     ((fixnum-2-args/operate operator) source2
+							       source1))))
+		      (cond ((fixnum-2-args/commutative? operator)
+			     (use-source2-alias!))
+			    ((effective-address/data-register? source1)
+			     (LAP (EXG ,source2 ,source1)
+				  ,@(use-source2-alias!)))
+			    (else
+			     (new-target-alias! source1 source2))))))
+		(lambda ()
+		  (new-target-alias!
+		   (standard-register-reference source1 'DATA)
+		   (source-reference source2))))))))      (lambda (target)
+	(worst-case target
+		    (standard-register-reference source1 'DATA)
+		    (source-reference source2))))))
+
+(define (standard-multiply-source register)
+  (let ((alias (register-alias register 'DATA)))
+    (cond (alias
+	   (register-reference alias))
+	  ((register-saved-into-home? register)
+	   (pseudo-register-home register))
+	  (else
+	   (reference-alias-register! register 'DATA)))))	
+
+;;;; CHAR->ASCII/BYTE-OFFSET
 
 (define-rule statement
-  (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) 
-	  (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
-	 (MOV L ,(register-reference temp-reg) (@-A 7)))))
+  (ASSIGN (REGISTER (? target))
+	  (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset))))
+  (QUALIFIER (pseudo-register? target))
+  (byte-offset->register (indirect-char/ascii-reference! address offset)
+			 (indirect-register address)
+			 target))
 
 (define-rule statement
-  (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) 
-	  (FIXNUM-1-ARG (? operator) (? operand)))
-  (let ((temp-reg (allocate-temporary-register! 'DATA)))
-    (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
-	 (MOV L ,(register-reference temp-reg) (@-A 7)))))
+  (ASSIGN (REGISTER (? target)) (CHAR->ASCII (REGISTER (? source))))
+  (QUALIFIER (pseudo-register? target))
+  (let ((source-reference (machine-register-reference source false)))
+    (if source-reference
+	(begin
+	  (delete-dead-registers!)
+	  (LAP (BFEXTU ,source-reference (& 24) (& 8)
+		       ,(reference-target-alias! target 'DATA))))
+	(byte-offset->register
+	 (indirect-char/ascii-reference! regnum:regs-pointer
+					 (pseudo-register-offset source))
+	 (indirect-register regnum:regs-pointer)
+	 target))))
+
+(define-rule statement
+  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+	  (CHAR->ASCII (REGISTER (? source))))
+  (let ((source (coerce->any/byte-reference source)))
+    (let ((target (indirect-byte-reference! address offset)))
+      (LAP (MOV B ,source ,target)))))
+
+(define-rule statement
+  (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+	  (CHAR->ASCII (CONSTANT (? character))))
+  (LAP (MOV B (& ,(char->signed-8-bit-immediate character))
+	    ,(indirect-byte-reference! address offset))))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+	  (BYTE-OFFSET (REGISTER (? address)) (? offset)))
+  (QUALIFIER (pseudo-register? target))
+  (byte-offset->register (indirect-byte-reference! address offset)
+			 (indirect-register address)
+			 target))
+
+(define-rule statement
+  (ASSIGN (BYTE-OFFSET (REGISTER (? target)) (? target-offset))
+	  (CHAR->ASCII (OFFSET (REGISTER (? source)) (? source-offset))))
+  (let ((source (indirect-char/ascii-reference! source source-offset)))
+    (LAP (MOV B ,source ,(indirect-byte-reference! target target-offset)))))
\ No newline at end of file
diff --git a/v7/src/compiler/machines/bobcat/rules2.scm b/v7/src/compiler/machines/bobcat/rules2.scm
index 909ae421a..bf866b501 100644
--- a/v7/src/compiler/machines/bobcat/rules2.scm
+++ b/v7/src/compiler/machines/bobcat/rules2.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.4 1988/06/14 08:48:37 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.5 1988/08/29 22:49:54 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -36,26 +36,84 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 
-;;;; Predicates
-
+(define (predicate/memory-operand? expression)
+  (or (rtl:offset? expression)
+      (and (rtl:post-increment? expression)
+	   (interpreter-stack-pointer?
+	    (rtl:post-increment-register expression)))))
+
+(define (predicate/memory-operand-reference expression)
+  (case (rtl:expression-type expression)
+    ((OFFSET) (offset->indirect-reference! expression))
+    ((POST-INCREMENT) (INST-EA (@A+ 7)))
+    (else (error "Illegal memory operand" expression))))
+
+(define (compare/register*register register-1 register-2 cc)
+  (let ((finish
+	 (lambda (reference-1 reference-2 cc)
+	   (set-standard-branches! cc)
+	   (LAP (CMP L ,reference-2 ,reference-1)))))
+    (let ((finish-1
+	   (lambda (alias)
+	     (finish (register-reference alias)
+		     (standard-register-reference register-2 'DATA)
+		     cc)))
+	  (finish-2
+	   (lambda (alias)
+	     (finish (register-reference alias)
+		     (standard-register-reference register-1 'DATA)
+		     (invert-cc-noncommutative cc)))))
+      (let ((try-type
+	     (lambda (type continue)
+	       (let ((alias (register-alias register-1 type)))
+		 (if alias
+		     (finish-1 alias)
+		     (let ((alias (register-alias register-2 type)))
+		       (if alias
+			   (finish-2 alias)
+			   (continue))))))))
+	(try-type 'DATA
+	  (lambda ()
+	    (try-type 'ADDRESS
+	      (lambda ()
+		(if (dead-register? register-1)
+		    (finish-2 (load-alias-register! register-2 'DATA))
+		    (finish-1 (load-alias-register! register-1 'DATA)))))))))))
+
+(define (compare/register*memory register memory cc)
+  (let ((reference (standard-register-reference register 'DATA)))
+    (if (effective-address/register? reference)
+	(begin
+	  (set-standard-branches! cc)
+	  (LAP (CMP L ,memory ,reference)))
+	(compare/memory*memory reference memory cc))))
+
+(define (compare/memory*memory memory-1 memory-2 cc)
+  (set-standard-branches! cc)
+  (let ((temp (reference-temporary-register! 'DATA)))
+    (LAP (MOV L ,memory-1 ,temp)
+	 (CMP L ,memory-2 ,temp))))
+
 (define-rule predicate
   (TRUE-TEST (REGISTER (? register)))
   (set-standard-branches! 'NE)
-  (LAP ,(test-non-pointer (ucode-type false) 0 (coerce->any register))))
+  (LAP ,(test-non-pointer (ucode-type false)
+			  0
+			  (standard-register-reference register false))))
 
 (define-rule predicate
-  (TRUE-TEST (OFFSET (REGISTER (? register)) (? offset)))
+  (TRUE-TEST (? memory))
+  (QUALIFIER (predicate/memory-operand? memory))
   (set-standard-branches! 'NE)
-  (LAP ,(test-non-pointer (ucode-type false) 0
-			  (indirect-reference! register offset))))
+  (LAP ,(test-non-pointer (ucode-type false)
+			  0
+			  (predicate/memory-operand-reference memory))))
 
 (define-rule predicate
   (TYPE-TEST (REGISTER (? register)) (? type))
   (QUALIFIER (pseudo-register? register))
   (set-standard-branches! 'EQ)
-  (LAP ,(test-byte
-	 type
-	 (register-reference (load-alias-register! register 'DATA)))))
+  (LAP ,(test-byte type (reference-alias-register! register 'DATA))))
 
 (define-rule predicate
   (TYPE-TEST (OBJECT->TYPE (REGISTER (? register))) (? type))
@@ -66,284 +124,200 @@ MIT in each case. |#
 	 ,(test-byte type reference))))
 
 (define-rule predicate
-  (TYPE-TEST (OBJECT->TYPE (OFFSET (REGISTER (? register)) (? offset)))
-	     (? type))
+  (TYPE-TEST (OBJECT->TYPE (? memory)) (? type))
+  (QUALIFIER (predicate/memory-operand? memory))
   (set-standard-branches! 'EQ)
-  (LAP ,(test-byte type (indirect-reference! register offset))))
+  (LAP ,(test-byte type (predicate/memory-operand-reference memory))))
 
 (define-rule predicate
   (UNASSIGNED-TEST (REGISTER (? register)))
   (set-standard-branches! 'EQ)
-  (LAP ,(test-non-pointer (ucode-type unassigned) 0
-			  (coerce->any register))))
+  (LAP ,(test-non-pointer (ucode-type unassigned)
+			  0
+			  (standard-register-reference register 'DATA))))
 
 (define-rule predicate
-  (UNASSIGNED-TEST (OFFSET (REGISTER (? register)) (? offset)))
+  (UNASSIGNED-TEST (? memory))
+  (QUALIFIER (predicate/memory-operand? memory))
   (set-standard-branches! 'EQ)
-  (LAP ,(test-non-pointer (ucode-type unassigned) 0
-			  (indirect-reference! register offset))))
-
-(define (eq-test/constant*register constant register)
-  (set-standard-branches! 'EQ)
-  (if (non-pointer-object? constant)
-      (LAP ,(test-non-pointer (object-type constant)
-			      (object-datum constant)
-			      (coerce->any register)))
-      (LAP (CMP L (@PCR ,(constant->label constant))
-		,(coerce->machine-register register)))))
-
-(define (eq-test/constant*memory constant memory-reference)
-  (set-standard-branches! 'EQ)
-  (if (non-pointer-object? constant)
-      (LAP ,(test-non-pointer (object-type constant)
-			      (object-datum constant)
-			      memory-reference))
-      (let ((temp (reference-temporary-register! false)))
-	(LAP (MOV L ,memory-reference ,temp)
-	     (CMP L (@PCR ,(constant->label constant))
-		  ,temp)))))
-
-(define (eq-test/register*register register-1 register-2)
-  (set-standard-branches! 'EQ)
-  (let ((finish
-	 (lambda (register-1 register-2)
-	   (LAP (CMP L ,(coerce->any register-2)
-		     ,(coerce->machine-register register-1))))))
-    (if (or (and (not (register-has-alias? register-1 'DATA))
-		 (register-has-alias? register-2 'DATA))
-	    (and (not (register-has-alias? register-1 'ADDRESS))
-		 (register-has-alias? register-2 'ADDRESS)))
-	(finish register-2 register-1)
-	(finish register-1 register-2))))
-
-(define (eq-test/register*memory register memory-reference)
-  (set-standard-branches! 'EQ)
-  (LAP (CMP L ,memory-reference
-	    ,(coerce->machine-register register))))
-
-(define (eq-test/memory*memory register-1 offset-1 register-2 offset-2)
-  (set-standard-branches! 'EQ)
-  (let ((temp (reference-temporary-register! false)))
-    (let ((finish
-	   (lambda (register-1 offset-1 register-2 offset-2)
-	     (LAP (MOV L ,(indirect-reference! register-1 offset-1)
-		       ,temp)
-		  (CMP L ,(indirect-reference! register-2 offset-2)
-		       ,temp)))))
-      (if (or (and (not (register-has-alias? register-1 'ADDRESS))
-		   (register-has-alias? register-2 'ADDRESS))
-	      (and (not (register-has-alias? register-1 'DATA))
-		   (register-has-alias? register-2 'DATA)))
-	  (finish register-2 offset-2 register-1 offset-1)
-	  (finish register-1 offset-1 register-2 offset-2)))))
-
-(define-rule predicate
-  (EQ-TEST (REGISTER (? register)) (CONSTANT (? constant)))
-  (eq-test/constant*register constant register))
-
-(define-rule predicate
-  (EQ-TEST (CONSTANT (? constant)) (REGISTER (? register)))
-  (eq-test/constant*register constant register))
+  (LAP ,(test-non-pointer (ucode-type unassigned)
+			  0
+			  (predicate/memory-operand-reference memory))))
 
 (define-rule predicate
-  (EQ-TEST (OFFSET (REGISTER (? register)) (? offset)) (CONSTANT (? constant)))
-  (eq-test/constant*memory constant (indirect-reference! register offset)))
-
-(define-rule predicate
-  (EQ-TEST (CONSTANT (? constant)) (OFFSET (REGISTER (? register)) (? offset)))
-  (eq-test/constant*memory constant (indirect-reference! register offset)))
-
-(define-rule predicate
-  (EQ-TEST (CONSTANT (? constant)) (POST-INCREMENT (REGISTER 15) 1))
-  (eq-test/constant*memory constant (INST-EA (@A+ 7))))
-
-(define-rule predicate
-  (EQ-TEST (POST-INCREMENT (REGISTER 15) 1) (CONSTANT (? constant)))
-  (eq-test/constant*memory constant (INST-EA (@A+ 7))))
-
+  (OVERFLOW-TEST)
+  (set-standard-branches! 'VS))
+
 (define-rule predicate
   (EQ-TEST (REGISTER (? register-1)) (REGISTER (? register-2)))
-  (eq-test/register*register register-1 register-2))
+  (QUALIFIER (and (pseudo-register? register-1)
+		  (pseudo-register? register-2)))
+  (compare/register*register register-1 register-2 'EQ))
 
 (define-rule predicate
-  (EQ-TEST (OFFSET (REGISTER (? register-1)) (? offset-1))
-	   (REGISTER (? register-2)))
-  (eq-test/register*memory register-2
-			   (indirect-reference! register-1 offset-1)))
+  (EQ-TEST (REGISTER (? register)) (? memory))
+  (QUALIFIER (and (predicate/memory-operand? memory)
+		  (pseudo-register? register)))
+  (compare/register*memory register
+			   (predicate/memory-operand-reference memory)
+			   'EQ))
 
 (define-rule predicate
-  (EQ-TEST (REGISTER (? register-1))
-	   (OFFSET (REGISTER (? register-2)) (? offset-2)))
-  (eq-test/register*memory register-1
-			   (indirect-reference! register-2 offset-2)))
+  (EQ-TEST (? memory) (REGISTER (? register)))
+  (QUALIFIER (and (predicate/memory-operand? memory)
+		  (pseudo-register? register)))
+  (compare/register*memory register
+			   (predicate/memory-operand-reference memory)
+			   'EQ))
 
 (define-rule predicate
-  (EQ-TEST (POST-INCREMENT (REGISTER 15) 1) (REGISTER (? register)))
-  (eq-test/register*memory register (INST-EA (@A+ 7))))
+  (EQ-TEST (? memory-1) (? memory-2))
+  (QUALIFIER (and (predicate/memory-operand? memory-1)
+		  (predicate/memory-operand? memory-2)))
+  (compare/memory*memory (predicate/memory-operand-reference memory-1)
+			 (predicate/memory-operand-reference memory-2)
+			 'EQ))
 
-(define-rule predicate
-  (EQ-TEST (REGISTER (? register)) (POST-INCREMENT (REGISTER 15) 1))
-  (eq-test/register*memory register (INST-EA (@A+ 7))))
-
-(define-rule predicate
-  (EQ-TEST (OFFSET (REGISTER (? register-1)) (? offset-1))
-	   (OFFSET (REGISTER (? register-2)) (? offset-2)))
-  (eq-test/memory*memory register-1 offset-1 register-2 offset-2))
-
-
-;;; fixnum predicates
-
-(define (fixnum-pred/register*register register-1 register-2 cc)
-  (let ((finish
-	 (lambda (register-1 register-2 maybe-invert)
-	   (set-standard-branches! (maybe-invert cc))
-	   (LAP (CMP L ,(coerce->any register-1)
-		     ,(coerce->machine-register register-2))))))
-    (if (or (and (not (register-has-alias? register-1 'DATA))
-		 (register-has-alias? register-2 'DATA))
-	    (and (not (register-has-alias? register-1 'ADDRESS))
-		 (register-has-alias? register-2 'ADDRESS)))
-	(finish register-2 register-1 invert-cc)
-	(finish register-1 register-2 (lambda (x) x)))))
-
-(define (fixnum-pred/constant*register constant register cc)
-  (set-standard-branches! cc)
+(define (eq-test/constant*register constant register)
   (if (non-pointer-object? constant)
-      (LAP (CMPI L (& ,(object-datum constant)) ,(coerce->any register)))
-      (LAP (CMP L (@PCR ,(constant->label constant))
-		,(coerce->machine-register register)))))
-
-(define (fixnum-pred/constant*memory constant memory-reference cc)
-  (set-standard-branches! cc)
+      (begin
+	(set-standard-branches! 'EQ)
+	(LAP ,(test-non-pointer (object-type constant)
+				(object-datum constant)
+				(standard-register-reference register 'DATA))))
+      (compare/register*memory register
+			       (INST-EA (@PCR ,(constant->label constant)))
+			       'EQ)))
+
+(define (eq-test/constant*memory constant memory)
   (if (non-pointer-object? constant)
-      (LAP (CMPI L (& ,(object-datum constant)) ,memory-reference))
-      (let ((temp (reference-temporary-register! false)))
-	(LAP (MOV L ,memory-reference ,temp)
-	     (CMP L (@PCR ,(constant->label constant))
-		  ,temp)))))
-
-(define (fixnum-pred/register*memory register memory-reference cc)
-  (set-standard-branches! cc)
-  (LAP (CMP L ,memory-reference
-	    ,(coerce->machine-register register))))
-
-(define (fixnum-pred/memory*memory register-1 offset-1 register-2 offset-2 cc)
-  (let ((temp (reference-temporary-register! false)))
-    (let ((finish
-	   (lambda (register-1 offset-1 register-2 offset-2 maybe-invert)
-	     (set-standard-branches! (maybe-invert cc))
-	     (LAP (MOV L ,(indirect-reference! register-1 offset-1)
-		       ,temp)
-		  (CMP L ,(indirect-reference! register-2 offset-2)
-		       ,temp)))))
-      (if (or (and (not (register-has-alias? register-1 'ADDRESS))
-		   (register-has-alias? register-2 'ADDRESS))
-	      (and (not (register-has-alias? register-1 'DATA))
-		   (register-has-alias? register-2 'DATA)))
-	  (finish register-2 offset-2 register-1 offset-1 invert-cc)
-	  (finish register-1 offset-1 register-2 offset-2 (lambda (x) x))))))
-
-
+      (begin
+	(set-standard-branches! 'EQ)
+	(LAP ,(test-non-pointer (object-type constant)
+				(object-datum constant)
+				memory)))
+      (compare/memory*memory memory
+			     (INST-EA (@PCR ,(constant->label constant)))
+			     'EQ)))
 
 (define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (REGISTER (? register-1)) (REGISTER (? register-2)))
-  (fixnum-pred/register*register register-2 register-1
-				 (fixnum-pred->cc predicate)))
-
-(define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (REGISTER (? register)) (CONSTANT (? constant)))
-  (fixnum-pred/constant*register constant register
-				 (fixnum-pred->cc predicate)))
+  (EQ-TEST (CONSTANT (? constant)) (REGISTER (? register)))
+  (QUALIFIER (pseudo-register? register))
+  (eq-test/constant*register constant register))
 
 (define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (CONSTANT (? constant)) (REGISTER (? register)))
-  (fixnum-pred/constant*register constant register
-				 (invert-cc (fixnum-pred->cc predicate))))
+  (EQ-TEST (REGISTER (? register)) (CONSTANT (? constant)))
+  (QUALIFIER (pseudo-register? register))
+  (eq-test/constant*register constant register))
 
 (define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (OFFSET (REGISTER (? register)) (? offset))
-		      (CONSTANT (? constant)))
-  (fixnum-pred/constant*memory constant (indirect-reference! register offset)
-			       (fixnum-pred->cc predicate)))
+  (EQ-TEST (CONSTANT (? constant)) (? memory))
+  (QUALIFIER (predicate/memory-operand? memory))
+  (eq-test/constant*memory constant
+			   (predicate/memory-operand-reference memory)))
 
 (define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (CONSTANT (? constant))
-		      (OFFSET (REGISTER (? register)) (? offset)))
-  (fixnum-pred/constant*memory constant (indirect-reference! register offset)
-			       (invert-cc (fixnum-pred->cc predicate))))
+  (EQ-TEST (? memory) (CONSTANT (? constant)))
+  (QUALIFIER (predicate/memory-operand? memory))
+  (eq-test/constant*memory constant
+			   (predicate/memory-operand-reference memory)))
+
+;;;; Fixnum Predicates
 
 (define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (CONSTANT (? constant))
-		      (POST-INCREMENT (REGISTER 15) 1))
-  (fixnum-pred/constant*memory constant (INST-EA (@A+ 7))
-			       (invert-cc (fixnum-pred->cc predicate))))
+  (FIXNUM-PRED-1-ARG (? predicate) (REGISTER (? register)))
+  (QUALIFIER (pseudo-register? register))
+  (set-standard-branches! (fixnum-predicate->cc predicate))
+  (test-fixnum (standard-register-reference register 'DATA)))
 
 (define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (POST-INCREMENT (REGISTER 15) 1) (CONSTANT (? constant)))
-  (fixnum-pred/constant*memory constant (INST-EA (@A+ 7))
-			       (fixnum-pred->cc predicate)))
+  (FIXNUM-PRED-1-ARG (? predicate) (? memory))
+  (QUALIFIER (predicate/memory-operand? memory))
+  (set-standard-branches! (fixnum-predicate->cc predicate))
+  (test-fixnum (predicate/memory-operand-reference memory)))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
-		      (OFFSET (REGISTER (? register-1)) (? offset-1))
+		      (REGISTER (? register-1))
 		      (REGISTER (? register-2)))
-  (fixnum-pred/register*memory register-2
-			       (indirect-reference! register-1 offset-1)
-			       (invert-cc (fixnum-pred->cc predicate))))
+  (QUALIFIER (and (pseudo-register? register-1)
+		  (pseudo-register? register-2)))
+  (compare/register*register register-1
+			     register-2
+			     (fixnum-predicate->cc predicate)))
+
+(define-rule predicate
+  (FIXNUM-PRED-2-ARGS (? predicate) (REGISTER (? register)) (? memory))
+  (QUALIFIER (and (predicate/memory-operand? memory)
+		  (pseudo-register? register)))
+  (compare/register*memory register
+			   (predicate/memory-operand-reference memory)
+			   (fixnum-predicate->cc predicate)))
+
+(define-rule predicate
+  (FIXNUM-PRED-2-ARGS (? predicate) (? memory) (REGISTER (? register)))
+  (QUALIFIER (and (predicate/memory-operand? memory)
+		  (pseudo-register? register)))
+  (compare/register*memory
+   register
+   (predicate/memory-operand-reference memory)
+   (invert-cc-noncommutative (fixnum-predicate->cc predicate))))
+
+(define-rule predicate
+  (FIXNUM-PRED-2-ARGS (? predicate) (? memory-1) (? memory-2))
+  (QUALIFIER (and (predicate/memory-operand? memory-1)
+		  (predicate/memory-operand? memory-2)))
+  (compare/memory*memory (predicate/memory-operand-reference memory-1)
+			 (predicate/memory-operand-reference memory-2)
+			 (fixnum-predicate->cc predicate)))
+
+(define (fixnum-predicate/register*constant register constant cc)
+  (set-standard-branches! cc)
+  (guarantee-signed-fixnum constant)
+  (let ((reference (standard-register-reference register 'DATA)))
+    (if (effective-address/register? reference)
+	(LAP (CMP L (& ,constant) ,reference))
+	(LAP (CMPI L (& ,constant) ,reference)))))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
-		      (REGISTER (? register-1))
-		      (OFFSET (REGISTER (? register-2)) (? offset-2)))
-  (fixnum-pred/register*memory register-1
-			   (indirect-reference! register-2 offset-2)
-			   (fixnum-pred->cc predicate)))
+		      (REGISTER (? register))
+		      (OBJECT->FIXNUM (CONSTANT (? constant))))
+  (QUALIFIER (pseudo-register? register))
+  (fixnum-predicate/register*constant register
+				      constant
+				      (fixnum-predicate->cc predicate)))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
-		      (POST-INCREMENT (REGISTER 15) 1) (REGISTER (? register)))
-  (fixnum-pred/register*memory register (INST-EA (@A+ 7))
-			       (invert-cc (fixnum-pred->cc predicate))))
+		      (OBJECT->FIXNUM (CONSTANT (? constant)))
+		      (REGISTER (? register)))
+  (QUALIFIER (pseudo-register? register))
+  (fixnum-predicate/register*constant
+   register
+   constant
+   (invert-cc-noncommutative (fixnum-predicate->cc predicate))))
 
-(define-rule predicate
-  (FIXNUM-PRED-2-ARGS (? predicate)
-		      (REGISTER (? register)) (POST-INCREMENT (REGISTER 15) 1))
-  (fixnum-pred/register*memory register (INST-EA (@A+ 7))
-			       (fixnum-pred->cc predicate)))
+(define (fixnum-predicate/memory*constant memory constant cc)
+  (set-standard-branches! cc)
+  (guarantee-signed-fixnum constant)
+  (LAP (CMPI L (& ,constant) ,memory)))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
-		      (OFFSET (REGISTER (? register-1)) (? offset-1))
-		      (OFFSET (REGISTER (? register-2)) (? offset-2)))
-  (fixnum-pred/memory*memory register-1 offset-1 register-2 offset-2
-			     (fixnum-pred->cc predicate)))
-
-
-(define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate) (REGISTER (? register)))
-  (set-standard-branches! (fixnum-pred->cc predicate))
-  (test-fixnum (coerce->any register)))
+		      (? memory)
+		      (OBJECT->FIXNUM (CONSTANT (? constant))))
+  (QUALIFIER (predicate/memory-operand? memory))
+  (fixnum-predicate/memory*constant (predicate/memory-operand-reference memory)
+				    constant
+				    (fixnum-predicate->cc predicate)))
 
 (define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate) (CONSTANT (? constant)))
-  (set-standard-branches! (fixnum-pred->cc predicate))
-    (if (non-pointer-object? constant)
-      (test-fixnum (INST-EA (& ,(object-datum constant))))
-      (test-fixnum (INST-EA (@PCR ,(constant->label constant))))))
-
-(define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate) (POST-INCREMENT (REGISTER 15) 1))
-  (set-standard-branches! (fixnum-pred->cc predicate))
-  (test-fixnum (INST-EA (@A+ 7))))
-
-(define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate) (OFFSET (REGISTER (? register)) (? offset)))
-  (set-standard-branches! (fixnum-pred->cc predicate))
-  (test-fixnum (indirect-reference! offset register)))
+  (FIXNUM-PRED-2-ARGS (? predicate)
+		      (OBJECT->FIXNUM (CONSTANT (? constant)))
+		      (? memory))
+  (QUALIFIER (predicate/memory-operand? memory))
+  (fixnum-predicate/memory*constant
+   (predicate/memory-operand-reference memory)
+   constant
+   (invert-cc-noncommutative (fixnum-predicate->cc predicate))))
\ No newline at end of file
-- 
2.25.1