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 /MLRISC/trunk/block-placement/default-block-placement.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2126 - (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 : jhr 1162 val entry = CFG.entry cfg
39 :     val exit = CFG.exit cfg
40 : jhr 1177 val _ = mark(#1 exit) (* we place exit at the end *)
41 : jhr 1157 (* return true if the edge must connect adjacent nodes *)
42 :     fun adjEdge (_, _, CFG.EDGE{k=CFG.FALLSTHRU, ...}) = true
43 :     | adjEdge (_, _, CFG.EDGE{k=CFG.BRANCH false, ...}) = true
44 :     | adjEdge _ = false
45 :     val findAdjEdge = List.find adjEdge
46 :     (* place nodes by assuming that the initial order is close to
47 :     * correct.
48 :     *)
49 :     fun placeNodes ([], l) = List.rev (exit::l)
50 :     | placeNodes ((nd1 as (id1, b1))::r1, l) = if isMarked id1
51 :     then placeNodes (r1, l)
52 :     else (
53 :     case r1
54 :     of [] => List.rev (exit::nd1::l)
55 :     | (nd2 as (id2, b2))::r2 => if isMarked id2
56 : george 1168 then placeNodes(nd1::r2, l)
57 : jhr 1157 else (
58 :     (* Here we know that both nd1 and nd2 have not been
59 :     * placed. We need to check for placement constraints
60 :     * in nd1's out edges and nd2's in edges.
61 :     *)
62 : george 1168 mark id1;
63 : jhr 1157 case findAdjEdge (#out_edges graph id1)
64 :     of NONE => let
65 :     fun pushPredChain (nd as (id, _), r) = (
66 :     case findAdjEdge (#in_edges graph id)
67 :     of NONE => nd::r
68 :     | SOME(src, _, _) => (
69 :     assertNotMarked src;
70 :     pushPredChain (getBlk src, nd::r))
71 :     (* end case *))
72 :     in
73 :     placeNodes (pushPredChain(nd2, r2), nd1::l)
74 :     end
75 :     | SOME(_, dst, _) => if (dst = id2)
76 :     then placeNodes(r1, nd1::l)
77 :     else (
78 :     assertNotMarked dst;
79 :     placeNodes (getBlk dst::r1, nd1::l))
80 :     (* end case *))
81 :     (* end case *))
82 : jhr 1169 val blocks = placeNodes (entry :: #nodes graph (), [])
83 : jhr 1157 in
84 :     if !dumpBlocks
85 :     then let
86 :     fun say s = TextIO.output(!dumpStrm, s)
87 :     in
88 :     say "Block placement order:\n";
89 :     List.app
90 :     (fn b => say(concat[" ", blockToString b, "\n"]))
91 :     blocks
92 :     end
93 :     else ();
94 :     if !dumpCFG
95 :     then let
96 :     val prBlock = CFG.dumpBlock (!dumpStrm, cfg)
97 :     in
98 :     TextIO.output(!dumpStrm, "[ after block placement ]\n");
99 :     List.app prBlock blocks
100 :     end
101 :     else ();
102 :     (cfg, blocks)
103 :     end
104 :    
105 :     end

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