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