diff options
| -rw-r--r-- | aarch64/Machregsaux.ml | 4 | ||||
| -rw-r--r-- | aarch64/Machregsaux.mli | 2 | ||||
| -rw-r--r-- | aarch64/PostpassSchedulingOracle.ml | 3 | ||||
| -rw-r--r-- | aarch64/PrepassSchedulingOracle.ml | 55 | ||||
| -rw-r--r-- | scheduling/InstructionScheduler.ml | 79 | ||||
| -rw-r--r-- | scheduling/InstructionScheduler.mli | 7 | ||||
| -rw-r--r-- | scheduling/RTLpathScheduleraux.ml | 26 | ||||
| -rw-r--r-- | test/nardino/scheduling/entry_regs.c | 5 | ||||
| -rw-r--r-- | test/nardino/scheduling/spille_backw.c (renamed from test/nardino/scheduling/spille_etrange.c) | 0 |
9 files changed, 165 insertions, 16 deletions
diff --git a/aarch64/Machregsaux.ml b/aarch64/Machregsaux.ml index 41db3bd4..15fb08ca 100644 --- a/aarch64/Machregsaux.ml +++ b/aarch64/Machregsaux.ml @@ -19,3 +19,7 @@ let class_of_type = function | AST.Tint | AST.Tlong -> 0 | AST.Tfloat | AST.Tsingle -> 1 | AST.Tany32 | AST.Tany64 -> assert false + +(* number of available registers per class *) +(* TODO: add this to all archs *) +let nr_regs = [| 29; 32 |] diff --git a/aarch64/Machregsaux.mli b/aarch64/Machregsaux.mli index 01b0f9fd..8487a557 100644 --- a/aarch64/Machregsaux.mli +++ b/aarch64/Machregsaux.mli @@ -15,3 +15,5 @@ val is_scratch_register: string -> bool val class_of_type: AST.typ -> int + +val nr_regs : int array diff --git a/aarch64/PostpassSchedulingOracle.ml b/aarch64/PostpassSchedulingOracle.ml index a9737088..834d42f5 100644 --- a/aarch64/PostpassSchedulingOracle.ml +++ b/aarch64/PostpassSchedulingOracle.ml @@ -507,7 +507,8 @@ let build_problem bb = { max_latency = -1; resource_bounds = opweights.pipelined_resource_bounds; - live_regs_entry = Registers.Regset.empty; (* PLACEHOLDER *) + live_regs_entry = Registers.Regset.empty; (* unused here *) + typing = (fun x -> AST.Tint); (* unused here *) instruction_usages = instruction_usages bb; latency_constraints = latency_constraints bb; } diff --git a/aarch64/PrepassSchedulingOracle.ml b/aarch64/PrepassSchedulingOracle.ml index a743fb68..6d445f10 100644 --- a/aarch64/PrepassSchedulingOracle.ml +++ b/aarch64/PrepassSchedulingOracle.ml @@ -201,6 +201,52 @@ let get_simple_dependencies (opweights : opweights) (seqa : (instruction*Regset. end seqa; !latency_constraints;; +let get_pressure_deltas (seqa : (instruction * Regset.t) array) + (typing : RTLtyping.regenv) + : int array array = + let nr_types_regs = Array.length Machregsaux.nr_regs in + let ret = Array.init (Array.length seqa) (fun i -> + Array.make nr_types_regs 0) in + Array.iteri (fun i (instr, liveins) -> match instr with + | Iop (_, args, dest, _) | Iload (_, _, _, args, dest, _) -> + ret.(i).(Machregsaux.class_of_type (typing dest)) <- + if List.mem dest args then 0 + else 1 + | Istore (_, _, _, src, _) -> + ret.(i).(Machregsaux.class_of_type (typing src)) <- + -1 + | Icall (_, fn, args, dest, _) -> + ret.(i).(Machregsaux.class_of_type (typing dest)) <- + if List.mem dest + (match fn with + | Datatypes.Coq_inl reg -> reg::args + | _ -> args) + then 0 else 1 + | Ibuiltin (_, args, dest, _) -> + let rec arg_l list = function + | AST.BA r -> r::list + | AST.BA_splitlong (hi, lo) | AST.BA_addptr (hi, lo) -> + arg_l (arg_l list lo) hi + | _ -> list + in + let l = (List.fold_left arg_l [] args) in + let rec dest_l = function + | AST.BR r -> + let t = Machregsaux.class_of_type (typing r) in + ret.(i).(t) <- + (if List.mem r l + then 0 else 1) + ret.(i).(t) + | AST.BR_splitlong (hi, lo) -> + dest_l hi; + dest_l lo + | _ -> () + in + dest_l dest + | _ -> () + ) seqa; + ret + + let resources_of_instruction (opweights : opweights) = function | Inop _ -> Array.map (fun _ -> 0) opweights.pipelined_resource_bounds | Iop(op, inputs, output, _) -> @@ -406,11 +452,13 @@ let get_alias_dependencies seqa = !deps;; *) -let define_problem (opweights : opweights) (live_entry_regs : Regset.t) seqa = +let define_problem (opweights : opweights) (live_entry_regs : Regset.t) + (typing : RTLtyping.regenv) seqa = let simple_deps = get_simple_dependencies opweights seqa in { max_latency = -1; resource_bounds = opweights.pipelined_resource_bounds; live_regs_entry = live_entry_regs; + typing = typing; instruction_usages = Array.map (resources_of_instruction opweights) (Array.map fst seqa); latency_constraints = (* if (use_alias_analysis ()) @@ -441,7 +489,8 @@ let prepass_scheduler_by_name name problem early_ones = | _ -> scheduler_by_name name problem let schedule_sequence (seqa : (instruction*Regset.t) array) - (live_regs_entry : Registers.Regset.t)= + (live_regs_entry : Registers.Regset.t) + (typing : RTLtyping.regenv) = let opweights = OpWeights.get_opweights () in try if (Array.length seqa) <= 1 @@ -451,7 +500,7 @@ let schedule_sequence (seqa : (instruction*Regset.t) array) let nr_instructions = Array.length seqa in (if !Clflags.option_debug_compcert > 6 then Printf.printf "prepass scheduling length = %d\n" (Array.length seqa)); - let problem = define_problem opweights live_regs_entry seqa in + let problem = define_problem opweights live_regs_entry typing seqa in (if !Clflags.option_debug_compcert > 7 then (print_sequence stdout (Array.map fst seqa); print_problem stdout problem)); diff --git a/scheduling/InstructionScheduler.ml b/scheduling/InstructionScheduler.ml index 976037bd..08164293 100644 --- a/scheduling/InstructionScheduler.ml +++ b/scheduling/InstructionScheduler.ml @@ -34,6 +34,7 @@ type problem = { max_latency : int; resource_bounds : int array; live_regs_entry : Registers.Regset.t; + typing : RTLtyping.regenv; instruction_usages : int array array; latency_constraints : latency_constraint list; };; @@ -258,8 +259,8 @@ let priority_list_scheduler (order : list_scheduler_order) assert(!time >= 0); !time with Exit -> -1 - in + let advance_time() = begin (if !current_time < max_time-1 @@ -268,7 +269,8 @@ let priority_list_scheduler (order : list_scheduler_order) Array.blit problem.resource_bounds 0 current_resources 0 (Array.length current_resources); ready.(!current_time + 1) <- - InstrSet.union (ready.(!current_time)) (ready.(!current_time + 1)); + InstrSet.union (ready.(!current_time)) + (ready.(!current_time + 1)); ready.(!current_time) <- InstrSet.empty; end); incr current_time @@ -335,6 +337,75 @@ let list_scheduler = priority_list_scheduler CRITICAL_PATH_ORDER;; (* dummy code for placating ocaml's warnings *) let _ = fun x -> priority_list_scheduler INSTRUCTION_ORDER x;; + +(* A scheduler sensitive to register pressure *) +let reg_pres_scheduler (problem : problem) : solution option = + let nr_instructions = get_nr_instructions problem in + let successors = get_successors problem + and predecessors = get_predecessors problem + and times = Array.make (nr_instructions+1) (-1) in + let live_regs_entry = problem.live_regs_entry in + + let available_regs = Array.copy Machregsaux.nr_regs in + + List.iter (fun r -> let classe = Machregsaux.class_of_type + (problem.typing r) in + available_regs.(classe) + <- available_regs.(classe) - 1) + (Registers.Regset.elements live_regs_entry); + + let nr_types_regs = Array.length available_regs in + + (* wait di we have access to instructions here? No, we have to add + al this to constraints *) + (* let pressures = + * Array.init (nr_instructions) (fun i -> + * Array.init (nr_types_regs) (fun t -> + * match i with + * | Inop -> 0 + * | Iop (_, args, dest, _) + * | Iload(_, _, _, args, dest, _) -> + * if + * )) *) + + let priorities = critical_paths successors in + + let module InstrSetCSP = + Set.Make (struct + type t=int + let compare x y = + match priorities.(y) - priorities.(x) with + | 0 -> x - y + | z -> z + end) in + + (* TODO: find a way to efficiently find an instruction which + decreases register pressure *) + (* idea: *) + (* let module InstrSetCSR = + * Set.Make (struct + * type t = int + * let compare x y = + * match pressures.(y) - pressures.(x) with + * | 0 -> (match priorities.(y) - priorities.(x) with + * | 0 -> x - y + * | z -> z) + * | z -> z + * end) in *) + (* where pressure.(x) is the delta of register pressure for + instruction x. Pb: different register types. Need to think about + it. Have one module for each register type, that's used when this + particular type reach a high pressure? *) + + let max_time = bound_max_time problem in + let ready = Array.make max_time InstrSetCSP.empty in + + (* silence warning, enable compilation while working *) + let _ = successors, predecessors, times, ready, nr_types_regs in + (* PLACEHOLDER *) + None + + type bundle = int list;; let rec extract_deps_to index = function @@ -440,6 +511,10 @@ let reverse_problem problem = max_latency = problem.max_latency; resource_bounds = problem.resource_bounds; live_regs_entry = Registers.Regset.empty; (* PLACEHOLDER *) + (* Not needed for the revlist sched, and for now we wont bother + with creating a reverse scheduler aware of reg press *) + + typing = problem.typing; instruction_usages = Array.init (nr_instructions + 1) (fun i -> if i=0 diff --git a/scheduling/InstructionScheduler.mli b/scheduling/InstructionScheduler.mli index f53dc0ef..8dcc4ef5 100644 --- a/scheduling/InstructionScheduler.mli +++ b/scheduling/InstructionScheduler.mli @@ -26,6 +26,9 @@ type problem = { live_regs_entry : Registers.Regset.t; (** The set of live pseudo-registers at entry. *) + typing : RTLtyping.regenv; + (** Register type map. *) + instruction_usages: int array array; (** At index {i i} the vector of resources used by instruction number {i i}. It must be the same length as [resource_bounds] *) @@ -71,6 +74,10 @@ 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 +(** WIP : Same as list_scheduler, but schedules instructions which decrease +register pressure when it gets too high. *) +val reg_pres_scheduler : problem -> solution option + (** Schedule the problem using the order of instructions without any reordering *) val greedy_scheduler : problem -> solution option diff --git a/scheduling/RTLpathScheduleraux.ml b/scheduling/RTLpathScheduleraux.ml index 72cf6682..e04e7c23 100644 --- a/scheduling/RTLpathScheduleraux.ml +++ b/scheduling/RTLpathScheduleraux.ml @@ -94,7 +94,7 @@ let get_live_regs_entry (sb : superblock) code = match ins with | Inop _ -> regset | Iop (_, args, dest, _) - | Iload (_, _, _, args, dest, _) -> + | Iload (_, _, _, args, dest, _) -> List.fold_left (fun set reg -> Registers.Regset.add reg set) (Registers.Regset.remove dest regset) args | Istore (_, _, args, src, _) -> @@ -114,13 +114,20 @@ let get_live_regs_entry (sb : superblock) code = | Datatypes.Coq_inr _ -> regset) args | Ibuiltin (_, args, dest, _) -> - List.fold_left (fun set reg -> - match reg with - | AST.BA r -> Registers.Regset.add r set - | _ -> set) - (match dest with - | AST.BR r -> Registers.Regset.remove r regset - | _ -> regset) + List.fold_left (fun set arg -> + let rec add reg set = + match reg with + | AST.BA r -> Registers.Regset.add r set + | AST.BA_splitlong (hi, lo) + | AST.BA_addptr (hi, lo) -> add hi (add lo set) + | _ -> set + in add arg set) + (let rec rem dest set = + match dest with + | AST.BR r -> Registers.Regset.remove r set + | AST.BR_splitlong (hi, lo) -> rem hi (rem lo set) + | _ -> set + in rem dest regset) args | Icond (_, args, _, _, _) -> List.fold_left (fun set reg -> @@ -166,7 +173,8 @@ let schedule_superblock sb code = | Some s -> s | None -> Regset.empty)) (Array.sub sb.instructions 0 (nr_instr-trailer_length))) - live_regs_entry with + live_regs_entry + sb.typing with | None -> sb.instructions | Some order -> let ins' = diff --git a/test/nardino/scheduling/entry_regs.c b/test/nardino/scheduling/entry_regs.c index 047a613d..9e6adacb 100644 --- a/test/nardino/scheduling/entry_regs.c +++ b/test/nardino/scheduling/entry_regs.c @@ -1,7 +1,10 @@ #include <stdio.h> int f(int n) { - return n; + if (n > 0) + return 42; + else + return n; } diff --git a/test/nardino/scheduling/spille_etrange.c b/test/nardino/scheduling/spille_backw.c index 1c36ee86..1c36ee86 100644 --- a/test/nardino/scheduling/spille_etrange.c +++ b/test/nardino/scheduling/spille_backw.c |