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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/block-placement/default-block-placement.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/block-placement/default-block-placement.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1157 - (view) (download)

1 : george 906 (* default-block-placement.sml
2 :     *
3 :     * COPYRIGHT (c) 2001 Bell Labs, Lucent Technologies
4 : jhr 1157 *
5 :     * Place blocks in an order that respects the FALLSTHRU and BRANCH(false)
6 :     * edges and is otherwise the order of block generation.
7 : george 906 *)
8 :    
9 : jhr 1157 functor DefaultBlockPlacement (CFG : CONTROL_FLOW_GRAPH) : BLOCK_PLACEMENT =
10 :     struct
11 : george 906
12 : jhr 1157 structure CFG=CFG
13 :     structure G = Graph
14 : george 906
15 : jhr 1157 (* flags *)
16 :     val dumpBlocks = MLRiscControl.mkFlag (
17 :     "dump-block-list",
18 :     "whether block list is shown")
19 :     val dumpCFG = MLRiscControl.mkFlag (
20 :     "dump-cfg-after-placement",
21 :     "whether CFG is shown after block placement")
22 :     val dumpStrm = MLRiscControl.debug_stream
23 : george 906
24 : jhr 1157 fun blockToString (id', CFG.BLOCK{id, ...}) =
25 :     concat["<", Int.toString id', ":", Int.toString id, ">"]
26 :    
27 :     fun error msg = MLRiscErrorMsg.error ("DefaultBlockPlacement", msg)
28 :    
29 :     fun blockPlacement (cfg as G.GRAPH graph) = let
30 :     val placed = Array.array(#capacity graph (), false)
31 :     fun isMarked id = Array.sub(placed, id)
32 :     fun mark id = Array.update(placed, id, true)
33 :     fun assertNotMarked id = if isMarked id
34 :     then error "conflicting placement constraints"
35 :     else ()
36 :     (* special case the entry and exit blocks *)
37 :     fun getBlk id = (id, #node_info graph id)
38 :     val entry = (case #entries graph ()
39 :     of [id] => (mark id; getBlk id)
40 :     | _ => error "entry block"
41 :     (* end case *))
42 :     val exit = (case #exits graph ()
43 :     of [id] => (mark id; getBlk id)
44 :     | _ => error "exit block"
45 :     (* end case *))
46 :     (* return true if the edge must connect adjacent nodes *)
47 :     fun adjEdge (_, _, CFG.EDGE{k=CFG.FALLSTHRU, ...}) = true
48 :     | adjEdge (_, _, CFG.EDGE{k=CFG.BRANCH false, ...}) = true
49 :     | adjEdge _ = false
50 :     val findAdjEdge = List.find adjEdge
51 :     (* place nodes by assuming that the initial order is close to
52 :     * correct.
53 :     *)
54 :     fun placeNodes ([], l) = List.rev (exit::l)
55 :     | placeNodes ((nd1 as (id1, b1))::r1, l) = if isMarked id1
56 :     then placeNodes (r1, l)
57 :     else (
58 :     mark id1;
59 :     case r1
60 :     of [] => List.rev (exit::nd1::l)
61 :     | (nd2 as (id2, b2))::r2 => if isMarked id2
62 :     then placeNodes(nd1::r1, l)
63 :     else (
64 :     (* Here we know that both nd1 and nd2 have not been
65 :     * placed. We need to check for placement constraints
66 :     * in nd1's out edges and nd2's in edges.
67 :     *)
68 :     case findAdjEdge (#out_edges graph id1)
69 :     of NONE => let
70 :     fun pushPredChain (nd as (id, _), r) = (
71 :     case findAdjEdge (#in_edges graph id)
72 :     of NONE => nd::r
73 :     | SOME(src, _, _) => (
74 :     assertNotMarked src;
75 :     pushPredChain (getBlk src, nd::r))
76 :     (* end case *))
77 :     in
78 :     placeNodes (pushPredChain(nd2, r2), nd1::l)
79 :     end
80 :     | SOME(_, dst, _) => if (dst = id2)
81 :     then placeNodes(r1, nd1::l)
82 :     else (
83 :     assertNotMarked dst;
84 :     placeNodes (getBlk dst::r1, nd1::l))
85 :     (* end case *))
86 :     (* end case *))
87 :     val blocks = placeNodes (#nodes graph (), [entry])
88 :     in
89 :     if !dumpBlocks
90 :     then let
91 :     fun say s = TextIO.output(!dumpStrm, s)
92 :     in
93 :     say "Block placement order:\n";
94 :     List.app
95 :     (fn b => say(concat[" ", blockToString b, "\n"]))
96 :     blocks
97 :     end
98 :     else ();
99 :     if !dumpCFG
100 :     then let
101 :     val prBlock = CFG.dumpBlock (!dumpStrm, cfg)
102 :     in
103 :     TextIO.output(!dumpStrm, "[ after block placement ]\n");
104 :     List.app prBlock blocks
105 :     end
106 :     else ();
107 :     (cfg, blocks)
108 :     end
109 :    
110 :     end

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