begin computing OpWeights

2 files changed, 91 insertions, 0 deletions

diff --git a/kvx/OpWeights.ml b/kvx/OpWeights.ml
new file mode 100644
index 00000000..8396bde1
--- /dev/null
+++ b/kvx/OpWeights.ml
@@ -0,0 +1,73 @@
+open Op;;
+open PostpassSchedulingOracle;;
+let resource_bounds = PostpassSchedulingOracle.resource_bounds;;
+
+
+let rec nlist_rec x l = function
+  | 0 -> l
+  | n when n > 0 -> nlist_rec x (x :: l) (n-1)
+  | _ -> failwith "nlist_rec";;
+let nlist x n = nlist_rec x [] n;;
+
+let bogus_register = Machregs.R0;;
+let bogus_inputs n = nlist bogus_register n;;
+
+let insns_of_op (op : operation) (nargs : int) =
+  match Asmblockgen.transl_op op
+          (bogus_inputs nargs) bogus_register [] with
+  | Errors.Error msg -> failwith "OpWeights.insns_of_op"
+  | Errors.OK insns -> insns;;
+
+let insn_of_op op nargs =
+  match insns_of_op op nargs with
+  | [] -> failwith "OpWeights.insn_of_op"
+  | h::_ -> h;;
+
+let insns_of_load trap chunk addressing (nargs : int) =
+  match Asmblockgen.transl_load trap chunk addressing
+          (bogus_inputs nargs) bogus_register [] with
+  | Errors.Error msg -> failwith "OpWeights.insns_of_load"
+  | Errors.OK insns -> insns;;
+
+let insn_of_load trap chunk addressing nargs =
+  match insns_of_load trap chunk addressing nargs with
+  | [] -> failwith "OpWeights.insn_of_load"
+  | h::_ -> h;;
+
+let insns_of_store chunk addressing (nargs : int) =
+  match Asmblockgen.transl_store chunk addressing
+          (bogus_inputs nargs) bogus_register [] with
+  | Errors.Error msg -> failwith "OpWeights.insns_of_store"
+  | Errors.OK insns -> insns;;
+
+let insn_of_store chunk addressing nargs =
+  match insns_of_store chunk addressing nargs with
+  | [] -> failwith "OpWeights.insn_of_store"
+  | h::_ -> h;;
+
+let latency_of_op (op : operation) (nargs : int) =
+  let insn = insn_of_op op nargs in
+  let record = basic_rec insn in
+  let latency = real_inst_to_latency record.inst in
+  latency;;
+
+let resources_of_op (op : operation) (nargs : int) =
+  let insn = insn_of_op op nargs in
+  let record = basic_rec insn in
+  rec_to_usage record;;
+
+let latency_of_load trap chunk (addr : addressing) (nargs : int) = 3;;
+let latency_of_call _ _ = 6;;
+
+let resources_of_load trap chunk addressing nargs =
+  let insn = insn_of_load trap chunk addressing nargs in
+  let record = basic_rec insn in
+  rec_to_usage record;;
+
+let resources_of_store chunk addressing nargs =
+  let insn = insn_of_store chunk addressing nargs in
+  let record = basic_rec insn in
+  rec_to_usage record;;
+
+let resources_of_call _ _ = resource_bounds;;
+let resources_of_builtin _ = resource_bounds;;
diff --git a/kvx/lib/RTLpathScheduleraux.ml b/kvx/lib/RTLpathScheduleraux.ml
index 1a13da67..87d03fed 100644
--- a/kvx/lib/RTLpathScheduleraux.ml
+++ b/kvx/lib/RTLpathScheduleraux.ml
@@ -94,7 +94,25 @@ let get_superblocks code entry pm =
 end
 
 (* TODO David *)
+let compute_latency (insn : RTL.instruction) =
+  match insn with
+  | Inop(successor) -> 0
+  | Iop(op, args, dst, successor) -> OpWeights.latency_of_op op (List.length args)
+  | Iload(trap, chunk, addr, args, dst, successor) -> OpWeights.latency_of_load trap chunk addr (List.length args)
+  | Istore(chunk, addr, args, src, successor) -> 0
+  | Icond(cond, args, ifso, ifnot, suggestion) -> 0
+                                                
+  | Ijumptable(arg, targets) -> 0
+  | Itailcall(sign, ros, args) -> 0
+  | Icall(sign, ros, args, dst, successor) -> 0
+  | Ibuiltin(ef, args, res, successor) -> 0
+  | Ireturn(arg) -> 0;;
+                           
 let schedule_superblock sb code =
+  let old_flag = !debug_flag in
+  debug_flag := true;
+  print_superblock sb code;
+  debug_flag := old_flag;
   (* stub2: reverse function *)
   (*
   let reversed = Array.of_list @@ List.rev @@ Array.to_list (sb.instructions) in