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

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