Changeset 645 for Deliverables/D2.2/8051
 Timestamp:
 Mar 7, 2011, 4:04:42 PM (10 years ago)
 Location:
 Deliverables/D2.2/8051/src
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D2.2/8051/src/ASM/Pretty.ml
r640 r645 29 29 let pp_jump = 30 30 function 31 `CJNE (`U1 (a1,a2),a3) > "cjne " ^ pp_arg a1 ^ ", " ^ pp_arg a2 ^ ", " ^ pp_arg a332  `CJNE (`U2 (a1,a2),a3) > "cjne " ^ pp_arg a1 ^ ", " ^ pp_arg a2 ^ ", " ^ pp_arg a333  `DJNZ (a1,a2) > "djnz " ^ pp_arg a1 ^ ", " ^ pp_arg a234  `JB (a1,a2) > "jb " ^ pp_arg a1 ^ ", " ^ pp_arg a235  `JBC (a1,a2) > "jbc " ^ pp_arg a1 ^ ", " ^ pp_arg a236  `JC a1 > "jc " ^ pp_arg a137  `JNB (a1,a2) > "jnb " ^ pp_arg a1 ^ ", " ^ pp_arg a238  `JNC a1 > "jnc " ^ pp_arg a139  `JNZ a1 > "jnz " ^ pp_arg a140  `JZ a1 > "jz " ^ pp_arg a131 `CJNE (`U1 (a1,a2),a3) > "cjne " ^ pp_arg a1 ^ ", " ^ pp_arg a2 ^ ", " ^ pp_arg a3 32  `CJNE (`U2 (a1,a2),a3) > "cjne " ^ pp_arg a1 ^ ", " ^ pp_arg a2 ^ ", " ^ pp_arg a3 33  `DJNZ (a1,a2) > "djnz " ^ pp_arg a1 ^ ", " ^ pp_arg a2 34  `JB (a1,a2) > "jb " ^ pp_arg a1 ^ ", " ^ pp_arg a2 35  `JBC (a1,a2) > "jbc " ^ pp_arg a1 ^ ", " ^ pp_arg a2 36  `JC a1 > "jc " ^ pp_arg a1 37  `JNB (a1,a2) > "jnb " ^ pp_arg a1 ^ ", " ^ pp_arg a2 38  `JNC a1 > "jnc " ^ pp_arg a1 39  `JNZ a1 > "jnz " ^ pp_arg a1 40  `JZ a1 > "jz " ^ pp_arg a1 41 41 42 42 let pp_instruction = … … 44 44 `Label l > l ^ ":" 45 45  `Cost l > l ^ ":" 46  `Jmp j > "ljmp " ^ j46  `Jmp j > "ljmp " ^ j 47 47  `Call j > "lcall " ^ j 48 48  `WithLabel i > pp_jump i 49  `Begin_fun > "\n; Begin function"50  `End_fun > "; End function\n"51 49  (#jump as i) > pp_jump i 52  `Mov (a1,a2) > "mov " ^ pp_arg a1 ^ ", " ^ a250  `Mov (a1,a2) > "mov " ^ pp_arg a1 ^ ", " ^ a2 53 51  `ACALL a1 > "acall " ^ pp_arg a1 54  `ADD (a1,a2) > "add " ^ pp_arg a1 ^ ", " ^ pp_arg a255  `ADDC (a1,a2) > "addc " ^ pp_arg a1 ^ ", " ^ pp_arg a256  `AJMP a1 > "ajmp " ^ pp_arg a157  `ANL (`U1 (a1,a2)) > "anl " ^ pp_arg a1 ^ ", " ^ pp_arg a258  `ANL (`U2 (a1,a2)) > "anl " ^ pp_arg a1 ^ ", " ^ pp_arg a259  `ANL (`U3 (a1,a2)) > "anl " ^ pp_arg a1 ^ ", " ^ pp_arg a260  `CLR a1 > "clr " ^ pp_arg a161  `CPL a1 > "cpl " ^ pp_arg a162  `DA a1 > "da " ^ pp_arg a163  `DEC a1 > "dec " ^ pp_arg a164  `DIV (a1,a2) > "div AB"65  `INC a1 > "inc " ^ pp_arg a166  `JMP a1 > "jmp " ^ pp_arg a152  `ADD (a1,a2) > "add " ^ pp_arg a1 ^ ", " ^ pp_arg a2 53  `ADDC (a1,a2) > "addc " ^ pp_arg a1 ^ ", " ^ pp_arg a2 54  `AJMP a1 > "ajmp " ^ pp_arg a1 55  `ANL (`U1 (a1,a2)) > "anl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 56  `ANL (`U2 (a1,a2)) > "anl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 57  `ANL (`U3 (a1,a2)) > "anl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 58  `CLR a1 > "clr " ^ pp_arg a1 59  `CPL a1 > "cpl " ^ pp_arg a1 60  `DA a1 > "da " ^ pp_arg a1 61  `DEC a1 > "dec " ^ pp_arg a1 62  `DIV (a1,a2) > "div AB" 63  `INC a1 > "inc " ^ pp_arg a1 64  `JMP a1 > "jmp " ^ pp_arg a1 67 65  `LCALL a1 > "lcall " ^ pp_arg a1 68  `LJMP a1 > "ljmp " ^ pp_arg a169  `MOV (`U1 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a270  `MOV (`U2 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a271  `MOV (`U3 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a272  `MOV (`U4 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a273  `MOV (`U5 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a274  `MOV (`U6 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a275  `MOVC (a1,a2) > "movc " ^ pp_arg a1 ^ ", " ^ pp_arg a276  `MOVX (`U1 (a1,a2)) > "movx " ^ pp_arg a1 ^ ", " ^ pp_arg a277  `MOVX (`U2 (a1,a2)) > "movx " ^ pp_arg a1 ^ ", " ^ pp_arg a278  `MUL(a1, a2) > "mul AB"66  `LJMP a1 > "ljmp " ^ pp_arg a1 67  `MOV (`U1 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a2 68  `MOV (`U2 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a2 69  `MOV (`U3 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a2 70  `MOV (`U4 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a2 71  `MOV (`U5 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a2 72  `MOV (`U6 (a1,a2)) > "mov " ^ pp_arg a1 ^ ", " ^ pp_arg a2 73  `MOVC (a1,a2) > "movc " ^ pp_arg a1 ^ ", " ^ pp_arg a2 74  `MOVX (`U1 (a1,a2)) > "movx " ^ pp_arg a1 ^ ", " ^ pp_arg a2 75  `MOVX (`U2 (a1,a2)) > "movx " ^ pp_arg a1 ^ ", " ^ pp_arg a2 76  `MUL(a1, a2) > "mul AB" 79 77  `NOP > "nop" 80  `ORL (`U1(a1,a2)) > "orl " ^ pp_arg a1 ^ ", " ^ pp_arg a281  `ORL (`U2(a1,a2)) > "orl " ^ pp_arg a1 ^ ", " ^ pp_arg a282  `ORL (`U3(a1,a2)) > "orl " ^ pp_arg a1 ^ ", " ^ pp_arg a283  `POP a1 > "pop " ^ pp_arg a184  `PUSH a1 > "push " ^ pp_arg a178  `ORL (`U1(a1,a2)) > "orl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 79  `ORL (`U2(a1,a2)) > "orl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 80  `ORL (`U3(a1,a2)) > "orl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 81  `POP a1 > "pop " ^ pp_arg a1 82  `PUSH a1 > "push " ^ pp_arg a1 85 83  `RET > "ret" 86 84  `RETI > "reti" 87  `RL a1 > "rl " ^ pp_arg a188  `RLC a1 > "rlc " ^ pp_arg a189  `RR a1 > "rr " ^ pp_arg a190  `RRC a1 > "rrc " ^ pp_arg a191  `SETB a1 > "setb " ^ pp_arg a192  `SJMP a1 > "sjmp " ^ pp_arg a193  `SUBB (a1,a2) > "subb " ^ pp_arg a1 ^ ", " ^ pp_arg a294  `SWAP a1 > "swap " ^ pp_arg a195  `XCH (a1,a2) > "xch " ^ pp_arg a1 ^ ", " ^ pp_arg a296  `XCHD(a1,a2) > "xchd " ^ pp_arg a1 ^ ", " ^ pp_arg a297  `XRL(`U1(a1,a2)) > "xrl " ^ pp_arg a1 ^ ", " ^ pp_arg a298  `XRL(`U2(a1,a2)) > "xrl " ^ pp_arg a1 ^ ", " ^ pp_arg a285  `RL a1 > "rl " ^ pp_arg a1 86  `RLC a1 > "rlc " ^ pp_arg a1 87  `RR a1 > "rr " ^ pp_arg a1 88  `RRC a1 > "rrc " ^ pp_arg a1 89  `SETB a1 > "setb " ^ pp_arg a1 90  `SJMP a1 > "sjmp " ^ pp_arg a1 91  `SUBB (a1,a2) > "subb " ^ pp_arg a1 ^ ", " ^ pp_arg a2 92  `SWAP a1 > "swap " ^ pp_arg a1 93  `XCH (a1,a2) > "xch " ^ pp_arg a1 ^ ", " ^ pp_arg a2 94  `XCHD(a1,a2) > "xchd " ^ pp_arg a1 ^ ", " ^ pp_arg a2 95  `XRL(`U1(a1,a2)) > "xrl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 96  `XRL(`U2(a1,a2)) > "xrl " ^ pp_arg a1 ^ ", " ^ pp_arg a2 99 97 100 98 let print_program p = 101 99 let mem = ASMInterpret.load_code_memory p.ASM.code in 102 100 let f (s, pc) _ = 103 let (inst, new_pc, _) = ASMInterpret.fetch mem pc in104 (Printf.sprintf "%s% s: %s%s\n"101 let (inst, new_pc, cost) = ASMInterpret.fetch mem pc in 102 (Printf.sprintf "%s% 6s % 18s ;; %d %s\n" 105 103 s 106 ( string_of_int (BitVectors.int_of_vect pc))104 ((string_of_int (BitVectors.int_of_vect pc)) ^ ":") 107 105 (pp_instruction inst) 106 cost 108 107 (if BitVectors.WordMap.mem pc p.ASM.cost_labels then 109 " ;; (" ^ (BitVectors.WordMap.find pc p.ASM.cost_labels) ^ ")"108 (BitVectors.WordMap.find pc p.ASM.cost_labels) 110 109 else ""), 111 110 new_pc) in 
Deliverables/D2.2/8051/src/clight/clightAnnotator.ml
r640 r645 181 181  Clight.Sskip  Clight.Sbreak  Clight.Scontinue  Clight.Sreturn None 182 182  Clight.Sgoto _ > 183 183 stmt 184 184  Clight.Sassign (e1, e2) > 185 186 187 185 let e1' = instrument_expr cost_mapping cost_incr e1 in 186 let e2' = instrument_expr cost_mapping cost_incr e2 in 187 Clight.Sassign (e1', e2') 188 188  Clight.Scall (eopt, f, args) > 189 190 191 192 193 194 189 let eopt' = match eopt with 190  None > None 191  Some e > Some (instrument_expr cost_mapping cost_incr e) in 192 let f' = instrument_expr cost_mapping cost_incr f in 193 let args' = List.map (instrument_expr cost_mapping cost_incr) args in 194 Clight.Scall (eopt', f', args') 195 195  Clight.Ssequence (s1, s2) > 196 197 196 Clight.Ssequence (instrument_body cost_mapping cost_incr s1, 197 instrument_body cost_mapping cost_incr s2) 198 198  Clight.Sifthenelse (e, s1, s2) > 199 200 201 202 199 let e' = instrument_expr cost_mapping cost_incr e in 200 let s1' = instrument_body cost_mapping cost_incr s1 in 201 let s2' = instrument_body cost_mapping cost_incr s2 in 202 Clight.Sifthenelse (e', s1', s2') 203 203  Clight.Swhile (e, s) > 204 205 206 204 let e' = instrument_expr cost_mapping cost_incr e in 205 let s' = instrument_body cost_mapping cost_incr s in 206 Clight.Swhile (e', s') 207 207  Clight.Sdowhile (e, s) > 208 209 210 208 let e' = instrument_expr cost_mapping cost_incr e in 209 let s' = instrument_body cost_mapping cost_incr s in 210 Clight.Sdowhile (e', s') 211 211  Clight.Sfor (s1, e, s2, s3) > 212 213 214 215 216 212 let s1' = instrument_body cost_mapping cost_incr s1 in 213 let e' = instrument_expr cost_mapping cost_incr e in 214 let s2' = instrument_body cost_mapping cost_incr s2 in 215 let s3' = instrument_body cost_mapping cost_incr s3 in 216 Clight.Sfor (s1', e', s2', s3') 217 217  Clight.Sreturn (Some e) > 218 219 218 let e' = instrument_expr cost_mapping cost_incr e in 219 Clight.Sreturn (Some e') 220 220  Clight.Sswitch (e, ls) > 221 222 223 221 let e' = instrument_expr cost_mapping cost_incr e in 222 let ls' = instrument_ls cost_mapping cost_incr ls in 223 Clight.Sswitch (e', ls') 224 224  Clight.Slabel (lbl, s) > 225 226 225 let s' = instrument_body cost_mapping cost_incr s in 226 Clight.Slabel (lbl, s') 227 227  Clight.Scost (lbl, s) when CostLabel.Map.mem lbl cost_mapping > 228 let s' = instrument_body cost_mapping cost_incr s in 229 let incr = CostLabel.Map.find lbl cost_mapping in 230 if incr = 0 then s' 231 else 232 let fun_typ = Clight.Tfunction ([int_typ], Clight.Tvoid) in 233 let f = Clight.Expr (Clight.Evar cost_incr, fun_typ) in 234 let args = [Clight.Expr (Clight.Econst_int incr, int_typ)] in 235 Clight.Ssequence (Clight.Scall (None, f, args), s') 236  Clight.Scost (_, s) > 237 instrument_body cost_mapping cost_incr s 228 (* Keep the cost label in the code. *) 229 let s' = instrument_body cost_mapping cost_incr s in 230 let incr = CostLabel.Map.find lbl cost_mapping in 231 let fun_typ = Clight.Tfunction ([int_typ], Clight.Tvoid) in 232 let f = Clight.Expr (Clight.Evar cost_incr, fun_typ) in 233 let args = [Clight.Expr (Clight.Econst_int incr, int_typ)] in 234 Clight.Scost (lbl, Clight.Ssequence (Clight.Scall (None, f, args), s')) 235 (* 236 let s' = instrument_body cost_mapping cost_incr s in 237 let incr = CostLabel.Map.find lbl cost_mapping in 238 if incr = 0 then s' 239 else 240 let fun_typ = Clight.Tfunction ([int_typ], Clight.Tvoid) in 241 let f = Clight.Expr (Clight.Evar cost_incr, fun_typ) in 242 let args = [Clight.Expr (Clight.Econst_int incr, int_typ)] in 243 Clight.Ssequence (Clight.Scall (None, f, args), s') 244 *) 245  Clight.Scost (lbl, s) > 246 (* Keep the cost label in the code and show the increment of 0. *) 247 let s' = instrument_body cost_mapping cost_incr s in 248 let fun_typ = Clight.Tfunction ([int_typ], Clight.Tvoid) in 249 let f = Clight.Expr (Clight.Evar cost_incr, fun_typ) in 250 let args = [Clight.Expr (Clight.Econst_int 0, int_typ)] in 251 Clight.Scost (lbl, Clight.Ssequence (Clight.Scall (None, f, args), s')) 252 (* 253 instrument_body cost_mapping cost_incr s 254 *) 238 255 and instrument_ls cost_mapping cost_incr = function 239 256  Clight.LSdefault s > 240 241 257 let s' = instrument_body cost_mapping cost_incr s in 258 Clight.LSdefault s' 242 259  Clight.LScase (i, s, ls) > 243 244 245 260 let s' = instrument_body cost_mapping cost_incr s in 261 let ls' = instrument_ls cost_mapping cost_incr ls in 262 Clight.LScase (i, s', ls') 246 263 247 264 (* Instrument a function. *)
Note: See TracChangeset
for help on using the changeset viewer.