diff options
Diffstat (limited to 'aarch64')
| -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 | 64 |
4 files changed, 69 insertions, 4 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 cde3e7a7..6f784238 100644 --- a/aarch64/PostpassSchedulingOracle.ml +++ b/aarch64/PostpassSchedulingOracle.ml @@ -507,6 +507,9 @@ let build_problem bb = { max_latency = -1; resource_bounds = opweights.pipelined_resource_bounds; + live_regs_entry = Registers.Regset.empty; (* unused here *) + typing = (fun x -> AST.Tint); (* unused here *) + reference_counting = None; instruction_usages = instruction_usages bb; latency_constraints = latency_constraints bb; } diff --git a/aarch64/PrepassSchedulingOracle.ml b/aarch64/PrepassSchedulingOracle.ml index 2c3eb14f..fe757c99 100644 --- a/aarch64/PrepassSchedulingOracle.ml +++ b/aarch64/PrepassSchedulingOracle.ml @@ -201,6 +201,54 @@ let get_simple_dependencies (opweights : opweights) (seqa : (instruction*Regset. end seqa; !latency_constraints;; + +(** useless *) +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 +454,15 @@ let get_alias_dependencies seqa = !deps;; *) -let define_problem (opweights : opweights) seqa = +let define_problem (opweights : opweights) (live_entry_regs : Regset.t) + (typing : RTLtyping.regenv) reference_counting seqa = let simple_deps = get_simple_dependencies opweights seqa in { max_latency = -1; resource_bounds = opweights.pipelined_resource_bounds; - instruction_usages = Array.map (resources_of_instruction opweights) (Array.map fst seqa); + live_regs_entry = live_entry_regs; + typing = typing; + reference_counting = Some reference_counting; + instruction_usages = Array.map (resources_of_instruction opweights) (Array.map fst seqa); latency_constraints = (* if (use_alias_analysis ()) then (get_alias_dependencies seqa) @ simple_deps @@ -439,7 +491,10 @@ let prepass_scheduler_by_name name problem early_ones = | "zigzag" -> zigzag_scheduler problem early_ones | _ -> scheduler_by_name name problem -let schedule_sequence (seqa : (instruction*Regset.t) array) = +let schedule_sequence (seqa : (instruction*Regset.t) array) + (live_regs_entry : Registers.Regset.t) + (typing : RTLtyping.regenv) + reference = let opweights = OpWeights.get_opweights () in try if (Array.length seqa) <= 1 @@ -449,7 +504,8 @@ 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 seqa in + let problem = define_problem opweights live_regs_entry + typing reference seqa in (if !Clflags.option_debug_compcert > 7 then (print_sequence stdout (Array.map fst seqa); print_problem stdout problem)); |