compiler/cmm/CmmProcPoint.hs

   1 {-# LANGUAGE GADTs, DisambiguateRecordFields #-}
   2 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
   3
   4 module CmmProcPoint
   5     ( ProcPointSet, Status(..)
   6     , callProcPoints, minimalProcPointSet
   7     , addProcPointProtocols, splitAtProcPoints, procPointAnalysis
   8     )
   9 where
  10
  11 import Prelude hiding (last, unzip, succ, zip)
  12
  13 import BlockId
  14 import CLabel
  15 import Cmm
  16 import CmmDecl
  17 import CmmExpr
  18 import CmmContFlowOpt
  19 import CmmInfo
  20 import CmmLive
  21 import Constants
  22 import Data.List (sortBy)
  23 import Maybes
  24 import MkGraph
  25 import Control.Monad
  26 import OptimizationFuel
  27 import Outputable
  28 import UniqSet
  29 import UniqSupply
  30
  31 import Compiler.Hoopl
  32
  33 import qualified Data.Map as Map
  34
  35 -- Compute a minimal set of proc points for a control-flow graph.
  36
  37 -- Determine a protocol for each proc point (which live variables will
  38 -- be passed as arguments and which will be on the stack).
  39
  40 {-
  41 A proc point is a basic block that, after CPS transformation, will
  42 start a new function.  The entry block of the original function is a
  43 proc point, as is the continuation of each function call.
  44 A third kind of proc point arises if we want to avoid copying code.
  45 Suppose we have code like the following:
  46
  47   f() {
  48     if (...) { ..1..; call foo(); ..2..}
  49     else     { ..3..; call bar(); ..4..}
  50     x = y + z;
  51     return x;
  52   }
  53
  54 The statement 'x = y + z' can be reached from two different proc
  55 points: the continuations of foo() and bar().  We would prefer not to
  56 put a copy in each continuation; instead we would like 'x = y + z' to
  57 be the start of a new procedure to which the continuations can jump:
  58
  59   f_cps () {
  60     if (...) { ..1..; push k_foo; jump foo_cps(); }
  61     else     { ..3..; push k_bar; jump bar_cps(); }
  62   }
  63   k_foo() { ..2..; jump k_join(y, z); }
  64   k_bar() { ..4..; jump k_join(y, z); }
  65   k_join(y, z) { x = y + z; return x; }
  66
  67 You might think then that a criterion to make a node a proc point is
  68 that it is directly reached by two distinct proc points.  (Note
  69 [Direct reachability].)  But this criterion is a bit too simple; for
  70 example, 'return x' is also reached by two proc points, yet there is
  71 no point in pulling it out of k_join.  A good criterion would be to
  72 say that a node should be made a proc point if it is reached by a set
  73 of proc points that is different than its immediate dominator.  NR
  74 believes this criterion can be shown to produce a minimum set of proc
  75 points, and given a dominator tree, the proc points can be chosen in
  76 time linear in the number of blocks.  Lacking a dominator analysis,
  77 however, we turn instead to an iterative solution, starting with no
  78 proc points and adding them according to these rules:
  79
  80   1. The entry block is a proc point.
  81   2. The continuation of a call is a proc point.
  82   3. A node is a proc point if it is directly reached by more proc
  83      points than one of its predecessors.
  84
  85 Because we don't understand the problem very well, we apply rule 3 at
  86 most once per iteration, then recompute the reachability information.
  87 (See Note [No simple dataflow].)  The choice of the new proc point is
  88 arbitrary, and I don't know if the choice affects the final solution,
  89 so I don't know if the number of proc points chosen is the
  90 minimum---but the set will be minimal.
  91 -}
  92
  93 type ProcPointSet = BlockSet
  94
  95 data Status
  96   = ReachedBy ProcPointSet  -- set of proc points that directly reach the block
  97   | ProcPoint               -- this block is itself a proc point
  98
  99 instance Outputable Status where
 100   ppr (ReachedBy ps)
 101       | setNull ps = text "<not-reached>"
 102       | otherwise = text "reached by" <+>
 103                     (hsep $ punctuate comma $ map ppr $ setElems ps)
 104   ppr ProcPoint = text "<procpt>"
 105
 106 lattice :: DataflowLattice Status
 107 lattice = DataflowLattice "direct proc-point reachability" unreached add_to
 108     where unreached = ReachedBy setEmpty
 109           add_to _ (OldFact ProcPoint) _ = (NoChange, ProcPoint)
 110           add_to _ _ (NewFact ProcPoint) = (SomeChange, ProcPoint) -- because of previous case
 111           add_to _ (OldFact (ReachedBy p)) (NewFact (ReachedBy p')) =
 112               let union = setUnion p' p
 113               in  if setSize union > setSize p then (SomeChange, ReachedBy union)
 114                                                else (NoChange, ReachedBy p)
 115 --------------------------------------------------
 116 -- transfer equations
 117
 118 forward :: FwdTransfer CmmNode Status
 119 forward = mkFTransfer3 first middle ((mkFactBase lattice . ) . last)
 120     where first :: CmmNode C O -> Status -> Status
 121           first (CmmEntry id) ProcPoint = ReachedBy $ setSingleton id
 122           first  _ x = x
 123
 124           middle _ x = x
 125
 126           last :: CmmNode O C -> Status -> [(Label, Status)]
 127           last (CmmCall {cml_cont = Just k}) _ = [(k, ProcPoint)]
 128           last (CmmForeignCall {succ = k})   _ = [(k, ProcPoint)]
 129           last l x = map (\id -> (id, x)) (successors l)
 130
 131 -- It is worth distinguishing two sets of proc points:
 132 -- those that are induced by calls in the original graph
 133 -- and those that are introduced because they're reachable from multiple proc points.
 134 callProcPoints      :: CmmGraph -> ProcPointSet
 135 callProcPoints g = foldGraphBlocks add (setSingleton (g_entry g)) g
 136   where add :: CmmBlock -> BlockSet -> BlockSet
 137         add b set = case lastNode b of
 138                       CmmCall {cml_cont = Just k} -> setInsert k set
 139                       CmmForeignCall {succ=k}     -> setInsert k set
 140                       _ -> set
 141
 142 minimalProcPointSet :: ProcPointSet -> CmmGraph -> FuelUniqSM ProcPointSet
 143 -- Given the set of successors of calls (which must be proc-points)
 144 -- figure out the minimal set of necessary proc-points
 145 minimalProcPointSet callProcPoints g = extendPPSet g (postorderDfs g) callProcPoints
 146
 147 procPointAnalysis :: ProcPointSet -> CmmGraph -> FuelUniqSM (BlockEnv Status)
 148 -- Once you know what the proc-points are, figure out
 149 -- what proc-points each block is reachable from
 150 procPointAnalysis procPoints g =
 151   liftM snd $ dataflowPassFwd g initProcPoints $ analFwd lattice forward
 152   where initProcPoints = [(id, ProcPoint) | id <- setElems procPoints]
 153
 154 extendPPSet :: CmmGraph -> [CmmBlock] -> ProcPointSet -> FuelUniqSM ProcPointSet
 155 extendPPSet g blocks procPoints =
 156     do env <- procPointAnalysis procPoints g
 157        let add block pps = let id = entryLabel block
 158                            in  case mapLookup id env of
 159                                  Just ProcPoint -> setInsert id pps
 160                                  _ -> pps
 161            procPoints' = foldGraphBlocks add setEmpty g
 162            newPoints = mapMaybe ppSuccessor blocks
 163            newPoint  = listToMaybe newPoints
 164            ppSuccessor b =
 165                let nreached id = case mapLookup id env `orElse`
 166                                        pprPanic "no ppt" (ppr id <+> ppr b) of
 167                                    ProcPoint -> 1
 168                                    ReachedBy ps -> setSize ps
 169                    block_procpoints = nreached (entryLabel b)
 170                    -- | Looking for a successor of b that is reached by
 171                    -- more proc points than b and is not already a proc
 172                    -- point.  If found, it can become a proc point.
 173                    newId succ_id = not (setMember succ_id procPoints') &&
 174                                    nreached succ_id > block_procpoints
 175                in  listToMaybe $ filter newId $ successors b
 176 {-
 177        case newPoints of
 178            []  -> return procPoints'
 179            pps -> extendPPSet g blocks
 180                     (foldl extendBlockSet procPoints' pps)
 181 -}
 182        case newPoint of Just id ->
 183                           if setMember id procPoints' then panic "added old proc pt"
 184                           else extendPPSet g blocks (setInsert id procPoints')
 185                         Nothing -> return procPoints'
 186
 187
 188 ------------------------------------------------------------------------
 189 --                    Computing Proc-Point Protocols                  --
 190 ------------------------------------------------------------------------
 191
 192 {-
 193
 194 There is one major trick, discovered by Michael Adams, which is that
 195 we want to choose protocols in a way that enables us to optimize away
 196 some continuations.  The optimization is very much like branch-chain
 197 elimination, except that it involves passing results as well as
 198 control.  The idea is that if a call's continuation k does nothing but
 199 CopyIn its results and then goto proc point P, the call's continuation
 200 may be changed to P, *provided* P's protocol is identical to the
 201 protocol for the CopyIn.  We choose protocols to make this so.
 202
 203 Here's an explanatory example; we begin with the source code (lines
 204 separate basic blocks):
 205
 206   ..1..;
 207   x, y = g();
 208   goto P;
 209   -------
 210   P: ..2..;
 211
 212 Zipperization converts this code as follows:
 213
 214   ..1..;
 215   call g() returns to k;
 216   -------
 217   k: CopyIn(x, y);
 218      goto P;
 219   -------
 220   P: ..2..;
 221
 222 What we'd like to do is assign P the same CopyIn protocol as k, so we
 223 can eliminate k:
 224
 225   ..1..;
 226   call g() returns to P;
 227   -------
 228   P: CopyIn(x, y); ..2..;
 229
 230 Of course, P may be the target of more than one continuation, and
 231 different continuations may have different protocols.  Michael Adams
 232 implemented a voting mechanism, but he thinks a simple greedy
 233 algorithm would be just as good, so that's what we do.
 234
 235 -}
 236
 237 data Protocol = Protocol Convention CmmFormals Area
 238   deriving Eq
 239 instance Outputable Protocol where
 240   ppr (Protocol c fs a) = text "Protocol" <+> ppr c <+> ppr fs <+> ppr a
 241
 242 -- | Function 'optimize_calls' chooses protocols only for those proc
 243 -- points that are relevant to the optimization explained above.
 244 -- The others are assigned by 'add_unassigned', which is not yet clever.
 245
 246 addProcPointProtocols :: ProcPointSet -> ProcPointSet -> CmmGraph -> FuelUniqSM CmmGraph
 247 addProcPointProtocols callPPs procPoints g =
 248   do liveness <- cmmLiveness g
 249      (protos, g') <- optimize_calls liveness g
 250      blocks'' <- add_CopyOuts protos procPoints g'
 251      return $ ofBlockMap (g_entry g) blocks''
 252     where optimize_calls liveness g =  -- see Note [Separate Adams optimization]
 253             do let (protos, blocks') =
 254                        foldGraphBlocks maybe_add_call (mapEmpty, mapEmpty) g
 255                    protos' = add_unassigned liveness procPoints protos
 256                let g' = ofBlockMap (g_entry g) (add_CopyIns callPPs protos' blocks')
 257                return (protos', removeUnreachableBlocks g')
 258           maybe_add_call :: CmmBlock -> (BlockEnv Protocol, BlockEnv CmmBlock)
 259                          -> (BlockEnv Protocol, BlockEnv CmmBlock)
 260           -- ^ If the block is a call whose continuation goes to a proc point
 261           -- whose protocol either matches the continuation's or is not yet set,
 262           -- redirect the call (cf 'newblock') and set the protocol if necessary
 263           maybe_add_call block (protos, blocks) =
 264               case lastNode block of
 265                 CmmCall tgt (Just k) args res s
 266                     | Just proto <- mapLookup k protos,
 267                       Just pee   <- branchesToProcPoint k
 268                     -> let newblock = replaceLastNode block (CmmCall tgt (Just pee)
 269                                                                      args res s)
 270                            changed_blocks   = insertBlock newblock blocks
 271                            unchanged_blocks = insertBlock block    blocks
 272                        in case mapLookup pee protos of
 273                             Nothing -> (mapInsert pee proto protos, changed_blocks)
 274                             Just proto' ->
 275                               if proto == proto' then (protos, changed_blocks)
 276                               else (protos, unchanged_blocks)
 277                 _ -> (protos, insertBlock block blocks)
 278
 279           branchesToProcPoint :: BlockId -> Maybe BlockId
 280           -- ^ Tells whether the named block is just a branch to a proc point
 281           branchesToProcPoint id =
 282               let block = mapLookup id (toBlockMap g) `orElse`
 283                                     panic "branch out of graph"
 284               in case blockToNodeList block of
 285 -- MS: There is an ugly bug in ghc-6.10, which rejects following valid code.
 286 -- After trying several tricks, the NOINLINE on getItOut worked. Uffff.
 287 #if __GLASGOW_HASKELL__ >= 612
 288                    (_, [], JustC (CmmBranch pee)) | setMember pee procPoints -> Just pee
 289                    _                                                         -> Nothing
 290 #else
 291                    (_, [], exit) | CmmBranch pee <- getItOut exit
 292                                  , setMember pee procPoints      -> Just pee
 293                    _                                             -> Nothing
 294               where {-# NOINLINE getItOut #-}
 295                     getItOut :: MaybeC C a -> a
 296                     getItOut (JustC a) = a
 297 #endif
 298
 299 -- | For now, following a suggestion by Ben Lippmeier, we pass all
 300 -- live variables as arguments, hoping that a clever register
 301 -- allocator might help.
 302
 303 add_unassigned :: BlockEnv CmmLive -> ProcPointSet -> BlockEnv Protocol ->
 304                   BlockEnv Protocol
 305 add_unassigned = pass_live_vars_as_args
 306
 307 pass_live_vars_as_args :: BlockEnv CmmLive -> ProcPointSet ->
 308                           BlockEnv Protocol -> BlockEnv Protocol
 309 pass_live_vars_as_args _liveness procPoints protos = protos'
 310   where protos' = setFold addLiveVars protos procPoints
 311         addLiveVars :: BlockId -> BlockEnv Protocol -> BlockEnv Protocol
 312         addLiveVars id protos =
 313             case mapLookup id protos of
 314               Just _  -> protos
 315               Nothing -> let live = emptyRegSet
 316                                     --lookupBlockEnv _liveness id `orElse`
 317                                     --panic ("no liveness at block " ++ show id)
 318                              formals = uniqSetToList live
 319                              prot = Protocol Private formals $ CallArea $ Young id
 320                          in  mapInsert id prot protos
 321
 322
 323 -- | Add copy-in instructions to each proc point that did not arise from a call
 324 -- instruction. (Proc-points that arise from calls already have their copy-in instructions.)
 325
 326 add_CopyIns :: ProcPointSet -> BlockEnv Protocol -> BlockEnv CmmBlock -> BlockEnv CmmBlock
 327 add_CopyIns callPPs protos blocks = mapFold maybe_insert_CopyIns mapEmpty blocks
 328     where maybe_insert_CopyIns block blocks
 329              | not $ setMember bid callPPs
 330              , Just (Protocol c fs _area) <- mapLookup bid protos
 331              = let nodes     = copyInSlot c fs
 332                    (h, m, l) = blockToNodeList block
 333                in insertBlock (blockOfNodeList (h, nodes ++ m, l)) blocks
 334              | otherwise = insertBlock block blocks
 335            where bid = entryLabel block
 336
 337
 338 -- | Add a CopyOut node before each procpoint.
 339 -- If the predecessor is a call, then the copy outs should already be done by the callee.
 340 -- Note: If we need to add copy-out instructions, they may require stack space,
 341 -- so we accumulate a map from the successors to the necessary stack space,
 342 -- then update the successors after we have finished inserting the copy-outs.
 343
 344 add_CopyOuts :: BlockEnv Protocol -> ProcPointSet -> CmmGraph ->
 345                 FuelUniqSM (BlockEnv CmmBlock)
 346 add_CopyOuts protos procPoints g = foldGraphBlocks mb_copy_out (return mapEmpty) g
 347     where mb_copy_out :: CmmBlock -> FuelUniqSM (BlockEnv CmmBlock) ->
 348                                      FuelUniqSM (BlockEnv CmmBlock)
 349           mb_copy_out b z | entryLabel b == g_entry g = skip b z
 350           mb_copy_out b z =
 351             case lastNode b of
 352               CmmCall {}        -> skip b z -- copy out done by callee
 353               CmmForeignCall {} -> skip b z -- copy out done by callee
 354               _ -> copy_out b z
 355           copy_out b z = foldr trySucc init (successors b) >>= finish
 356             where init = (\bmap -> (b, bmap)) `liftM` z
 357                   trySucc succId z =
 358                     if setMember succId procPoints then
 359                       case mapLookup succId protos of
 360                         Nothing -> z
 361                         Just (Protocol c fs _area) -> insert z succId $ copyOutSlot c fs
 362                     else z
 363                   insert z succId m =
 364                     do (b, bmap) <- z
 365                        (b, bs)   <- insertBetween b m succId
 366                        -- pprTrace "insert for succ" (ppr succId <> ppr m) $ do
 367                        return $ (b, foldl (flip insertBlock) bmap bs)
 368                   finish (b, bmap) = return $ insertBlock b bmap
 369           skip b bs = insertBlock b `liftM` bs
 370
 371 -- At this point, we have found a set of procpoints, each of which should be
 372 -- the entry point of a procedure.
 373 -- Now, we create the procedure for each proc point,
 374 -- which requires that we:
 375 -- 1. build a map from proc points to the blocks reachable from the proc point
 376 -- 2. turn each branch to a proc point into a jump
 377 -- 3. turn calls and returns into jumps
 378 -- 4. build info tables for the procedures -- and update the info table for
 379 --    the SRTs in the entry procedure as well.
 380 -- Input invariant: A block should only be reachable from a single ProcPoint.
 381 splitAtProcPoints :: CLabel -> ProcPointSet-> ProcPointSet -> BlockEnv Status ->
 382                      CmmTop -> FuelUniqSM [CmmTop]
 383 splitAtProcPoints entry_label callPPs procPoints procMap
 384                   (CmmProc (TopInfo {info_tbl=info_tbl, stack_info=stack_info})
 385                            top_l g@(CmmGraph {g_entry=entry})) =
 386   do -- Build a map from procpoints to the blocks they reach
 387      let addBlock b graphEnv =
 388            case mapLookup bid procMap of
 389              Just ProcPoint -> add graphEnv bid bid b
 390              Just (ReachedBy set) ->
 391                case setElems set of
 392                  []   -> graphEnv
 393                  [id] -> add graphEnv id bid b
 394                  _    -> panic "Each block should be reachable from only one ProcPoint"
 395              Nothing -> pprPanic "block not reached by a proc point?" (ppr bid)
 396            where bid = entryLabel b
 397          add graphEnv procId bid b = mapInsert procId graph' graphEnv
 398                where graph  = mapLookup procId graphEnv `orElse` mapEmpty
 399                      graph' = mapInsert bid b graph
 400      graphEnv <- return $ foldGraphBlocks addBlock emptyBlockMap g
 401      -- Build a map from proc point BlockId to labels for their new procedures
 402      -- Due to common blockification, we may overestimate the set of procpoints.
 403      let add_label map pp = return $ Map.insert pp lbl map
 404            where lbl = if pp == entry then entry_label else blockLbl pp
 405      procLabels <- foldM add_label Map.empty
 406                          (filter (flip mapMember (toBlockMap g)) (setElems procPoints))
 407      -- For each procpoint, we need to know the SP offset on entry.
 408      -- If the procpoint is:
 409      --  - continuation of a call, the SP offset is in the call
 410      --  - otherwise, 0 (and left out of the spEntryMap)
 411      let add_sp_off :: CmmBlock -> BlockEnv CmmStackInfo -> BlockEnv CmmStackInfo
 412          add_sp_off b env =
 413            case lastNode b of
 414              CmmCall {cml_cont = Just succ, cml_ret_args = off, cml_ret_off = updfr_off} ->
 415                mapInsert succ (StackInfo { arg_space = off, updfr_space = Just updfr_off}) env
 416              CmmForeignCall {succ = succ, updfr = updfr_off} ->
 417                mapInsert succ (StackInfo { arg_space = wORD_SIZE, updfr_space = Just updfr_off}) env
 418              _ -> env
 419          spEntryMap = foldGraphBlocks add_sp_off (mapInsert entry stack_info emptyBlockMap) g
 420          getStackInfo id = mapLookup id spEntryMap `orElse` StackInfo {arg_space = 0, updfr_space = Nothing}
 421      -- In each new graph, add blocks jumping off to the new procedures,
 422      -- and replace branches to procpoints with branches to the jump-off blocks
 423      let add_jump_block (env, bs) (pp, l) =
 424            do bid <- liftM mkBlockId getUniqueM
 425               let b = blockOfNodeList (JustC (CmmEntry bid), [], JustC jump)
 426                   StackInfo {arg_space = argSpace, updfr_space = off} = getStackInfo pp
 427                   jump = CmmCall (CmmLit (CmmLabel l')) Nothing argSpace 0
 428                                  (off `orElse` 0) -- Jump's shouldn't need the offset...
 429                   l' = if setMember pp callPPs then entryLblToInfoLbl l else l
 430               return (mapInsert pp bid env, b : bs)
 431          add_jumps (newGraphEnv) (ppId, blockEnv) =
 432            do let needed_jumps = -- find which procpoints we currently branch to
 433                     mapFold add_if_branch_to_pp [] blockEnv
 434                   add_if_branch_to_pp :: CmmBlock -> [(BlockId, CLabel)] -> [(BlockId, CLabel)]
 435                   add_if_branch_to_pp block rst =
 436                     case lastNode block of
 437                       CmmBranch id          -> add_if_pp id rst
 438                       CmmCondBranch _ ti fi -> add_if_pp ti (add_if_pp fi rst)
 439                       CmmSwitch _ tbl       -> foldr add_if_pp rst (catMaybes tbl)
 440                       _                     -> rst
 441                   add_if_pp id rst = case Map.lookup id procLabels of
 442                                        Just x -> (id, x) : rst
 443                                        Nothing -> rst
 444               (jumpEnv, jumpBlocks) <-
 445                  foldM add_jump_block (mapEmpty, []) needed_jumps
 446                   -- update the entry block
 447               let b = expectJust "block in env" $ mapLookup ppId blockEnv
 448                   off = getStackInfo ppId
 449                   blockEnv' = mapInsert ppId b blockEnv
 450                   -- replace branches to procpoints with branches to jumps
 451                   blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv'
 452                   -- add the jump blocks to the graph
 453                   blockEnv''' = foldl (flip insertBlock) blockEnv'' jumpBlocks
 454               let g' = (off, ofBlockMap ppId blockEnv''')
 455               -- pprTrace "g' pre jumps" (ppr g') $ do
 456               return (mapInsert ppId g' newGraphEnv)
 457      graphEnv <- foldM add_jumps emptyBlockMap $ mapToList graphEnv
 458      let to_proc (bid, (stack_info, g)) | setMember bid callPPs =
 459            if bid == entry then
 460              CmmProc (TopInfo {info_tbl=info_tbl, stack_info=stack_info})
 461                      top_l (replacePPIds g)
 462            else
 463              CmmProc (TopInfo {info_tbl=emptyContInfoTable, stack_info=stack_info})
 464                      lbl (replacePPIds g)
 465            where lbl = expectJust "pp label" $ Map.lookup bid procLabels
 466          to_proc (bid, (stack_info, g)) =
 467            CmmProc (TopInfo {info_tbl=CmmNonInfoTable, stack_info=stack_info})
 468                    lbl (replacePPIds g)
 469              where lbl = expectJust "pp label" $ Map.lookup bid procLabels
 470          -- References to procpoint IDs can now be replaced with the infotable's label
 471          replacePPIds g = mapGraphNodes (id, mapExp repl, mapExp repl) g
 472            where repl e@(CmmLit (CmmBlock bid)) =
 473                    case Map.lookup bid procLabels of
 474                      Just l  -> CmmLit (CmmLabel (entryLblToInfoLbl l))
 475                      Nothing -> e
 476                  repl e = e
 477      -- The C back end expects to see return continuations before the call sites.
 478      -- Here, we sort them in reverse order -- it gets reversed later.
 479      let (_, block_order) = foldl add_block_num (0::Int, emptyBlockMap) (postorderDfs g)
 480          add_block_num (i, map) block = (i+1, mapInsert (entryLabel block) i map)
 481          sort_fn (bid, _) (bid', _) =
 482            compare (expectJust "block_order" $ mapLookup bid  block_order)
 483                    (expectJust "block_order" $ mapLookup bid' block_order)
 484      procs <- return $ map to_proc $ sortBy sort_fn $ mapToList graphEnv
 485      return -- pprTrace "procLabels" (ppr procLabels)
 486             -- pprTrace "splitting graphs" (ppr procs)
 487             procs
 488 splitAtProcPoints _ _ _ _ t@(CmmData _ _) = return [t]
 489
 490 ----------------------------------------------------------------
 491
 492 {-
 493 Note [Direct reachability]
 494
 495 Block B is directly reachable from proc point P iff control can flow
 496 from P to B without passing through an intervening proc point.
 497 -}
 498
 499 ----------------------------------------------------------------
 500
 501 {-
 502 Note [No simple dataflow]
 503
 504 Sadly, it seems impossible to compute the proc points using a single
 505 dataflow pass.  One might attempt to use this simple lattice:
 506
 507   data Location = Unknown
 508                 | InProc BlockId -- node is in procedure headed by the named proc point
 509                 | ProcPoint      -- node is itself a proc point
 510
 511 At a join, a node in two different blocks becomes a proc point.
 512 The difficulty is that the change of information during iterative
 513 computation may promote a node prematurely.  Here's a program that
 514 illustrates the difficulty:
 515
 516   f () {
 517   entry:
 518     ....
 519   L1:
 520     if (...) { ... }
 521     else { ... }
 522
 523   L2: if (...) { g(); goto L1; }
 524       return x + y;
 525   }
 526
 527 The only proc-point needed (besides the entry) is L1.  But in an
 528 iterative analysis, consider what happens to L2.  On the first pass
 529 through, it rises from Unknown to 'InProc entry', but when L1 is
 530 promoted to a proc point (because it's the successor of g()), L1's
 531 successors will be promoted to 'InProc L1'.  The problem hits when the
 532 new fact 'InProc L1' flows into L2 which is already bound to 'InProc entry'.
 533 The join operation makes it a proc point when in fact it needn't be,
 534 because its immediate dominator L1 is already a proc point and there
 535 are no other proc points that directly reach L2.
 536 -}
 537
 538
 539
 540 {- Note [Separate Adams optimization]
 541 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 542 It may be worthwhile to attempt the Adams optimization by rewriting
 543 the graph before the assignment of proc-point protocols.  Here are a
 544 couple of rules:
 545
 546   g() returns to k;                    g() returns to L;
 547   k: CopyIn c ress; goto L:
 548    ...                        ==>        ...
 549   L: // no CopyIn node here            L: CopyIn c ress;
 550
 551
 552 And when c == c' and ress == ress', this also:
 553
 554   g() returns to k;                    g() returns to L;
 555   k: CopyIn c ress; goto L:
 556    ...                        ==>        ...
 557   L: CopyIn c' ress'                   L: CopyIn c' ress' ;
 558
 559 In both cases the goal is to eliminate k.
 560 -}