From 41c6f60911e1718128805d7581f20ac3713f23ea Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 22 Dec 1992 02:20:45 +0000
Subject: [PATCH] Add open-coding for FIXNUM-NOT, FIXNUM-AND, FIXNUM-ANDC,
 FIXNUM-OR, and FIXNUM-XOR.

---
 v7/src/compiler/machines/mips/machin.scm | 12 +++------
 v7/src/compiler/machines/mips/rulfix.scm | 31 ++++++++++++++++++++++--
 2 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/v7/src/compiler/machines/mips/machin.scm b/v7/src/compiler/machines/mips/machin.scm
index 864abea14..b16a9e8cc 100644
--- a/v7/src/compiler/machines/mips/machin.scm
+++ b/v7/src/compiler/machines/mips/machin.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: machin.scm,v 1.9 1992/11/18 03:52:14 gjr Exp $
+$Id: machin.scm,v 1.10 1992/12/22 02:17:06 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -369,11 +369,8 @@ MIT in each case. |#
 	       3)))
 	((MACHINE-CONSTANT)
 	 (if-integer (rtl:machine-constant-value expression)))
-	((ENTRY:PROCEDURE
-	  ENTRY:CONTINUATION
-	  ASSIGNMENT-CACHE
-	  VARIABLE-CACHE
-	  OFFSET-ADDRESS)
+	((ENTRY:PROCEDURE ENTRY:CONTINUATION ASSIGNMENT-CACHE VARIABLE-CACHE
+			  OFFSET-ADDRESS)
 	 3)
 	((CONS-NON-POINTER)
 	 (and (rtl:machine-constant? (rtl:cons-non-pointer-type expression))
@@ -389,8 +386,7 @@ MIT in each case. |#
   true)
 
 (define compiler:primitives-with-no-open-coding
-  '(DIVIDE-FIXNUM GCD-FIXNUM FIXNUM-QUOTIENT FIXNUM-REMAINDER
-    FIXNUM-NOT FIXNUM-AND FIXNUM-ANDC FIXNUM-OR FIXNUM-XOR FIXNUM-LSH
+  '(DIVIDE-FIXNUM GCD-FIXNUM FIXNUM-QUOTIENT FIXNUM-REMAINDER FIXNUM-LSH
     INTEGER-QUOTIENT INTEGER-REMAINDER &/ QUOTIENT REMAINDER
     FLONUM-SIN FLONUM-COS FLONUM-TAN FLONUM-ASIN FLONUM-ACOS
     FLONUM-ATAN FLONUM-EXP FLONUM-LOG FLONUM-TRUNCATE FLONUM-ROUND
diff --git a/v7/src/compiler/machines/mips/rulfix.scm b/v7/src/compiler/machines/mips/rulfix.scm
index 3f63a8494..5ff92f9a2 100644
--- a/v7/src/compiler/machines/mips/rulfix.scm
+++ b/v7/src/compiler/machines/mips/rulfix.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rulfix.scm,v 1.6 1992/08/20 01:28:14 jinx Exp $
+$Id: rulfix.scm,v 1.7 1992/12/22 02:20:45 cph Exp $
 
 Copyright (c) 1989-1992 Massachusetts Institute of Technology
 
@@ -229,6 +229,11 @@ MIT in each case. |#
 			   (BLTZ ,tgt (@PCR ,if-no-overflow))
 			   (NOP)))))))
 	   (LAP)))))
+
+(define-arithmetic-method 'FIXNUM-NOT fixnum-methods/1-arg
+  (lambda (tgt src overflow?)
+    overflow?
+    (LAP (NOR ,tgt 0 ,src))))
 
 (define-rule statement
   ;; execute a binary fixnum operation
@@ -365,6 +370,27 @@ MIT in each case. |#
        (MFLO ,tgt)))
 
 (define-arithmetic-method 'MULTIPLY-FIXNUM fixnum-methods/2-args do-multiply)
+
+(define-arithmetic-method 'FIXNUM-AND fixnum-methods/2-args
+  (lambda (tgt src1 src2 overflow?)
+    overflow?
+    (LAP (AND ,tgt ,src1 ,src2))))
+
+(define-arithmetic-method 'FIXNUM-ANDC fixnum-methods/2-args
+  (lambda (tgt src1 src2 overflow?)
+    overflow?
+    (LAP (NOR ,regnum:assembler-temp 0 ,src2)
+	 (AND ,tgt ,src1 ,regnum:assembler-temp))))
+
+(define-arithmetic-method 'FIXNUM-OR fixnum-methods/2-args
+  (lambda (tgt src1 src2 overflow?)
+    overflow?
+    (LAP (OR ,tgt ,src1 ,src2))))
+
+(define-arithmetic-method 'FIXNUM-XOR fixnum-methods/2-args
+  (lambda (tgt src1 src2 overflow?)
+    overflow?
+    (LAP (XOR ,tgt ,src1 ,src2))))
 
 (define-rule statement
   ;; execute binary fixnum operation with constant second arg
@@ -394,7 +420,8 @@ MIT in each case. |#
 	   target constant source overflow?)))))
 
 (define (fixnum-2-args/commutative? operator)
-  (memq operator '(PLUS-FIXNUM MULTIPLY-FIXNUM)))
+  (memq operator
+	'(PLUS-FIXNUM MULTIPLY-FIXNUM FIXNUM-AND FIXNUM-OR FIXNUM-XOR)))
 
 (define (fixnum-2-args/operator/register*constant operation)
   (lookup-arithmetic-method operation fixnum-methods/2-args/register*constant))
-- 
2.25.1