1 {-# OPTIONS_GHC -XGADTs -XNoMonoLocalBinds #-}
2 -- Norman likes local bindings
3 -- If this module lives on I'd like to get rid of this flag in due course
7 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
8 module CmmBuildInfoTables
9 ( CAFSet, CAFEnv, cafAnal, localCAFInfo, mkTopCAFInfo
10 , setInfoTableSRT, setInfoTableStackMap
11 , TopSRT, emptySRT, srtToData
13 , lowerSafeForeignCalls
14 , cafTransfers, liveSlotTransfers)
17 #include "HsVersions.h"
21 import qualified Prelude as P
22 import Prelude hiding (succ)
41 import OptimizationFuel
52 import qualified Data.Map as Map
53 import qualified FiniteMap as Map
55 ----------------------------------------------------------------
56 -- Building InfoTables
59 -----------------------------------------------------------------------
62 -- Given a block ID, we return a representation of the layout of the stack,
63 -- as suspended before entering that block.
64 -- (For a return site to a function call, the layout does not include the
65 -- parameter passing area (or the "return address" on the stack)).
66 -- If the element is `Nothing`, then it represents a word of the stack that
67 -- does not contain a live pointer.
68 -- If the element is `Just` a register, then it represents a live spill slot
69 -- for a pointer; we assume that a pointer is the size of a word.
70 -- The head of the list represents the young end of the stack where the infotable
71 -- pointer for the block `Bid` is stored.
72 -- The infotable pointer itself is not included in the list.
73 -- Call areas are also excluded from the list: besides the stuff in the update
74 -- frame (and the return infotable), call areas should never be live across
77 -- RTS Invariant: All pointers must be word-aligned because each bit in the bitmap
78 -- represents a word. Consequently, we have to be careful when we see a live slot
79 -- on the stack: if we have packed multiple sub-word values into a word,
80 -- we have to make sure that we only mark the entire word as a non-pointer.
82 -- Also, don't forget to stop at the old end of the stack (oldByte),
83 -- which may differ depending on whether there is an update frame.
86 = ( Int -- Offset from oldest byte of Old area
87 , LocalReg -- The register
88 , Int) -- Width of the register
90 live_ptrs :: ByteOff -> BlockEnv SubAreaSet -> AreaMap -> BlockId -> [Maybe LocalReg]
91 live_ptrs oldByte slotEnv areaMap bid =
92 -- pprTrace "live_ptrs for" (ppr bid <+> text (show oldByte ++ "-" ++ show youngByte) <+>
94 -- pprTrace ("stack layout for " ++ show bid ++ ": ") (ppr res) $ res
96 where res = reverse $ slotsToList youngByte liveSlots []
98 slotsToList :: Int -> [RegSlotInfo] -> [Maybe LocalReg] -> [Maybe LocalReg]
99 -- n starts at youngByte and is decremented down to oldByte
100 -- Returns a list, one element per word, with
101 -- (Just r) meaning 'pointer register r is saved here',
102 -- Nothing meaning 'non-pointer or empty'
104 slotsToList n [] results | n == oldByte = results -- at old end of stack frame
106 slotsToList n (s : _) _ | n == oldByte =
107 pprPanic "slot left off live_ptrs" (ppr s <+> ppr oldByte <+>
108 ppr n <+> ppr liveSlots <+> ppr youngByte)
110 slotsToList n _ _ | n < oldByte =
111 panic "stack slots not allocated on word boundaries?"
113 slotsToList n l@((n', r, w) : rst) results =
114 if n == (n' + w) then -- slot's young byte is at n
115 ASSERT (not (isPtr r) ||
116 (n `mod` wORD_SIZE == 0 && w == wORD_SIZE)) -- ptrs must be aligned
117 slotsToList next (dropWhile (non_ptr_younger_than next) rst)
118 (stack_rep : results)
119 else slotsToList next (dropWhile (non_ptr_younger_than next) l)
121 where next = n - wORD_SIZE
122 stack_rep = if isPtr r then Just r else Nothing
124 slotsToList n [] results = slotsToList (n - wORD_SIZE) [] (Nothing : results)
126 non_ptr_younger_than next (n', r, w) =
128 ASSERT (not (isPtr r))
130 isPtr = isGcPtrType . localRegType
132 liveSlots :: [RegSlotInfo]
133 liveSlots = sortBy (\ (off,_,_) (off',_,_) -> compare off' off)
134 (Map.foldRightWithKey (\_ -> flip $ foldl add_slot) [] slots)
136 add_slot :: [RegSlotInfo] -> SubArea -> [RegSlotInfo]
137 add_slot rst (a@(RegSlot r@(LocalReg _ ty)), off, w) =
138 if off == w && widthInBytes (typeWidth ty) == w then
139 (expectJust "add_slot" (Map.lookup a areaMap), r, w) : rst
140 else panic "live_ptrs: only part of a variable live at a proc point"
141 add_slot rst (CallArea Old, _, _) =
142 rst -- the update frame (or return infotable) should be live
143 -- would be nice to check that only that part of the callarea is live...
144 add_slot rst ((CallArea _), _, _) =
146 -- JD: THIS ISN'T CURRENTLY A CORRECTNESS PROBLEM, BUT WE SHOULD REALLY
147 -- MAKE LIVENESS INFO AROUND CALLS MORE PRECISE -- FOR NOW, A 32-BIT
148 -- FLOAT PADS OUT TO 64 BITS, BUT WE ASSUME THE WHOLE PARAMETER-PASSING
149 -- AREA IS LIVE (WHICH IT ISN'T...). WE SHOULD JUST PUT THE LIVE AREAS
150 -- IN THE CALL NODES, WHICH SHOULD EVENTUALLY HAVE LIVE REGISTER AS WELL,
151 -- SO IT'S ALL GOING IN THE SAME DIRECTION.
152 -- pprPanic "CallAreas must not be live across function calls" (ppr bid <+> ppr c)
154 slots :: SubAreaSet -- The SubAreaSet for 'bid'
155 slots = expectJust "live_ptrs slots" $ mapLookup bid slotEnv
156 youngByte = expectJust "live_ptrs bid_pos" $ Map.lookup (CallArea (Young bid)) areaMap
158 -- Construct the stack maps for a procedure _if_ it needs an infotable.
159 -- When wouldn't a procedure need an infotable? If it is a procpoint that
160 -- is not the successor of a call.
161 setInfoTableStackMap :: SlotEnv -> AreaMap -> CmmTop -> CmmTop
162 setInfoTableStackMap slotEnv areaMap
163 t@(CmmProc (TopInfo {stack_info=StackInfo {updfr_space = Just updfr_off}}) _ (CmmGraph {g_entry = eid})) =
164 updInfo (const (live_ptrs updfr_off slotEnv areaMap eid)) id t
165 setInfoTableStackMap _ _ t = t
169 -----------------------------------------------------------------------
172 -- WE NEED AN EXAMPLE HERE.
173 -- IN PARTICULAR, WE NEED TO POINT OUT THE DISTINCTION BETWEEN
174 -- FUNCTIONS WITH STATIC CLOSURES AND THOSE THAT MUST BE CONSTRUCTED
175 -- DYNAMICALLY (AND HENCE CAN'T BE REFERENCED IN AN SRT).
176 -- IN THE LATTER CASE, WE HAVE TO TAKE ALL THE CAFs REFERENCED BY
177 -- THE CLOSURE AND INLINE THEM INTO ANY SRT THAT MAY MENTION THE CLOSURE.
178 -- (I.E. TAKE THE TRANSITIVE CLOSURE, but only for non-static closures).
181 -----------------------------------------------------------------------
182 -- Finding the CAFs used by a procedure
184 type CAFSet = Map CLabel ()
185 type CAFEnv = BlockEnv CAFSet
187 -- First, an analysis to find live CAFs.
188 cafLattice :: DataflowLattice CAFSet
189 cafLattice = DataflowLattice "live cafs" Map.empty add
190 where add _ (OldFact old) (NewFact new) = case old `Map.union` new of
191 new' -> (changeIf $ Map.size new' > Map.size old, new')
193 cafTransfers :: BwdTransfer CmmNode CAFSet
194 cafTransfers = mkBTransfer3 first middle last
195 where first _ live = live
196 middle m live = foldExpDeep addCaf m live
197 last l live = foldExpDeep addCaf l (joinOutFacts cafLattice l live)
198 addCaf e set = case e of
199 CmmLit (CmmLabel c) -> add c set
200 CmmLit (CmmLabelOff c _) -> add c set
201 CmmLit (CmmLabelDiffOff c1 c2 _) -> add c1 $ add c2 set
203 add l s = if hasCAF l then Map.insert (cvtToClosureLbl l) () s else s
205 cafAnal :: CmmGraph -> FuelUniqSM CAFEnv
206 cafAnal g = liftM snd $ dataflowPassBwd g [] $ analBwd cafLattice cafTransfers
208 -----------------------------------------------------------------------
211 -- Description of the SRT for a given module.
212 -- Note that this SRT may grow as we greedily add new CAFs to it.
213 data TopSRT = TopSRT { lbl :: CLabel
214 , next_elt :: Int -- the next entry in the table
215 , rev_elts :: [CLabel]
216 , elt_map :: Map CLabel Int }
217 -- map: CLabel -> its last entry in the table
218 instance Outputable TopSRT where
219 ppr (TopSRT lbl next elts eltmap) =
220 text "TopSRT:" <+> ppr lbl <+> ppr next <+> ppr elts <+> ppr eltmap
222 emptySRT :: MonadUnique m => m TopSRT
224 do top_lbl <- getUniqueM >>= \ u -> return $ mkSRTLabel (mkFCallName u "srt") NoCafRefs
225 return TopSRT { lbl = top_lbl, next_elt = 0, rev_elts = [], elt_map = Map.empty }
227 cafMember :: TopSRT -> CLabel -> Bool
228 cafMember srt lbl = Map.member lbl (elt_map srt)
230 cafOffset :: TopSRT -> CLabel -> Maybe Int
231 cafOffset srt lbl = Map.lookup lbl (elt_map srt)
233 addCAF :: CLabel -> TopSRT -> TopSRT
235 srt { next_elt = last + 1
236 , rev_elts = caf : rev_elts srt
237 , elt_map = Map.insert caf last (elt_map srt) }
238 where last = next_elt srt
240 srtToData :: TopSRT -> Cmm
241 srtToData srt = Cmm [CmmData RelocatableReadOnlyData (CmmDataLabel (lbl srt) : tbl)]
242 where tbl = map (CmmStaticLit . CmmLabel) (reverse (rev_elts srt))
244 -- Once we have found the CAFs, we need to do two things:
245 -- 1. Build a table of all the CAFs used in the procedure.
246 -- 2. Compute the C_SRT describing the subset of CAFs live at each procpoint.
248 -- When building the local view of the SRT, we first make sure that all the CAFs are
249 -- in the SRT. Then, if the number of CAFs is small enough to fit in a bitmap,
250 -- we make sure they're all close enough to the bottom of the table that the
251 -- bitmap will be able to cover all of them.
252 buildSRTs :: TopSRT -> Map CLabel CAFSet -> CAFSet ->
253 FuelUniqSM (TopSRT, Maybe CmmTop, C_SRT)
254 buildSRTs topSRT topCAFMap cafs =
255 do let liftCAF lbl () z = -- get CAFs for functions without static closures
256 case Map.lookup lbl topCAFMap of Just cafs -> z `Map.union` cafs
257 Nothing -> Map.insert lbl () z
258 -- For each label referring to a function f without a static closure,
259 -- replace it with the CAFs that are reachable from f.
260 sub_srt topSRT localCafs =
261 let cafs = Map.keys (Map.foldRightWithKey liftCAF Map.empty localCafs)
263 do localSRTs <- procpointSRT (lbl topSRT) (elt_map topSRT) cafs
264 return (topSRT, localSRTs)
265 in if length cafs > maxBmpSize then
266 mkSRT (foldl add_if_missing topSRT cafs)
267 else -- make sure all the cafs are near the bottom of the srt
268 mkSRT (add_if_too_far topSRT cafs)
269 add_if_missing srt caf =
270 if cafMember srt caf then srt else addCAF caf srt
271 -- If a CAF is more than maxBmpSize entries from the young end of the
272 -- SRT, then we add it to the SRT again.
273 -- (Note: Not in the SRT => infinitely far.)
274 add_if_too_far srt@(TopSRT {elt_map = m}) cafs =
275 add srt (sortBy farthestFst cafs)
277 farthestFst x y = case (Map.lookup x m, Map.lookup y m) of
278 (Nothing, Nothing) -> EQ
279 (Nothing, Just _) -> LT
280 (Just _, Nothing) -> GT
281 (Just d, Just d') -> compare d' d
283 add srt@(TopSRT {next_elt = next}) (caf : rst) =
284 case cafOffset srt caf of
285 Just ix -> if next - ix > maxBmpSize then
286 add (addCAF caf srt) rst
288 Nothing -> add (addCAF caf srt) rst
289 (topSRT, subSRTs) <- sub_srt topSRT cafs
290 let (sub_tbls, blockSRTs) = subSRTs
291 return (topSRT, sub_tbls, blockSRTs)
293 -- Construct an SRT bitmap.
294 -- Adapted from simpleStg/SRT.lhs, which expects Id's.
295 procpointSRT :: CLabel -> Map CLabel Int -> [CLabel] ->
296 FuelUniqSM (Maybe CmmTop, C_SRT)
297 procpointSRT _ _ [] =
298 return (Nothing, NoC_SRT)
299 procpointSRT top_srt top_table entries =
300 do (top, srt) <- bitmap `seq` to_SRT top_srt offset len bitmap
303 ints = map (expectJust "constructSRT" . flip Map.lookup top_table) entries
304 sorted_ints = sortLe (<=) ints
305 offset = head sorted_ints
306 bitmap_entries = map (subtract offset) sorted_ints
307 len = P.last bitmap_entries + 1
308 bitmap = intsToBitmap len bitmap_entries
311 maxBmpSize = widthInBits wordWidth `div` 2
313 -- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT.
314 to_SRT :: CLabel -> Int -> Int -> Bitmap -> FuelUniqSM (Maybe CmmTop, C_SRT)
315 to_SRT top_srt off len bmp
316 | len > maxBmpSize || bmp == [fromIntegral srt_escape]
317 = do id <- getUniqueM
318 let srt_desc_lbl = mkLargeSRTLabel id
319 tbl = CmmData RelocatableReadOnlyData $
320 CmmDataLabel srt_desc_lbl : map CmmStaticLit
321 ( cmmLabelOffW top_srt off
322 : mkWordCLit (fromIntegral len)
323 : map mkWordCLit bmp)
324 return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape)
326 = return (Nothing, C_SRT top_srt off (fromIntegral (head bmp)))
327 -- The fromIntegral converts to StgHalfWord
329 -- Gather CAF info for a procedure, but only if the procedure
330 -- doesn't have a static closure.
331 -- (If it has a static closure, it will already have an SRT to
332 -- keep its CAFs live.)
333 -- Any procedure referring to a non-static CAF c must keep live
334 -- any CAF that is reachable from c.
335 localCAFInfo :: CAFEnv -> CmmTop -> Maybe (CLabel, CAFSet)
336 localCAFInfo _ (CmmData _ _) = Nothing
337 localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
338 case info_tbl top_info of
339 CmmInfoTable False _ _ _ ->
340 Just (cvtToClosureLbl top_l,
341 expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
344 -- Once we have the local CAF sets for some (possibly) mutually
345 -- recursive functions, we can create an environment mapping
346 -- each function to its set of CAFs. Note that a CAF may
347 -- be a reference to a function. If that function f does not have
348 -- a static closure, then we need to refer specifically
349 -- to the set of CAFs used by f. Of course, the set of CAFs
350 -- used by f must be included in the local CAF sets that are input to
351 -- this function. To minimize lookup time later, we return
352 -- the environment with every reference to f replaced by its set of CAFs.
353 -- To do this replacement efficiently, we gather strongly connected
354 -- components, then we sort the components in topological order.
355 mkTopCAFInfo :: [(CLabel, CAFSet)] -> Map CLabel CAFSet
356 mkTopCAFInfo localCAFs = foldl addToTop Map.empty g
357 where addToTop env (AcyclicSCC (l, cafset)) =
358 Map.insert l (flatten env cafset) env
359 addToTop env (CyclicSCC nodes) =
360 let (lbls, cafsets) = unzip nodes
361 cafset = lbls `Map.deleteList` foldl Map.union Map.empty cafsets
362 in foldl (\env l -> Map.insert l (flatten env cafset) env) env lbls
363 flatten env cafset = Map.foldRightWithKey (lookup env) Map.empty cafset
364 lookup env caf () cafset' =
365 case Map.lookup caf env of Just cafs -> Map.foldRightWithKey add cafset' cafs
366 Nothing -> add caf () cafset'
367 add caf () cafset' = Map.insert caf () cafset'
368 g = stronglyConnCompFromEdgedVertices
369 (map (\n@(l, cafs) -> (n, l, Map.keys cafs)) localCAFs)
371 type StackLayout = [Maybe LocalReg]
373 -- Bundle the CAFs used at a procpoint.
374 bundleCAFs :: CAFEnv -> CmmTop -> (CAFSet, CmmTop)
375 bundleCAFs cafEnv t@(CmmProc _ _ (CmmGraph {g_entry=entry})) =
376 (expectJust "bundleCAFs" (mapLookup entry cafEnv), t)
377 bundleCAFs _ t = (Map.empty, t)
379 -- Construct the SRTs for the given procedure.
380 setInfoTableSRT :: Map CLabel CAFSet -> TopSRT -> (CAFSet, CmmTop) ->
381 FuelUniqSM (TopSRT, [CmmTop])
382 setInfoTableSRT topCAFMap topSRT (cafs, t) =
383 setSRT cafs topCAFMap topSRT t
385 setSRT :: CAFSet -> Map CLabel CAFSet -> TopSRT ->
386 CmmTop -> FuelUniqSM (TopSRT, [CmmTop])
387 setSRT cafs topCAFMap topSRT t =
388 do (topSRT, cafTable, srt) <- buildSRTs topSRT topCAFMap cafs
389 let t' = updInfo id (const srt) t
391 Just tbl -> return (topSRT, [t', tbl])
392 Nothing -> return (topSRT, [t'])
394 updInfo :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmTop -> CmmTop
395 updInfo toVars toSrt (CmmProc top_info top_l g) =
396 CmmProc (top_info {info_tbl=updInfoTbl toVars toSrt (info_tbl top_info)}) top_l g
399 updInfoTbl :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmInfoTable -> CmmInfoTable
400 updInfoTbl toVars toSrt (CmmInfoTable s p t typeinfo)
401 = CmmInfoTable s p t typeinfo'
402 where typeinfo' = case typeinfo of
403 t@(ConstrInfo _ _ _) -> t
404 (FunInfo c s a d e) -> FunInfo c (toSrt s) a d e
405 (ThunkInfo c s) -> ThunkInfo c (toSrt s)
406 (ThunkSelectorInfo x s) -> ThunkSelectorInfo x (toSrt s)
407 (ContInfo v s) -> ContInfo (toVars v) (toSrt s)
408 updInfoTbl _ _ t@CmmNonInfoTable = t
410 ----------------------------------------------------------------
411 -- Safe foreign calls: We need to insert the code that suspends and resumes
412 -- the thread before and after a safe foreign call.
413 -- Why do we do this so late in the pipeline?
414 -- Because we need this code to appear without interrruption: you can't rely on the
415 -- value of the stack pointer between the call and resetting the thread state;
416 -- you need to have an infotable on the young end of the stack both when
417 -- suspending the thread and making the foreign call.
418 -- All of this is much easier if we insert the suspend and resume calls here.
420 -- At the same time, we prepare for the stages of the compiler that
421 -- build the proc points. We have to do this at the same time because
422 -- the safe foreign calls need special treatment with respect to infotables.
423 -- A safe foreign call needs an infotable even though it isn't
424 -- a procpoint. The following datatype captures the information
425 -- needed to generate the infotables along with the Cmm data and procedures.
427 -- JD: Why not do this while splitting procedures?
428 lowerSafeForeignCalls :: AreaMap -> CmmTop -> FuelUniqSM CmmTop
429 lowerSafeForeignCalls _ t@(CmmData _ _) = return t
430 lowerSafeForeignCalls areaMap (CmmProc info l g@(CmmGraph {g_entry=entry})) = do
431 let block b mblocks = mblocks >>= lowerSafeCallBlock entry areaMap b
432 blocks <- foldGraphBlocks block (return mapEmpty) g
433 return $ CmmProc info l (ofBlockMap entry blocks)
435 -- If the block ends with a safe call in the block, lower it to an unsafe
436 -- call (with appropriate saves and restores before and after).
437 lowerSafeCallBlock :: BlockId -> AreaMap -> CmmBlock -> BlockEnv CmmBlock
438 -> FuelUniqSM (BlockEnv CmmBlock)
439 lowerSafeCallBlock entry areaMap b blocks =
440 case blockToNodeList b of
441 (JustC (CmmEntry id), m, JustC l@(CmmForeignCall {})) -> lowerSafeForeignCall entry areaMap blocks id m l
442 _ -> return $ insertBlock b blocks
444 -- Late in the code generator, we want to insert the code necessary
445 -- to lower a safe foreign call to a sequence of unsafe calls.
446 lowerSafeForeignCall :: BlockId -> AreaMap -> BlockEnv CmmBlock -> BlockId -> [CmmNode O O] -> CmmNode O C
447 -> FuelUniqSM (BlockEnv CmmBlock)
448 lowerSafeForeignCall entry areaMap blocks bid m
449 (CmmForeignCall {tgt=tgt, res=rs, args=as, succ=succ, updfr = updfr_off, intrbl = intrbl}) =
450 do let newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep)
451 -- Both 'id' and 'new_base' are KindNonPtr because they're
452 -- RTS-only objects and are not subject to garbage collection
454 new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
455 let (caller_save, caller_load) = callerSaveVolatileRegs
456 load_tso <- newTemp gcWord -- TODO FIXME NOW
457 load_stack <- newTemp gcWord -- TODO FIXME NOW
459 let suspendThread = foreignLbl "suspendThread"
460 resumeThread = foreignLbl "resumeThread"
461 foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit name)))
462 suspend = saveThreadState <**>
464 mkUnsafeCall (ForeignTarget suspendThread
465 (ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint]))
466 [id] [CmmReg (CmmGlobal BaseReg), CmmLit (CmmInt (fromIntegral (fromEnum intrbl)) wordWidth)]
467 midCall = mkUnsafeCall tgt rs as
468 resume = mkUnsafeCall (ForeignTarget resumeThread
469 (ForeignConvention CCallConv [AddrHint] [AddrHint]))
470 [new_base] [CmmReg (CmmLocal id)] <**>
471 -- Assign the result to BaseReg: we
472 -- might now have a different Capability!
473 mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <**>
475 loadThreadState load_tso load_stack
476 -- We have to save the return value on the stack because its next use
477 -- may appear in a different procedure due to procpoint splitting...
478 saveRetVals = foldl (<**>) emptyAGraph $ map (M.mkMiddle . spill) rs
479 spill r = CmmStore (regSlot r) (CmmReg $ CmmLocal r)
480 regSlot r@(LocalReg _ _) = CmmRegOff (CmmGlobal Sp) (sp_off - offset)
481 where offset = w + expectJust "lowerForeign" (Map.lookup (RegSlot r) areaMap)
482 sp_off = wORD_SIZE + expectJust "lowerForeign" (Map.lookup (CallArea area) areaMap)
483 area = if succ == entry then Old else Young succ
484 w = widthInBytes $ typeWidth $ localRegType r
485 -- Note: The successor must be a procpoint, and we have already split,
486 -- so we use a jump, not a branch.
487 succLbl = CmmLit (CmmLabel (infoTblLbl succ))
488 jump = CmmCall { cml_target = succLbl, cml_cont = Nothing
489 , cml_args = widthInBytes wordWidth ,cml_ret_args = 0
490 , cml_ret_off = updfr_off}
491 graph' <- liftUniq $ labelAGraph bid $ catAGraphs (map M.mkMiddle m) <**>
492 suspend <**> midCall <**>
493 resume <**> saveRetVals <**> M.mkLast jump
494 return $ blocks `mapUnion` toBlockMap graph'
495 lowerSafeForeignCall _ _ _ _ _ _ = panic "lowerSafeForeignCall was passed something else"