CmmProcPoint.hs 4.87 KB
 Ian Lynagh committed Sep 03, 2007 1 ``````{-# OPTIONS -w #-} `````` Ian Lynagh committed Sep 01, 2007 2 3 4 ``````-- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See `````` Ian Lynagh committed Sep 04, 2007 5 ``````-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings `````` Ian Lynagh committed Sep 01, 2007 6 7 ``````-- for details `````` Michael D. Adams committed May 23, 2007 8 9 10 11 12 13 ``````module CmmProcPoint ( calculateProcPoints ) where #include "HsVersions.h" `````` dias@eecs.harvard.edu committed May 29, 2008 14 ``````import BlockId `````` Michael D. Adams committed May 23, 2007 15 ``````import Cmm `````` Michael D. Adams committed May 24, 2007 16 ``````import CmmBrokenBlock `````` Michael D. Adams committed May 23, 2007 17 18 19 20 21 22 ``````import Dataflow import UniqSet import UniqFM import Panic `````` Michael D. Adams committed Jun 28, 2007 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 ``````-- Determine the proc points for a set of basic blocks. -- -- A proc point is any basic block that must start a new function. -- The entry block of the original function is a proc point. -- The continuation of a function call is also a proc point. -- The third kind of proc point arises when there is a joint point -- in the control flow. Suppose we have code like the following: -- -- if (...) { ...; call foo(); ...} -- else { ...; call bar(); ...} -- x = y; -- -- That last statement "x = y" must be a proc point because -- it can be reached by blocks owned by different proc points -- (the two branches of the conditional). -- -- We calculate these proc points by starting with the minimal set -- and finding blocks that are reachable from more proc points than -- one of their parents. (This ensures we don't choose a block -- simply beause it is reachable from another block that is reachable -- from multiple proc points.) These new blocks are added to the -- set of proc points and the process is repeated until there -- are no more proc points to be found. `````` Michael D. Adams committed May 23, 2007 46 47 `````` calculateProcPoints :: [BrokenBlock] -> UniqSet BlockId `````` Michael D. Adams committed Jun 27, 2007 48 49 ``````calculateProcPoints blocks = calculateProcPoints' init_proc_points blocks `````` Michael D. Adams committed May 23, 2007 50 51 52 53 54 `````` where init_proc_points = mkUniqSet \$ map brokenBlockId \$ filter always_proc_point blocks always_proc_point BrokenBlock { `````` Michael D. Adams committed Jun 27, 2007 55 `````` brokenBlockEntry = FunctionEntry _ _ _ } = True `````` Michael D. Adams committed May 23, 2007 56 `````` always_proc_point BrokenBlock { `````` Michael D. Adams committed Jul 02, 2007 57 `````` brokenBlockEntry = ContinuationEntry _ _ _ } = True `````` Michael D. Adams committed May 23, 2007 58 59 60 61 62 63 64 65 66 67 68 69 `````` always_proc_point _ = False calculateProcPoints' :: UniqSet BlockId -> [BrokenBlock] -> UniqSet BlockId calculateProcPoints' old_proc_points blocks = if sizeUniqSet old_proc_points == sizeUniqSet new_proc_points then old_proc_points else calculateProcPoints' new_proc_points blocks where blocks_ufm :: BlockEnv BrokenBlock blocks_ufm = blocksToBlockEnv blocks owners = calculateOwnership blocks_ufm old_proc_points blocks `````` Michael D. Adams committed Jun 28, 2007 70 71 72 73 `````` new_proc_points = unionManyUniqSets (old_proc_points: map (calculateNewProcPoints owners) blocks) `````` Michael D. Adams committed May 23, 2007 74 `````` `````` Michael D. Adams committed Jun 28, 2007 75 76 77 78 79 ``````calculateNewProcPoints :: BlockEnv (UniqSet BlockId) -> BrokenBlock -> UniqSet BlockId calculateNewProcPoints owners block = unionManyUniqSets (map (maybe_proc_point parent_id) child_ids) `````` Michael D. Adams committed May 23, 2007 80 81 82 `````` where parent_id = brokenBlockId block child_ids = brokenBlockTargets block `````` Michael D. Adams committed Jun 28, 2007 83 `````` maybe_proc_point parent_id child_id = `````` Michael D. Adams committed May 23, 2007 84 85 86 87 88 89 `````` if needs_proc_point then unitUniqSet child_id else emptyUniqSet where parent_owners = lookupWithDefaultUFM owners emptyUniqSet parent_id child_owners = lookupWithDefaultUFM owners emptyUniqSet child_id `````` Michael D. Adams committed Jul 15, 2007 90 91 92 93 94 95 `````` needs_proc_point = -- only if parent isn't dead (not \$ isEmptyUniqSet parent_owners) && -- and only if child has more owners than parent (not \$ isEmptyUniqSet \$ child_owners `minusUniqSet` parent_owners) `````` Michael D. Adams committed Jun 28, 2007 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 `````` calculateOwnership :: BlockEnv BrokenBlock -> UniqSet BlockId -> [BrokenBlock] -> BlockEnv (UniqSet BlockId) calculateOwnership blocks_ufm proc_points blocks = fixedpoint dependants update (map brokenBlockId blocks) emptyUFM where dependants :: BlockId -> [BlockId] dependants ident = brokenBlockTargets \$ lookupWithDefaultUFM blocks_ufm unknown_block ident update :: BlockId -> Maybe BlockId -> BlockEnv (UniqSet BlockId) -> Maybe (BlockEnv (UniqSet BlockId)) update ident cause owners = case (cause, ident `elementOfUniqSet` proc_points) of (Nothing, True) -> Just \$ addToUFM owners ident (unitUniqSet ident) (Nothing, False) -> Nothing (Just cause', True) -> Nothing (Just cause', False) -> if (sizeUniqSet old) == (sizeUniqSet new) then Nothing else Just \$ addToUFM owners ident new where old = lookupWithDefaultUFM owners emptyUniqSet ident new = old `unionUniqSets` lookupWithDefaultUFM owners emptyUniqSet cause' `````` Michael D. Adams committed Jul 03, 2007 128 `` unknown_block = panic "unknown BlockId in calculateOwnership"``