Changeset 621

Timestamp:

Mar 2, 2011, 5:53:31 PM (9 years ago)

Author:

ayache

Message:

Bug fix in cost computation in D2.2.

File:

• Deliverables/D2.2/8051/src/ASM/ASMCosts.ml (modified) (2 diffs)

Deliverables/D2.2/8051/src/ASM/ASMCosts.ml

@@ -36 +36 @@
 
 
-(* TODO: do not consider the very first instruction as ending the block since it
-   contains the cost label whose cost we are trying to compute! *)
-let block_cost mem costs =
-  let rec aux oldpc =
-    if BitVectors.WordMap.mem oldpc costs then 0
-    else
-      let inst,pc,inst_cost = ASMInterpret.fetch mem oldpc in
-      let cost = match inst_nature oldpc inst with
-        | Return -> 0
-        | Goto pc -> aux pc
-        | Branch pc2 ->
-          let pc1 =
-            snd (BitVectors.half_add pc (BitVectors.vect_of_int 1 `Sixteen)) in
-          let cost1 = aux pc1 in
-          let cost2 = aux pc2 in
-          if cost1 <> cost2 then
-            warning
-              (Printf.sprintf
-                 "Warning: branching to %s has cost %d; continuing has cost %d.\n"
-                 "*fixme*"(*pc2*) cost2 cost1) ;
-        max cost1 cost2
-      | _ -> aux pc
-    in
-     cost + inst_cost
-  in
-  aux
+let treat mem costs pc =
+  let (inst, next_pc, inst_cost) = ASMInterpret.fetch mem pc in
+  let next_pcs = match inst_nature pc inst with
+    | Return -> []
+    | Goto pc -> [pc]
+    | Branch pc2 ->
+      let pc1 =
+        snd (BitVectors.half_add pc (BitVectors.vect_of_int 1 `Sixteen)) in
+      [pc1 ; pc2]
+    | _ -> [next_pc] in
+  (inst_cost, next_pcs)
+
+let compare pc1 cost1 pc2 cost2 =
+  if cost1 <> cost2 then
+    warning
+      (Printf.sprintf
+         "Warning: branching to %s has cost %d, branching to %s has cost %d"
+         "*fixme*"(* pc1 *) cost1 "*fixme*" (* pc2 *) cost2) ;
+  max cost1 cost2
+
+let block_cost mem costs pc =
+  let treat = treat mem costs in
+  let (init_cost, next_pcs) = treat pc in
+  let rec aux = function
+    | [] -> 0
+    | [pc] when BitVectors.WordMap.mem pc costs -> 0
+    | [pc] -> full_cost pc
+    | [pc1 ; pc2] when BitVectors.WordMap.mem pc1 costs &&
+                       BitVectors.WordMap.mem pc2 costs -> 0
+    | [pc1 ; pc2] when BitVectors.WordMap.mem pc1 costs ->
+      let cost2 = full_cost pc2 in
+      compare pc1 0 pc2 cost2
+    | [pc1 ; pc2] when BitVectors.WordMap.mem pc2 costs ->
+      let cost1 = full_cost pc1 in
+      compare pc1 cost1 pc2 0
+    | [pc1 ; pc2] ->
+      let cost1 = full_cost pc1 in
+      let cost2 = full_cost pc2 in
+      compare pc1 cost1 pc2 cost2
+    | _ -> assert false (* should be impossible: only 0, 1 or 2 following pcs *)
+  and full_cost pc =
+    let (cost, next_pcs) = treat pc in
+    cost + (aux next_pcs) in
+  init_cost + (aux next_pcs)
 
 
@@ -103 +121 @@
   let (lbl, cost) = first_cost_label mem costs in
   let old_cost =
-    assert (CostLabel.Map.mem lbl costs_mapping) ;
-    CostLabel.Map.find lbl costs_mapping in
+    if CostLabel.Map.mem lbl costs_mapping then
+      CostLabel.Map.find lbl costs_mapping
+    else 0 in
   let new_cost = old_cost + cost in
   CostLabel.Map.add lbl new_cost costs_mapping