From bff4e6ff0b782619b6fcc18751fa575cbb11de68 Mon Sep 17 00:00:00 2001 From: "nicolas.nardino" Date: Mon, 14 Jun 2021 17:39:58 +0200 Subject: was very wrong, fixing --- aarch64/PostpassSchedulingOracle.ml | 2 +- aarch64/PrepassSchedulingOracle.ml | 11 ++++-- scheduling/InstructionScheduler.ml | 7 ++-- scheduling/InstructionScheduler.mli | 6 +-- scheduling/RTLpathScheduleraux.ml | 74 ++++++++++++++++++++++++++++++++----- 5 files changed, 80 insertions(+), 20 deletions(-) diff --git a/aarch64/PostpassSchedulingOracle.ml b/aarch64/PostpassSchedulingOracle.ml index 867341ca..6f784238 100644 --- a/aarch64/PostpassSchedulingOracle.ml +++ b/aarch64/PostpassSchedulingOracle.ml @@ -509,7 +509,7 @@ let build_problem bb = resource_bounds = opweights.pipelined_resource_bounds; live_regs_entry = Registers.Regset.empty; (* unused here *) typing = (fun x -> AST.Tint); (* unused here *) - pressure_deltas = [| [| |] |] ; + reference_counting = None; instruction_usages = instruction_usages bb; latency_constraints = latency_constraints bb; } diff --git a/aarch64/PrepassSchedulingOracle.ml b/aarch64/PrepassSchedulingOracle.ml index 19f05749..fe757c99 100644 --- a/aarch64/PrepassSchedulingOracle.ml +++ b/aarch64/PrepassSchedulingOracle.ml @@ -202,6 +202,7 @@ let get_simple_dependencies (opweights : opweights) (seqa : (instruction*Regset. !latency_constraints;; +(** useless *) let get_pressure_deltas (seqa : (instruction * Regset.t) array) (typing : RTLtyping.regenv) : int array array = @@ -454,13 +455,13 @@ let get_alias_dependencies seqa = *) let define_problem (opweights : opweights) (live_entry_regs : Regset.t) - (typing : RTLtyping.regenv) seqa = + (typing : RTLtyping.regenv) reference_counting 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; - pressure_deltas = get_pressure_deltas seqa typing; + reference_counting = Some reference_counting; instruction_usages = Array.map (resources_of_instruction opweights) (Array.map fst seqa); latency_constraints = (* if (use_alias_analysis ()) @@ -492,7 +493,8 @@ let prepass_scheduler_by_name name problem early_ones = let schedule_sequence (seqa : (instruction*Regset.t) array) (live_regs_entry : Registers.Regset.t) - (typing : RTLtyping.regenv) = + (typing : RTLtyping.regenv) + reference = let opweights = OpWeights.get_opweights () in try if (Array.length seqa) <= 1 @@ -502,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 live_regs_entry typing 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)); diff --git a/scheduling/InstructionScheduler.ml b/scheduling/InstructionScheduler.ml index a069de59..08349f60 100644 --- a/scheduling/InstructionScheduler.ml +++ b/scheduling/InstructionScheduler.ml @@ -35,7 +35,8 @@ type problem = { resource_bounds : int array; live_regs_entry : Registers.Regset.t; typing : RTLtyping.regenv; - pressure_deltas : int array array; + reference_counting : ((Registers.reg, int * int) Hashtbl.t + * (Registers.reg list array)) option; instruction_usages : int array array; latency_constraints : latency_constraint list; };; @@ -370,7 +371,7 @@ let reg_pres_scheduler (problem : problem) : solution option = (Registers.Regset.elements live_regs_entry); - let pressures = problem.pressure_deltas in + let pressures = [| [| |] |] in let priorities = critical_paths successors in @@ -629,7 +630,7 @@ let reverse_problem problem = with creating a reverse scheduler aware of reg press *) typing = problem.typing; - pressure_deltas = [| [| |] |] ; + reference_counting = problem.reference_counting; instruction_usages = Array.init (nr_instructions + 1) (fun i -> if i=0 diff --git a/scheduling/InstructionScheduler.mli b/scheduling/InstructionScheduler.mli index e7f9e7db..9b6f7a3c 100644 --- a/scheduling/InstructionScheduler.mli +++ b/scheduling/InstructionScheduler.mli @@ -29,9 +29,9 @@ type problem = { typing : RTLtyping.regenv; (** Register type map. *) - pressure_deltas : int array array; - (** At index (i, j), the pressure delta for instruction i, for - register class j. *) + reference_counting : ((Registers.reg, int * int) Hashtbl.t + * (Registers.reg list array)) option; + (** See RTLpathScheduleraux.reference_counting. *) 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] *) diff --git a/scheduling/RTLpathScheduleraux.ml b/scheduling/RTLpathScheduleraux.ml index e04e7c23..02e0c769 100644 --- a/scheduling/RTLpathScheduleraux.ml +++ b/scheduling/RTLpathScheduleraux.ml @@ -72,7 +72,60 @@ let get_superblocks code entry pm typing = lsb end +(** the useful one. Returns a hashtable with bindings of form + ** [(r,(t, n)], where [r] is a pseudo-register (Registers.reg), + ** [t] is its class (according to [typing]), and [n] the number of + ** times it's referenced as an argument in instructions of [seqa] ; + ** and an arrray containg the argument regset of each instruction *) +let reference_counting (seqa : (instruction * Regset.t) array) + (out_regs : Registers.Regset.t) (typing : RTLtyping.regenv) : + (Registers.reg, int * int) Hashtbl.t * Registers.reg list array = + let retl = Hashtbl.create 42 in + let retr = Array.make (Array.length seqa) [] in + List.iter (fun reg -> + Hashtbl.add retl + reg (Machregsaux.class_of_type (typing reg), 1) + ) (Registers.Regset.elements out_regs); + let add_reg reg = + match Hashtbl.find_opt retl reg with + | Some (t, n) -> Hashtbl.add retl reg (t, n+1) + | None -> Hashtbl.add retl reg (Machregsaux.class_of_type + (typing reg), 1) + in + Array.iteri (fun i (ins, _) -> + match ins with + | Iop(_,args,_,_) | Iload(_,_,_,args,_,_) + | Icond(_,args,_,_,_) -> + List.iter (add_reg) args; + retr.(i) <- args + | Istore(_,_,args,src,_) -> + List.iter (add_reg) args; + add_reg src; + retr.(i) <- src::args + | Icall(_,fn,args,_,_) | Itailcall(_,fn,args) -> + List.iter (add_reg) args; + retr.(i) <- (match fn with + | Datatypes.Coq_inl reg -> + add_reg reg; + reg::args + | _ -> args) + | Ibuiltin(_,args,_,_) -> + let rec bar = function + | AST.BA r -> add_reg r; + retr.(i) <- r::retr.(i) + | AST.BA_splitlong (hi, lo) | AST.BA_addptr (hi, lo) -> + bar hi; bar lo + | _ -> () + in + List.iter (bar) args + | Ijumptable (reg,_) | Ireturn (Some reg) -> + add_reg reg; + retr.(i) <- [reg] + | _ -> () + ) seqa; + retl, retr + let get_live_regs_entry (sb : superblock) code = (if !Clflags.option_debug_compcert > 6 then debug_flag := true); @@ -164,17 +217,20 @@ let schedule_superblock sb code = | None -> 1 in debug "hello\n"; let live_regs_entry = get_live_regs_entry sb code in + let seqa = + Array.map (fun i -> + (match PTree.get i code with + | Some ii -> ii + | None -> failwith "RTLpathScheduleraux.schedule_superblock"), + (match PTree.get i sb.liveins with + | Some s -> s + | None -> Regset.empty)) + (Array.sub sb.instructions 0 (nr_instr-trailer_length)) in match PrepassSchedulingOracle.schedule_sequence - (Array.map (fun i -> - (match PTree.get i code with - | Some ii -> ii - | None -> failwith "RTLpathScheduleraux.schedule_superblock"), - (match PTree.get i sb.liveins with - | Some s -> s - | None -> Regset.empty)) - (Array.sub sb.instructions 0 (nr_instr-trailer_length))) + seqa live_regs_entry - sb.typing with + sb.typing + (reference_counting seqa sb.s_output_regs sb.typing) with | None -> sb.instructions | Some order -> let ins' = -- cgit