Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
0981e24e
Commit
0981e24e
authored
Sep 04, 2007
by
Simon Marlow
Browse files
put the @N suffix on stdcall foreign calls in .cmm code
This applies to EnterCriticalSection and LeaveCriticalSection in the RTS
parent
0f8ecdcd
Changes
5
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CLabel.hs
View file @
0981e24e
...
...
@@ -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
...
...
compiler/cmm/CmmParse.y
View file @
0981e24e
...
...
@@ -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
...
...
rts/HeapStackCheck.cmm
View file @
0981e24e
...
...
@@ -13,6 +13,8 @@
#include "Cmm.h"
#ifdef __PIC__
import EnterCriticalSection
import LeaveCriticalSection
import pthread_mutex_unlock;
#endif
...
...
rts/PrimOps.cmm
View file @
0981e24e
...
...
@@ -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
/*-----------------------------------------------------------------------------
...
...
rts/StgMiscClosures.cmm
View file @
0981e24e
...
...
@@ -14,6 +14,8 @@
#if
def
__PIC__
import
pthread_mutex_lock
;
import
EnterCriticalSection
import
LeaveCriticalSection
import
base_GHCziBase_Czh_static_info
;
import
base_GHCziBase_Izh_static_info
;
#endif
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment