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

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

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

revision 1156, Thu Mar 21 22:01:11 2002 UTC revision 1157, Thu Mar 21 22:33:35 2002 UTC
# Line 1  Line 1 
1  (* default-block-placement.sml  (* default-block-placement.sml
2   *   *
3   * COPYRIGHT (c) 2001 Bell Labs, Lucent Technologies   * COPYRIGHT (c) 2001 Bell Labs, Lucent Technologies
4     *
5     * Place blocks in an order that respects the FALLSTHRU and BRANCH(false)
6     * edges and is otherwise the order of block generation.
7   *)   *)
8    
 (* Just the order in which blocks were generated *)  
9  functor DefaultBlockPlacement (CFG : CONTROL_FLOW_GRAPH) : BLOCK_PLACEMENT =  functor DefaultBlockPlacement (CFG : CONTROL_FLOW_GRAPH) : BLOCK_PLACEMENT =
10  struct  struct
11    
12    structure CFG=CFG    structure CFG=CFG
13    structure G = Graph    structure G = Graph
14    
15    fun error msg = MLRiscErrorMsg.error ("NaiveBlockPlacement", msg)    (* 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    
24        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    fun blockPlacement (cfg as G.GRAPH graph) = let
30      val ENTRY =            val placed = Array.array(#capacity graph (), false)
31        (case #entries graph () of [n] => n | _ => error "ENTRY")            fun isMarked id = Array.sub(placed, id)
32      val EXIT =            fun mark id = Array.update(placed, id, true)
33        (case #exits graph () of [n] => n | _ => error "EXIT")            fun assertNotMarked id = if isMarked id
34                    then error "conflicting placement constraints"
35      fun blocks () = let                  else ()
36        val entryBlk = (ENTRY, #node_info graph ENTRY)          (* special case the entry and exit blocks *)
37        val exitBlk = (EXIT, #node_info graph EXIT)            fun getBlk id = (id, #node_info graph id)
38        fun filter([]) = [exitBlk]            val entry = (case #entries graph ()
39          | filter((node as (i, CFG.BLOCK{kind, ...}))::rest) =                   of [id] => (mark id; getBlk id)
40              (case kind                    | _ => error "entry block"
41               of CFG.START  => filter rest                  (* end case *))
42                | CFG.STOP   => filter rest            val exit = (case #exits graph ()
43                | CFG.NORMAL => node::filter rest                   of [id] => (mark id; getBlk id)
44              (*esac*))                    | _ => error "exit block"
45      in entryBlk :: filter(#nodes graph ())                  (* 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      end
98                  else ();
99                if !dumpCFG
100                  then let
101                    val prBlock = CFG.dumpBlock (!dumpStrm, cfg)
102    in    in
103        (cfg, blocks())                    TextIO.output(!dumpStrm, "[ after block placement ]\n");
104                      List.app prBlock blocks
105                    end
106                  else ();
107                (cfg, blocks)
108    end    end
109    
110  end  end

Legend:
Removed from v.1156  
changed lines
  Added in v.1157

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