From: simonmar <unknown>
Date: Tue, 12 Mar 2002 16:48:52 +0000 (+0000)
Subject: [project @ 2002-03-12 16:48:52 by simonmar]
X-Git-Tag: Approx_11550_changesets_converted~2276
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c50d5acc8e9cd98bbb960d0149f104066d0c49b3;p=ghc-hetmet.git

[project @ 2002-03-12 16:48:52 by simonmar]
Fix a bug in the native code generator's handling of floating-point
arguments to ccalls: it wasn't correctly promoting float arguments to
doubles.  Amazingly this has gone undetected for quite a while.

Fixes bug #523996.
---

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 1806565..3c89799 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -2752,6 +2752,10 @@ genCCall fn cconv ret_rep args
        | cconv == StdCallConv = '@':show tot_arg_size
        | otherwise            = ""
 
+    -- floats are always promoted to doubles when passed to a ccall
+    promote_size F  = DF
+    promote_size sz = sz
+
     arg_size DF = 8
     arg_size F  = 4
     arg_size _  = 4
@@ -2775,14 +2779,17 @@ genCCall fn cconv ret_rep args
       | otherwise
       = get_op arg			`thenNat` \ (code, reg, sz) ->
         getDeltaNat			`thenNat` \ delta ->
-        arg_size sz			`bind`    \ size ->
+	let 
+		real_sz = promote_size sz
+		size    = arg_size real_sz
+ 	in
         setDeltaNat (delta-size)  	`thenNat` \ _ ->
-        if   (case sz of DF -> True; F -> True; _ -> False)
+        if   (case real_sz of DF -> True; _ -> False)
         then returnNat (size,
                         code `appOL`
                         toOL [SUB L (OpImm (ImmInt size)) (OpReg esp),
                               DELTA (delta-size),
-                              GST sz reg (AddrBaseIndex (Just esp) 
+                              GST DF reg (AddrBaseIndex (Just esp) 
                                                         Nothing 
                                                         (ImmInt 0))]
                        )