From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Wed, 18 Feb 1998 07:56:05 +0000 (+0000)
Subject: Changes to improve flonum code.
X-Git-Tag: 20090517-FFI~4847
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2e3de1a1e0a6cdbb37efc15ad1db0b47c4992d78;p=mit-scheme.git

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 09ca9afe2..b700e17f5 100644
--- 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 14c373b34..24a0dc887 100644
--- 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