From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Thu, 13 Feb 1992 07:48:52 +0000 (+0000)
Subject: More changes.
X-Git-Tag: 20090517-FFI~9762
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=895d167bc440a572031dc825dfee842ba9230313;p=mit-scheme.git

More changes.
---

diff --git a/v7/src/compiler/machines/i386/insmac.scm b/v7/src/compiler/machines/i386/insmac.scm
index 6db10f57c..a55492196 100644
--- a/v7/src/compiler/machines/i386/insmac.scm
+++ b/v7/src/compiler/machines/i386/insmac.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insmac.scm,v 1.6 1992/02/13 05:43:25 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insmac.scm,v 1.7 1992/02/13 07:47:07 jinx Exp $
 $Vax-Header: insmac.scm,v 1.12 89/05/17 20:29:15 GMT jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -81,6 +81,11 @@ MIT in each case. |#
 		    (and (memq ',restriction (ea/categories ea))
 			 ea))))))))
 
+;; *** We can't really handle switching these right now. ***
+
+(define-integrable *ADDRESS-SIZE* 32)
+(define-integrable *OPERAND-SIZE* 32)
+
 (define (parse-instruction opcode tail early?)
   (process-fields (cons opcode tail) early?))
 
@@ -173,6 +178,7 @@ MIT in each case. |#
 				 'SIGNED
 				 (cadddr field))))
 		 `(CONS-SYNTAX
+		   #|
 		   (COERCE-TO-TYPE ,value
 				   ,(case mode
 				      ((OPERAND)
@@ -182,6 +188,17 @@ MIT in each case. |#
 				      (else
 				       (error "Unknown IMMEDIATE mode" mode)))
 				   ,domain)
+		   |#
+		   ,(integer-syntaxer
+		     value
+		     domain
+		     (case mode
+		       ((OPERAND)
+			*operand-size*)
+		       ((ADDRESS)
+			*address-size*)
+		       (else
+			(error "Unknown IMMEDIATE mode" mode))))
 		   ,tail)))
 	     tail-size))
 	   (else
diff --git a/v7/src/compiler/machines/i386/instr1.scm b/v7/src/compiler/machines/i386/instr1.scm
index e82f252f1..6fe9a9db6 100644
--- a/v7/src/compiler/machines/i386/instr1.scm
+++ b/v7/src/compiler/machines/i386/instr1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/instr1.scm,v 1.6 1992/02/13 03:22:20 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/instr1.scm,v 1.7 1992/02/13 07:47:52 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -201,11 +201,11 @@ MIT in each case. |#
 (define-instruction CALL
   (((@PCR (? dest)))
    (BYTE (8 #xe8))
-   (IMMEDIATE `(- ,dest (+ *PC* ,*ADDRESS-SIZE*)) ADDRESS))
+   (IMMEDIATE `(- ,dest (+ *PC* 4)) ADDRESS)) ; fcn(*ADDRESS-SIZE*)
 
   (((@PCRO (? dest) (? offset)))
    (BYTE (8 #xe8))
-   (IMMEDIATE `(- (+ ,dest ,offset) (+ *PC* ,*ADDRESS-SIZE*)) ADDRESS))
+   (IMMEDIATE `(- (+ ,dest ,offset) (+ *PC* 4)) ADDRESS)); fcn(*ADDRESS-SIZE*)
 
   (((@PCO (? displ)))
    (BYTE (8 #xe8))
@@ -290,11 +290,11 @@ MIT in each case. |#
 	 `(define-instruction ,mnemonic
 	    ((W (R 0) (? operand r/mW))
 	     (BYTE (8 #xf7))
-	     (ModR/M digit operand))
+	     (ModR/M ,digit operand))
 
 	    ((B (R 0) (? operand r/mB))
 	     (BYTE (8 #xf6))
-	     (ModR/M digit operand))))))
+	     (ModR/M ,digit operand))))))
 
   (define-mul/div DIV 6)
   (define-mul/div IDIV 7)
