From a6006df63f0d03cc223d13834e81a71651513fbe Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Mon, 24 May 2021 17:39:44 +0200 Subject: a draft frontend for prepass --- scheduling/BTLScheduleraux.ml | 221 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) create mode 100644 scheduling/BTLScheduleraux.ml (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml new file mode 100644 index 00000000..699538ca --- /dev/null +++ b/scheduling/BTLScheduleraux.ml @@ -0,0 +1,221 @@ +open AST +open Maps +open Registers +open BTL +open DebugPrint +open RTLcommonaux +open InstructionScheduler +open PrepassSchedulingOracleDeps + +let use_alias_analysis () = false + +let build_constraints_and_resources (opweights : opweights) insts btl = + let last_reg_reads : int list PTree.t ref = ref PTree.empty + and last_reg_write : (int * int) PTree.t ref = ref PTree.empty + and last_mem_reads : int list ref = ref [] + and last_mem_write : int option ref = ref None + and last_branch : int option ref = ref None + and last_non_pipelined_op : int array = + Array.make opweights.nr_non_pipelined_units (-1) + and latency_constraints : latency_constraint list ref = ref [] + and resources = ref [] in + let add_constraint instr_from instr_to latency = + assert (instr_from <= instr_to); + assert (latency >= 0); + if instr_from = instr_to then + if latency = 0 then () + else + failwith "PrepassSchedulingOracle.get_dependencies: negative self-loop" + else + latency_constraints := + { instr_from; instr_to; latency } :: !latency_constraints + and get_last_reads reg = + match PTree.get reg !last_reg_reads with Some l -> l | None -> [] + in + let add_input_mem i = + if not (use_alias_analysis ()) then ( + (* Read after write *) + (match !last_mem_write with None -> () | Some j -> add_constraint j i 1); + last_mem_reads := i :: !last_mem_reads) + and add_output_mem i = + if not (use_alias_analysis ()) then ( + (* Write after write *) + (match !last_mem_write with None -> () | Some j -> add_constraint j i 1); + (* Write after read *) + List.iter (fun j -> add_constraint j i 0) !last_mem_reads; + last_mem_write := Some i; + last_mem_reads := []) + and add_input_reg i reg = + (* Read after write *) + (match PTree.get reg !last_reg_write with + | None -> () + | Some (j, latency) -> add_constraint j i latency); + last_reg_reads := PTree.set reg (i :: get_last_reads reg) !last_reg_reads + and add_output_reg i latency reg = + (* Write after write *) + (match PTree.get reg !last_reg_write with + | None -> () + | Some (j, _) -> add_constraint j i 1); + (* Write after read *) + List.iter (fun j -> add_constraint j i 0) (get_last_reads reg); + last_reg_write := PTree.set reg (i, latency) !last_reg_write; + last_reg_reads := PTree.remove reg !last_reg_reads + in + let add_input_regs i regs = List.iter (add_input_reg i) regs + and irreversible_action i = + match !last_branch with None -> () | Some j -> add_constraint j i 1 + in + let set_branch i = + irreversible_action i; + last_branch := Some i + and add_non_pipelined_resources i resources = + Array.iter2 + (fun latency last -> + if latency >= 0 && last >= 0 then add_constraint last i latency) + resources last_non_pipelined_op; + Array.iteri + (fun rsc latency -> if latency >= 0 then last_non_pipelined_op.(rsc) <- i) + resources + in + Array.iteri + (fun i inst -> + (* TODO gourdinl liveins for Bcond *) + match inst with + | Bnop _ -> + let rs = Array.map (fun _ -> 0) opweights.pipelined_resource_bounds in + resources := rs :: !resources + | Bop (op, lr, rd, _) -> + add_non_pipelined_resources i + (opweights.non_pipelined_resources_of_op op (List.length lr)); + if Op.is_trapping_op op then irreversible_action i; + add_input_regs i lr; + add_output_reg i (opweights.latency_of_op op (List.length lr)) rd; + let rs = opweights.resources_of_op op (List.length lr) in + resources := rs :: !resources + | Bload (trap, chk, addr, lr, rd, _) -> + if trap = TRAP then irreversible_action i; + add_input_mem i; + add_input_regs i lr; + add_output_reg i + (opweights.latency_of_load trap chk addr (List.length lr)) + rd; + let rs = opweights.resources_of_load trap chk addr (List.length lr) in + resources := rs :: !resources + | Bstore (chk, addr, lr, src, _) -> + irreversible_action i; + add_input_regs i lr; + add_input_reg i src; + add_output_mem i; + let rs = opweights.resources_of_store chk addr (List.length lr) in + resources := rs :: !resources + | Bcond (cond, lr, BF (Bgoto s, _), Bnop _, _) -> + (* TODO gourdinl test with/out this line *) + let live = (get_some @@ PTree.get s btl).input_regs in + add_input_regs i (Regset.elements live); + set_branch i; + add_input_mem i; + add_input_regs i lr; + let rs = opweights.resources_of_cond cond (List.length lr) in + resources := rs :: !resources + | Bcond (_, _, _, _, _) -> + failwith "get_simple_dependencies: invalid Bcond" + | BF (_, _) -> failwith "get_simple_dependencies: BF" + | Bseq (_, _) -> failwith "get_simple_dependencies: Bseq") + insts; + (!latency_constraints, Array.of_list (List.rev !resources)) + +let define_problem (opweights : opweights) ibf btl = + let simple_deps, resources = + build_constraints_and_resources opweights ibf btl + in + { + max_latency = -1; + resource_bounds = opweights.pipelined_resource_bounds; + instruction_usages = resources; + latency_constraints = + (* if (use_alias_analysis ()) + then (get_alias_dependencies seqa) @ simple_deps + else *) + simple_deps; + } + +let zigzag_scheduler problem early_ones = + let nr_instructions = get_nr_instructions problem in + assert (nr_instructions = Array.length early_ones); + match list_scheduler problem with + | Some fwd_schedule -> + let fwd_makespan = fwd_schedule.(Array.length fwd_schedule - 1) in + let constraints' = ref problem.latency_constraints in + Array.iteri + (fun i is_early -> + if is_early then + constraints' := + { + instr_from = i; + instr_to = nr_instructions; + latency = fwd_makespan - fwd_schedule.(i); + } + :: !constraints') + early_ones; + validated_scheduler reverse_list_scheduler + { problem with latency_constraints = !constraints' } + | None -> None + +let prepass_scheduler_by_name name problem early_ones = + match name with + | "zigzag" -> zigzag_scheduler problem early_ones + | _ -> scheduler_by_name name problem + +let schedule_sequence insts btl = + let opweights = OpWeights.get_opweights () in + try + if Array.length insts <= 1 then None + else + let nr_instructions = Array.length insts in + let problem = define_problem opweights insts btl in + match + prepass_scheduler_by_name + !Clflags.option_fprepass_sched + problem + (Array.map + (fun inst -> + match inst with Bcond (_, _, _, _, _) -> true | _ -> false) + insts) + with + | None -> + Printf.printf "no solution in prepass scheduling\n"; + None + | Some solution -> + let positions = Array.init nr_instructions (fun i -> i) in + Array.sort + (fun i j -> + let si = solution.(i) and sj = solution.(j) in + if si < sj then -1 else if si > sj then 1 else i - j) + positions; + Some positions + with Failure s -> + Printf.printf "failure in prepass scheduling: %s\n" s; + None + +let flatten_blk_basics ibf = + let ib = ibf.entry in + let rec traverse_blk ib = + match ib with + | BF (_, _) + | Bcond (_, _, BF (Bgoto _, _), BF (Bgoto _, _), _) -> [] + | Bseq (ib1, ib2) -> + traverse_blk ib1 @ traverse_blk ib2 + | _ -> [ib] + in + Array.of_list (traverse_blk ib) + +let btl_scheduler btl entry = + List.iter (fun (n,ibf) -> + let bseq = flatten_blk_basics ibf in + match schedule_sequence bseq btl with + | Some positions -> + Array.iter (fun p -> debug "%d " p) positions + | None -> () + ) (PTree.elements btl); + (*let seqs = get_sequences seqs in*) + () -- cgit From 1a78c940f46273b7146d2111b1e2da309434f021 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Thu, 27 May 2021 16:55:18 +0200 Subject: [disabled checker] BTL Scheduling and Renumbering OK! --- scheduling/BTLScheduleraux.ml | 94 ++++++++++++++++++++++++++++--------------- 1 file changed, 62 insertions(+), 32 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index 699538ca..4b5ebb32 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -2,6 +2,7 @@ open AST open Maps open Registers open BTL +open BTLtypes open DebugPrint open RTLcommonaux open InstructionScheduler @@ -108,7 +109,7 @@ let build_constraints_and_resources (opweights : opweights) insts btl = add_output_mem i; let rs = opweights.resources_of_store chk addr (List.length lr) in resources := rs :: !resources - | Bcond (cond, lr, BF (Bgoto s, _), Bnop _, _) -> + | Bcond (cond, lr, BF (Bgoto s, _), ibnot, _) -> (* TODO gourdinl test with/out this line *) let live = (get_some @@ PTree.get s btl).input_regs in add_input_regs i (Regset.elements live); @@ -132,11 +133,7 @@ let define_problem (opweights : opweights) ibf btl = max_latency = -1; resource_bounds = opweights.pipelined_resource_bounds; instruction_usages = resources; - latency_constraints = - (* if (use_alias_analysis ()) - then (get_alias_dependencies seqa) @ simple_deps - else *) - simple_deps; + latency_constraints = simple_deps; } let zigzag_scheduler problem early_ones = @@ -161,9 +158,16 @@ let zigzag_scheduler problem early_ones = { problem with latency_constraints = !constraints' } | None -> None -let prepass_scheduler_by_name name problem early_ones = +let prepass_scheduler_by_name name problem insts = match name with - | "zigzag" -> zigzag_scheduler problem early_ones + | "zigzag" -> + let early_ones = + Array.map + (fun inst -> + match inst with Bcond (_, _, _, _, _) -> true | _ -> false) + insts + in + zigzag_scheduler problem early_ones | _ -> scheduler_by_name name problem let schedule_sequence insts btl = @@ -174,13 +178,7 @@ let schedule_sequence insts btl = let nr_instructions = Array.length insts in let problem = define_problem opweights insts btl in match - prepass_scheduler_by_name - !Clflags.option_fprepass_sched - problem - (Array.map - (fun inst -> - match inst with Bcond (_, _, _, _, _) -> true | _ -> false) - insts) + prepass_scheduler_by_name !Clflags.option_fprepass_sched problem insts with | None -> Printf.printf "no solution in prepass scheduling\n"; @@ -199,23 +197,55 @@ let schedule_sequence insts btl = let flatten_blk_basics ibf = let ib = ibf.entry in + let last = ref None in let rec traverse_blk ib = match ib with - | BF (_, _) - | Bcond (_, _, BF (Bgoto _, _), BF (Bgoto _, _), _) -> [] - | Bseq (ib1, ib2) -> - traverse_blk ib1 @ traverse_blk ib2 - | _ -> [ib] - in - Array.of_list (traverse_blk ib) + | BF (_, _) -> + last := Some ib; + [] + | Bseq (ib1, ib2) -> traverse_blk ib1 @ traverse_blk ib2 + | Bcond (_, _, _, _, iinfo) -> ( + match iinfo.pcond with + | Some _ -> [ ib ] + | None -> + last := Some ib; + []) + | _ -> [ ib ] + in + let ibl = traverse_blk ib in + (Array.of_list ibl, !last) -let btl_scheduler btl entry = - List.iter (fun (n,ibf) -> - let bseq = flatten_blk_basics ibf in - match schedule_sequence bseq btl with - | Some positions -> - Array.iter (fun p -> debug "%d " p) positions - | None -> () - ) (PTree.elements btl); - (*let seqs = get_sequences seqs in*) - () +let apply_schedule bseq olast positions = + let ibl = Array.to_list (Array.map (fun i -> bseq.(i)) positions) in + let rec build_iblock = function + | [] -> failwith "build_iblock: empty list" + | [ ib ] -> ( match olast with Some last -> Bseq (ib, last) | None -> ib) + | ib1 :: ib2 :: k -> Bseq (ib1, build_iblock (ib2 :: k)) + in + build_iblock ibl + +let schedule_blk n ibf btl = + let bseq, olast = flatten_blk_basics ibf in + match schedule_sequence bseq btl with + | Some positions -> + debug "%d," (p2i n); + Array.iter (fun p -> debug "%d " p) positions; + debug "\n"; + let new_ib = apply_schedule bseq olast positions in + let new_ibf = + { entry = new_ib; binfo = ibf.binfo; input_regs = ibf.input_regs } + in + PTree.set n new_ibf btl + | None -> btl + +let rec do_schedule btl = function + | [] -> btl + | (n, ibf) :: blks -> + let btl' = schedule_blk n ibf btl in + do_schedule btl' blks + +let btl_scheduler btl = + (*debug_flag := true;*) + let btl' = do_schedule btl (PTree.elements btl) in + (*debug_flag := false;*) + btl' -- cgit From 05b24fdb11414100b9b04867e6e2d3a1a9054162 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Fri, 28 May 2021 11:44:11 +0200 Subject: Improvements in scheduling and renumbering BTL code --- scheduling/BTLScheduleraux.ml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index 4b5ebb32..ad0c307d 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -80,7 +80,6 @@ let build_constraints_and_resources (opweights : opweights) insts btl = in Array.iteri (fun i inst -> - (* TODO gourdinl liveins for Bcond *) match inst with | Bnop _ -> let rs = Array.map (fun _ -> 0) opweights.pipelined_resource_bounds in @@ -203,13 +202,13 @@ let flatten_blk_basics ibf = | BF (_, _) -> last := Some ib; [] - | Bseq (ib1, ib2) -> traverse_blk ib1 @ traverse_blk ib2 - | Bcond (_, _, _, _, iinfo) -> ( + | Bseq ((Bcond (_, _, _, _, iinfo) as ib1), ib2) -> ( match iinfo.pcond with - | Some _ -> [ ib ] + | Some _ -> [ ib1 ] @ traverse_blk ib2 | None -> last := Some ib; []) + | Bseq (ib1, ib2) -> traverse_blk ib1 @ traverse_blk ib2 | _ -> [ ib ] in let ibl = traverse_blk ib in -- cgit From 271f87ba08f42340900378c0797511d4071fc1b8 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Mon, 31 May 2021 16:55:18 +0200 Subject: BTL Scheduler oracle and some drafts --- scheduling/BTLScheduleraux.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index ad0c307d..b87636e1 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -4,6 +4,7 @@ open Registers open BTL open BTLtypes open DebugPrint +open PrintBTL open RTLcommonaux open InstructionScheduler open PrepassSchedulingOracleDeps @@ -243,8 +244,11 @@ let rec do_schedule btl = function let btl' = schedule_blk n ibf btl in do_schedule btl' blks -let btl_scheduler btl = +let btl_scheduler f = + let btl = f.fn_code in (*debug_flag := true;*) let btl' = do_schedule btl (PTree.elements btl) in + debug "Scheduled BTL Code:\n"; + print_btl_code stderr btl'; (*debug_flag := false;*) btl' -- cgit From a3319eb05543930844dedd9ac31ed1beaac3047e Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Tue, 20 Jul 2021 15:21:29 +0200 Subject: Fix compile on ARM/x86 backends --- scheduling/BTLScheduleraux.ml | 195 +----------------------------------------- 1 file changed, 4 insertions(+), 191 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index b87636e1..98bc4590 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -1,199 +1,11 @@ -open AST open Maps -open Registers open BTL open BTLtypes open DebugPrint open PrintBTL open RTLcommonaux -open InstructionScheduler -open PrepassSchedulingOracleDeps - -let use_alias_analysis () = false - -let build_constraints_and_resources (opweights : opweights) insts btl = - let last_reg_reads : int list PTree.t ref = ref PTree.empty - and last_reg_write : (int * int) PTree.t ref = ref PTree.empty - and last_mem_reads : int list ref = ref [] - and last_mem_write : int option ref = ref None - and last_branch : int option ref = ref None - and last_non_pipelined_op : int array = - Array.make opweights.nr_non_pipelined_units (-1) - and latency_constraints : latency_constraint list ref = ref [] - and resources = ref [] in - let add_constraint instr_from instr_to latency = - assert (instr_from <= instr_to); - assert (latency >= 0); - if instr_from = instr_to then - if latency = 0 then () - else - failwith "PrepassSchedulingOracle.get_dependencies: negative self-loop" - else - latency_constraints := - { instr_from; instr_to; latency } :: !latency_constraints - and get_last_reads reg = - match PTree.get reg !last_reg_reads with Some l -> l | None -> [] - in - let add_input_mem i = - if not (use_alias_analysis ()) then ( - (* Read after write *) - (match !last_mem_write with None -> () | Some j -> add_constraint j i 1); - last_mem_reads := i :: !last_mem_reads) - and add_output_mem i = - if not (use_alias_analysis ()) then ( - (* Write after write *) - (match !last_mem_write with None -> () | Some j -> add_constraint j i 1); - (* Write after read *) - List.iter (fun j -> add_constraint j i 0) !last_mem_reads; - last_mem_write := Some i; - last_mem_reads := []) - and add_input_reg i reg = - (* Read after write *) - (match PTree.get reg !last_reg_write with - | None -> () - | Some (j, latency) -> add_constraint j i latency); - last_reg_reads := PTree.set reg (i :: get_last_reads reg) !last_reg_reads - and add_output_reg i latency reg = - (* Write after write *) - (match PTree.get reg !last_reg_write with - | None -> () - | Some (j, _) -> add_constraint j i 1); - (* Write after read *) - List.iter (fun j -> add_constraint j i 0) (get_last_reads reg); - last_reg_write := PTree.set reg (i, latency) !last_reg_write; - last_reg_reads := PTree.remove reg !last_reg_reads - in - let add_input_regs i regs = List.iter (add_input_reg i) regs - and irreversible_action i = - match !last_branch with None -> () | Some j -> add_constraint j i 1 - in - let set_branch i = - irreversible_action i; - last_branch := Some i - and add_non_pipelined_resources i resources = - Array.iter2 - (fun latency last -> - if latency >= 0 && last >= 0 then add_constraint last i latency) - resources last_non_pipelined_op; - Array.iteri - (fun rsc latency -> if latency >= 0 then last_non_pipelined_op.(rsc) <- i) - resources - in - Array.iteri - (fun i inst -> - match inst with - | Bnop _ -> - let rs = Array.map (fun _ -> 0) opweights.pipelined_resource_bounds in - resources := rs :: !resources - | Bop (op, lr, rd, _) -> - add_non_pipelined_resources i - (opweights.non_pipelined_resources_of_op op (List.length lr)); - if Op.is_trapping_op op then irreversible_action i; - add_input_regs i lr; - add_output_reg i (opweights.latency_of_op op (List.length lr)) rd; - let rs = opweights.resources_of_op op (List.length lr) in - resources := rs :: !resources - | Bload (trap, chk, addr, lr, rd, _) -> - if trap = TRAP then irreversible_action i; - add_input_mem i; - add_input_regs i lr; - add_output_reg i - (opweights.latency_of_load trap chk addr (List.length lr)) - rd; - let rs = opweights.resources_of_load trap chk addr (List.length lr) in - resources := rs :: !resources - | Bstore (chk, addr, lr, src, _) -> - irreversible_action i; - add_input_regs i lr; - add_input_reg i src; - add_output_mem i; - let rs = opweights.resources_of_store chk addr (List.length lr) in - resources := rs :: !resources - | Bcond (cond, lr, BF (Bgoto s, _), ibnot, _) -> - (* TODO gourdinl test with/out this line *) - let live = (get_some @@ PTree.get s btl).input_regs in - add_input_regs i (Regset.elements live); - set_branch i; - add_input_mem i; - add_input_regs i lr; - let rs = opweights.resources_of_cond cond (List.length lr) in - resources := rs :: !resources - | Bcond (_, _, _, _, _) -> - failwith "get_simple_dependencies: invalid Bcond" - | BF (_, _) -> failwith "get_simple_dependencies: BF" - | Bseq (_, _) -> failwith "get_simple_dependencies: Bseq") - insts; - (!latency_constraints, Array.of_list (List.rev !resources)) - -let define_problem (opweights : opweights) ibf btl = - let simple_deps, resources = - build_constraints_and_resources opweights ibf btl - in - { - max_latency = -1; - resource_bounds = opweights.pipelined_resource_bounds; - instruction_usages = resources; - latency_constraints = simple_deps; - } - -let zigzag_scheduler problem early_ones = - let nr_instructions = get_nr_instructions problem in - assert (nr_instructions = Array.length early_ones); - match list_scheduler problem with - | Some fwd_schedule -> - let fwd_makespan = fwd_schedule.(Array.length fwd_schedule - 1) in - let constraints' = ref problem.latency_constraints in - Array.iteri - (fun i is_early -> - if is_early then - constraints' := - { - instr_from = i; - instr_to = nr_instructions; - latency = fwd_makespan - fwd_schedule.(i); - } - :: !constraints') - early_ones; - validated_scheduler reverse_list_scheduler - { problem with latency_constraints = !constraints' } - | None -> None - -let prepass_scheduler_by_name name problem insts = - match name with - | "zigzag" -> - let early_ones = - Array.map - (fun inst -> - match inst with Bcond (_, _, _, _, _) -> true | _ -> false) - insts - in - zigzag_scheduler problem early_ones - | _ -> scheduler_by_name name problem - -let schedule_sequence insts btl = - let opweights = OpWeights.get_opweights () in - try - if Array.length insts <= 1 then None - else - let nr_instructions = Array.length insts in - let problem = define_problem opweights insts btl in - match - prepass_scheduler_by_name !Clflags.option_fprepass_sched problem insts - with - | None -> - Printf.printf "no solution in prepass scheduling\n"; - None - | Some solution -> - let positions = Array.init nr_instructions (fun i -> i) in - Array.sort - (fun i j -> - let si = solution.(i) and sj = solution.(j) in - if si < sj then -1 else if si > sj then 1 else i - j) - positions; - Some positions - with Failure s -> - Printf.printf "failure in prepass scheduling: %s\n" s; - None +open ExpansionOracle +open PrepassSchedulingOracle let flatten_blk_basics ibf = let ib = ibf.entry in @@ -241,7 +53,8 @@ let schedule_blk n ibf btl = let rec do_schedule btl = function | [] -> btl | (n, ibf) :: blks -> - let btl' = schedule_blk n ibf btl in + let code_exp = expanse n ibf btl in + let btl' = schedule_blk n ibf code_exp in do_schedule btl' blks let btl_scheduler f = -- cgit From 23c01485970efa11a7207ac2124f5922a011b0d4 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Tue, 20 Jul 2021 20:01:12 +0200 Subject: new expansion oracle for BTL --- scheduling/BTLScheduleraux.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index 98bc4590..6a114b74 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -60,7 +60,9 @@ let rec do_schedule btl = function let btl_scheduler f = let btl = f.fn_code in (*debug_flag := true;*) - let btl' = do_schedule btl (PTree.elements btl) in + let elts = PTree.elements btl in + find_last_reg elts; + let btl' = do_schedule btl elts in debug "Scheduled BTL Code:\n"; print_btl_code stderr btl'; (*debug_flag := false;*) -- cgit From 0b076ef6eb5553be43ce81c27e438f632b17cb32 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Tue, 27 Jul 2021 11:22:30 +0200 Subject: prepass act --- scheduling/BTLScheduleraux.ml | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index 6a114b74..9c8f6ab5 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -37,18 +37,20 @@ let apply_schedule bseq olast positions = build_iblock ibl let schedule_blk n ibf btl = - let bseq, olast = flatten_blk_basics ibf in - match schedule_sequence bseq btl with - | Some positions -> - debug "%d," (p2i n); - Array.iter (fun p -> debug "%d " p) positions; - debug "\n"; - let new_ib = apply_schedule bseq olast positions in - let new_ibf = - { entry = new_ib; binfo = ibf.binfo; input_regs = ibf.input_regs } - in - PTree.set n new_ibf btl - | None -> btl + if not !Clflags.option_fprepass then btl + else + let bseq, olast = flatten_blk_basics ibf in + match schedule_sequence bseq btl with + | Some positions -> + debug "%d," (p2i n); + Array.iter (fun p -> debug "%d " p) positions; + debug "\n"; + let new_ib = apply_schedule bseq olast positions in + let new_ibf = + { entry = new_ib; binfo = ibf.binfo; input_regs = ibf.input_regs } + in + PTree.set n new_ibf btl + | None -> btl let rec do_schedule btl = function | [] -> btl -- cgit From b3e47d62f708777248e5c630abd3afa8ddfdefc4 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Tue, 27 Jul 2021 17:07:46 +0200 Subject: test non-trapping loads using CI... --- scheduling/BTLScheduleraux.ml | 95 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 93 insertions(+), 2 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index 6a114b74..ebd4089b 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -1,6 +1,7 @@ open Maps open BTL open BTLtypes +open Machine open DebugPrint open PrintBTL open RTLcommonaux @@ -27,13 +28,80 @@ let flatten_blk_basics ibf = let ibl = traverse_blk ib in (Array.of_list ibl, !last) +let is_a_cb = function Bcond _ -> true | _ -> false + +let is_a_load = function Bload _ -> true | _ -> false + +module SI = Set.Make (Int) + +let find_array arr n = + let index = ref None in + (try + Array.iteri + (fun i n' -> + match !index with + | Some _ -> raise Exit + | None -> if n = n' then index := Some i) + arr + with Exit -> ()); + get_some @@ !index + +let count_cbs bseq olast indexes = + debug "count_cbs\n"; + let current_cbs = ref SI.empty in + let cbs_above = Hashtbl.create 100 in + let update_cbs n ib = + print_btl_inst stderr ib; + if is_a_cb ib then ( + debug "n is %d, add cb at: %d\n" n indexes.(n); + current_cbs := SI.add indexes.(n) !current_cbs) + else if is_a_load ib then ( + debug "n is %d, add load at: %d\n" n indexes.(n); + Hashtbl.add cbs_above indexes.(n) !current_cbs) + in + Array.iteri (fun n ib -> update_cbs n ib) bseq; + (match olast with + | Some last -> + debug "last\n"; + update_cbs (Array.length bseq) last + | None -> ()); + cbs_above + let apply_schedule bseq olast positions = - let ibl = Array.to_list (Array.map (fun i -> bseq.(i)) positions) in + let fmap n = find_array positions n in + let seq = (Array.init (Array.length positions) (fun i -> i)) in + let fseq = Array.map fmap seq in + debug_flag := true; + Array.iter (fun i -> debug "%d " i) positions; + debug "\n"; + Array.iter (fun i -> debug "%d " i) fseq; + debug "\n"; + Array.iter + (fun i -> debug "%d " i) + (Array.init (Array.length positions) (fun i -> i)); + debug "\n"; + let cbs_above_old = count_cbs bseq olast fseq in + let bseq_new = Array.map (fun i -> bseq.(i)) positions in + let cbs_above_new = count_cbs bseq_new olast seq in + Array.iteri + (fun n ib -> + let n' = fseq.(n) in + match ib with + | Bload (t, a, b, c, d, e) -> + let set_old = Hashtbl.find cbs_above_old n' in + let set_new = Hashtbl.find cbs_above_new n' in + if SI.subset set_old set_new then + bseq_new.(n') <- Bload (AST.TRAP, a, b, c, d, e) + else assert !config.has_non_trapping_loads + | _ -> ()) + bseq; + let ibl = Array.to_list bseq_new in let rec build_iblock = function | [] -> failwith "build_iblock: empty list" | [ ib ] -> ( match olast with Some last -> Bseq (ib, last) | None -> ib) | ib1 :: ib2 :: k -> Bseq (ib1, build_iblock (ib2 :: k)) in + debug_flag := false; build_iblock ibl let schedule_blk n ibf btl = @@ -50,11 +118,34 @@ let schedule_blk n ibf btl = PTree.set n new_ibf btl | None -> btl +let turn_all_loads_nontrap n ibf btl = + if not !config.has_non_trapping_loads then btl + else + let rec traverse_rec ib = + match ib with + | Bseq (ib1, ib2) -> Bseq (traverse_rec ib1, traverse_rec ib2) + | Bload (t, a, b, c, d, e) -> Bload (AST.NOTRAP, a, b, c, d, e) + | _ -> ib + in + let ib' = traverse_rec ibf.entry in + let ibf' = + { entry = ib'; input_regs = ibf.input_regs; binfo = ibf.binfo } + in + PTree.set n ibf' btl + let rec do_schedule btl = function | [] -> btl | (n, ibf) :: blks -> let code_exp = expanse n ibf btl in - let btl' = schedule_blk n ibf code_exp in + let code_nt = turn_all_loads_nontrap n ibf btl in + let btl' = schedule_blk n ibf code_nt in + (*debug_flag := true;*) + if btl != code_exp then ( + debug "#######################################################\n"; + print_btl_code stderr btl; + debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"; + print_btl_code stderr code_exp); + (*debug_flag := false;*) do_schedule btl' blks let btl_scheduler f = -- cgit From 77ee161826e24e87f801cbbeb797fb3a4a4a0fe9 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Tue, 27 Jul 2021 17:28:16 +0200 Subject: test ci2 --- scheduling/BTLScheduleraux.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index 268ee7a5..5ebc4144 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -71,7 +71,7 @@ let apply_schedule bseq olast positions = let fmap n = find_array positions n in let seq = (Array.init (Array.length positions) (fun i -> i)) in let fseq = Array.map fmap seq in - debug_flag := true; + (*debug_flag := true;*) Array.iter (fun i -> debug "%d " i) positions; debug "\n"; Array.iter (fun i -> debug "%d " i) fseq; @@ -92,7 +92,7 @@ let apply_schedule bseq olast positions = let set_new = Hashtbl.find cbs_above_new n' in if SI.subset set_old set_new then bseq_new.(n') <- Bload (AST.TRAP, a, b, c, d, e) - else assert !config.has_non_trapping_loads + else (Printf.eprintf "\nTEST_GOURDINL_OK\n"; assert !config.has_non_trapping_loads) | _ -> ()) bseq; let ibl = Array.to_list bseq_new in @@ -101,7 +101,7 @@ let apply_schedule bseq olast positions = | [ ib ] -> ( match olast with Some last -> Bseq (ib, last) | None -> ib) | ib1 :: ib2 :: k -> Bseq (ib1, build_iblock (ib2 :: k)) in - debug_flag := false; + (*debug_flag := false;*) build_iblock ibl let schedule_blk n ibf btl = -- cgit From 056658bd2986d9e12ac07a54d25c08eb8a62ff60 Mon Sep 17 00:00:00 2001 From: Léo Gourdin Date: Wed, 28 Jul 2021 10:32:09 +0200 Subject: remove todos, clean --- scheduling/BTLScheduleraux.ml | 70 ++++++++++++++----------------------------- 1 file changed, 22 insertions(+), 48 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index 5ebc4144..c8c4e0d3 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -47,61 +47,45 @@ let find_array arr n = get_some @@ !index let count_cbs bseq olast indexes = - debug "count_cbs\n"; let current_cbs = ref SI.empty in let cbs_above = Hashtbl.create 100 in let update_cbs n ib = print_btl_inst stderr ib; - if is_a_cb ib then ( - debug "n is %d, add cb at: %d\n" n indexes.(n); - current_cbs := SI.add indexes.(n) !current_cbs) - else if is_a_load ib then ( - debug "n is %d, add load at: %d\n" n indexes.(n); - Hashtbl.add cbs_above indexes.(n) !current_cbs) + if is_a_cb ib then current_cbs := SI.add indexes.(n) !current_cbs + else if is_a_load ib then Hashtbl.add cbs_above indexes.(n) !current_cbs in Array.iteri (fun n ib -> update_cbs n ib) bseq; (match olast with - | Some last -> - debug "last\n"; - update_cbs (Array.length bseq) last + | Some last -> update_cbs (Array.length bseq) last | None -> ()); cbs_above let apply_schedule bseq olast positions = - let fmap n = find_array positions n in - let seq = (Array.init (Array.length positions) (fun i -> i)) in - let fseq = Array.map fmap seq in - (*debug_flag := true;*) - Array.iter (fun i -> debug "%d " i) positions; - debug "\n"; - Array.iter (fun i -> debug "%d " i) fseq; - debug "\n"; - Array.iter - (fun i -> debug "%d " i) - (Array.init (Array.length positions) (fun i -> i)); - debug "\n"; - let cbs_above_old = count_cbs bseq olast fseq in let bseq_new = Array.map (fun i -> bseq.(i)) positions in - let cbs_above_new = count_cbs bseq_new olast seq in - Array.iteri - (fun n ib -> - let n' = fseq.(n) in - match ib with - | Bload (t, a, b, c, d, e) -> - let set_old = Hashtbl.find cbs_above_old n' in - let set_new = Hashtbl.find cbs_above_new n' in - if SI.subset set_old set_new then - bseq_new.(n') <- Bload (AST.TRAP, a, b, c, d, e) - else (Printf.eprintf "\nTEST_GOURDINL_OK\n"; assert !config.has_non_trapping_loads) - | _ -> ()) - bseq; + (if !config.has_non_trapping_loads then + let fmap n = find_array positions n in + let seq = Array.init (Array.length positions) (fun i -> i) in + let fseq = Array.map fmap seq in + let cbs_above_old = count_cbs bseq olast fseq in + let cbs_above_new = count_cbs bseq_new olast seq in + Array.iteri + (fun n ib -> + let n' = fseq.(n) in + match ib with + | Bload (t, a, b, c, d, e) -> + let set_old = Hashtbl.find cbs_above_old n' in + let set_new = Hashtbl.find cbs_above_new n' in + if SI.subset set_old set_new then + bseq_new.(n') <- Bload (AST.TRAP, a, b, c, d, e) + else assert !config.has_non_trapping_loads + | _ -> ()) + bseq); let ibl = Array.to_list bseq_new in let rec build_iblock = function | [] -> failwith "build_iblock: empty list" | [ ib ] -> ( match olast with Some last -> Bseq (ib, last) | None -> ib) | ib1 :: ib2 :: k -> Bseq (ib1, build_iblock (ib2 :: k)) in - (*debug_flag := false;*) build_iblock ibl let schedule_blk n ibf btl = @@ -110,9 +94,6 @@ let schedule_blk n ibf btl = let bseq, olast = flatten_blk_basics ibf in match schedule_sequence bseq btl with | Some positions -> - debug "%d," (p2i n); - Array.iter (fun p -> debug "%d " p) positions; - debug "\n"; let new_ib = apply_schedule bseq olast positions in let new_ibf = { entry = new_ib; binfo = ibf.binfo; input_regs = ibf.input_regs } @@ -139,15 +120,8 @@ let rec do_schedule btl = function | [] -> btl | (n, ibf) :: blks -> let code_exp = expanse n ibf btl in - let code_nt = turn_all_loads_nontrap n ibf btl in + let code_nt = turn_all_loads_nontrap n ibf code_exp in let btl' = schedule_blk n ibf code_nt in - (*debug_flag := true;*) - if btl != code_exp then ( - debug "#######################################################\n"; - print_btl_code stderr btl; - debug "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n"; - print_btl_code stderr code_exp); - (*debug_flag := false;*) do_schedule btl' blks let btl_scheduler f = -- cgit From 806a3844f154fb76ce45c446c35d846c58b942fc Mon Sep 17 00:00:00 2001 From: Leo Gourdin Date: Mon, 2 Aug 2021 11:59:11 +0200 Subject: non-trapping loads fix --- scheduling/BTLScheduleraux.ml | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'scheduling/BTLScheduleraux.ml') diff --git a/scheduling/BTLScheduleraux.ml b/scheduling/BTLScheduleraux.ml index c8c4e0d3..00be2aa7 100644 --- a/scheduling/BTLScheduleraux.ml +++ b/scheduling/BTLScheduleraux.ml @@ -120,9 +120,17 @@ let rec do_schedule btl = function | [] -> btl | (n, ibf) :: blks -> let code_exp = expanse n ibf btl in - let code_nt = turn_all_loads_nontrap n ibf code_exp in - let btl' = schedule_blk n ibf code_nt in - do_schedule btl' blks + let ibf_exp = get_some @@ PTree.get n code_exp in + let code_nt = turn_all_loads_nontrap n ibf_exp code_exp in + let ibf_nt = get_some @@ PTree.get n code_nt in + let btl' = schedule_blk n ibf_nt code_nt in + begin + (*debug_flag := true;*) + print_btl_code stderr code_nt; + print_btl_code stderr btl'; + (*debug_flag := false;*) + do_schedule btl' blks + end let btl_scheduler f = let btl = f.fn_code in -- cgit