-data CmmTopForInfoTables
- = NoInfoTable CmmTopZ -- must be CmmData
- | ProcInfoTable CmmTopZ BlockSet -- CmmProc; argument is its set of procpoints
- | FloatingInfoTable CmmInfo BlockId UpdFrameOffset
-instance Outputable CmmTopForInfoTables where
- ppr (NoInfoTable t) = text "NoInfoTable: " <+> ppr t
- ppr (ProcInfoTable t bids) = text "ProcInfoTable: " <+> ppr t <+> ppr bids
- ppr (FloatingInfoTable info bid upd) =
- text "FloatingInfoTable: " <+> ppr info <+> ppr bid <+> ppr upd
-
--- The `safeState' record collects the info we update while lowering the
--- safe foreign calls in the graph.
-data SafeState = State { s_blocks :: BlockEnv CmmBlock
- , s_pps :: ProcPointSet
- , s_safeCalls :: [CmmTopForInfoTables]}
-
-lowerSafeForeignCalls
- :: [[CmmTopForInfoTables]] -> CmmTopZ -> FuelMonad [[CmmTopForInfoTables]]
-lowerSafeForeignCalls rst t@(CmmData _ _) = return $ [NoInfoTable t] : rst
-lowerSafeForeignCalls rst (CmmProc info l args (off, g@(LGraph entry _))) = do
- let init = return $ State emptyBlockEnv emptyBlockSet []
- let block b@(Block bid _) z = do
- state@(State {s_pps = ppset, s_blocks = blocks}) <- z
- let ppset' = if bid == entry then extendBlockSet ppset bid else ppset
- state' = state { s_pps = ppset' }
- if hasSafeForeignCall b
- then lowerSafeCallBlock state' b
- else return (state' { s_blocks = insertBlock b blocks })
- State blocks' g_procpoints safeCalls <- fold_blocks block init g
- let proc = (CmmProc info l args (off, LGraph entry blocks'))
- procTable = case off of
- (_, Just _) -> [ProcInfoTable proc g_procpoints]
- _ -> [NoInfoTable proc] -- not a successor of a call
- return $ safeCalls : procTable : rst
-
--- Check for foreign calls -- if none, then we can avoid copying the block.
-hasSafeForeignCall :: CmmBlock -> Bool
-hasSafeForeignCall (Block _ t) = tail t
- where tail (ZTail (MidForeignCall (Safe _ _) _ _ _) _) = True
- tail (ZTail _ t) = tail t
- tail (ZLast _) = False
-
--- Lower each safe call in the block, update the CAF and slot environments
--- to include each of those calls, and insert the new block in the blockEnv.
-lowerSafeCallBlock :: SafeState-> CmmBlock -> FuelMonad SafeState
-lowerSafeCallBlock state b = tail (return state) (ZBlock head (ZLast last))
- where (head, last) = goto_end (G.unzip b)
- tail s b@(ZBlock (ZFirst _) _) =
- do state <- s
- return $ state { s_blocks = insertBlock (G.zip b) (s_blocks state) }
- tail s (ZBlock (ZHead h m@(MidForeignCall (Safe bid updfr_off) _ _ _)) t) =
- do state <- s
- let state' = state
- { s_safeCalls = FloatingInfoTable emptyContInfoTable bid updfr_off :
- s_safeCalls state }
- (state'', t') <- lowerSafeForeignCall state' m t
- tail (return state'') (ZBlock h t')
- tail s (ZBlock (ZHead h m) t) = tail s (ZBlock h (ZTail m t))
-
+-- JD: Why not do this while splitting procedures?
+lowerSafeForeignCalls :: AreaMap -> CmmTop -> FuelUniqSM CmmTop
+lowerSafeForeignCalls _ t@(CmmData _ _) = return t
+lowerSafeForeignCalls areaMap (CmmProc info l g@(CmmGraph {g_entry=entry})) = do
+ let block b mblocks = mblocks >>= lowerSafeCallBlock entry areaMap b
+ blocks <- foldGraphBlocks block (return mapEmpty) g
+ return $ CmmProc info l (ofBlockMap entry blocks)
+
+-- If the block ends with a safe call in the block, lower it to an unsafe
+-- call (with appropriate saves and restores before and after).
+lowerSafeCallBlock :: BlockId -> AreaMap -> CmmBlock -> BlockEnv CmmBlock
+ -> FuelUniqSM (BlockEnv CmmBlock)
+lowerSafeCallBlock entry areaMap b blocks =
+ case blockToNodeList b of
+ (JustC (CmmEntry id), m, JustC l@(CmmForeignCall {})) -> lowerSafeForeignCall entry areaMap blocks id m l
+ _ -> return $ insertBlock b blocks