More changes.

diff --git a/v7/src/compiler/machines/i386/rulflo.scm b/v7/src/compiler/machines/i386/rulflo.scm
index 0248fb4c59e904f4586c137095a8a7a3caa5fc33..572d71e690cf1e57c4e83cb2953c461ba4239965 100644 (file)
--- 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.6 1992/02/04 00:58:32 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulflo.scm,v 1.7 1992/02/05 05:03:48 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
@@ -93,6 +93,16 @@ MIT in each case. |#
     (LAP ,@(object->address source)
         (FLD D (@RO ,source 4))
         (FSTP D (ST ,(1+ target))))))
+
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+         (OBJECT->FLOAT (CONSTANT (? value))))
+  (QUALIFIER (or (= value 0.) (= value 1.)))
+  (let ((target (flonum-target! target)))
+    (LAP ,@(if (= value 0.)
+              (LAP (FLDZ))
+              (LAP (FLD1)))
+        (FSTP D (ST ,(1+ target))))))
 \f
 ;;;; Flonum Arithmetic
 

diff --git a/v7/src/compiler/machines/i386/rulrew.scm b/v7/src/compiler/machines/i386/rulrew.scm
index 023f03f264ddcfdac55ecd43809707962b1f459b..d2357563befb55b2b3f48a68d064597622fb83f3 100644 (file)
--- 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.1 1992/02/05 04:54:39 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulrew.scm,v 1.2 1992/02/05 05:03:36 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
@@ -183,12 +183,20 @@ MIT in each case. |#
                (and (fix:fixnum? n)
                     (predicate n)))))))
 \f
+(define-rule rewriting
+  (OBJECT->FLOAT (REGISTER (? operand register-known-value)))
+  (QUALIFIER
+   (rtl:constant-flonum-test operand
+                            (lambda (v)
+                              (or (flo:zero? v) (flo:one? v)))))
+  (rtl:make-object->float operand))
+
 (define-rule rewriting
   (FLONUM-2-ARGS FLONUM-SUBTRACT
                 (REGISTER (? operand-1 register-known-value))
                 (? operand-2)
                 (? overflow?))
-  (QUALIFIER (rtl:constant-flonum-test operand-1 zero?))
+  (QUALIFIER (rtl:constant-flonum-test operand-1 flo:zero?))
   (rtl:make-flonum-2-args 'FLONUM-SUBTRACT operand-1 operand-2 overflow?))
 
 (define-rule rewriting
@@ -199,7 +207,7 @@ MIT in each case. |#
   (QUALIFIER
    (and (memq operation
              '(FLONUM-ADD FLONUM-SUBTRACT FLONUM-MULTIPLY FLONUM-DIVIDE))
-       (rtl:constant-flonum-test operand-1 one?)))
+       (rtl:constant-flonum-test operand-1 flo:one?)))
   (rtl:make-flonum-2-args operation operand-1 operand-2 overflow?))
 
 (define-rule rewriting
@@ -210,21 +218,21 @@ MIT in each case. |#
   (QUALIFIER
    (and (memq operation
              '(FLONUM-ADD FLONUM-SUBTRACT FLONUM-MULTIPLY FLONUM-DIVIDE))
-       (rtl:constant-flonum-test operand-2 one?)))
+       (rtl:constant-flonum-test operand-2 flo:one?)))
   (rtl:make-flonum-2-args operation operand-1 operand-2 overflow?))
 
 (define-rule rewriting
   (FLONUM-PRED-2-ARGS (? predicate)
                      (? operand-1)
                      (REGISTER (? operand-2 register-known-value)))
-  (QUALIFIER (rtl:constant-flonum-test operand-2 zero?))
+  (QUALIFIER (rtl:constant-flonum-test operand-2 flo:zero?))
   (list 'FLONUM-PRED-2-ARGS predicate operand-1 operand-2))
 
 (define-rule rewriting
   (FLONUM-PRED-2-ARGS (? predicate)
                      (REGISTER (? operand-1 register-known-value))
                      (? operand-2))
-  (QUALIFIER (rtl:constant-flonum-test operand-1 zero?))
+  (QUALIFIER (rtl:constant-flonum-test operand-1 flo:zero?))
   (list 'FLONUM-PRED-2-ARGS predicate operand-1 operand-2))
 \f
 ;; acos (x) = atan ((sqrt (1 - x^2)) / x)
@@ -263,5 +271,5 @@ MIT in each case. |#
                (and (flo:flonum? n)
                     (predicate n)))))))
 
-(define (one? value)
-  (= value 1))
\ No newline at end of file
+(define (flo:one? value)
+  (flo:= value 1.))
\ No newline at end of file