Ignore:
Timestamp:
Mar 2, 2011, 3:27:41 PM (9 years ago)
Author:
ayache
Message:

Update of D2.2 from Paris.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/ASM/ASMCosts.ml

    r486 r619  
    11
    22let error_prefix = "ASMCosts"
    3 let error s = Error.global_error error_prefix s
    4 let warning s = Error.warning error_prefix s
     3let warning s = prerr_endline (error_prefix ^ s)
    54
    65
    76type 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
    119  | Other
    1210
    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
     11let 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
    2634  | `RET -> Return
    2735  | _ -> Other
    2836
    2937
    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! *)
     40let block_cost mem costs =
     41  let rec aux oldpc =
     42    if BitVectors.WordMap.mem oldpc costs then 0
    4643    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
    6256                 "Warning: branching to %s has cost %d; continuing has cost %d.\n"
    63               lbl cost2 cost1) ;
    64           cost
    65         | _ -> aux (pc+1)
     57                 "*fixme*"(*pc2*) cost2 cost1) ;
     58        max cost1 cost2
     59      | _ -> aux pc
    6660    in
    67     cost + inst_cost inst
     61     cost + inst_cost
    6862  in
    6963  aux
    7064
    7165
    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)
     66let 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
    7979
    8080
    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)
     81let 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)
    9198  in
    92   aux 0
     99  aux (BitVectors.zero `Sixteen)
    93100
    94101
    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
     102let initialize_cost mem costs costs_mapping =
     103  let (lbl, cost) = first_cost_label mem costs in
    108104  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
    114108  CostLabel.Map.add lbl new_cost costs_mapping
    115109
    116110
    117111let compute p =
    118   let pc_of_label = pc_of_label p in
    119   let costs_mapping = traverse_code pc_of_label p in
    120   if p.ASM.has_main then initialize_cost pc_of_label p costs_mapping
     112  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
    121115  else costs_mapping
Note: See TracChangeset for help on using the changeset viewer.