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
13(* Translate Tree expressions to Assem expressions                                                      *)
14
15 fun one_exp (Tree.TEMP e) =
16        Assem.TEMP e
17  |  one_exp (Tree.NAME e) =
18        Assem.NAME e
19  |  one_exp (Tree.NCONST e) =
20        Assem.NCONST e
21  |  one_exp (Tree.WCONST e) =
22        Assem.WCONST e
23  |  one_exp (Tree.CALL(f, args)) =
24        Assem.CALL (one_exp f,
25                    one_exp args)
26  |  one_exp (Tree.PAIR(e1,e2)) =
27        Assem.PAIR(one_exp e1, one_exp e2)
28  |  one_exp _ = raise CFG
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  fun one_stm (Tree.MOVE(d, Tree.BINOP(bop, e1, e2))) =
81    let
82      val not_change = if (bop = Tree.MUL) then
83        [{instr = Assem.OPER {oper = (Assem.NOP,NONE,false), dst = [], src = [], jump = NONE},
84      def = [], use = tmpIndexL [e1]}]
85        else [];
86    in
87         ({ instr = Assem.OPER {oper = (bi_operator bop,NONE,false), dst = [one_exp d], src = [one_exp e1, one_exp e2], jump = NONE},
88           def = tmpIndexL [d],
89           use = tmpIndexL [e1,e2]
90         }::not_change)
91  end
92   |  one_stm (Tree.MOVE(d, Tree.RELOP(rop, e1, e2))) =
93        let
94            val _= relopT := T.enter(!relopT, getTmp d, rop) in
95            [{ instr = Assem.OPER {oper = (Assem.CMP,NONE,false), dst = [one_exp d], src = [one_exp e1, one_exp e2], jump = NONE},
96              def = tmpIndexL [d],
97              use = tmpIndexL [e1, e2]
98            }]
99        end
100   |  one_stm (Tree.MOVE(d, Tree.CALL(name, args))) =
101        let val (Tree.NAME fun_name) = name;
102            val outL = Tree.pair2list d in
103            [{ instr = Assem.OPER {oper = (Assem.BL,NONE,false),
104                                 dst = [one_exp d],
105                                 src = [one_exp args],
106                                 jump = SOME [fun_name]},
107              def = tmpIndexL outL,
108              use = tmpIndexL (Tree.pair2list args)
109            }]
110        end
111   |  one_stm (Tree.MOVE(d, s)) =
112            [{ instr = Assem.MOVE {dst = one_exp d, src = one_exp s},
113              def = tmpIndexL [d],
114              use = tmpIndexL [s]
115            }]
116   |  one_stm (Tree.JUMP lab) =
117            [{ instr = Assem.OPER {oper = (Assem.B,SOME Assem.AL,false), dst = [], src = [], jump = SOME [lab]},
118              def = [],
119              use = []
120            }]
121   |  one_stm (Tree.CJUMP(e,lab)) =
122            [{ instr = Assem.OPER {oper = (Assem.B, SOME (cjump (getTmp e)), false), dst = [], src = [one_exp e], jump = SOME [lab]},
123              def = [],
124              use = tmpIndexL [e]
125            }]
126   |  one_stm (Tree.LABEL lab) =
127            [{ instr = Assem.LABEL {lab = lab},
128              def = [],
129              use = []
130            }]
131   |  one_stm _ = raise CFG
132
133   (* Calcuate the number of the node holding a label, this number serves as the tail of an edge corresponding to an jump       *)
134
135    fun calLabels ({instr = Assem.LABEL {lab = lab1}, def = d1, use = s1} :: rest, i) =
136            ( labT := T.enter(!labT, Symbol.index lab1, i);
137              calLabels (rest, i+1)
138            )
139     |  calLabels ([],i) = ()
140     |  calLabels (stm :: rest, i) = calLabels (rest, i+1);
141
142
143    (* Build edges for the whole CFG                                                                                            *)
144
145    fun buildEdges instL =
146        let val edgeL = ref ([])
147            val i = ref 0;
148            val ll = length instL;
149            fun one_stm (stm:{instr:Assem.instr, use:int list, def:int list}) =
150                case (#instr stm) of
151                    Assem.OPER x =>
152                        (case #jump (x) of
153                              NONE => (edgeL := (!i,!i+1,0) :: (!edgeL))
154                           |  SOME labs => (case T.peek(!labT, Symbol.index (hd labs)) of
155                                                 NONE => edgeL := (!i,!i+1,0) :: (!edgeL)
156                                             |   SOME j =>
157                                                      let val (op',cond',flag') = #oper x
158                                                      in
159                                                          if (cond' = SOME (Assem.AL)) orelse (op' = Assem.BL) then
160                                                              edgeL := (!i, j, 1) :: (!i,!i+1,2) :: (!edgeL)
161                                                          else
162                                                              edgeL := (!i, j, 1) :: (!i,!i+1,0) :: (!edgeL)
163                                                      end))
164
165                 |  _ => (edgeL := (!i,!i+1,0) :: (!edgeL))
166        in
167          (  List.map (fn stm => (one_stm stm; i := !i + 1)) instL;
168             List.filter (fn (a,b,l) => b < ll) (!edgeL)
169          )
170        end;
171
172    val insts = Lib.flatten (List.map (fn inst => one_stm inst) stmList);
173    val augmentedInsts = ({instr = Assem.OPER{oper = (Assem.NOP,NONE,false), dst = [], src = [], jump = NONE},
174                          def = tmpIndexL2 (Assem.pair2list args),use = []}) ::
175        insts @ [{instr = Assem.OPER {oper = (Assem.NOP,NONE,false), dst = [], src = [], jump = NONE},
176                  def = [], use = tmpIndexL2 (Assem.pair2list outs)}];
177    val _ = calLabels (augmentedInsts,0);
178    val edgeL = List.rev (buildEdges augmentedInsts)
179  in
180        Graph.mkgr(augmentedInsts, edgeL)
181  end
182
183
184fun convert_to_CFG prog =
185  let
186     val (fun_name, fun_type, args, stms, outs) = IR.convert_to_IR prog
187     val (args, outs) = (one_exp args, one_exp outs)
188  in
189     ((fun_name, fun_type, args, buildCFG (!IR.tmpT) (args,stms,outs), outs), !IR.tmpT)
190  end
191
192
193fun linearizeCFG (cfg : ({instr : Assem.instr, use : int list, def : int list}, int) Graph.graph) =
194   let
195      fun intOrder (s1:int,s2:int) =
196        if s1 > s2 then GREATER
197        else if s1 = s2 then EQUAL
198        else LESS;
199
200      val visited = ref(Binaryset.empty intOrder);
201      val instL = ref [];
202
203      fun visit n =
204          if Binaryset.numItems (!visited) = Graph.noNodes cfg then ()
205          else if not (Binaryset.member (!visited, n)) then
206             let val (nd,nextL) = Graph.fwd (n,cfg);
207                 val next = if nextL = [] then n
208                            else if length nextL = 1 then #2 (hd nextL)
209                            else if #1(hd nextL)=1 then #2 (hd(tl(nextL)))
210                            else #2 (hd nextL)
211             in
212                 (  instL := !instL @ [#instr nd];
213                    visited := Binaryset.add(!visited, n);
214                    visit next
215                 )
216             end
217          else ()
218      in
219         (visit 0;
220          tl(List.take(!instL, length (!instL) - 1)))
221   end
222
223(*
224fun linearizeCFG (cfg : ({instr : Assem.instr, use : int list, def : int list}, bool) Graph.graph) =
225   let
226
227      val stack : (int list ref) = ref [];
228      fun push (i:int) = (stack := i :: (!stack));
229      fun pop () = let val x = hd (!stack) in
230                      ( stack := tl (!stack);
231                        x)
232                  end
233
234      fun intOrder (s1:int,s2:int) =
235          if s1 > s2 then GREATER
236          else if s1 = s2 then EQUAL
237          else LESS;
238      val lastNode = ref 0;
239      val sucS = ref (Array.fromList(
240                List.map (fn n =>
241                        ( lastNode := (if null (Graph.suc(n,cfg)) then n else (!lastNode));
242                          Binaryset.addList(Binaryset.empty intOrder, Graph.suc(n,cfg)))) (Graph.nodes cfg)));
243      val _ = push (!lastNode);
244
245      fun find_first_free_node () =
246          let val i = pop () in
247              if Binaryset.isEmpty (Array.sub(!sucS,i)) then i
248              else find_first_free_node ()
249          end;
250
251      fun round () =
252        let val cur_node = find_first_free_node ();
253            val in_edges = #1 (Graph.context(cur_node, cfg));
254            val _ = if length in_edges = 1 then push (#2 (hd in_edges))
255                    else if length in_edges = 2 then
256                        ( if #1 (hd in_edges) then (push (#2 (hd in_edges)); push (#2 (hd (tl in_edges))))
257                          else (push (#2 (hd (tl in_edges))); push (#2 (hd in_edges))))
258                    else ();
259            val _ = List.map (fn n => Array.update(!sucS, n, Binaryset.delete(Array.sub(!sucS,n), cur_node))) (Graph.pred (cur_node, cfg))
260       in
261            if null in_edges then [cur_node]
262            else (round()) @ [cur_node]
263       end;
264
265       val stms = List.map (fn node => #instr (#3 (Graph.context(node,cfg)))) (round())
266
267     in
268        tl(List.take(stms, length stms - 1))
269     end
270*)
271
272end
273