From: simonmar <unknown>
Date: Mon, 18 Oct 2004 11:38:41 +0000 (+0000)
Subject: [project @ 2004-10-18 11:38:41 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~1497
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=e0546be279fde7febac43421c2d69da51f542dd4

[project @ 2004-10-18 11:38:41 by simonmar]
Make foreign import stdcall "dynamic" work via-C (we'd forgotten to
add the __stdcall qualifier to the type cast for the function).
---

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index a9aba40..44fe7ae 100644
--- a/ghc/compiler/cmm/PprC.hs
+++ b/ghc/compiler/cmm/PprC.hs
@@ -195,7 +195,7 @@ pprStmt stmt = case stmt of
 	where
     	ppr_fn = case fn of
 		   CmmLit (CmmLabel lbl) -> pprCLabel lbl
-		   _other -> parens (cCast (pprCFunType results args) fn)
+		   _other -> parens (cCast (pprCFunType cconv results args) fn)
 			-- for a dynamic call, cast the expression to
 			-- a function of the right type (we hope).
 
@@ -218,9 +218,13 @@ pprStmt stmt = case stmt of
     CmmJump lbl _params      -> mkJMP_(pprExpr lbl) <> semi
     CmmSwitch arg ids        -> pprSwitch arg ids
 
-pprCFunType :: [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)] -> SDoc
-pprCFunType ress args = 
-  res_type ress <> parens (char '*') <> parens (commafy (map arg_type args))
+pprCFunType :: CCallConv -> [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)] -> SDoc
+pprCFunType cconv ress args
+  = hcat [
+	res_type ress,
+	parens (text (ccallConvAttribute cconv) <>  char '*'),
+	parens (commafy (map arg_type args))
+   ]
   where
 	res_type [] = ptext SLIT("void")
 	res_type [(one,hint)] = machRepHintCType (cmmRegRep one) hint