Changeset 619 for Deliverables/D2.2/8051/src/ASM/ASMCosts.ml
 Timestamp:
 Mar 2, 2011, 3:27:41 PM (9 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D2.2/8051/src/ASM/ASMCosts.ml
r486 r619 1 1 2 2 let error_prefix = "ASMCosts" 3 let error s = Error.global_error error_prefix s 4 let warning s = Error.warning error_prefix s 3 let warning s = prerr_endline (error_prefix ^ s) 5 4 6 5 7 6 type instruction_nature = 8  Cost of CostLabel.t 9  Goto of Label.t  Branch of Label.t 10  Direct_fun_call of Label.t  Return 7  Goto of BitVectors.word  Branch of BitVectors.word 8  Direct_fun_call of BitVectors.word  Return 11 9  Other 12 10 13 let inst_nature = function 14  `Cost lbl > Cost lbl 15  `Call lbl > Direct_fun_call lbl 16  `Jmp lbl > Goto lbl 17  `WithLabel (`JC (`Label lbl)) 18  `WithLabel (`JNC (`Label lbl)) 19  `WithLabel (`JB (_, `Label lbl)) 20  `WithLabel (`JNB (_, `Label lbl)) 21  `WithLabel (`JBC (_, `Label lbl)) 22  `WithLabel (`JZ (`Label lbl)) 23  `WithLabel (`JNZ (`Label lbl)) 24  `WithLabel (`CJNE (_, `Label lbl)) 25  `WithLabel (`DJNZ (_, `Label lbl)) > Branch lbl 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) > 31 let `REL addr = addr in 32 let _, addr = BitVectors.half_add pc (BitVectors.sign_extension addr) in 33 Branch addr 26 34  `RET > Return 27 35  _ > Other 28 36 29 37 30 let pc_of_label p = 31 let f pc map = function 32  `Label lab > StringTools.Map.add lab pc map 33  _ > map 34 in 35 MiscPottier.foldi f StringTools.Map.empty p.ASM.code 36 37 38 let inst_cost = function 39  `Cost _  `Label _ > 0 40  _ > 1 41 42 43 let block_cost pc_of_label p = 44 let rec aux pc = 45 if pc >= List.length p.ASM.code then 0 38 (* TODO: do not consider the very first instruction as ending the block since it 39 contains the cost label whose cost we are trying to compute! *) 40 let block_cost mem costs = 41 let rec aux oldpc = 42 if BitVectors.WordMap.mem oldpc costs then 0 46 43 else 47 let inst = List.nth p.ASM.code pc in 48 let cost = match inst_nature inst with 49  Cost _  Return > 0 50  Goto lbl > 51 let pc = StringTools.Map.find lbl pc_of_label in 52 aux pc 53  Branch lbl > 54 let pc1 = pc + 1 in 55 let pc2 = StringTools.Map.find lbl pc_of_label in 56 let cost1 = aux pc1 in 57 let cost2 = aux pc2 in 58 let cost = max cost1 cost2 in 59 if cost1 <> cost2 then 60 warning 61 (Printf.sprintf 44 let inst,pc,inst_cost = ASMInterpret.fetch mem oldpc in 45 let cost = match inst_nature oldpc inst with 46  Return > 0 47  Goto pc > aux pc 48  Branch pc2 > 49 let pc1 = 50 snd (BitVectors.half_add pc (BitVectors.vect_of_int 1 `Sixteen)) in 51 let cost1 = aux pc1 in 52 let cost2 = aux pc2 in 53 if cost1 <> cost2 then 54 warning 55 (Printf.sprintf 62 56 "Warning: branching to %s has cost %d; continuing has cost %d.\n" 63 lblcost2 cost1) ;64 cost65  _ > aux (pc+1) 57 "*fixme*"(*pc2*) cost2 cost1) ; 58 max cost1 cost2 59  _ > aux pc 66 60 in 67 cost + inst_cost inst61 cost + inst_cost 68 62 in 69 63 aux 70 64 71 65 72 let rec init_function p pc = 73 let inst = List.nth p.ASM.code pc in 74 match inst_nature inst with 75  Cost lbl > (lbl, 0, pc+1) 76  _ > 77 let (lbl, cost, pc) = init_function p (pc+1) in 78 (lbl, cost + (inst_cost inst), pc) 66 let traverse_code mem p = 67 let rec aux pc code = 68 let _,newpc,_ = ASMInterpret.fetch mem pc in 69 match code with 70  [] > CostLabel.Map.empty 71  _::tl when BitVectors.WordMap.mem pc p.ASM.cost_labels > 72 let lbl = BitVectors.WordMap.find pc p.ASM.cost_labels in 73 let cost = block_cost mem p.ASM.cost_labels pc in 74 let costs_mapping = aux newpc tl in 75 CostLabel.Map.add lbl cost costs_mapping 76  _::tl > aux newpc tl 77 in 78 aux (BitVectors.zero `Sixteen) p.ASM.code 79 79 80 80 81 let traverse_code pc_of_label p = 82 let rec aux pc = 83 if pc >= List.length p.ASM.code then CostLabel.Map.empty 84 else 85 match inst_nature (List.nth p.ASM.code pc) with 86  Cost lbl > 87 let cost = block_cost pc_of_label p (pc+1) in 88 let costs_mapping = aux (pc+1) in 89 CostLabel.Map.add lbl cost costs_mapping 90  _ > aux (pc+1) 81 let first_cost_label mem costs = 82 let rec aux oldpc = 83 try (BitVectors.WordMap.find oldpc costs, 0) 84 with 85  Not_found > 86 let inst,pc,inst_cost = ASMInterpret.fetch mem oldpc in 87 match inst_nature oldpc inst with 88  Direct_fun_call pc > 89 let (lbl, cost) = aux pc in 90 (lbl, inst_cost + cost) 91  Return 92  Goto _ 93  Branch _ > 94 assert false (* no such instructions before calling main *) 95  Other > 96 let (lbl, cost) = aux pc in 97 (lbl, inst_cost + cost) 91 98 in 92 aux 099 aux (BitVectors.zero `Sixteen) 93 100 94 101 95 let first_cost_label pc_of_label p = 96 let rec aux pc = 97 if pc >= List.length p.ASM.code then assert false (* should not happen *) 98 else 99 match inst_nature (List.nth p.ASM.code pc) with 100  Cost lbl > lbl 101  Direct_fun_call lbl > aux (StringTools.Map.find lbl pc_of_label) 102  _ > aux (pc+1) 103 in 104 aux 0 105 106 let initialize_cost pc_of_label p costs_mapping = 107 let lbl = first_cost_label pc_of_label p in 102 let initialize_cost mem costs costs_mapping = 103 let (lbl, cost) = first_cost_label mem costs in 108 104 let old_cost = 109 if CostLabel.Map.mem lbl costs_mapping then 110 CostLabel.Map.find lbl costs_mapping 111 else 0 in 112 let init = 1 (* cost of the preamble *) in 113 let new_cost = old_cost + init in 105 assert (CostLabel.Map.mem lbl costs_mapping) ; 106 CostLabel.Map.find lbl costs_mapping in 107 let new_cost = old_cost + cost in 114 108 CostLabel.Map.add lbl new_cost costs_mapping 115 109 116 110 117 111 let compute p = 118 let pc_of_label = pc_of_label pin119 let costs_mapping = traverse_code pc_of_labelp in120 if p.ASM.has_main then initialize_cost pc_of_label pcosts_mapping112 let mem = ASMInterpret.load_code_memory p.ASM.code in 113 let costs_mapping = traverse_code mem p in 114 if p.ASM.has_main then initialize_cost mem p.ASM.cost_labels costs_mapping 121 115 else costs_mapping
Note: See TracChangeset
for help on using the changeset viewer.