Initial revision

diff --git a/v7/src/compiler/machines/i386/rules2.scm b/v7/src/compiler/machines/i386/rules2.scm
new file mode 100644 (file)
index 0000000..9add592
--- /dev/null
+++ b/v7/src/compiler/machines/i386/rules2.scm
@@ -0,0 +1,140 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules2.scm,v 1.1 1992/01/28 05:09:19 jinx Exp $
+$MC68020-Header: rules2.scm,v 4.12 90/01/18 22:44:04 GMT cph Exp $
+
+Copyright (c) 1992 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  Permission to copy this software, to redistribute
+it, and to use it for any purpose is granted, subject to the following
+restrictions and understandings.
+
+1. Any copy made of this software must include this copyright notice
+in full.
+
+2. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; LAP Generation Rules: Predicates
+;;; package: (compiler lap-syntaxer)
+
+(declare (usual-integrations))
+\f
+(define (set-equal-branches!)
+  (set-current-branches! (lambda (label)
+                          (LAP (JE (@PCR ,label))))
+                        (lambda (label)
+                          (LAP (JNE (@PCR ,label))))))
+
+(define (compare/register*register reg1 reg2)
+  (cond ((register-alias reg1 'GENERAL)
+        =>
+        (lambda (alias)
+          (LAP (CMP W ,(register-reference alias) ,(any-reference reg2)))))
+       ((register-alias reg2 'GENERAL)
+        =>
+        (lambda (alias)
+          (LAP (CMP W ,(any-reference reg1) ,(register-reference alias)))))
+       (else
+        (LAP (CMP W ,(source-register-reference reg1)
+                  ,(any-reference reg2))))))
+
+(define-rule predicate
+  (TYPE-TEST (REGISTER (? register)) (? type))
+  (set-equal-branches!)
+  (LAP (CMP B ,(reference-alias-register! register) (&U ,type))))
+
+(define-rule predicate
+  (EQ-TEST (REGISTER (? register-1)) (REGISTER (? register-2)))
+  (set-equal-branches!)
+  (compare/register*register register-1 register-2))
+
+(define-rule predicate
+  (EQ-TEST (REGISTER (? register)) (OFFSET (REGISTER (? address)) (? offset)))
+  (set-equal-branches!)
+  (LAP (CMP W ,(source-register-reference register)
+           ,(source-indirect-reference! address offset))))
+
+(define-rule predicate
+  (EQ-TEST (OFFSET (REGISTER (? address)) (? offset)) (REGISTER (? register)))
+  (set-equal-branches!)
+  (LAP (CMP W ,(source-indirect-reference! address offset)
+           ,(source-register-reference register))))
+
+(define-rule predicate
+  (EQ-TEST (CONSTANT (? constant)) (REGISTER (? register)))
+  (QUALIFIER (non-pointer-object? constant))
+  (set-equal-branches!)
+  (LAP (CMP W ,(any-reference register)
+           (&U ,(non-pointer->immediate constant)))))
+
+(define-rule predicate
+  (EQ-TEST (REGISTER (? register)) (CONSTANT (? constant)))
+  (QUALIFIER (non-pointer-object? constant))
+  (set-equal-branches!)
+  (LAP (CMP W ,(any-reference register)
+           (&U ,(non-pointer->immediate constant)))))
+\f
+(define-rule predicate
+  (EQ-TEST (CONSTANT (? constant)) (OFFSET (REGISTER (? address)) (? offset)))
+  (QUALIFIER (non-pointer-object? constant))
+  (set-equal-branches!)
+  (LAP (CMP W ,(source-indirect-reference! address offset)
+           (&U ,(non-pointer->literal constant)))))
+
+(define-rule predicate
+  (EQ-TEST (OFFSET (REGISTER (? address)) (? offset)) (CONSTANT (? constant)))
+  (QUALIFIER (non-pointer-object? constant))
+  (set-equal-branches!)
+  (LAP (CMP W ,(source-indirect-reference! address offset)
+           (&U ,(non-pointer->literal constant)))))
+
+(define-rule predicate
+  (EQ-TEST (CONS-POINTER (MACHINE-CONSTANT (? type))
+                        (MACHINE-CONSTANT (? datum)))
+          (REGISTER (? register)))
+  (set-equal-branches!)
+  (LAP (CMP W ,(any-reference register)
+           (&U ,(make-non-pointer-literal type datum)))))
+
+(define-rule predicate
+  (EQ-TEST (REGISTER (? register))
+          (CONS-POINTER (MACHINE-CONSTANT (? type))
+                        (MACHINE-CONSTANT (? datum))))
+  (set-equal-branches!)
+  (LAP (CMP W ,(any-reference register)
+           (&U ,(make-non-pointer-literal type datum)))))
+
+(define-rule predicate
+  (EQ-TEST (CONS-POINTER (MACHINE-CONSTANT (? type))
+                        (MACHINE-CONSTANT (? datum)))
+          (OFFSET (REGISTER (? address)) (? offset)))
+  (set-equal-branches!)
+  (LAP (CMP W ,(source-indirect-reference! address offset)
+           (&U ,(make-non-pointer-literal type datum)))))
+
+(define-rule predicate
+  (EQ-TEST (OFFSET (REGISTER (? address)) (? offset))
+          (CONS-POINTER (MACHINE-CONSTANT (? type))
+                        (MACHINE-CONSTANT (? datum))))
+  (set-equal-branches!)
+  (LAP (CMP W ,(source-indirect-reference! address offset)
+           (&U ,(make-non-pointer-literal type datum)))))
\ No newline at end of file