diff options
Diffstat (limited to 'scheduling/RTLpathScheduleraux.ml')
-rw-r--r-- | scheduling/RTLpathScheduleraux.ml | 74 |
1 files changed, 65 insertions, 9 deletions
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' = |