diff options
| -rw-r--r-- | driver/Clflags.ml | 2 | ||||
| -rw-r--r-- | driver/Driver.ml | 9 | ||||
| -rw-r--r-- | mppa_k1c/InstructionScheduler.ml | 61 | ||||
| -rw-r--r-- | mppa_k1c/InstructionScheduler.mli | 3 | ||||
| -rw-r--r-- | mppa_k1c/PostpassSchedulingOracle.ml | 11 |
5 files changed, 79 insertions, 7 deletions
diff --git a/driver/Clflags.ml b/driver/Clflags.ml index 4d70d350..5b8ad443 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -28,7 +28,7 @@ let option_fconstprop = ref true let option_fcse = ref true let option_fredundancy = ref true let option_fpostpass = ref true -let option_fpostpass_ilp = ref false +let option_fpostpass_sched = ref "list" let option_falignfunctions = ref (None: int option) let option_falignbranchtargets = ref 0 let option_faligncondbranchs = ref 0 diff --git a/driver/Driver.ml b/driver/Driver.ml index c68c066a..2672ed99 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -194,7 +194,8 @@ Processing options: -fcse Perform common subexpression elimination [on] -fredundancy Perform redundancy elimination [on] -fpostpass Perform postpass scheduling (only for K1 architecture) [on] - -fpostpass-ilp Use integer linear programming for postpass scheduling [off] + -fpostpass= <optim> Perform postpass scheduling with the specified optimization [list] + (<optim>=list: list scheduling, <optim>=ilp: ILP, <optim>=dumb: just packing bundles) -finline Perform inlining of functions [on] -finline-functions-called-once Integrate functions only required by their single caller [on] @@ -264,6 +265,10 @@ let num_input_files = ref 0 let cmdline_actions = let f_opt name ref = [Exact("-f" ^ name), Set ref; Exact("-fno-" ^ name), Unset ref] in + let f_opt_str name ref strref = + [Exact("-f" ^ name ^ "="), String + (fun s -> (strref := (if s == "" then "list" else s)); ref := true) + ] in [ (* Getting help *) Exact "-help", Unit print_usage_and_exit; @@ -364,7 +369,7 @@ let cmdline_actions = @ f_opt "cse" option_fcse @ f_opt "redundancy" option_fredundancy @ f_opt "postpass" option_fpostpass - @ f_opt "postpass-ilp" option_fpostpass_ilp + @ f_opt_str "postpass" option_fpostpass option_fpostpass_sched @ f_opt "inline" option_finline @ f_opt "inline-functions-called-once" option_finline_functions_called_once (* Code generation options *) 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 |