import MachOp (MachHint(NoHint))
import Maybes
import MkZipCfgCmm hiding (CmmBlock, CmmGraph)
import MachOp (MachHint(NoHint))
import Maybes
import MkZipCfgCmm hiding (CmmBlock, CmmGraph)
deriving Eq
instance Outputable Protocol where
ppr (Protocol c fs a) = text "Protocol" <+> ppr c <+> ppr fs <+> ppr a
deriving Eq
instance Outputable Protocol where
ppr (Protocol c fs a) = text "Protocol" <+> ppr c <+> ppr fs <+> ppr a
-- points that are relevant to the optimization explained above.
-- The others are assigned by 'add_unassigned', which is not yet clever.
-- points that are relevant to the optimization explained above.
-- The others are assigned by 'add_unassigned', which is not yet clever.
-addProcPointProtocols :: ProcPointSet -> ProcPointSet -> CmmFormalsWithoutKinds ->
- CmmGraph -> FuelMonad CmmGraph
-addProcPointProtocols callPPs procPoints formals g =
+addProcPointProtocols :: ProcPointSet -> ProcPointSet -> CmmGraph -> FuelMonad CmmGraph
+addProcPointProtocols callPPs procPoints g =
do liveness <- cmmLivenessZ g
(protos, g') <- return $ optimize_calls liveness g
blocks'' <- add_CopyOuts protos procPoints g'
do liveness <- cmmLivenessZ g
(protos, g') <- return $ optimize_calls liveness g
blocks'' <- add_CopyOuts protos procPoints g'
maybe_add_proto :: CmmBlock -> BlockEnv Protocol -> BlockEnv Protocol
maybe_add_proto (Block id (ZTail (CopyIn c fs _srt) _)) env =
extendBlockEnv env id (Protocol c fs $ toArea id fs)
maybe_add_proto :: CmmBlock -> BlockEnv Protocol -> BlockEnv Protocol
maybe_add_proto (Block id (ZTail (CopyIn c fs _srt) _)) env =
extendBlockEnv env id (Protocol c fs $ toArea id fs)
-- | For now, following a suggestion by Ben Lippmeier, we pass all
-- live variables as arguments, hoping that a clever register
-- | For now, following a suggestion by Ben Lippmeier, we pass all
-- live variables as arguments, hoping that a clever register
panic ("no liveness at block " ++ show id)
formals = map (\x -> CmmKinded x NoHint) $ uniqSetToList live
prot = Protocol ConventionPrivate formals $
panic ("no liveness at block " ++ show id)
formals = map (\x -> CmmKinded x NoHint) $ uniqSetToList live
prot = Protocol ConventionPrivate formals $
add_CopyOuts protos procPoints g = fold_blocks maybe_insert_CopyOut (return emptyBlockEnv) g
where maybe_insert_CopyOut :: CmmBlock -> FuelMonad (BlockEnv CmmBlock) ->
FuelMonad (BlockEnv CmmBlock)
add_CopyOuts protos procPoints g = fold_blocks maybe_insert_CopyOut (return emptyBlockEnv) g
where maybe_insert_CopyOut :: CmmBlock -> FuelMonad (BlockEnv CmmBlock) ->
FuelMonad (BlockEnv CmmBlock)
_ -> maybe_insert_CopyOut' b blocks
maybe_insert_CopyOut' b blocks = fold_succs trySucc b init >>= finish
where init = blocks >>= (\bmap -> return (b, bmap))
_ -> maybe_insert_CopyOut' b blocks
maybe_insert_CopyOut' b blocks = fold_succs trySucc b init >>= finish
where init = blocks >>= (\bmap -> return (b, bmap))
(b, bs) <- insertBetween b m succId
return $ (b, foldl (flip insertBlock) bmap bs)
finish (b@(Block bid _), bmap) = return $ extendBlockEnv bmap bid b
(b, bs) <- insertBetween b m succId
return $ (b, foldl (flip insertBlock) bmap bs)
finish (b@(Block bid _), bmap) = return $ extendBlockEnv bmap bid b