[commit: ghc] master: Refactor cmmMakeDynamicReference (7e723a1)
Ian Lynagh
igloo at earth.li
Tue May 14 16:05:49 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : master
https://github.com/ghc/ghc/commit/7e723a1c70bee46a42d2cafb9ebd7399c3c054f0
>---------------------------------------------------------------
commit 7e723a1c70bee46a42d2cafb9ebd7399c3c054f0
Author: Ian Lynagh <ian at well-typed.com>
Date: Mon May 13 19:36:49 2013 +0100
Refactor cmmMakeDynamicReference
It now has its own class, and the addImport function is defined in that
class, rather than needing to be passed as an argument.
>---------------------------------------------------------------
compiler/nativeGen/AsmCodeGen.lhs | 7 +++++--
compiler/nativeGen/PIC.hs | 21 +++++++++++++--------
compiler/nativeGen/PPC/CodeGen.hs | 8 ++++----
compiler/nativeGen/SPARC/CodeGen.hs | 2 +-
compiler/nativeGen/X86/CodeGen.hs | 9 ++++-----
5 files changed, 27 insertions(+), 20 deletions(-)
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 34c4309..a0a0a71 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -875,6 +875,9 @@ instance Monad CmmOptM where
case g x of
CmmOptM g' -> g' (imports', dflags)
+instance CmmMakeDynamicReferenceM CmmOptM where
+ addImport = addImportCmmOpt
+
addImportCmmOpt :: CLabel -> CmmOptM ()
addImportCmmOpt lbl = CmmOptM $ \(imports, _dflags) -> (# (), lbl:imports #)
@@ -986,10 +989,10 @@ cmmExprNative referenceKind expr = do
CmmLit (CmmLabel lbl)
-> do
- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
+ cmmMakeDynamicReference dflags referenceKind lbl
CmmLit (CmmLabelOff lbl off)
-> do
- dynRef <- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
+ dynRef <- cmmMakeDynamicReference dflags referenceKind lbl
-- need to optimize here, since it's late
return $ cmmMachOpFold dflags (MO_Add (wordWidth dflags)) [
dynRef,
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 0187c4c..6bf843a 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -35,6 +35,7 @@
module PIC (
cmmMakeDynamicReference,
+ CmmMakeDynamicReferenceM(..),
ReferenceKind(..),
needImportedSymbols,
pprImportedSymbol,
@@ -96,16 +97,20 @@ data ReferenceKind
| JumpReference
deriving(Eq)
+class Monad m => CmmMakeDynamicReferenceM m where
+ addImport :: CLabel -> m ()
+
+instance CmmMakeDynamicReferenceM NatM where
+ addImport = addImportNat
cmmMakeDynamicReference
- :: Monad m => DynFlags
- -> (CLabel -> m ()) -- a monad & a function
- -- used for recording imported symbols
- -> ReferenceKind -- whether this is the target of a jump
- -> CLabel -- the label
- -> m CmmExpr
-
-cmmMakeDynamicReference dflags addImport referenceKind lbl
+ :: CmmMakeDynamicReferenceM m
+ => DynFlags
+ -> ReferenceKind -- whether this is the target of a jump
+ -> CLabel -- the label
+ -> m CmmExpr
+
+cmmMakeDynamicReference dflags referenceKind lbl
| Just _ <- dynamicLinkerLabelInfo lbl
= return $ CmmLit $ CmmLabel lbl -- already processed it, pass through
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 92eff36..b3f5a48 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -561,7 +561,7 @@ getRegister' _ (CmmLit (CmmInt i rep))
getRegister' _ (CmmLit (CmmFloat f frep)) = do
lbl <- getNewLabelNat
dflags <- getDynFlags
- dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+ dynRef <- cmmMakeDynamicReference dflags DataReference lbl
Amode addr addr_code <- getAmode dynRef
let size = floatSize frep
code dst =
@@ -1107,7 +1107,7 @@ genCCall' dflags gcp target dest_regs args0
outOfLineMachOp mop =
do
dflags <- getDynFlags
- mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
+ mopExpr <- cmmMakeDynamicReference dflags CallReference $
mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
@@ -1179,7 +1179,7 @@ genSwitch dflags expr ids
tmp <- getNewRegNat II32
lbl <- getNewLabelNat
dflags <- getDynFlags
- dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+ dynRef <- cmmMakeDynamicReference dflags DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let code = e_code `appOL` t_code `appOL` toOL [
SLW tmp reg (RIImm (ImmInt 2)),
@@ -1382,7 +1382,7 @@ coerceInt2FP fromRep toRep x = do
itmp <- getNewRegNat II32
ftmp <- getNewRegNat FF64
dflags <- getDynFlags
- dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+ dynRef <- cmmMakeDynamicReference dflags DataReference lbl
Amode addr addr_code <- getAmode dynRef
let
code' dst = code `appOL` maybe_exts `appOL` toOL [
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 30ffcd9..9c84a38 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -588,7 +588,7 @@ outOfLineMachOp mop
= outOfLineMachOp_table mop
dflags <- getDynFlags
- mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
+ mopExpr <- cmmMakeDynamicReference dflags CallReference
$ mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
let mopLabelOrExpr
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 36aebea..ef8a628 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1170,7 +1170,6 @@ memConstant align lit = do
(addr, addr_code) <- if target32Bit (targetPlatform dflags)
then do dynRef <- cmmMakeDynamicReference
dflags
- addImportNat
DataReference
lbl
Amode addr addr_code <- getAmode dynRef
@@ -1677,7 +1676,7 @@ genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
unitOL (POPCNT size (OpReg src_r)
(getRegisterReg platform False (CmmLocal dst))))
else do
- targetExpr <- cmmMakeDynamicReference dflags addImportNat
+ targetExpr <- cmmMakeDynamicReference dflags
CallReference lbl
let target = ForeignTarget targetExpr (ForeignConvention CCallConv
[NoHint] [NoHint]
@@ -1689,7 +1688,7 @@ genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
genCCall is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do
dflags <- getDynFlags
- targetExpr <- cmmMakeDynamicReference dflags addImportNat
+ targetExpr <- cmmMakeDynamicReference dflags
CallReference lbl
let target = ForeignTarget targetExpr (ForeignConvention CCallConv
[NoHint] [NoHint]
@@ -2271,7 +2270,7 @@ outOfLineCmmOp :: CallishMachOp -> Maybe CmmFormal -> [CmmActual] -> NatM InstrB
outOfLineCmmOp mop res args
= do
dflags <- getDynFlags
- targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
+ targetExpr <- cmmMakeDynamicReference dflags CallReference lbl
let target = ForeignTarget targetExpr
(ForeignConvention CCallConv [] [] CmmMayReturn)
@@ -2351,7 +2350,7 @@ genSwitch dflags expr ids
(reg,e_code) <- getSomeReg expr
lbl <- getNewLabelNat
dflags <- getDynFlags
- dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+ dynRef <- cmmMakeDynamicReference dflags DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
(EAIndex reg (wORD_SIZE dflags)) (ImmInt 0))
More information about the ghc-commits
mailing list