diff options
author | nicolas.nardino <nicolas.nardino@ens-lyon.fr> | 2021-06-14 17:39:58 +0200 |
---|---|---|
committer | nicolas.nardino <nicolas.nardino@ens-lyon.fr> | 2021-06-14 17:39:58 +0200 |
commit | bff4e6ff0b782619b6fcc18751fa575cbb11de68 (patch) | |
tree | 76d6f4ee4ed6711e4a548b6cd62e881cf0bbbbff /scheduling | |
parent | 3eb3751f84348a20b7ce211fdbf1d01a9c4685a8 (diff) | |
download | compcert-kvx-bff4e6ff0b782619b6fcc18751fa575cbb11de68.tar.gz compcert-kvx-bff4e6ff0b782619b6fcc18751fa575cbb11de68.zip |
was very wrong, fixing
Diffstat (limited to 'scheduling')
-rw-r--r-- | scheduling/InstructionScheduler.ml | 7 | ||||
-rw-r--r-- | scheduling/InstructionScheduler.mli | 6 | ||||
-rw-r--r-- | scheduling/RTLpathScheduleraux.ml | 74 |
3 files changed, 72 insertions, 15 deletions
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' = |