summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/nativeGen/AsmCodeGen.lhs10
-rw-r--r--compiler/nativeGen/NCGMonad.hs14
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs18
-rw-r--r--compiler/nativeGen/SPARC/CodeGen.hs2
-rw-r--r--compiler/nativeGen/SPARC/CodeGen/CCall.hs4
-rw-r--r--compiler/nativeGen/SPARC/CodeGen/CondCode.hs4
-rw-r--r--compiler/nativeGen/SPARC/CodeGen/Gen64.hs4
-rw-r--r--compiler/nativeGen/X86/CodeGen.hs26
8 files changed, 40 insertions, 42 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index bdb411e5f4..f56238fd12 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -843,8 +843,8 @@ instance Monad CmmOptM where
addImportCmmOpt :: CLabel -> CmmOptM ()
addImportCmmOpt lbl = CmmOptM $ \(imports, _dflags) -> (# (), lbl:imports #)
-getDynFlagsCmmOpt :: CmmOptM DynFlags
-getDynFlagsCmmOpt = CmmOptM $ \(imports, dflags) -> (# dflags, imports #)
+instance HasDynFlags CmmOptM where
+ getDynFlags = CmmOptM $ \(imports, dflags) -> (# dflags, imports #)
runCmmOpt :: DynFlags -> CmmOptM a -> (a, [CLabel])
runCmmOpt dflags (CmmOptM f) = case f ([], dflags) of
@@ -895,7 +895,7 @@ cmmStmtConFold stmt
CmmCondBranch test dest
-> do test' <- cmmExprConFold DataReference test
- dflags <- getDynFlagsCmmOpt
+ dflags <- getDynFlags
let platform = targetPlatform dflags
return $ case test' of
CmmLit (CmmInt 0 _) ->
@@ -914,7 +914,7 @@ cmmStmtConFold stmt
cmmExprConFold :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
cmmExprConFold referenceKind expr = do
- dflags <- getDynFlagsCmmOpt
+ dflags <- getDynFlags
-- Skip constant folding if new code generator is running
-- (this optimization is done in Hoopl)
let expr' = if dopt Opt_TryNewCodeGen dflags
@@ -932,7 +932,7 @@ cmmExprCon _ other = other
-- of things to do.
cmmExprNative :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
cmmExprNative referenceKind expr = do
- dflags <- getDynFlagsCmmOpt
+ dflags <- getDynFlags
let platform = targetPlatform dflags
arch = platformArch platform
case expr of
diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 71250a2452..eb59d2b82a 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -29,7 +29,7 @@ module NCGMonad (
getNewRegPairNat,
getPicBaseMaybeNat,
getPicBaseNat,
- getDynFlagsNat
+ getDynFlags
)
where
@@ -100,11 +100,9 @@ getUniqueNat = NatM $ \ (NatM_State us delta imports pic dflags) ->
case takeUniqFromSupply us of
(uniq, us') -> (uniq, (NatM_State us' delta imports pic dflags))
-
-getDynFlagsNat :: NatM DynFlags
-getDynFlagsNat
- = NatM $ \ (NatM_State us delta imports pic dflags) ->
- (dflags, (NatM_State us delta imports pic dflags))
+instance HasDynFlags NatM where
+ getDynFlags = NatM $ \ (NatM_State us delta imports pic dflags) ->
+ (dflags, (NatM_State us delta imports pic dflags))
getDeltaNat :: NatM Int
@@ -139,14 +137,14 @@ getNewLabelNat
getNewRegNat :: Size -> NatM Reg
getNewRegNat rep
= do u <- getUniqueNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
return (RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep)
getNewRegPairNat :: Size -> NatM (Reg,Reg)
getNewRegPairNat rep
= do u <- getUniqueNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
let vLo = targetMkVirtualReg (targetPlatform dflags) u rep
let lo = RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep
let hi = RegVirtual $ getHiVirtualRegFromLo vLo
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index a043af01f8..2fd11bc35a 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -73,7 +73,7 @@ cmmTopCodeGen
cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
(nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
picBaseMb <- getPicBaseMaybeNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
tops = proc : concat statics
os = platformOS $ targetPlatform dflags
@@ -114,7 +114,7 @@ stmtsToInstrs stmts
stmtToInstrs :: CmmStmt -> NatM InstrBlock
stmtToInstrs stmt = do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
case stmt of
CmmNop -> return nilOL
CmmComment s -> return (unitOL (COMMENT s))
@@ -357,13 +357,13 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
rlo
iselExpr64 expr
- = do dflags <- getDynFlagsNat
+ = do dflags <- getDynFlags
pprPanic "iselExpr64(powerpc)" (pprPlatform (targetPlatform dflags) expr)
getRegister :: CmmExpr -> NatM Register
-getRegister e = do dflags <- getDynFlagsNat
+getRegister e = do dflags <- getDynFlags
getRegister' dflags e
getRegister' :: DynFlags -> CmmExpr -> NatM Register
@@ -555,7 +555,7 @@ getRegister' _ (CmmLit (CmmInt i rep))
getRegister' _ (CmmLit (CmmFloat f frep)) = do
lbl <- getNewLabelNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let size = floatSize frep
@@ -845,7 +845,7 @@ genCCall :: CmmCallTarget -- function to call
-> [HintedCmmActual] -- arguments (of mixed type)
-> NatM InstrBlock
genCCall target dest_regs argsAndHints
- = do dflags <- getDynFlagsNat
+ = do dflags <- getDynFlags
case platformOS (targetPlatform dflags) of
OSLinux -> genCCall' GCPLinux target dest_regs argsAndHints
OSDarwin -> genCCall' GCPDarwin target dest_regs argsAndHints
@@ -1098,7 +1098,7 @@ genCCall' gcp target dest_regs argsAndHints
outOfLineMachOp mop =
do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction
let mopLabelOrExpr = case mopExpr of
@@ -1162,7 +1162,7 @@ genSwitch expr ids
(reg,e_code) <- getSomeReg expr
tmp <- getNewRegNat II32
lbl <- getNewLabelNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let code = e_code `appOL` t_code `appOL` toOL [
@@ -1364,7 +1364,7 @@ coerceInt2FP fromRep toRep x = do
lbl <- getNewLabelNat
itmp <- getNewRegNat II32
ftmp <- getNewRegNat FF64
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 663b95b236..ff1e9f2eb2 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -63,7 +63,7 @@ cmmTopCodeGen :: RawCmmDecl
cmmTopCodeGen (CmmProc info lab (ListGraph blocks))
= do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
let platform = targetPlatform dflags
(nat_blocks,statics) <- mapAndUnzipM (basicBlockCodeGen platform) blocks
diff --git a/compiler/nativeGen/SPARC/CodeGen/CCall.hs b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
index 48c766f8e0..91351a2e18 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CCall.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
@@ -141,7 +141,7 @@ genCCall target dest_regs argsAndHints
let transfer_code
= toOL (move_final vregs allArgRegs extraStackArgsHere)
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
return
$ argcode `appOL`
move_sp_down `appOL`
@@ -276,7 +276,7 @@ outOfLineMachOp mop
= do let functionName
= outOfLineMachOp_table mop
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
$ mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
index 215a565ba6..f02b7a45a8 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
@@ -62,10 +62,10 @@ getCondCode (CmmMachOp mop [x, y])
MO_U_Lt _ -> condIntCode LU x y
MO_U_Le _ -> condIntCode LEU x y
- _ -> do dflags <- getDynFlagsNat
+ _ -> do dflags <- getDynFlags
pprPanic "SPARC.CodeGen.CondCode.getCondCode" (pprPlatform (targetPlatform dflags) (CmmMachOp mop [x,y]))
-getCondCode other = do dflags <- getDynFlagsNat
+getCondCode other = do dflags <- getDynFlags
pprPanic "SPARC.CodeGen.CondCode.getCondCode" (pprPlatform (targetPlatform dflags) other)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
index 5bcab2cb10..5352281296 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
@@ -190,7 +190,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
-- compute expr and load it into r_dst_lo
(a_reg, a_code) <- getSomeReg expr
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
let platform = targetPlatform dflags
code = a_code
`appOL` toOL
@@ -201,7 +201,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
iselExpr64 expr
- = do dflags <- getDynFlagsNat
+ = do dflags <- getDynFlags
pprPanic "iselExpr64(sparc)" (pprPlatform (targetPlatform dflags) expr)
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 5f0f716281..2ade04d36f 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -63,12 +63,12 @@ import Data.Word
is32BitPlatform :: NatM Bool
is32BitPlatform = do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
return $ target32Bit (targetPlatform dflags)
sse2Enabled :: NatM Bool
sse2Enabled = do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
case platformArch (targetPlatform dflags) of
ArchX86_64 -> -- SSE2 is fixed on for x86_64. It would be
-- possible to make it optional, but we'd need to
@@ -81,7 +81,7 @@ sse2Enabled = do
sse4_2Enabled :: NatM Bool
sse4_2Enabled = do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
return (dopt Opt_SSE4_2 dflags)
if_sse2 :: NatM a -> NatM a -> NatM a
@@ -96,7 +96,7 @@ cmmTopCodeGen
cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
(nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
picBaseMb <- getPicBaseMaybeNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
tops = proc : concat statics
os = platformOS $ targetPlatform dflags
@@ -400,7 +400,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do
)
iselExpr64 expr
- = do dflags <- getDynFlagsNat
+ = do dflags <- getDynFlags
pprPanic "iselExpr64(i386)" (pprPlatform (targetPlatform dflags) expr)
@@ -887,7 +887,7 @@ getRegister' _ (CmmLit lit)
in
return (Any size code)
-getRegister' _ other = do dflags <- getDynFlagsNat
+getRegister' _ other = do dflags <- getDynFlags
pprPanic "getRegister(x86)" (pprPlatform (targetPlatform dflags) other)
@@ -1131,7 +1131,7 @@ isOperand _ _ = False
memConstant :: Int -> CmmLit -> NatM Amode
memConstant align lit = do
lbl <- getNewLabelNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
(addr, addr_code) <- if target32Bit (targetPlatform dflags)
then do dynRef <- cmmMakeDynamicReference
dflags
@@ -1228,10 +1228,10 @@ getCondCode (CmmMachOp mop [x, y])
MO_U_Lt _ -> condIntCode LU x y
MO_U_Le _ -> condIntCode LEU x y
- _other -> do dflags <- getDynFlagsNat
+ _other -> do dflags <- getDynFlags
pprPanic "getCondCode(x86,x86_64,sparc)" (pprPlatform (targetPlatform dflags) (CmmMachOp mop [x,y]))
-getCondCode other = do dflags <- getDynFlagsNat
+getCondCode other = do dflags <- getDynFlags
pprPanic "getCondCode(2)(x86,sparc)" (pprPlatform (targetPlatform dflags) other)
@@ -1621,7 +1621,7 @@ genCCall is32Bit (CmmPrim (MO_PopCnt width)) dest_regs@[CmmHinted dst _]
unitOL (POPCNT size (OpReg src_r)
(getRegisterReg False (CmmLocal dst))))
else do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
targetExpr <- cmmMakeDynamicReference dflags addImportNat
CallReference lbl
let target = CmmCallee targetExpr CCallConv
@@ -1959,7 +1959,7 @@ genCCall64 target dest_regs args =
(arg_reg, arg_code) <- getSomeReg arg
delta <- getDeltaNat
setDeltaNat (delta-arg_size)
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
let platform = targetPlatform dflags
code' = code `appOL` arg_code `appOL` toOL [
SUB (intSize wordWidth) (OpImm (ImmInt arg_size)) (OpReg rsp) ,
@@ -1992,7 +1992,7 @@ maxInlineSizeThreshold = 128
outOfLineCmmOp :: CallishMachOp -> Maybe HintedCmmFormal -> [HintedCmmActual] -> NatM InstrBlock
outOfLineCmmOp mop res args
= do
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
let target = CmmCallee targetExpr CCallConv
@@ -2063,7 +2063,7 @@ genSwitch expr ids
= do
(reg,e_code) <- getSomeReg expr
lbl <- getNewLabelNat
- dflags <- getDynFlagsNat
+ dflags <- getDynFlags
dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
View Lorry Controller Status