@@ -392,7 +392,7 @@ MIT in each case. |#
 	    ((W (@PCR (? dest)))
 	     (BYTE (8 #x0f)
 		   (8 ,opcode2))
-	     (IMMEDIATE `(- ,dest (+ *PC* ,*ADDRESS-SIZE*)) ADDRESS))
+	     (IMMEDIATE `(- ,dest (+ *PC* 4)) ADDRESS))	; fcn(*ADDRESS-SIZE*)
 
 	    ((B (@PCO (? displ)))
 	     (BYTE (8 ,opcode1)
@@ -486,7 +486,7 @@ MIT in each case. |#
 
   ((W (@PCR (? dest)))
    (BYTE (8 #xe9))
-   (IMMEDIATE `(- ,dest (+ *PC* ,*ADDRESS-SIZE*)) ADDRESS))
+   (IMMEDIATE `(- ,dest (+ *PC* 4)) ADDRESS)) ; fcn(*ADDRESS-SIZE*)
 
   ((B (@PCO (? displ)))
    (BYTE (8 #xeb)
@@ -527,7 +527,7 @@ MIT in each case. |#
 	    (((? operand mW))
 	     (BYTE (8 #x0f)
 		   (8 ,opcode))
-	     (ModR/M digit operand))))))
+	     (ModR/M ,digit operand))))))
 
   (define-load/store-state INVLPG #x01 7)	; 486 only
   (define-load/store-state LGDT   #x01 2)
diff --git a/v7/src/compiler/machines/i386/instrf.scm b/v7/src/compiler/machines/i386/instrf.scm
index 820da6180..75b366b60 100644
--- a/v7/src/compiler/machines/i386/instrf.scm
+++ b/v7/src/compiler/machines/i386/instrf.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/instrf.scm,v 1.6 1992/02/13 06:01:59 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/instrf.scm,v 1.7 1992/02/13 07:48:08 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -52,11 +52,11 @@ MIT in each case. |#
        (macro (mnemonic pmnemonic imnemonic digit opcode1 opcode2)
 	 `(begin
 	    (define-instruction ,mnemonic
-	      (((ST 0) (ST i))
+	      (((ST 0) (ST (? i)))
 	       (BYTE (8 #xd8)
 		     (8 (+ ,opcode1 i))))
 
-	      (((ST i) (ST 0))
+	      (((ST (? i)) (ST 0))
 	       (BYTE (8 #xdc)
 		     (8 (+ ,opcode2 i))))
 
@@ -73,7 +73,7 @@ MIT in each case. |#
 	       (ModR/M ,digit source)))
 
 	    (define-instruction ,pmnemonic
-	      (((ST i) (ST 0))
+	      (((ST (? i)) (ST 0))
 	       (BYTE (8 #xde)
 		     (8 (+ #xc0 i)))))
 
@@ -177,7 +177,7 @@ MIT in each case. |#
   (define-flonum-integer-memory FISTP 3 7))
 
 (define-trivial-instruction FINCSTP #xd9 #xf7)
-(define-trivial-instruction FINIT   #x9b #xdb #xe3) = (FWAIT) (FNINT)
+(define-trivial-instruction FINIT   #x9b #xdb #xe3) ; = (FWAIT) (FNINT)
 (define-trivial-instruction FNINIT  #xdb #xe3)
 
 (let-syntax
diff --git a/v7/src/compiler/machines/i386/insutl.scm b/v7/src/compiler/machines/i386/insutl.scm
index 608e289c8..1811725c9 100644
--- a/v7/src/compiler/machines/i386/insutl.scm
+++ b/v7/src/compiler/machines/i386/insutl.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insutl.scm,v 1.6 1992/02/13 03:03:10 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insutl.scm,v 1.7 1992/02/13 07:48:52 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -38,11 +38,6 @@ MIT in each case. |#
 
 ;;;; Addressing modes
 
-;; *** We can't really handle switching these right now. ***
-
-(define-integrable *ADDRESS-SIZE* 32)
-(define-integrable *OPERAND-SIZE* 32)
-
 ;; r/m part of ModR/M byte and SIB byte.
 ;; These are valid only for 32-bit addressing.
 
diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index 5adf0665b..f19245ca0 100644
--- a/v7/src/compiler/machines/i386/lapgen.scm
+++ b/v7/src/compiler/machines/i386/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.9 1992/02/13 05:52:58 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.10 1992/02/13 07:46:53 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/lapgen.scm,v 4.42 1991/05/28 19:14:26 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -222,7 +222,7 @@ MIT in each case. |#
 
 (define (non-pointer->literal object)
   (make-non-pointer-literal (object-type object)
-			    (careful-objct-datum object)))
+			    (careful-object-datum object)))
 
 (define (load-immediate target value)
   (if (zero? value)
@@ -238,7 +238,7 @@ MIT in each case. |#
 (define (load-constant target obj)
   (if (non-pointer-object? obj)
       (load-non-pointer target (object-type obj) (careful-object-datum obj))
-      (load-pc-relative target (free-constant-label obj))))
+      (load-pc-relative target (constant->label obj))))
 
 (define (load-pc-relative target label-expr)
   (with-pc
@@ -255,13 +255,19 @@ MIT in each case. |#
     (lambda (label reg)
       (if label
 	  (recvr label reg)
-	  (let ((temporary (allocate-temporary-register! 'GENERAL))
-		(label (generate-label 'GET-PC)))
-	    (cache-label! label temporary)
-	    (LAP (CALL (@PCR ,label))
-		 (LABEL ,label)
-		 (POP (R ,(register-reference temporary)))
-		 ,@(recvr label temporary)))))))
+	  (let ((temporary (allocate-temporary-register! 'GENERAL)))
+	    (pc->reg temporary
+		     (lambda (label prefix)
+		       (cache-label! label temporary)
+		       (LAP ,@prefix
+			    ,@(recvr label temporary)))))))))
+
+(define (pc->reg reg recvr)
+  (let ((label (generate-label 'GET-PC)))
+    (recvr label
+	   (LAP (CALL (@PCR ,label))
+		(LABEL ,label)
+		(POP ,(register-reference reg))))))
 
 (define-integrable (get-cached-label)
   (register-map-label *register-map* 'GENERAL))
@@ -469,4 +475,17 @@ MIT in each case. |#
     error
     primitive-error
     |#
-    ))
\ No newline at end of file
+    ))
+
+;; Operation tables
+
+(define (define-arithmetic-method operator methods method)
+  (let ((entry (assq operator (cdr methods))))
+    (if entry
+	(set-cdr! entry method)
+	(set-cdr! methods (cons (cons operator method) (cdr methods)))))
+  operator)
+
+(define (lookup-arithmetic-method operator methods)
+  (cdr (or (assq operator (cdr methods))
+	   (error "Unknown operator" operator))))
\ No newline at end of file
diff --git a/v7/src/compiler/machines/i386/rules1.scm b/v7/src/compiler/machines/i386/rules1.scm
index a62a5df67..4654fe1f1 100644
--- a/v7/src/compiler/machines/i386/rules1.scm
+++ b/v7/src/compiler/machines/i386/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.7 1992/02/11 14:48:05 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.8 1992/02/13 07:46:35 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rules1.scm,v 4.36 1991/10/25 06:49:58 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -250,6 +250,10 @@ MIT in each case. |#
 	    ,(indirect-byte-reference! address offset)
 	    (& ,(char->signed-8-bit-immediate character)))))
 
+(define (char->signed-8-bit-immediate character)
+  (let ((ascii (char->ascii character)))
+    (if (< ascii 128) ascii (- ascii 256))))
+
 (define-rule statement
   (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
 	  (REGISTER (? source)))
@@ -299,4 +303,10 @@ MIT in each case. |#
 	  |#
 	  (else
 	   (LAP ,@(load-non-pointer target type 0)
-		(MOV B ,target ,source))))))
\ No newline at end of file
+		(MOV B ,target ,source))))))
+
+(define (indirect-char/ascii-reference! register offset)
+  (indirect-byte-reference! register (* offset 4)))
+
+(define (indirect-byte-reference! register offset)
+  (byte-offset-reference (allocate-indirection-register! register) offset))
\ No newline at end of file
diff --git a/v7/src/compiler/machines/i386/rules2.scm b/v7/src/compiler/machines/i386/rules2.scm
index 65fdccba0..f2f291d2c 100644
--- a/v7/src/compiler/machines/i386/rules2.scm
+++ b/v7/src/compiler/machines/i386/rules2.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules2.scm,v 1.2 1992/01/30 06:32:47 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules2.scm,v 1.3 1992/02/13 07:48:34 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
@@ -71,14 +71,14 @@ MIT in each case. |#
   (QUALIFIER (non-pointer-object? constant))
   (set-equal-branches!)
   (LAP (CMP W ,(any-reference register)
-	    (&U ,(non-pointer->immediate constant)))))
+	    (&U ,(non-pointer->literal 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)))))
+	    (&U ,(non-pointer->literal constant)))))
 
 (define-rule predicate
   (EQ-TEST (CONSTANT (? constant)) (OFFSET (REGISTER (? address)) (? offset)))
diff --git a/v7/src/compiler/machines/i386/rulfix.scm b/v7/src/compiler/machines/i386/rulfix.scm
index ea3ec9ac5..5d8986d9a 100644
--- a/v7/src/compiler/machines/i386/rulfix.scm
+++ b/v7/src/compiler/machines/i386/rulfix.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulfix.scm,v 1.15 1992/02/13 06:40:36 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulfix.scm,v 1.16 1992/02/13 07:47:37 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rules1.scm,v 4.36 1991/10/25 06:49:58 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -185,7 +185,7 @@ MIT in each case. |#
 		      (OBJECT->FIXNUM (CONSTANT (? constant))))
   (fixnum-branch! predicate)
   (LAP (CMP W ,(source-register-reference register)
-	    (& ,(fixnum-object->fixnum-word constant)))))
+	    (& ,(* constant fixnum-1)))))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
@@ -193,7 +193,7 @@ MIT in each case. |#
 		      (REGISTER (? register)))
   (fixnum-branch! (commute-fixnum-predicate predicate))
   (LAP (CMP W ,(source-register-reference register)
-	    (& ,(fixnum-object->fixnum-word constant)))))
+	    (& ,(* constant fixnum-1)))))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
@@ -201,7 +201,7 @@ MIT in each case. |#
 		      (OBJECT->FIXNUM (CONSTANT (? constant))))
   (fixnum-branch! predicate)
   (LAP (CMP W ,(source-indirect-reference! address offset)
-	    (& ,(fixnum-object->fixnum-word constant)))))
+	    (& ,(* constant fixnum-1)))))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
@@ -209,7 +209,7 @@ MIT in each case. |#
 		      (OFFSET (REGISTER (? address)) (? offset)))
   (fixnum-branch! (commute-fixnum-predicate predicate))
   (LAP (CMP W ,(source-indirect-reference! address offset)
-	    (& ,(fixnum-object->fixnum-word constant)))))
+	    (& ,(* constant fixnum-1)))))
 
 ;; This assumes that the immediately preceding instruction sets the
 ;; condition code bits correctly.
@@ -288,24 +288,13 @@ MIT in each case. |#
 	(else
 	 (LAP (IMUL W ,target (& ,constant))))))
 
-;;;; Fixnum operation dispatch
-
-(define (define-fixnum-method operator methods method)
-  (let ((entry (assq operator (cdr methods))))
-    (if entry
-	(set-cdr! entry method)
-	(set-cdr! methods (cons (cons operator method) (cdr methods)))))
-  operator)
-
-(define (lookup-fixnum-method operator methods)
-  (cdr (or (assq operator (cdr methods))
-	   (error "Unknown operator" operator))))
+;;;; Operation tables
 
 (define fixnum-methods/1-arg
   (list 'FIXNUM-METHODS/1-ARG))
 
 (define-integrable (fixnum-1-arg/operate operator)
-  (lookup-fixnum-method operator fixnum-methods/1-arg))
+  (lookup-arithmetic-method operator fixnum-methods/1-arg))
 
 (define-integrable (fixnum-1-arg target source operation)
   (operation (standard-move-to-target! source target)))
@@ -314,13 +303,13 @@ MIT in each case. |#
   (list 'FIXNUM-METHODS/2-ARGS))
 
 (define-integrable (fixnum-2-args/operate operator)
-  (lookup-fixnum-method operator fixnum-methods/2-args))
+  (lookup-arithmetic-method operator fixnum-methods/2-args))
 
 (define fixnum-methods/2-args-constant
   (list 'FIXNUM-METHODS/2-ARGS-CONSTANT))
 
 (define-integrable (fixnum-2-args/operate-constant operator)
-  (lookup-fixnum-method operator fixnum-methods/2-args-constant))
+  (lookup-arithmetic-method operator fixnum-methods/2-args-constant))
 
 (define (fixnum-2-args/commutative? operator)
   (memq operator '(PLUS-FIXNUM
@@ -340,7 +329,7 @@ MIT in each case. |#
 				    target source1 source2)
   (let* ((worst-case
 	  (lambda (target source1 source2)
-	    (LAP (LAP (MOV W ,target ,source1))
+	    (LAP (MOV W ,target ,source1)
 		 ,@(operate target source2))))
 	 (new-target-alias!
 	  (lambda ()
@@ -390,27 +379,27 @@ MIT in each case. |#
 
 ;;;; Arithmetic operations
 
-(define-fixnum-method 'ONE-PLUS-FIXNUM fixnum-methods/1-arg
+(define-arithmetic-method 'ONE-PLUS-FIXNUM fixnum-methods/1-arg
   (lambda (target)
     (add-fixnum-constant target 1 false)))
 
-(define-fixnum-method 'MINUS-ONE-PLUS-FIXNUM fixnum-methods/1-arg
+(define-arithmetic-method 'MINUS-ONE-PLUS-FIXNUM fixnum-methods/1-arg
   (lambda (target)
     (add-fixnum-constant target -1 false)))
 
-(define-fixnum-method 'FIXNUM-NOT fixnum-methods/1-arg
+(define-arithmetic-method 'FIXNUM-NOT fixnum-methods/1-arg
   (lambda (target)
     (LAP (NOT W ,target)
 	 ,@(word->fixnum target))))
 
-(define-fixnum-method 'FIXNUM-NEGATE fixnum-methods/1-arg
+(define-arithmetic-method 'FIXNUM-NEGATE fixnum-methods/1-arg
   (lambda (target)
     (LAP (NEG W ,target))))
 
 (let-syntax
     ((binary-operation
       (macro (name instr commutative? idempotent?)
-	`(define-fixnum-method ',name fixnum-methods/2-args
+	`(define-arithmetic-method ',name fixnum-methods/2-args
 	   (fixnum-2-args/standard
 	    ,commutative?
 	    (lambda (target source2)
@@ -424,7 +413,7 @@ MIT in each case. |#
   (binary-operation FIXNUM-OR OR true true)
   (binary-operation FIXNUM-XOR XOR true false))
 
-(define-fixnum-method 'FIXNUM-ANDC fixnum-methods/2-args
+(define-arithmetic-method 'FIXNUM-ANDC fixnum-methods/2-args
   (fixnum-2-args/standard
    false
    (lambda (target source2)
@@ -437,7 +426,7 @@ MIT in each case. |#
 		(NOT W ,temp)
 		(AND W ,target ,temp)))))))
 
-(define-fixnum-method 'MULTIPLY-FIXNUM fixnum-methods/2-args
+(define-arithmetic-method 'MULTIPLY-FIXNUM fixnum-methods/2-args
   (fixnum-2-args/standard
    false
    (lambda (target source2)
@@ -453,7 +442,7 @@ MIT in each case. |#
 		   (SAR W ,target (& ,scheme-type-width))
 		   (IMUL W ,target ,temp))))))))
 
-(define-fixnum-method 'FIXNUM-LSH fixnum-methods/2-args
+(define-arithmetic-method 'FIXNUM-LSH fixnum-methods/2-args
   (let ((operate
 	 (lambda (target source2)
 	   ;; SOURCE2 is guaranteed not to be ECX because of the
@@ -489,7 +478,7 @@ MIT in each case. |#
 				  source1
 				  source2))))
 
-(define-fixnum-method 'FIXNUM-QUOTIENT fixnum-methods/2-args
+(define-arithmetic-method 'FIXNUM-QUOTIENT fixnum-methods/2-args
   (lambda (target source1 source2)
     (if (= source2 source1)
 	(load-fixnum-constant 1 (target-register-reference target))
@@ -503,7 +492,7 @@ MIT in each case. |#
 		 (IDIV W (R ,eax) ,source2)
 		 (SAL W (R ,eax) (& ,scheme-type-width))))))))
 
-(define-fixnum-method 'FIXNUM-REMAINDER fixnum-methods/2-args
+(define-arithmetic-method 'FIXNUM-REMAINDER fixnum-methods/2-args
   (lambda (target source1 source2)
     (if (= source2 source1)
 	(load-fixnum-constant 0 (target-register-reference target))
@@ -517,15 +506,15 @@ MIT in each case. |#
 		 (IDIV W (R ,eax) ,source2)
 		 (SAL W (R ,edx) (& ,scheme-type-width))))))))
 
-(define-fixnum-method 'PLUS-FIXNUM fixnum-methods/2-args-constant
+(define-arithmetic-method 'PLUS-FIXNUM fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     (add-fixnum-constant target n overflow?)))
 
-(define-fixnum-method 'MINUS-FIXNUM fixnum-methods/2-args-constant
+(define-arithmetic-method 'MINUS-FIXNUM fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     (add-fixnum-constant target (- 0 n) overflow?)))
 
-(define-fixnum-method 'FIXNUM-OR fixnum-methods/2-args-constant
+(define-arithmetic-method 'FIXNUM-OR fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     overflow?				; ignored
     (cond ((zero? n)
@@ -535,7 +524,7 @@ MIT in each case. |#
 	  (else
 	   (LAP (OR W ,target (& ,(* n fixnum-1))))))))
 
-(define-fixnum-method 'FIXNUM-XOR fixnum-methods/2-args-constant
+(define-arithmetic-method 'FIXNUM-XOR fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     overflow?				; ignored
     (cond ((zero? n)
@@ -546,7 +535,7 @@ MIT in each case. |#
 	  (else
 	   (LAP (XOR W ,target (& ,(* n fixnum-1))))))))
 
-(define-fixnum-method 'FIXNUM-AND fixnum-methods/2-args-constant
+(define-arithmetic-method 'FIXNUM-AND fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     overflow?				; ignored
     (cond ((zero? n)
@@ -556,7 +545,7 @@ MIT in each case. |#
 	  (else
 	   (LAP (AND W ,target (& ,(* n fixnum-1))))))))
 
-(define-fixnum-method 'FIXNUM-ANDC fixnum-methods/2-args-constant
+(define-arithmetic-method 'FIXNUM-ANDC fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     overflow?				; ignored
     (cond ((zero? n)
@@ -566,7 +555,7 @@ MIT in each case. |#
 	  (else
 	   (LAP (AND W ,target (& ,(* (fix:not n) fixnum-1))))))))
 
-(define-fixnum-method 'FIXNUM-LSH fixnum-methods/2-args-constant
+(define-arithmetic-method 'FIXNUM-LSH fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     overflow?				; ignored
     (cond ((zero? n)
@@ -579,11 +568,11 @@ MIT in each case. |#
 	   (LAP (SHR W ,target (& ,(- 0 n)))
 		,@(word->fixnum target))))))
 
-(define-fixnum-method 'MULTIPLY-FIXNUM fixnum-methods/2-args-constant
+(define-arithmetic-method 'MULTIPLY-FIXNUM fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     (multiply-fixnum-constant target n overflow?)))
 
-(define-fixnum-method 'FIXNUM-QUOTIENT fixnum-methods/2-args-constant
+(define-arithmetic-method 'FIXNUM-QUOTIENT fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     overflow?				; ignored
     (cond ((= n 1)
@@ -600,14 +589,14 @@ MIT in each case. |#
 		    (ADD W ,target (& ,(* (-1+ absn) fixnum-1)))
 		    (LABEL ,label)
 		    (SAR W ,target (& ,expt-of-2))
-		    ,@(word->fixnum ,target)
+		    ,@(word->fixnum target)
 		    ,@(if (negative? n)
 			  (LAP (NEG W ,target))
 			  (LAP))))))
 	  (else
 	   (error "Fixnum-quotient/constant: Bad value" n)))))
 
-(define-fixnum-method 'FIXNUM-REMAINDER fixnum-methods/2-args-constant
+(define-arithmetic-method 'FIXNUM-REMAINDER fixnum-methods/2-args-constant
   (lambda (target n overflow?)
     ;; (remainder x y) is 0 or has the sign of x.
     ;; Thus we can always "divide" by (abs y) to make things simpler.
diff --git a/v7/src/compiler/machines/i386/rulflo.scm b/v7/src/compiler/machines/i386/rulflo.scm
index 6b60b8714..d040c38cd 100644
--- a/v7/src/compiler/machines/i386/rulflo.scm
+++ b/v7/src/compiler/machines/i386/rulflo.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulflo.scm,v 1.11 1992/02/13 06:09:45 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulflo.scm,v 1.12 1992/02/13 07:47:21 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rules1.scm,v 4.36 1991/10/25 06:49:58 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -109,7 +109,7 @@ MIT in each case. |#
   (ASSIGN (REGISTER (? target))
 	  (FLONUM-1-ARG (? operation) (REGISTER (? source)) (? overflow?)))
   overflow?				;ignore
-  ((flonm-1-arg/operator operation) target source))
+  ((flonum-1-arg/operator operation) target source))
 
 (define ((flonum-unary-operation/general operate) target source)
   (let* ((source (flonum-source! source))
@@ -132,7 +132,7 @@ MIT in each case. |#
 	    (flonum-unary-operation/general
 	     (lambda (target source)
 	       (if (and (zero? target) (zero? source))
-		   (,opcode)
+		   (LAP (,opcode))
 		   (LAP (FLD (ST ,', source))
 			(,opcode)
 			(FSTP (ST ,',(1+ target)))))))))))
@@ -269,7 +269,7 @@ MIT in each case. |#
 	      (operate (flonum-target! target) sti1 sti2)))))
     (cond ((pseudo-register? target)
 	   (reuse-pseudo-register-alias
-	    source1 target-type
+	    source1 'FLOAT
 	    (lambda (alias)
 	      (let* ((sti1 (floreg->sti alias))
 		     (sti2 (if (= source1 source2)
@@ -278,10 +278,10 @@ MIT in each case. |#
 		(delete-register! alias)
 		(delete-dead-registers!)
 		(add-pseudo-register-alias! target alias)
-		(operate< sti1 sti1 sti2)))
+		(operate sti1 sti1 sti2)))
 	    (lambda ()
 	      (reuse-pseudo-register-alias
-	       source2 target-type
+	       source2 'FLOAT
 	       (lambda (alias2)
 		 (let ((sti1 (flonum-source! source1))
 		       (sti2 (floreg->sti alias2)))
@@ -290,9 +290,9 @@ MIT in each case. |#
 		   (add-pseudo-register-alias! target alias2)
 		   (operate sti2 sti1 sti2)))
 	       default))))
-	  ((not (eq? target-type (register-type target)))
+	  ((not (eq? (register-type target) 'FLOAT))
 	   (error "flonum-2-args: Wrong type register"
-		  target target-type))
+		  target 'FLOAT))
 	  (else
 	   (default)))))
 
diff --git a/v7/src/compiler/machines/i386/rulrew.scm b/v7/src/compiler/machines/i386/rulrew.scm
index 9871c2f60..165caa0d2 100644
--- a/v7/src/compiler/machines/i386/rulrew.scm
+++ b/v7/src/compiler/machines/i386/rulrew.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulrew.scm,v 1.5 1992/02/13 06:38:36 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulrew.scm,v 1.6 1992/02/13 07:48:20 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rulrew.scm,v 1.4 1991/10/25 06:50:06 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -168,7 +168,7 @@ MIT in each case. |#
    (and (memq operator '(FIXNUM-QUOTIENT FIXNUM-REMAINDER))
 	(rtl:constant-fixnum-test operand-2
 	  (lambda (n)
-	    (integer-log-base-2? (abs n))))))
+	    (integer-power-of-2? (abs n))))))
   (rtl:make-fixnum-2-args operator operand-1 operand-2 overflow?))
 
 (define (rtl:constant-fixnum? expression)