1structure Assem = struct 2 3 type label = Temp.label 4 5 exception invalidAssemExp; 6 7 type address = {reg:int, offset:int, wback:bool}; 8 9 datatype operation = ADD | SUB | RSB | MUL | MLA | 10 AND | ORR | EOR | CMP | TST | 11 LSL | LSR | ASR | ROR | 12 LDR | STR | LDMFD | STMFD | 13 MRS | MSR | 14 B | BL | 15 SWI | DCD | 16 NOP 17 18 datatype alias = FP | IP | SP | LR | PC 19 20 datatype exp = NAME of Temp.label 21 | TEMP of int 22 | NCONST of Arbint.int 23 | WCONST of Arbint.int 24 | PAIR of exp * exp 25 | CALL of exp * exp 26 | TMEM of int 27 | MEM of address 28 | REG of int 29 | WREG of int 30 | ALIAS of alias 31 | SHIFT of operation * int 32 33 datatype cond = EQ | NE | GE | LE | GT | LT | AL | NV | CC | LS | HI | CS 34 35 datatype instr = OPER of {oper: operation * cond option * bool, 36 dst: exp list, 37 src: exp list, 38 jump: label list option} 39 | LABEL of {lab: label} 40 | MOVE of {dst: exp, 41 src: exp}; 42 43 val indent = " " 44 45 fun pair2list (PAIR(v1, v2)) = 46 (pair2list v1) @ (pair2list v2) 47 | pair2list v = [v] 48 49 fun fromAlias FP = 11 50 | fromAlias IP = 12 51 | fromAlias SP = 13 52 | fromAlias LR = 14 53 | fromAlias PC = 15 54 55 fun toAlias 11 = FP 56 | toAlias 12 = IP 57 | toAlias 13 = SP 58 | toAlias 14 = LR 59 | toAlias 15 = PC 60 | toAlias _ = raise invalidAssemExp 61 62 fun print_op ADD = "ADD" 63 | print_op SUB = "SUB" 64 | print_op RSB = "RSB" 65 | print_op MUL = "MUL" 66 | print_op MLA = "MLA" 67 | print_op AND = "AND" 68 | print_op ORR = "ORR" 69 | print_op EOR = "EOR" 70 | print_op CMP = "CMP" 71 | print_op TST = "TST" 72 | print_op LSL = "LSL" 73 | print_op LSR = "LSR" 74 | print_op ASR = "ASR" 75 | print_op ROR = "ROR" 76 | print_op LDR = "LDR" 77 | print_op LDMFD = "LDMFD" 78 | print_op STR = "STR" 79 | print_op STMFD = "STMFD" 80 | print_op MRS = "MRS" 81 | print_op MSR = "MSR" 82 | print_op BL = "BL" 83 | print_op B = "B" 84 | print_op SWI = "SWI" 85 | print_op NOP = "NOP" 86 | print_op _ = raise invalidAssemExp 87 88 fun print_cond (SOME EQ) = "EQ" 89 | print_cond (SOME NE) = "NE" 90 | print_cond (SOME GE) = "GE" 91 | print_cond (SOME LT) = "LT" 92 | print_cond (SOME GT) = "GT" 93 | print_cond (SOME LE) = "LE" 94 | print_cond (SOME CC) = "CC" 95 | print_cond (SOME LS) = "LS" 96 | print_cond (SOME HI) = "HI" 97 | print_cond (SOME CS) = "CS" 98 | print_cond (SOME AL) = "AL" 99 | print_cond (SOME NV) = "NV" 100 | print_cond NONE = "" 101 102 103 fun print_flag flag = 104 if flag then "S" 105 else "" 106 107 fun printAlias FP = "FP" 108 | printAlias IP = "IP" 109 | printAlias SP = "SP" 110 | printAlias LR = "LR" 111 | printAlias PC = "PC" 112 113 val use_alias = ref true; 114 val use_capital = ref false; 115 val address_stride = ref 1; 116 117 fun printReg r = 118 if !use_alias andalso r >= 11 then 119 printAlias (toAlias r) 120 else "R" ^ Int.toString r 121 122 fun eval_exp (TEMP e) = 123 e 124 | eval_exp (NAME e) = 125 Symbol.index e 126 | eval_exp (NCONST e) = 127 Arbint.toInt e 128 | eval_exp (WCONST e) = 129 Arbint.toInt e 130 | eval_exp (TMEM e) = 131 e 132 | eval_exp (MEM {reg = r, offset = j, wback = w}) = 133 j 134 | eval_exp (REG e) = 135 e 136 | eval_exp (WREG e) = 137 e 138 | eval_exp (ALIAS e) = 139 fromAlias e 140 | eval_exp _ = 141 0 142 143 fun toLowerCase str = 144 Substring.translate (Char.toString o Char.toLower) 145 (Substring.substring (str, 0, String.size str)) 146 147 fun one_exp exp = 148 let 149 fun format_exp (TMEM e) = 150 "[" ^ Int.toString e ^ "]" 151 | format_exp (MEM {reg = r, offset = j, wback = w}) = 152 (if j = 0 then 153 "[" ^ printReg r ^ "]" 154 else 155 "[" ^ printReg r ^ ", " ^ "#" ^ Int.toString (j * !address_stride) ^ "]") ^ 156 (if w then "!" else "") 157 | format_exp (TEMP e) = 158 "t" ^ Int.toString e 159 | format_exp (NAME e) = 160 Symbol.name e 161 | format_exp (NCONST e) = 162 "#" ^ Arbint.toString e 163 | format_exp (WCONST e) = 164 "#" ^ (Arbint.toString e) ^ "w" 165 | format_exp (REG e) = 166 printReg e 167 | format_exp (WREG e) = 168 printReg e ^ "!" 169 | format_exp (CALL(f, args)) = 170 "BL " ^ (format_exp f) 171 | format_exp (PAIR(e1,e2)) = 172 "(" ^ format_exp e1 ^ "," ^ format_exp e2 ^ ")" 173 | format_exp _ = 174 raise invalidAssemExp 175 in 176 if !use_capital then format_exp exp 177 else toLowerCase (format_exp exp) 178 end 179 180 fun formatInst (OPER {oper = (op1, cond1, flag1), src = sl, dst = dl, jump = jl}) = 181 let 182 fun appendBlanks i = if i <= 0 then "" else " " ^ appendBlanks (i-1) 183 184 val (sl,dl) = if op1 = LDMFD orelse op1 = STR then (dl,sl) 185 else if op1 = CMP then (sl,[]) 186 else (sl,dl) 187 188 val ops0 = (print_op op1 ^ print_cond cond1 ^ print_flag flag1) 189 val ops1 = ops0 ^ appendBlanks (8 - String.size ops0) 190 191 val inst = 192 indent ^ ops1 ^ 193 194 ( 195 if op1 = STMFD orelse op1 = LDMFD then 196 (one_exp (hd dl)) ^ ", {" ^ one_exp (hd sl) ^ 197 (List.foldl (fn (n,s) => (s ^ "," ^ one_exp n)) "" (tl sl)) ^ "}" 198 else if op1 = BL then 199 (if null dl then "" 200 else 201 "(" ^ one_exp (hd dl) ^ (List.foldl (fn (n,s) => (s ^ "," ^ one_exp n)) "" (tl dl)) ^ "), " ^ 202 "(" ^ one_exp (hd sl) ^ (List.foldl (fn (n,s) => (s ^ "," ^ one_exp n)) "" (tl sl)) ^ ")" 203 ) ^ 204 Symbol.name (hd (valOf jl)) ^ " (" ^ Int.toString (Symbol.index (hd (valOf jl))) ^ ")" 205 else 206 (if null dl then "" else (one_exp (hd dl))) ^ 207 (if null sl orelse op1 = B then "" 208 else if null dl then (one_exp (hd sl)) 209 else ", " ^ (one_exp (hd sl)) 210 ) ^ 211 (if null sl then "" 212 else List.foldl (fn (v,s) => s ^ ", " ^ (one_exp v)) "" (tl sl)) ^ 213 (case jl of 214 NONE => "" 215 | SOME labs => Symbol.name (hd labs) ^ " (" ^ Int.toString (Symbol.index (hd labs)) ^ ")") 216 ) 217 in 218 if !use_capital then inst 219 else toLowerCase inst 220 end 221 222 | formatInst (LABEL {lab = v}) = Symbol.name v ^ ":" 223 224 | formatInst (MOVE {src = s, dst = d}) = 225 let val inst = indent ^ "MOV " ^ (one_exp d) ^ ", " ^ (one_exp s) 226 in 227 if !use_capital then inst 228 else toLowerCase inst 229 end 230 231(* ---------------------------------------------------------------------------------------------------------------------*) 232(* Print ARM programs *) 233(* ---------------------------------------------------------------------------------------------------------------------*) 234 235val lineNo = ref ~1; 236 237fun printInsts stms = 238 let 239 fun formatNextLineNo () = 240 ( lineNo := !lineNo + 1; 241 " " ^ 242 ( if !lineNo < 10 then " " ^ Int.toString (!lineNo) 243 else if !lineNo < 100 then " " ^ Int.toString (!lineNo) 244 else Int.toString (!lineNo) 245 ) ^ 246 ":" 247 ) 248 in 249 (lineNo := ~1; 250 List.map (fn stm => print ((formatNextLineNo() ^ " " ^ formatInst stm) ^ "\n")) stms 251 ) 252 end 253 254val print_structure = ref true; 255 256fun printarm progL = 257 let 258 val _ = lineNo := ~1; 259 fun one_fun flag(fname,ftype,args,stms,outs,rs) = 260 ( 261 (if flag then 262 ( print "*****************************************************************\n"; 263 print (" Name : " ^ fname ^ "\n"); 264 print " Arguments : "; 265 List.map (fn arg => print (one_exp arg ^ " ")) (pair2list args); 266 print "\n Modified Registers: "; 267 List.map (fn arg => print (one_exp arg ^ " ")) (Binaryset.listItems rs); 268 print "\n Returns : "; 269 List.map (fn arg => print (one_exp arg ^ " ")) (pair2list outs); 270 print "\n Body: \n" 271 ) 272 else print ""); 273 printInsts stms 274 ) 275 in 276 ( one_fun true (hd progL); 277 List.map (one_fun (!print_structure)) (tl progL) 278 ) 279 end 280 281end 282 283