Add open-coding for FIXNUM-NOT, FIXNUM-AND, FIXNUM-ANDC, FIXNUM-OR,

and FIXNUM-XOR.

diff --git a/v7/src/compiler/machines/mips/machin.scm b/v7/src/compiler/machines/mips/machin.scm
index 864abea14acc0cfd48a0b7c1d8035c45e518a95e..b16a9e8cc268ce4c1d2c8d63e746c9b44622f7ac 100644 (file)
--- 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 3f63a8494bbee732b1a99c30a2314d1570aba43d..5ff92f9a2d49b159b123f47027036bd274ca31f6 100644 (file)
--- 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))))
 \f
 (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))))
 \f
 (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))