Tweak fixnum rules slightly so that previous implementation of logical
authorChris Hanson <org/chris-hanson/cph>
Mon, 28 Dec 1992 22:01:22 +0000 (22:01 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 28 Dec 1992 22:01:22 +0000 (22:01 +0000)
fixnum operations will work correctly.

v7/src/compiler/machines/mips/lapgen.scm
v7/src/compiler/machines/mips/rulfix.scm

index bc04d40510703c631fc2b99a2de97537386a29d6..07b44529bb02c9703ac1ac32edf7750cf69f7058 100644 (file)
@@ -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))
index 5ff92f9a2d49b159b123f47027036bd274ca31f6..5b10374c5879e9884295182f7432e7153ec20cbc 100644 (file)
@@ -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))