Changeset 634
- Timestamp:
- Mar 4, 2011, 5:59:34 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Deliverables/D2.2/8051/src/ASM/ASMCosts.ml
r632 r634 9 9 | Other 10 10 11 let inst_nature pc = function 12 | `LCALL (`ADDR16 addr16) -> Direct_fun_call addr16 13 | `ACALL (`ADDR11 addr11) -> 14 Direct_fun_call (Physical.addr16_of_addr11 pc addr11) 15 | `LJMP (`ADDR16 addr16) -> Goto addr16 16 | `AJMP (`ADDR11 addr11) -> Goto (Physical.addr16_of_addr11 pc addr11) 17 | `SJMP (`REL addr) -> 18 let _, addr = BitVectors.half_add pc (BitVectors.sign_extension addr) in 19 Goto addr 20 | `JMP idptr -> Other (* Indirect jump; precondition: every possible 21 destination should start with its own label *) 22 | `JC addr 23 | `JNC addr 24 | `JB (_,addr) 25 | `JNB (_,addr) 26 | `JBC (_,addr) 27 | `JZ addr 28 | `JNZ addr 29 | `CJNE (_,addr) 30 | `DJNZ (_,addr) -> 11 let inst_infos mem pc = 12 let (inst, next_pc, inst_cost) = ASMInterpret.fetch mem pc in 13 let (nature, next_pcs) = match inst with 14 | `LCALL (`ADDR16 addr16) -> (Direct_fun_call addr16, [next_pc]) 15 | `ACALL (`ADDR11 addr11) -> 16 (Direct_fun_call (Physical.addr16_of_addr11 pc addr11), [next_pc]) 17 | `LJMP (`ADDR16 addr16) -> (Goto addr16, [addr16]) 18 | `AJMP (`ADDR11 addr11) -> 19 let addr = Physical.addr16_of_addr11 pc addr11 in 20 (Goto addr, [addr]) 21 | `SJMP (`REL addr) -> 22 let _, addr = 23 BitVectors.half_add next_pc (BitVectors.sign_extension addr) in 24 (Goto addr, [addr]) 25 | `JMP idptr -> 26 (Other, [next_pc]) (* Indirect jump; precondition: every possible 27 destination should start with its own label *) 28 | `JC addr 29 | `JNC addr 30 | `JB (_,addr) 31 | `JNB (_,addr) 32 | `JBC (_,addr) 33 | `JZ addr 34 | `JNZ addr 35 | `CJNE (_,addr) 36 | `DJNZ (_,addr) -> 31 37 let `REL addr = addr in 32 let _, addr = BitVectors.half_add pc (BitVectors.sign_extension addr) in 33 Branch addr 34 | `RET | `RETI -> Return 35 | _ -> Other 38 let _, addr = 39 BitVectors.half_add next_pc (BitVectors.sign_extension addr) in 40 (Branch addr, [next_pc ; addr]) 41 | `RET | `RETI -> (Return, []) 42 | _ -> (Other, [next_pc]) in 43 (nature, next_pc, next_pcs, inst_cost) 36 44 37 38 let treat mem costs pc =39 let (inst, next_pc, inst_cost) = ASMInterpret.fetch mem pc in40 (*41 (* <DEBUG> *)42 Printf.printf "%s%s: %s\n%!"43 (if BitVectors.WordMap.mem pc costs then44 BitVectors.WordMap.find pc costs ^ ": "45 else "")46 (BitVectors.string_of_vect pc)47 (Pretty.pp_instruction inst) ;48 (* </DEBUG> *)49 *)50 let next_pcs = match inst_nature pc inst with51 | Return -> []52 | Goto pc -> [pc]53 | Branch pc2 ->54 [next_pc ; pc2]55 | Direct_fun_call _ | Other -> [next_pc] in56 (inst_cost, next_pcs)57 45 58 46 let compare pc1 cost1 pc2 cost2 = … … 64 52 max cost1 cost2 65 53 66 let block_cost mem costs pc = 67 let treat = treat mem costs in 68 let rec aux = function 69 | [] -> 0 70 | [pc] when BitVectors.WordMap.mem pc costs -> 0 71 | [pc] -> full_cost pc 72 | [pc1 ; pc2] when BitVectors.WordMap.mem pc1 costs && 73 BitVectors.WordMap.mem pc2 costs -> 0 74 | [pc1 ; pc2] when BitVectors.WordMap.mem pc1 costs -> 75 let cost2 = full_cost pc2 in 76 compare pc1 0 pc2 cost2 77 | [pc1 ; pc2] when BitVectors.WordMap.mem pc2 costs -> 78 let cost1 = full_cost pc1 in 79 compare pc1 cost1 pc2 0 80 | [pc1 ; pc2] -> 81 let cost1 = full_cost pc1 in 82 let cost2 = full_cost pc2 in 83 compare pc1 cost1 pc2 cost2 84 | _ -> assert false (* should be impossible: only 0, 1 or 2 following pcs *) 85 and full_cost pc = 86 let (cost, next_pcs) = treat pc in 87 cost + (aux next_pcs) in 88 full_cost pc 54 let rec block_costl mem costs = function 55 | [] -> 0 56 | [pc] when BitVectors.WordMap.mem pc costs -> 0 57 | [pc] -> 58 let (_, _, next_pcs, cost) = inst_infos mem pc in 59 cost + (block_costl mem costs next_pcs) 60 | pc1 :: pc2 :: _ -> 61 let cost1 = block_costl mem costs [pc1] in 62 let cost2 = block_costl mem costs [pc2] in 63 compare pc1 cost1 pc2 cost2 64 65 let block_cost mem costs pc = block_costl mem costs [pc] 89 66 90 67 91 68 let traverse_code mem p = 92 69 let rec aux pc code = 93 let inst,newpc,_ = ASMInterpret.fetch mem pc in 94 (* 95 (* <DEBUG> *) 96 Printf.printf "Traversing %s: %s\n%!" 97 (BitVectors.string_of_vect pc) (Pretty.pp_instruction inst) ; 98 (* </DEBUG> *) 99 *) 70 let (_, newpc, _, _) = inst_infos mem pc in 100 71 match code with 101 72 | [] -> CostLabel.Map.empty 102 73 | _::tl when BitVectors.WordMap.mem pc p.ASM.cost_labels -> 103 74 let lbl = BitVectors.WordMap.find pc p.ASM.cost_labels in 104 let cost = block_cost mem p.ASM.cost_labels pc in75 let cost = block_cost mem p.ASM.cost_labels newpc in 105 76 let costs_mapping = aux newpc tl in 106 77 CostLabel.Map.add lbl cost costs_mapping … … 115 86 (BitVectors.WordMap.find oldpc costs, 0) 116 87 else 117 let ( inst, pc, inst_cost) = ASMInterpret.fetchmem oldpc in118 match inst_nature oldpc instwith88 let (nature, pc, _, inst_cost) = inst_infos mem oldpc in 89 match nature with 119 90 | Direct_fun_call pc -> 120 91 let (lbl, cost) = aux pc in … … 142 113 143 114 let compute p = 144 (*145 (* <DEBUG> *)146 Printf.printf "%s\n\n%!" (Pretty.print_program p) ;147 (* </DEBUG> *)148 *)149 115 let mem = ASMInterpret.load_code_memory p.ASM.code in 150 116 let costs_mapping = traverse_code mem p in
Note: See TracChangeset
for help on using the changeset viewer.