diff options
Diffstat (limited to 'scheduling/InstructionScheduler.ml')
| -rw-r--r-- | scheduling/InstructionScheduler.ml | 107 |
1 files changed, 46 insertions, 61 deletions
diff --git a/scheduling/InstructionScheduler.ml b/scheduling/InstructionScheduler.ml index 0203d9c8..e3a421a5 100644 --- a/scheduling/InstructionScheduler.ml +++ b/scheduling/InstructionScheduler.ml @@ -349,13 +349,13 @@ let _ = fun x -> priority_list_scheduler INSTRUCTION_ORDER x;; (* A scheduler sensitive to register pressure *) let reg_pres_scheduler (problem : problem) : solution option = - DebugPrint.debug_flag := true; - + (* DebugPrint.debug_flag := true; *) let nr_instructions = get_nr_instructions problem in if !Clflags.option_debug_compcert > 6 then - DebugPrint.debug "SCHEDULING_SUPERBLOCK %d\n" nr_instructions; - + (Printf.eprintf "\nSCHEDULING_SUPERBLOCK %d\n" nr_instructions; + flush stderr); + let successors = get_successors problem and predecessors = get_predecessors problem and times = Array.make (nr_instructions+1) (-1) in @@ -495,32 +495,22 @@ let reg_pres_scheduler (problem : problem) : solution option = let attempt_scheduling ready usages = let result = ref (-1) in + DebugPrint.debug "\n\nREADY: "; + InstrSet.iter (fun i -> DebugPrint.debug "%d " i) ready; + DebugPrint.debug "\n\n"; try Array.iteri (fun i avlregs -> - (* print_string "avlregs: "; - * print_int i; - * print_string " "; - * print_int avlregs; - * print_newline (); - * print_string "live regs: "; - * print_int (Hashtbl.length live_regs); - * print_newline (); - * flush stdout; *) - if avlregs <= regs_thresholds.(i) + DebugPrint.debug "avlregs: %d %d\nlive regs: %d\n" + i avlregs (Hashtbl.length live_regs); + if !cnt < 5 && avlregs <= regs_thresholds.(i) then ( csr_b := true; let maybe = InstrSet.sched_CSR i ready usages in - (* print_string "maybe\n"; - * print_int maybe; - * print_newline (); - * flush stdout; *) - (if maybe > 0 && + DebugPrint.debug "maybe %d\n" maybe; + (if maybe >= 0 && let delta = List.fold_left (fold_delta i) 0 mentions.(maybe) in - (* print_string "delta "; - * print_int delta; - * print_newline (); - * flush stdout; *) + DebugPrint.debug "delta %d\n" delta; delta > 0 then (vector_subtract usages.(maybe) current_resources; @@ -534,7 +524,8 @@ let reg_pres_scheduler (problem : problem) : solution option = then result := ins ) ready; if !result <> -1 then - vector_subtract usages.(!result) current_resources) + vector_subtract usages.(!result) current_resources; + incr cnt) else (incr cnt) ); @@ -558,33 +549,31 @@ let reg_pres_scheduler (problem : problem) : solution option = problem.instruction_usages with | -1 -> advance_time() | i -> (assert(times.(i) < 0); - ((* print_string "INSTR ISSUED: "; - * print_int i; - * print_newline (); - * flush stdout; *) - if !csr_b && !Clflags.option_debug_compcert > 6 then - DebugPrint.debug "REGPRES: high pres class %d\n" i; - csr_b := false; - if !Clflags.option_regpres_wait_window then - cnt := 0; - List.iter (fun (r,b) -> - if b then - (match Hashtbl.find_opt counts r with - | None -> assert false - | Some (t, n) -> - Hashtbl.remove counts r; - if n = 1 then - (Hashtbl.remove live_regs r; - available_regs.(t) - <- available_regs.(t) + 1)) - else - let t = class_r r in - match Hashtbl.find_opt live_regs r with - | None -> (Hashtbl.add live_regs r t; - available_regs.(t) - <- available_regs.(t) - 1) - | Some i -> () - ) mentions.(i)); + (DebugPrint.debug "INSTR ISSUED: %d\n" i; + if !csr_b && !Clflags.option_debug_compcert > 6 then + (Printf.eprintf "REGPRES: high pres class %d\n" i; + flush stderr); + csr_b := false; + (* if !Clflags.option_regpres_wait_window then *) + cnt := 0; + List.iter (fun (r,b) -> + if b then + (match Hashtbl.find_opt counts r with + | None -> assert false + | Some (t, n) -> + Hashtbl.remove counts r; + if n = 1 then + (Hashtbl.remove live_regs r; + available_regs.(t) + <- available_regs.(t) + 1)) + else + let t = class_r r in + match Hashtbl.find_opt live_regs r with + | None -> (Hashtbl.add live_regs r t; + available_regs.(t) + <- available_regs.(t) - 1) + | Some i -> () + ) mentions.(i)); times.(i) <- !current_time; ready.(!current_time) <- InstrSet.remove i (ready.(!current_time)); @@ -595,8 +584,8 @@ let reg_pres_scheduler (problem : problem) : solution option = | to_time -> ((* DebugPrint.debug "TO TIME %d : %d\n" to_time * (Array.length ready); *) - ready.(to_time) - <- InstrSet.add instr_to ready.(to_time)) + ready.(to_time) + <- InstrSet.add instr_to ready.(to_time)) ) successors.(i); successors.(i) <- [] ) @@ -605,8 +594,7 @@ let reg_pres_scheduler (problem : problem) : solution option = try let final_time = ref (-1) in for i = 0 to nr_instructions - 1 do - (* print_int i; - * flush stdout; *) + DebugPrint.debug "%d " i; (if times.(i) < 0 then raise Exit); (if !final_time < times.(i) + 1 then final_time := times.(i) + 1) done; @@ -615,11 +603,11 @@ let reg_pres_scheduler (problem : problem) : solution option = if target_time > !final_time then final_time := target_time) predecessors.(nr_instructions); times.(nr_instructions) <- !final_time; - DebugPrint.debug_flag := false; + (* DebugPrint.debug_flag := false; *) Some times with Exit -> DebugPrint.debug "reg_pres_sched failed\n"; - DebugPrint.debug_flag := false; + (* DebugPrint.debug_flag := false; *) None ;; @@ -628,8 +616,7 @@ let reg_pres_scheduler (problem : problem) : solution option = (********************************************************************) let reg_pres_scheduler_bis (problem : problem) : solution option = - DebugPrint.debug_flag := true; - Printf.printf "\nNEW\n\n"; + (* Printf.printf "\nNEW\n\n"; *) let nr_instructions = get_nr_instructions problem in let successors = get_successors problem and predecessors = get_predecessors problem @@ -814,11 +801,9 @@ let reg_pres_scheduler_bis (problem : problem) : solution option = if target_time > !final_time then final_time := target_time) predecessors.(nr_instructions); times.(nr_instructions) <- !final_time; - DebugPrint.debug_flag := false; Some times with Exit -> DebugPrint.debug "reg_pres_sched failed\n"; - DebugPrint.debug_flag := false; None ;; |