summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2007-09-04 14:28:53 +0000
committerSimon Marlow <simonmar@microsoft.com>2007-09-04 14:28:53 +0000
commit0981e24e9980b8b26e6f20fc56bebc1c7416cc4f (patch)
tree32e71877b4ce56a24e1ade784f1ebcbd9c436822
parent0f8ecdcd05627848c9eaea6c9d5e88e10e7ec78d (diff)
downloadhaskell-0981e24e9980b8b26e6f20fc56bebc1c7416cc4f.tar.gz
put the @N suffix on stdcall foreign calls in .cmm code
This applies to EnterCriticalSection and LeaveCriticalSection in the RTS
-rw-r--r--compiler/cmm/CLabel.hs7
-rw-r--r--compiler/cmm/CmmParse.y24
-rw-r--r--rts/HeapStackCheck.cmm2
-rw-r--r--rts/PrimOps.cmm2
-rw-r--r--rts/StgMiscClosures.cmm2
5 files changed, 32 insertions, 5 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 6d8018a42d..28c43e1b29 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -89,6 +89,7 @@ module CLabel (
mkRtsApFastLabel,
mkForeignLabel,
+ addLabelSize,
mkCCLabel, mkCCSLabel,
@@ -364,6 +365,12 @@ mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic
+addLabelSize :: CLabel -> Int -> CLabel
+addLabelSize (ForeignLabel str _ is_dynamic) sz
+ = ForeignLabel str (Just sz) is_dynamic
+addLabelSize label _
+ = label
+
-- Cost centres etc.
mkCCLabel cc = CC_Label cc
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 4cdb6ebe95..5a379c8c65 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -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
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index 753e6718e7..11af7c7073 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -13,6 +13,8 @@
#include "Cmm.h"
#ifdef __PIC__
+import EnterCriticalSection
+import LeaveCriticalSection
import pthread_mutex_unlock;
#endif
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index d465709617..805e1a497b 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -47,6 +47,8 @@ import __gmpz_com;
import base_GHCziIOBase_NestedAtomically_closure;
import pthread_mutex_lock;
import pthread_mutex_unlock;
+import EnterCriticalSection
+import LeaveCriticalSection
#endif
/*-----------------------------------------------------------------------------
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 43efa784a0..afd302aeff 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -14,6 +14,8 @@
#ifdef __PIC__
import pthread_mutex_lock;
+import EnterCriticalSection
+import LeaveCriticalSection
import base_GHCziBase_Czh_static_info;
import base_GHCziBase_Izh_static_info;
#endif