X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmParse.y;h=5a379c8c65f2cdd95c5434fd8857bf3f97df3aad;hb=0981e24e9980b8b26e6f20fc56bebc1c7416cc4f;hp=039c6161cacea0e0fcfbc0577bca83eb8b579d01;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 039c616..5a379c8 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -7,11 +7,11 @@
 -----------------------------------------------------------------------------
 
 {
-{-# OPTIONS_GHC -w #-}
+{-# OPTIONS -w #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module CmmParse ( parseCmmFile ) where
@@ -823,8 +823,8 @@ newLocal kind ty name = do
 -- classifies these labels as dynamic, hence the code generator emits the
 -- PIC code for them.
 newImport :: FastString -> ExtFCode ()
-newImport name =
-       addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True)))
+newImport name
+   = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True)))
 
 newLabel :: FastString -> ExtFCode BlockId
 newLabel name = do
@@ -909,15 +909,29 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
           case convention of
             -- Temporary hack so at least some functions are CmmSafe
             CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety ret))
-            _ -> case safety of
+            _ -> 
+             let expr' = adjCallTarget convention expr args in
+             case safety of
 	      CmmUnsafe ->
                 code (emitForeignCall' PlayRisky results 
-                   (CmmCallee expr convention) args vols NoC_SRT ret)
+                   (CmmCallee expr' convention) args vols NoC_SRT ret)
               CmmSafe srt ->
                 code (emitForeignCall' (PlaySafe unused) results 
-                   (CmmCallee expr convention) args vols NoC_SRT ret) where
+                   (CmmCallee expr' convention) args vols NoC_SRT ret) where
 	        unused = panic "not used by emitForeignCall'"
 
+adjCallTarget :: CCallConv -> CmmExpr -> [(CmmExpr,MachHint)] -> CmmExpr
+#ifdef mingw32_TARGET_OS
+-- On Windows, we have to add the '@N' suffix to the label when making
+-- a call with the stdcall calling convention.
+adjCallTarget StdCallConv (CmmLit (CmmLabel lbl)) args
+  = CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
+  where size (e,_) = max wORD_SIZE (machRepByteWidth (cmmExprRep e))
+                 -- c.f. CgForeignCall.emitForeignCall
+#endif
+adjCallTarget _ expr _
+  = expr
+
 primCall
 	:: [ExtFCode (CmmFormal,MachHint)]
 	-> FastString