From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 28 Dec 1992 22:01:22 +0000 (+0000)
Subject: Tweak fixnum rules slightly so that previous implementation of logical
X-Git-Tag: 20090517-FFI~8637
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c4bfe9722ec07fd8fca5909a9fb0b25bf41326db;p=mit-scheme.git

Tweak fixnum rules slightly so that previous implementation of logical
fixnum operations will work correctly.
---

diff --git a/v7/src/compiler/machines/mips/lapgen.scm b/v7/src/compiler/machines/mips/lapgen.scm
index bc04d4051..07b44529b 100644
--- a/v7/src/compiler/machines/mips/lapgen.scm
+++ b/v7/src/compiler/machines/mips/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/lapgen.scm,v 1.11 1992/08/20 01:23:26 jinx Exp $
+$Id: lapgen.scm,v 1.12 1992/12/28 22:01:14 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -532,6 +532,9 @@ MIT in each case. |#
   (cdr (or (assq operator (cdr methods))
 	   (error "Unknown operator" operator))))
 
+(define-integrable (arithmetic-method? operator methods)
+  (assq operator (cdr methods)))
+
 (define-integrable (ea/mode ea) (car ea))
 (define-integrable (register-ea/register ea) (cadr ea))
 (define-integrable (offset-ea/offset ea) (cadr ea))
diff --git a/v7/src/compiler/machines/mips/rulfix.scm b/v7/src/compiler/machines/mips/rulfix.scm
index 5ff92f9a2..5b10374c5 100644
--- a/v7/src/compiler/machines/mips/rulfix.scm
+++ b/v7/src/compiler/machines/mips/rulfix.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rulfix.scm,v 1.7 1992/12/22 02:20:45 cph Exp $
+$Id: rulfix.scm,v 1.8 1992/12/28 22:01:22 cph Exp $
 
 Copyright (c) 1989-1992 Massachusetts Institute of Technology
 
@@ -399,6 +399,7 @@ MIT in each case. |#
 			 (REGISTER (? source))
 			 (OBJECT->FIXNUM (CONSTANT (? constant)))
 			 (? overflow?)))
+  (QUALIFIER (fixnum-2-args/operator/register*constant? operation))
   (standard-unary-conversion source target
     (lambda (source target)
       ((fixnum-2-args/operator/register*constant operation)
@@ -411,6 +412,10 @@ MIT in each case. |#
 			 (OBJECT->FIXNUM (CONSTANT (? constant)))
 			 (REGISTER (? source))
 			 (? overflow?)))
+  (QUALIFIER
+   (or (fixnum-2-args/operator/constant*register? operation)
+       (and (fixnum-2-args/commutative? operation)
+	    (fixnum-2-args/operator/register*constant? operation))))
   (standard-unary-conversion source target
     (lambda (source target)
       (if (fixnum-2-args/commutative? operation)
@@ -426,12 +431,17 @@ MIT in each case. |#
 (define (fixnum-2-args/operator/register*constant operation)
   (lookup-arithmetic-method operation fixnum-methods/2-args/register*constant))
 
+(define (fixnum-2-args/operator/register*constant? operation)
+  (arithmetic-method? operation fixnum-methods/2-args/register*constant))
+
 (define fixnum-methods/2-args/register*constant
   (list 'FIXNUM-METHODS/2-ARGS/REGISTER*CONSTANT))
 
 (define (fixnum-2-args/operator/constant*register operation)
-  (lookup-arithmetic-method operation
-			    fixnum-methods/2-args/constant*register))
+  (lookup-arithmetic-method operation fixnum-methods/2-args/constant*register))
+
+(define (fixnum-2-args/operator/constant*register? operation)
+  (arithmetic-method? operation fixnum-methods/2-args/constant*register))
 
 (define fixnum-methods/2-args/constant*register
   (list 'FIXNUM-METHODS/2-ARGS/CONSTANT*REGISTER))