From 1f1e6297c91287cd2a4f9028c2f3611dcbfc7b07 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Fri, 4 Feb 2000 17:26:58 +0000
Subject: [PATCH] [project @ 2000-02-04 17:26:58 by sewardj] GSQRT, GSIN,
 GCOS, GTAN: if result size is float (as opposed to double),
 truncate the result to that length by writing it into
 memory and getting it back again (duh!), since that's what
 gcc does.

---
 ghc/compiler/nativeGen/NOTES       |    4 +++-
 ghc/compiler/nativeGen/PprMach.lhs |   19 ++++++++++++++-----
 2 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/ghc/compiler/nativeGen/NOTES b/ghc/compiler/nativeGen/NOTES
index 5f76d69..bdf94aa 100644
--- a/ghc/compiler/nativeGen/NOTES
+++ b/ghc/compiler/nativeGen/NOTES
@@ -28,7 +28,9 @@ All these bugs are for x86; I don't know about sparc/alpha.
 
    Currently, implementation of GITOF et al use the stack, so are
    incompatible with current ccall implementation.  When the latter
-   is fixed, GITOF et al should present no problem.
+   is fixed, GITOF et al should present no problem.  Same issue
+   applies to GCOS, GSIN, GTAN, GSQRT if they have to truncate their
+   result to 32-bit float.
 
 -- nofib/real/hidden gets slightly different FP answers from the
    via-C route; possibly due to exp/log not being done in-line.
diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index a3fe5de..56a94c4 100644
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -1019,17 +1019,21 @@ pprInstr g@(GABS sz src dst)
    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
 pprInstr g@(GNEG sz src dst)
    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
+
 pprInstr g@(GSQRT sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt ; ", gpop dst 1])
+   = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$ 
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 pprInstr g@(GSIN sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fsin ; ", gpop dst 1])
+   = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$ 
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 pprInstr g@(GCOS sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fcos ; ", gpop dst 1])
-
+   = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$ 
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 pprInstr g@(GTAN sz src dst)
    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
                    gpush src 0, text " ; fptan ; ", 
-                   text " fstp %st(0) ; ", gpop dst 1])
+                   text " fstp %st(0)"] $$
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 
 pprInstr g@(GADD sz src1 src2 dst)
    = pprG g (hcat [gtab, gpush src1 0, 
@@ -1054,6 +1058,11 @@ pprInstr GFREE
           ]
 
 --------------------------
+
+-- coerce %st(0) to the specified size
+gcoerceto DF = empty
+gcoerceto  F = text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
+
 gpush reg offset
    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
 gpop reg offset
-- 
1.7.10.4