Commit 14a5c62a authored by Simon Marlow's avatar Simon Marlow

Allow C argument regs to be used as global regs (R1, R2, etc.)

The problem here was that we generated C calls with expressions
involving R1 etc. as parameters.  When some of the R registers are
also C argument registers, both GCC and the native code generator
generate incorrect code.  The hacky workaround is to assign
problematic arguments to temporaries first; fortunately this works
with both GCC and the NCG, but we have to be careful not to undo this
with later optimisations (see changes to CmmOpt).
parent 04db0e9f
......@@ -15,6 +15,7 @@ module CmmOpt (
#include "HsVersions.h"
import Cmm
import CmmUtils ( hasNoGlobalRegs )
import CLabel ( entryLblToInfoLbl )
import MachOp
import SMRep ( tablesNextToCode )
......@@ -85,8 +86,17 @@ lookForInline u expr (CmmNop : rest)
lookForInline u expr (stmt:stmts)
= case lookupUFM (getStmtUses stmt) u of
Just 1 -> Just (inlineStmt u expr stmt : stmts)
Just 1 | ok_to_inline -> Just (inlineStmt u expr stmt : stmts)
_other -> Nothing
where
-- we don't inline into CmmCall if the expression refers to global
-- registers. This is a HACK to avoid global registers clashing with
-- C argument-passing registers, really the back-end ought to be able
-- to handle it properly, but currently neither PprC nor the NCG can
-- do it. See also CgForeignCall:load_args_into_temps.
ok_to_inline = case stmt of
CmmCall{} -> hasNoGlobalRegs expr
_ -> True
-- -----------------------------------------------------------------------------
-- Boring Cmm traversals for collecting usage info and substitutions.
......
......@@ -32,7 +32,7 @@ import MachOp
import SMRep ( fixedHdrSize, CgRep(..) )
import Lexer
import ForeignCall ( CCallConv(..) )
import ForeignCall ( CCallConv(..), Safety(..) )
import Literal ( mkMachInt )
import Unique
import UniqFM
......@@ -732,7 +732,8 @@ foreignCall "C" results_code expr_code args_code vols
results <- sequence results_code
expr <- expr_code
args <- sequence args_code
stmtEC (CmmCall (CmmForeignCall expr CCallConv) results args vols)
code (emitForeignCall' PlayRisky results
(CmmForeignCall expr CCallConv) args vols)
foreignCall conv _ _ _ _
= fail ("unknown calling convention: " ++ conv)
......
......@@ -10,7 +10,7 @@ module CmmUtils(
CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
isNopStmt,
isTrivialCmmExpr,
isTrivialCmmExpr, hasNoGlobalRegs,
cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
......@@ -90,6 +90,14 @@ isTrivialCmmExpr (CmmLit _) = True
isTrivialCmmExpr (CmmReg _) = True
isTrivialCmmExpr (CmmRegOff _ _) = True
hasNoGlobalRegs :: CmmExpr -> Bool
hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e
hasNoGlobalRegs (CmmMachOp _ es) = all hasNoGlobalRegs es
hasNoGlobalRegs (CmmLit _) = True
hasNoGlobalRegs (CmmReg (CmmLocal _)) = True
hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
hasNoGlobalRegs _ = False
---------------------------------------------------
--
-- Expr Construction helpers
......
......@@ -7,8 +7,9 @@
-----------------------------------------------------------------------------
module CgForeignCall (
emitForeignCall,
cgForeignCall,
emitForeignCall,
emitForeignCall',
shimForeignCallArg,
emitSaveThreadState, -- will be needed by the Cmm parser
emitLoadThreadState, -- ditto
......@@ -22,7 +23,8 @@ import StgSyn ( StgLiveVars, StgArg, stgArgType )
import CgProf ( curCCS, curCCSAddr )
import CgBindery ( getVolatileRegs, getArgAmodes )
import CgMonad
import CgUtils ( cmmOffsetW, cmmOffsetB, cmmLoadIndexW, newTemp )
import CgUtils ( cmmOffsetW, cmmOffsetB, cmmLoadIndexW, newTemp,
assignTemp )
import Type ( tyConAppTyCon, repType )
import TysPrim
import CLabel ( mkForeignLabel, mkRtsCodeLabel )
......@@ -68,32 +70,9 @@ emitForeignCall
-> Code
emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
| not (playSafe safety)
= do
vols <- getVolatileRegs live
stmtC (the_call vols)
| otherwise -- it's a safe foreign call
= do
vols <- getVolatileRegs live
id <- newTemp wordRep
emitSaveThreadState
stmtC (CmmCall (CmmForeignCall suspendThread CCallConv)
[(id,PtrHint)]
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
(Just vols)
)
stmtC (the_call vols)
stmtC (CmmCall (CmmForeignCall resumeThread CCallConv)
[ (CmmGlobal BaseReg, PtrHint) ]
-- Assign the result to BaseReg: we
-- might now have a different
-- Capability!
[ (CmmReg id, PtrHint) ]
(Just vols)
)
emitLoadThreadState
= do vols <- getVolatileRegs live
emitForeignCall' safety results
(CmmForeignCall cmm_target cconv) call_args (Just vols)
where
(call_args, cmm_target)
= case target of
......@@ -101,9 +80,6 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
(mkForeignLabel lbl call_size False)))
DynamicTarget -> case args of (fn,_):rest -> (rest, fn)
the_call vols = CmmCall (CmmForeignCall cmm_target cconv)
results call_args (Just vols)
-- in the stdcall calling convention, the symbol needs @size appended
-- to it, where size is the total number of bytes of arguments. We
-- attach this info to the CLabel here, and the CLabel pretty printer
......@@ -115,13 +91,66 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
-- ToDo: this might not be correct for 64-bit API
arg_size rep = max (machRepByteWidth rep) wORD_SIZE
emitForeignCall results (DNCall _) args live
= panic "emitForeignCall: DNCall"
-- alternative entry point, used by CmmParse
emitForeignCall'
:: Safety
-> [(CmmReg,MachHint)] -- where to put the results
-> CmmCallTarget -- the op
-> [(CmmExpr,MachHint)] -- arguments
-> Maybe [GlobalReg] -- live vars, in case we need to save them
-> Code
emitForeignCall' safety results target args vols
| not (playSafe safety) = do
temp_args <- load_args_into_temps args
stmtC (CmmCall target results temp_args vols)
| otherwise = do
id <- newTemp wordRep
temp_args <- load_args_into_temps args
emitSaveThreadState
stmtC (CmmCall (CmmForeignCall suspendThread CCallConv)
[(id,PtrHint)]
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
vols
)
stmtC (CmmCall target results temp_args vols)
stmtC (CmmCall (CmmForeignCall resumeThread CCallConv)
[ (CmmGlobal BaseReg, PtrHint) ]
-- Assign the result to BaseReg: we
-- might now have a different
-- Capability!
[ (CmmReg id, PtrHint) ]
vols
)
emitLoadThreadState
suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("suspendThread")))
resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))
-- we might need to load arguments into temporaries before
-- making the call, because certain global registers might
-- overlap with registers that the C calling convention uses
-- for passing arguments.
--
-- This is a HACK; really it should be done in the back end, but
-- it's easier to generate the temporaries here.
load_args_into_temps args = mapM maybe_assignTemp args
maybe_assignTemp (e, hint)
| hasNoGlobalRegs e = return (e, hint)
| otherwise = do
-- don't use assignTemp, it uses its own notion of "trivial"
-- expressions, which are wrong here
reg <- newTemp (cmmExprRep e)
stmtC (CmmAssign reg e)
return (CmmReg reg, hint)
-- -----------------------------------------------------------------------------
-- Save/restore the thread state in the TSO
......
......@@ -14,6 +14,7 @@ module CgPrimOp (
import ForeignCall ( CCallConv(CCallConv) )
import StgSyn ( StgLiveVars, StgArg )
import CgForeignCall ( emitForeignCall' )
import CgBindery ( getVolatileRegs, getArgAmodes )
import CgMonad
import CgInfoTbls ( getConstrTag )
......@@ -117,10 +118,11 @@ emitPrimOp [res] ParOp [arg] live
-- for now, just implement this in a C function
-- later, we might want to inline it.
vols <- getVolatileRegs live
stmtC (CmmCall (CmmForeignCall newspark CCallConv) [(res,NoHint)]
[(CmmReg (CmmGlobal BaseReg), PtrHint),
(arg,PtrHint)]
(Just vols))
emitForeignCall' PlayRisky
[(res,NoHint)]
(CmmForeignCall newspark CCallConv)
[(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)]
(Just vols)
where
newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
......@@ -131,12 +133,12 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
= do
stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
vols <- getVolatileRegs live
stmtC (CmmCall (CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
CCallConv)
emitForeignCall' PlayRisky
[{-no results-}]
[(CmmReg (CmmGlobal BaseReg), PtrHint),
(mutv,PtrHint)]
(Just vols))
(CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
CCallConv)
[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
(Just vols)
-- #define sizzeofByteArrayzh(r,a) \
-- r = (((StgArrWords *)(a))->words * sizeof(W_))
......@@ -336,8 +338,11 @@ emitPrimOp [res] op [arg] live
emitPrimOp [res] op args live
| Just prim <- callishOp op
= do vols <- getVolatileRegs live
stmtC (CmmCall (CmmPrim prim) [(res,NoHint)]
[(a,NoHint) | a<-args] (Just vols)) -- ToDo: hints?
emitForeignCall' PlayRisky
[(res,NoHint)]
(CmmPrim prim)
[(a,NoHint) | a<-args] -- ToDo: hints?
(Just vols)
| Just mop <- translateOp op
= let stmt = CmmAssign res (CmmMachOp mop args) in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment