Commit 7e723a1c authored by ian@well-typed.com's avatar ian@well-typed.com

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.
parent 1cc96d54
......@@ -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,
......
......@@ -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
......
......@@ -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 [
......
......@@ -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
......
......@@ -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))
......
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