Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/block-placement/weighted-block-placement-fn.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/block-placement/weighted-block-placement-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1105, Thu Feb 28 19:57:47 2002 UTC revision 1106, Thu Feb 28 19:58:04 2002 UTC
# Line 10  Line 10 
10   *)   *)
11    
12  functor WeightedBlockPlacementFn (  functor WeightedBlockPlacementFn (
13    
14      structure CFG : CONTROL_FLOW_GRAPH      structure CFG : CONTROL_FLOW_GRAPH
15      structure InsnProps : INSN_PROPERTIES      structure InsnProps : INSN_PROPERTIES
16      sharing CFG.I = InsnProps.I        where I = CFG.I
17    
18    ) : BLOCK_PLACEMENT = struct    ) : BLOCK_PLACEMENT = struct
19    
20      structure CFG = CFG      structure CFG = CFG
# Line 27  Line 29 
29          fun priority (_, _, CFG.EDGE{w, ...}) = !w          fun priority (_, _, CFG.EDGE{w, ...}) = !w
30        end)        end)
31    
32      (* flags *)
33        val dumpBlocks = MLRiscControl.getFlag "dump-block-list"
34        val dumpCFG = MLRiscControl.getFlag "dump-cfg-after-placement"
35        val dumpStrm = MLRiscControl.debug_stream
36    
37    (* sequences with constant-time concatenation *)    (* sequences with constant-time concatenation *)
38      datatype 'a seq      datatype 'a seq
39        = ONE of 'a        = ONE of 'a
# Line 44  Line 51 
51      fun id (CHAIN{hd, ...}) = #1 hd     (* use node ID of head to identify chains *)      fun id (CHAIN{hd, ...}) = #1 hd     (* use node ID of head to identify chains *)
52      fun sameChain (CHAIN{hd=h1, ...}, CHAIN{hd=h2, ...}) = (h1 = h2)      fun sameChain (CHAIN{hd=h1, ...}, CHAIN{hd=h2, ...}) = (h1 = h2)
53    
54        fun blockToString (id', CFG.BLOCK{id, ...}) =
55              concat["<", Int.toString id', ":", Int.toString id, ">"]
56    
57        fun chainToString (CHAIN{hd, blocks, ...}) = let
58              fun seq (ONE blk, l) = blockToString blk :: l
59                | seq (SEQ(s1, s2), l) = seq(s1, "," :: seq(s2, l))
60              in
61                concat("CHAIN{" :: blockToString hd :: ",[" :: seq(blocks, ["]}"]))
62              end
63    
64    (* join two chains *)    (* join two chains *)
65      fun joinChains (CHAIN{blocks=b1, hd, ...}, CHAIN{blocks=b2, tl, ...}) =      fun joinChains (CHAIN{blocks=b1, hd, ...}, CHAIN{blocks=b2, tl, ...}) =
66            CHAIN{blocks=SEQ(b1, b2), hd=hd, tl=tl}            CHAIN{blocks=SEQ(b1, b2), hd=hd, tl=tl}
# Line 107  Line 124 
124              (ITbl.foldi blockToNd [] tbl, gTbl)              (ITbl.foldi blockToNd [] tbl, gTbl)
125            end            end
126    
127      fun blockPlacement (G.GRAPH graph) = let      fun blockPlacement (cfg as G.GRAPH graph) = let
128          (* a map from block IDs to their chain *)          (* a map from block IDs to their chain *)
129            val blkTbl : chain_ptr ITbl.hash_table = let            val blkTbl : chain_ptr ITbl.hash_table = let
130                  val tbl = ITbl.mkTable (#size graph (), Fail "blkTbl")                  val tbl = ITbl.mkTable (#size graph (), Fail "blkTbl")
# Line 119  Line 136 
136                    tbl                    tbl
137                  end                  end
138            val lookupChain = ITbl.lookup blkTbl            val lookupChain = ITbl.lookup blkTbl
139            (* the unique exit node *)
140              val exitId = hd(#exits graph ())
141          (* given an edge that connects two blocks, attempt to merge their chains.          (* given an edge that connects two blocks, attempt to merge their chains.
142           * We return true if a merge occurred.           * We return true if a merge occurred.  We do not join exit edges so that
143             * the exit and entry nodes end up in distinct chains.
144           *)           *)
145            fun join (src, dst, _) = let            fun join (src, dst, _) = if (dst = exitId)
146                    then false
147                    else let
148                  val cptr1 = lookupChain src                  val cptr1 = lookupChain src
149                  val chain1 = URef.!! cptr1                  val chain1 = URef.!! cptr1
150                  val cptr2 = lookupChain dst                  val cptr2 = lookupChain dst
151                  val chain2 = URef.!! cptr2                  val chain2 = URef.!! cptr2
152                  in                  in
153                    if (tail chain1 = src) andalso (dst = head chain2)                    if (tail chain1 = src) andalso (dst = head chain2)
154                        andalso not(sameChain(chain1, chain2))
155                      then (                      then (
156                      (* the source block is the tail of its chain and the                      (* the source block is the tail of its chain and the
157                       * destination block is the head of its chain, so we can                       * destination block is the head of its chain, so we can
# Line 174  Line 197 
197                  fun addKid (E{ign=ref true, ...}, l) = l                  fun addKid (E{ign=ref true, ...}, l) = l
198                    | addKid (E{dst, ...}, l) = dfs (dst, l)                    | addKid (E{dst, ...}, l) = dfs (dst, l)
199                  in                  in
200                      mark := true;
201                    List.foldl addKid (chain::l) (!kids)                    List.foldl addKid (chain::l) (!kids)
202                  end                  end
203          (* mark the exit node, since it should be last *)          (* mark the exit node, since it should be last.  Note that we
204             * ensured above that the exit and entry nodes are in distinct
205             * chains!
206             *)
207            val exitChain = let            val exitChain = let
208                  val ND{chain, mark, ...} = lookupNd(hd(#exits graph ()))                  val ND{chain, mark, ...} = lookupNd(hd(#exits graph ()))
209                  in                  in
# Line 189  Line 216 
216            val chains = List.foldl dfs chains chainNodes            val chains = List.foldl dfs chains chainNodes
217            val chains = exitChain :: chains            val chains = exitChain :: chains
218          (* extract the list of blocks from the chains list; the chains list is          (* extract the list of blocks from the chains list; the chains list is
219           * in reverse order.           * in reverse order.  The resulting list of blocks is in order.
220           *)           *)
221            fun addChain (CHAIN{blocks, ...}, blks) = let            fun addChain (CHAIN{blocks, ...}, blks) = let
222                  fun addSeq (ONE b, blks) = b::blks                  fun addSeq (ONE b, blks) = b::blks
# Line 214  Line 241 
241                  (* end case *))                  (* end case *))
242            fun patch (            fun patch (
243                  (blkId, CFG.BLOCK{kind=CFG.NORMAL, insns, ...}),                  (blkId, CFG.BLOCK{kind=CFG.NORMAL, insns, ...}),
244                  (next as (blkId', _)) :: rest                  (next as (nextId, _)) :: rest
245                ) = (case #out_edges graph blkId                ) = (
246                   of [(_, dst, e as CFG.EDGE{k, w, a})] => (case (dst = blkId', k)                  case #out_edges graph blkId
247                     of [(_, dst, e as CFG.EDGE{k, w, a})] => (case (dst = nextId, k)
248                         of (false, CFG.FALLSTHRU) => (                         of (false, CFG.FALLSTHRU) => (
249                              (* rewrite edge as JUMP and add jump insn *)                              (* rewrite edge as JUMP and add jump insn *)
250                              setEdges (blkId, [(blkId, dst, updEdge(e, CFG.JUMP))]);                              setEdges (blkId, [(blkId, dst, updEdge(e, CFG.JUMP))]);
# Line 230  Line 258 
258                        (* end case *))                        (* end case *))
259                    | [(_, dst1, e1 as CFG.EDGE{k=CFG.BRANCH b, ...}),                    | [(_, dst1, e1 as CFG.EDGE{k=CFG.BRANCH b, ...}),
260                        (_, dst2, e2)                        (_, dst2, e2)
261                      ] => (case (dst1 = blkId', b)                      ] => (case (dst1 = nextId, b)
262                         of (true, true) => (                         of (true, true) => (
263                              setEdges (blkId, [                              setEdges (blkId, [
264                                  (blkId, dst1, updEdge(e1, CFG.BRANCH false)),                                  (blkId, dst1, updEdge(e1, CFG.BRANCH false)),
# Line 246  Line 274 
274                          | _ => ()                          | _ => ()
275                        (* end case *))                        (* end case *))
276                    | _ => ()                    | _ => ()
277                  (* end case *))                  (* end case *);
278                    patch (next, rest))
279              | patch (_, next::rest) = patch(next, rest)              | patch (_, next::rest) = patch(next, rest)
280              | patch (_, []) = ()              | patch (_, []) = ()
281            in            in
282              patch (hd blocks, tl blocks);              patch (hd blocks, tl blocks);
283                if !dumpBlocks
284                  then let
285                    fun say s = TextIO.output(!dumpStrm, s)
286                    in
287                      say "Block placement order:\n";
288                      List.app
289                        (fn b => say(concat["  ", blockToString b, "\n"]))
290                          blocks
291                    end
292                  else ();
293                if !dumpCFG
294                  then CFG.dump(!dumpStrm, "after block placement", cfg)
295                  else ();
296              blocks              blocks
297            end            end
298    

Legend:
Removed from v.1105  
changed lines
  Added in v.1106

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0