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