Merge branch 'dumb-scheduling' into mppa-work

3 files changed, 71 insertions, 4 deletions

diff --git a/mppa_k1c/InstructionScheduler.ml b/mppa_k1c/InstructionScheduler.ml
index dca4b8ff..f9f99b1f 100644
--- a/mppa_k1c/InstructionScheduler.ml
+++ b/mppa_k1c/InstructionScheduler.ml
@@ -307,10 +307,67 @@ let priority_list_scheduler (order : list_scheduler_order)
 
 let list_scheduler = priority_list_scheduler CRITICAL_PATH_ORDER;;
 
-(* FIXME DUMMY CODE to placate warnings
- *)
+(** FIXME - warning fix *)
 let _ = priority_list_scheduler INSTRUCTION_ORDER;;
 
+type bundle = int list;;
+
+let rec extract_deps_to index = function
+  | [] -> []
+  | dep :: deps -> let extracts = extract_deps_to index deps in
+      if (dep.instr_to == index) then 
+        dep :: extracts
+      else
+        extracts
+
+exception InvalidBundle;;
+
+let dependency_check problem bundle index =
+  let index_deps = extract_deps_to index problem.latency_constraints in
+  List.iter (fun i -> 
+    List.iter (fun dep ->
+      if (dep.instr_from == i) then raise InvalidBundle
+    ) index_deps
+  ) bundle;;
+
+let rec make_bundle problem resources bundle index =
+  let resources_copy = Array.copy resources in
+  let nr_instructions = get_nr_instructions problem in
+  if (index >= nr_instructions) then (bundle, index+1) else
+  let inst_usage = problem.instruction_usages.(index) in
+  try match vector_less_equal inst_usage resources with
+  | false -> raise InvalidBundle
+  | true -> (
+      dependency_check problem bundle index;
+      vector_subtract problem.instruction_usages.(index) resources_copy;
+      make_bundle problem resources_copy (index::bundle) (index+1)
+      )
+  with InvalidBundle -> (bundle, index);;
+
+let rec make_bundles problem index : bundle list =
+  if index >= get_nr_instructions problem then
+    []
+  else
+    let (bundle, new_index) = make_bundle problem problem.resource_bounds [] index in
+    bundle :: (make_bundles problem new_index);;
+
+let bundles_to_schedule problem bundles : solution =
+  let nr_instructions = get_nr_instructions problem in
+  let schedule = Array.make (nr_instructions+1) (nr_instructions+4) in
+  let time = ref 0 in
+  List.iter (fun bundle ->
+    begin
+    List.iter (fun i ->
+      schedule.(i) <- !time
+    ) bundle;
+    time := !time + 1
+    end
+  ) bundles; schedule;;
+
+let dumb_scheduler (problem : problem) : solution option =
+  let bundles = make_bundles problem 0 in
+  Some (bundles_to_schedule problem bundles);;
+
 (* alternate implementation
 let swap_array_elements a i j =
   let x = a.(i) in
diff --git a/mppa_k1c/InstructionScheduler.mli b/mppa_k1c/InstructionScheduler.mli
index 629664f9..701ccb25 100644
--- a/mppa_k1c/InstructionScheduler.mli
+++ b/mppa_k1c/InstructionScheduler.mli
@@ -62,6 +62,9 @@ Once a clock tick is full go to the next.
 @return [Some solution] when a solution is found, [None] if not. *)
 val list_scheduler : problem -> solution option
 
+(** Schedule the problem using the order of instructions without any reordering *)
+val dumb_scheduler : problem -> solution option
+
 (** Schedule a problem using a scheduler applied in the opposite direction, e.g. for list scheduling from the end instead of the start. BUGGY *)
 val schedule_reversed : scheduler -> problem -> int array option
 
diff --git a/mppa_k1c/PostpassSchedulingOracle.ml b/mppa_k1c/PostpassSchedulingOracle.ml
index f931b64b..b63dcb6c 100644
--- a/mppa_k1c/PostpassSchedulingOracle.ml
+++ b/mppa_k1c/PostpassSchedulingOracle.ml
@@ -767,10 +767,17 @@ let print_bb oc bb =
 
 let do_schedule bb =
   let problem = build_problem bb
-  in let solution = validated_scheduler
+  in let solution = (if !Clflags.option_fpostpass_sched = "ilp" then
+                      validated_scheduler cascaded_scheduler
+                    else if !Clflags.option_fpostpass_sched = "list" then
+                      validated_scheduler list_scheduler
+                    else if !Clflags.option_fpostpass_sched = "dumb" then
+                      dumb_scheduler else failwith ("Invalid scheduler:" ^ !Clflags.option_fpostpass_sched)) problem
+  (* in let solution = validated_scheduler
                       (if !Clflags.option_fpostpass_ilp
                        then cascaded_scheduler
-                       else list_scheduler) problem
+                       else dumb_scheduler) problem *)
+  (* in let solution = dumb_scheduler problem *)
   in match solution with
   | None -> failwith "Could not find a valid schedule"
   | Some sol -> let bundles = bundlize_solution bb sol in