1structure CFG =
2struct
3
4exception CFG;
5
6type node = {instr:Assem.instr, def : int list, use : int list};
7type Cfg = (node,int) Graph.graph;
8type dataSeg = Assem.instr list;
9
10exception CFG
11
12(* Translate Tree expressions to Assem expressions                                                      *)
13
14 fun one_exp (Tree.TEMP e) =
15        Assem.TEMP e
16  |  one_exp (Tree.NAME e) =
17        Assem.NAME e
18  |  one_exp (Tree.NCONST e) =
19        Assem.NCONST e
20  |  one_exp (Tree.WCONST e) =
21        Assem.WCONST e
22  |  one_exp (Tree.CALL(f, args)) =
23        Assem.CALL (one_exp f,
24                    one_exp args)
25  |  one_exp (Tree.PAIR(e1,e2)) =
26        Assem.PAIR(one_exp e1, one_exp e2)
27  |  one_exp _ = raise CFG
28  ;
29
30
31fun buildCFG tmpT (args,stmList,outs) =
32 let
33
34  structure T = IntMapTable(type key = int  fun getInt n = n);
35  val relopT : (Tree.relop T.table) ref  = ref (T.empty);
36  val labT : (int T.table) ref  = ref (T.empty);
37
38  fun bi_operator Tree.PLUS = Assem.ADD
39   |  bi_operator Tree.MINUS = Assem.SUB
40   |  bi_operator Tree.MUL = Assem.MUL
41   |  bi_operator Tree.AND = Assem.AND
42   |  bi_operator Tree.OR = Assem.ORR
43   |  bi_operator Tree.XOR = Assem.EOR
44   |  bi_operator Tree.LSHIFT = Assem.LSL
45   |  bi_operator Tree.RSHIFT = Assem.LSR
46   |  bi_operator Tree.ARSHIFT = Assem.ASR
47   |  bi_operator Tree.ROR = Assem.ROR
48   |  bi_operator Tree.DIV = raise CFG
49
50  fun cjump e =
51    let val x = T.look(!relopT, e)
52    in  if x = Tree.EQ then Assem.EQ
53        else if x = Tree.NE then Assem.NE
54        else if x = Tree.LT then Assem.LT
55        else if x = Tree.GT then Assem.GT
56        else if x = Tree.LE then Assem.LE
57        else if x = Tree.GE then Assem.GE
58        else if x = Tree.CC then Assem.CC
59        else if x = Tree.LS then Assem.LS
60        else if x = Tree.HI then Assem.HI
61        else if x = Tree.CS then Assem.CS
62        else Assem.NE                                   (* there may be no relational operation defined previously, so if e!=0 then jump *)
63    end;
64
65
66
67  fun getTmp (Tree.TEMP x) = x
68   |  getTmp _ = 0;
69
70  fun tmpIndexL [] = []
71   |  tmpIndexL ((Tree.TEMP x)::rest) = x :: (tmpIndexL rest)
72   |  tmpIndexL _ = [];
73
74  fun tmpIndexL2 [] = []
75   |  tmpIndexL2 ((Assem.TEMP x)::rest) = x :: (tmpIndexL2 rest)
76   |  tmpIndexL2 _ = [];
77
78
79  (* Translate a Tree expression to the Assem expression including use and def information                                      *)
80
81  fun one_stm (Tree.MOVE(d, Tree.BINOP(bop, e1, e2))) =
82    let
83      val not_change = if (bop = Tree.MUL) then
84        [{instr = Assem.OPER {oper = (Assem.NOP,NONE,false), dst = [], src = [], jump = NONE},
85      def = [], use = tmpIndexL [e1]}]
86        else [];
87    in
88         ({ instr = Assem.OPER {oper = (bi_operator bop,NONE,false), dst = [one_exp d], src = [one_exp e1, one_exp e2], jump = NONE},
89           def = tmpIndexL [d],
90           use = tmpIndexL [e1,e2]
91         }::not_change)
92  end
93   |  one_stm (Tree.MOVE(d, Tree.RELOP(rop, e1, e2))) =
94        let
95            val _= relopT := T.enter(!relopT, getTmp d, rop) in
96            [{ instr = Assem.OPER {oper = (Assem.CMP,NONE,false), dst = [one_exp d], src = [one_exp e1, one_exp e2], jump = NONE},
97              def = tmpIndexL [d],
98              use = tmpIndexL [e1, e2]
99            }]
100        end
101   |  one_stm (Tree.MOVE(d, Tree.CALL(name, args))) =
102        let val (Tree.NAME fun_name) = name;
103            val outL = Tree.pair2list d in
104            [{ instr = Assem.OPER {oper = (Assem.BL,NONE,false),
105                                 dst = [one_exp d],
106                                 src = [one_exp args],
107                                 jump = SOME [fun_name]},
108              def = tmpIndexL outL,
109              use = tmpIndexL (Tree.pair2list args)
110            }]
111        end
112   |  one_stm (Tree.MOVE(d, s)) =
113            [{ instr = Assem.MOVE {dst = one_exp d, src = one_exp s},
114              def = tmpIndexL [d],
115              use = tmpIndexL [s]
116            }]
117   |  one_stm (Tree.JUMP lab) =
118            [{ instr = Assem.OPER {oper = (Assem.B,SOME Assem.AL,false), dst = [], src = [], jump = SOME [lab]},
119              def = [],
120              use = []
121            }]
122   |  one_stm (Tree.CJUMP(e,lab)) =
123            [{ instr = Assem.OPER {oper = (Assem.B, SOME (cjump (getTmp e)), false), dst = [], src = [one_exp e], jump = SOME [lab]},
124              def = [],
125              use = tmpIndexL [e]
126            }]
127   |  one_stm (Tree.LABEL lab) =
128            [{ instr = Assem.LABEL {lab = lab},
129              def = [],
130              use = []
131            }]
132   |  one_stm _ = raise CFG
133
134   (* Calcuate the number of the node holding a label, this number serves as the tail of an edge corresponding to an jump       *)
135
136    fun calLabels ({instr = Assem.LABEL {lab = lab1}, def = d1, use = s1} :: rest, i) =
137            ( labT := T.enter(!labT, Symbol.index lab1, i);
138              calLabels (rest, i+1)
139            )
140     |  calLabels ([],i) = ()
141     |  calLabels (stm :: rest, i) = calLabels (rest, i+1);
142
143
144    (* Build edges for the whole CFG                                                                                            *)
145
146    fun buildEdges instL =
147        let val edgeL = ref ([])
148            val i = ref 0;
149            val ll = length instL;
150            fun one_stm (stm:{instr:Assem.instr, use:int list, def:int list}) =
151                case (#instr stm) of
152                    Assem.OPER x =>
153                        (case #jump (x) of
154                              NONE => (edgeL := (!i,!i+1,0) :: (!edgeL))
155                           |  SOME labs => (case T.peek(!labT, Symbol.index (hd labs)) of
156                                                 NONE => edgeL := (!i,!i+1,0) :: (!edgeL)
157                                             |   SOME j =>
158                                                      let val (op',cond',flag') = #oper x
159                                                      in
160                                                          if (cond' = SOME (Assem.AL)) orelse (op' = Assem.BL) then
161                                                              edgeL := (!i, j, 1) :: (!i,!i+1,2) :: (!edgeL)
162                                                          else
163                                                              edgeL := (!i, j, 1) :: (!i,!i+1,0) :: (!edgeL)
164                                                      end))
165
166                 |  _ => (edgeL := (!i,!i+1,0) :: (!edgeL))
167        in
168          (  List.map (fn stm => (one_stm stm; i := !i + 1)) instL;
169             List.filter (fn (a,b,l) => b < ll) (!edgeL)
170          )
171        end;
172
173    val insts = Lib.flatten (List.map (fn inst => one_stm inst) stmList);
174    val augmentedInsts = ({instr = Assem.OPER{oper = (Assem.NOP,NONE,false), dst = [], src = [], jump = NONE},
175                          def = tmpIndexL2 (Assem.pair2list args),use = []}) ::
176        insts @ [{instr = Assem.OPER {oper = (Assem.NOP,NONE,false), dst = [], src = [], jump = NONE},
177                  def = [], use = tmpIndexL2 (Assem.pair2list outs)}];
178    val _ = calLabels (augmentedInsts,0);
179    val edgeL = List.rev (buildEdges augmentedInsts)
180  in
181        Graph.mkgr(augmentedInsts, edgeL)
182  end
183
184
185fun convert_to_CFG prog =
186  let
187     val (fun_name, fun_type, args, stms, outs) = IR.convert_to_IR prog
188     val (args, outs) = (one_exp args, one_exp outs)
189  in
190     ((fun_name, fun_type, args, buildCFG (!IR.tmpT) (args,stms,outs), outs), !IR.tmpT)
191  end
192
193
194fun linearizeCFG (cfg : ({instr : Assem.instr, use : int list, def : int list}, int) Graph.graph) =
195   let
196      fun intOrder (s1:int,s2:int) =
197        if s1 > s2 then GREATER
198        else if s1 = s2 then EQUAL
199        else LESS;
200
201      val visited = ref(Binaryset.empty intOrder);
202      val instL = ref [];
203
204      fun visit n =
205          if Binaryset.numItems (!visited) = Graph.noNodes cfg then ()
206          else if not (Binaryset.member (!visited, n)) then
207             let val (nd,nextL) = Graph.fwd (n,cfg);
208                 val next = if nextL = [] then n
209                            else if length nextL = 1 then #2 (hd nextL)
210                            else if #1(hd nextL)=1 then #2 (hd(tl(nextL)))
211                            else #2 (hd nextL)
212             in
213                 (  instL := !instL @ [#instr nd];
214                    visited := Binaryset.add(!visited, n);
215                    visit next
216                 )
217             end
218          else ()
219      in
220         (visit 0;
221          tl(List.take(!instL, length (!instL) - 1)))
222   end
223
224(*
225fun linearizeCFG (cfg : ({instr : Assem.instr, use : int list, def : int list}, bool) Graph.graph) =
226   let
227
228      val stack : (int list ref) = ref [];
229      fun push (i:int) = (stack := i :: (!stack));
230      fun pop () = let val x = hd (!stack) in
231                      ( stack := tl (!stack);
232                        x)
233                  end
234
235      fun intOrder (s1:int,s2:int) =
236          if s1 > s2 then GREATER
237          else if s1 = s2 then EQUAL
238          else LESS;
239      val lastNode = ref 0;
240      val sucS = ref (Array.fromList(
241                List.map (fn n =>
242                        ( lastNode := (if null (Graph.suc(n,cfg)) then n else (!lastNode));
243                          Binaryset.addList(Binaryset.empty intOrder, Graph.suc(n,cfg)))) (Graph.nodes cfg)));
244      val _ = push (!lastNode);
245
246      fun find_first_free_node () =
247          let val i = pop () in
248              if Binaryset.isEmpty (Array.sub(!sucS,i)) then i
249              else find_first_free_node ()
250          end;
251
252      fun round () =
253        let val cur_node = find_first_free_node ();
254            val in_edges = #1 (Graph.context(cur_node, cfg));
255            val _ = if length in_edges = 1 then push (#2 (hd in_edges))
256                    else if length in_edges = 2 then
257                        ( if #1 (hd in_edges) then (push (#2 (hd in_edges)); push (#2 (hd (tl in_edges))))
258                          else (push (#2 (hd (tl in_edges))); push (#2 (hd in_edges))))
259                    else ();
260            val _ = List.map (fn n => Array.update(!sucS, n, Binaryset.delete(Array.sub(!sucS,n), cur_node))) (Graph.pred (cur_node, cfg))
261       in
262            if null in_edges then [cur_node]
263            else (round()) @ [cur_node]
264       end;
265
266       val stms = List.map (fn node => #instr (#3 (Graph.context(node,cfg)))) (round())
267
268     in
269        tl(List.take(stms, length stms - 1))
270     end
271*)
272
273end
274