compiler/cmm/CmmProcPointZ.hs

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