Changes to improve flonum code.

Prefer ST(0) over other registers as a target for flonum operations.
  - lapgen: sort-machine-registers
  - rulflo: improved search for target register
  - rulrew: accept any flonum constants, not just 0.0 and 1.0

diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index 09ca9afe2ca58c0b12d790cea977a99edc6b7057..b700e17f5d75f1e2dd8e9a75f0b79d4516023bc1 100644 (file)
--- a/v7/src/compiler/machines/i386/lapgen.scm
+++ b/v7/src/compiler/machines/i386/lapgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.24 1993/08/26 05:43:47 gjr Exp $
+$Id: lapgen.scm,v 1.25 1998/02/18 07:55:07 adams Exp $
 
-Copyright (c) 1992-1993 Massachusetts Institute of Technology
+Copyright (c) 1992-1998 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -47,8 +47,20 @@ MIT in each case. |#
   ;; fr7 is not used so that we can always push on the stack once.
   (list eax ecx edx ebx fr0 fr1 fr2 fr3 fr4 fr5 fr6))
 
-(define-integrable (sort-machine-registers registers)
-  registers)
+(define (sort-machine-registers registers)
+  ;; FR0 is preferable to other FPU regs.  We promote it to the front
+  ;; if we find another FPU reg in front of it.
+  (let loop ((regs registers))
+    (cond ((null? regs) registers)     ; no float regs at all
+         ((general-register? (car regs)); ignore general regs
+          (loop (cdr regs)))
+         ((= (car regs) fr0)           ; found FR0 first
+          registers)
+         ((memq fr0 regs)              ; FR0 not first, is it present?
+          (cons fr0 (delq fr0 registers)) ; move to front
+          registers)
+         (else                         ; FR0 absent
+          registers))))
 
 (define (register-type register)
   (cond ((machine-register? register)

diff --git a/v7/src/compiler/machines/i386/rulrew.scm b/v7/src/compiler/machines/i386/rulrew.scm
index 14c373b34b9460ac7735670b7bc7fd4d9414bd49..24a0dc8877e786f357a57061335e973da57e2901 100644 (file)
--- a/v7/src/compiler/machines/i386/rulrew.scm
+++ b/v7/src/compiler/machines/i386/rulrew.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rulrew.scm,v 1.12 1993/07/16 19:27:58 gjr Exp $
+$Id: rulrew.scm,v 1.13 1998/02/18 07:56:05 adams Exp $
 
-Copyright (c) 1992-1993 Massachusetts Institute of Technology
+Copyright (c) 1992-1998 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -211,7 +211,8 @@ MIT in each case. |#
 
 (define (rtl:constant-fixnum? expression)
   (and (rtl:constant? expression)
-       (fix:fixnum? (rtl:constant-value expression))))
+       (fix:fixnum? (rtl:constant-value expression))
+       (rtl:constant-value expression)))
 
 (define (rtl:constant-fixnum-test expression predicate)
   (and (rtl:object->fixnum? expression)
@@ -224,9 +225,7 @@ MIT in each case. |#
 (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:constant-flonum-test operand (lambda (v) v #T)))
   (rtl:make-object->float operand))
 
 (define-rule rewriting