Skip to content

Tweak logging code of register allocators #3822

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Apr 8, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions backend/cfg/sub_cfg.ml
Original file line number Diff line number Diff line change
Expand Up @@ -123,8 +123,8 @@ let dump sub_cfg =
let liveness = InstructionId.Tbl.create 32 in
DLL.iter sub_cfg.layout ~f:(fun (block : Cfg.basic_block) ->
Format.eprintf "Block %a@." Label.print block.start;
Regalloc_irc_utils.log_body_and_terminator ~indent:0 block.body
block.terminator liveness)
Regalloc_irc_utils.log_body_and_terminator block.body block.terminator
liveness)

(* note: `dump` is for debugging, and thus not always in use. *)
let (_ : t -> unit) = dump
106 changes: 70 additions & 36 deletions backend/regalloc/regalloc_gi.ml
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,10 @@ let rewrite : State.t -> Cfg_with_infos.t -> spilled_nodes:Reg.t list -> bool =

let update_register_locations : State.t -> unit =
fun state ->
if gi_debug then log ~indent:0 "update_register_locations";
if gi_debug
then (
log "update_register_locations";
indent ());
let update_register (reg : Reg.t) : unit =
match reg.Reg.loc with
| Reg _ -> ()
Expand All @@ -56,11 +59,12 @@ let update_register_locations : State.t -> unit =
| Some location ->
if gi_debug
then
log ~indent:1 "updating %a to %a" Printreg.reg reg
log "updating %a to %a" Printreg.reg reg
Hardware_register.print_location location;
reg.Reg.loc <- Hardware_register.reg_location_of_location location)
in
List.iter (Reg.all_registers ()) ~f:update_register
List.iter (Reg.all_registers ()) ~f:update_register;
if gi_debug then dedent ()

module Prio_queue = Make_max_priority_queue (Int)

Expand All @@ -74,7 +78,10 @@ let priority_heuristics : Reg.t -> Interval.t -> int =

let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
Hardware_registers.t * prio_queue =
if gi_debug then log ~indent:0 "creating registers and queue";
if gi_debug
then (
log "creating registers and queue";
indent ());
let intervals = build_intervals cfg_with_infos in
let hardware_registers = Hardware_registers.make () in
let prio_queue =
Expand All @@ -87,8 +94,10 @@ let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
| Reg _ -> (
if gi_debug
then (
log ~indent:1 "pre-assigned register %a" Printreg.reg reg;
log ~indent:2 "%a" Interval.print interval);
log "pre-assigned register %a" Printreg.reg reg;
indent ();
log "%a" Interval.print interval;
dedent ());
match Hardware_registers.of_reg hardware_registers reg with
| None -> ()
| Some hardware_reg ->
Expand All @@ -97,17 +106,22 @@ let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
let priority = priority_heuristics reg interval in
if gi_debug
then (
log ~indent:1 "register %a" Printreg.reg reg;
log ~indent:2 "%a" Interval.print interval;
log ~indent:2 "priority=%d" priority);
log "register %a" Printreg.reg reg;
indent ();
log "%a" Interval.print interval;
log "priority=%d" priority;
dedent ());
Prio_queue.add prio_queue ~priority ~data:(reg, interval)
| Stack _ ->
if gi_debug
then (
log ~indent:1 "stack register %a" Printreg.reg reg;
log ~indent:2 "%a" Interval.print interval);
log "stack register %a" Printreg.reg reg;
indent ();
log "%a" Interval.print interval;
dedent ());
())
intervals;
if gi_debug then dedent ();
hardware_registers, prio_queue

(* CR xclerc for xclerc: try to find a reasonable threshold. *)
Expand All @@ -132,37 +146,43 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
(State.initial_temporary_count state);
if gi_debug
then (
log ~indent:0 "main, round #%d" round;
log_cfg_with_infos ~indent:0 cfg_with_infos);
if gi_debug then log ~indent:0 "updating spilling costs";
log "main, round #%d" round;
log_cfg_with_infos cfg_with_infos);
if gi_debug then log "updating spilling costs";
update_spill_cost cfg_with_infos ~flat ();
State.iter_introduced_temporaries state ~f:(fun (reg : Reg.t) ->
reg.Reg.spill_cost <- reg.Reg.spill_cost + 10_000);
if gi_debug
then (
log ~indent:0 "spilling costs";
log "spilling costs";
indent ();
List.iter (Reg.all_registers ()) ~f:(fun (reg : Reg.t) ->
reg.Reg.spill <- false;
log ~indent:1 "%a: %d" Printreg.reg reg reg.spill_cost));
log "%a: %d" Printreg.reg reg reg.spill_cost);
dedent ());
let hardware_registers, prio_queue =
make_hardware_registers_and_prio_queue cfg_with_infos
in
let step = ref 0 in
let spilling = ref ([] : (Reg.t * Interval.t) list) in
indent ();
while not (Prio_queue.is_empty prio_queue) do
incr step;
if gi_debug
then log ~indent:1 "step #%d (size=%d)" !step (Prio_queue.size prio_queue);
if gi_debug then log "step #%d (size=%d)" !step (Prio_queue.size prio_queue);
let { Prio_queue.priority; data = reg, interval } =
Prio_queue.get_and_remove prio_queue
in
if gi_debug
then log ~indent:2 "got register %a (prio=%d)" Printreg.reg reg priority;
match Hardware_registers.find_available hardware_registers reg interval with
then (
indent ();
log "got register %a (prio=%d)" Printreg.reg reg priority);
(match
Hardware_registers.find_available hardware_registers reg interval
with
| For_assignment { hardware_reg } ->
if gi_debug
then
log ~indent:3 "assigning %a to %a" Printreg.reg reg
log "assigning %a to %a" Printreg.reg reg
Hardware_register.print_location hardware_reg.location;
State.add_assignment state reg ~to_:hardware_reg.location;
hardware_reg.assigned
Expand All @@ -171,7 +191,7 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
| For_eviction { hardware_reg; evicted_regs } ->
if gi_debug
then
log ~indent:3 "evicting %a from %a" Printreg.regs
log "evicting %a from %a" Printreg.regs
(Array.of_list
(List.map evicted_regs
~f:(fun { Hardware_register.pseudo_reg; _ } -> pseudo_reg)))
Expand Down Expand Up @@ -205,23 +225,31 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
Reg.same r r')))
| Split_or_spill ->
(* CR xclerc for xclerc: we should actually try to split. *)
if gi_debug then log ~indent:3 "spilling %a" Printreg.reg reg;
if gi_debug then log "spilling %a" Printreg.reg reg;
reg.Reg.spill <- true;
spilling := (reg, interval) :: !spilling
spilling := (reg, interval) :: !spilling);
if gi_debug then dedent ()
done;
dedent ();
match !spilling with
| [] -> ()
| _ :: _ as spilled_nodes -> (
if gi_debug
then (
log_cfg_with_infos ~indent:0 cfg_with_infos;
log ~indent:1 "stack slots";
log_cfg_with_infos cfg_with_infos;
indent ();
log "stack slots";
indent ();
Regalloc_stack_slots.iter (State.stack_slots state)
~f:(fun (reg : Reg.t) (slot : int) ->
log ~indent:2 " - %a ~> %d" Printreg.reg reg slot);
log ~indent:1 "needs to spill %d registers:" (List.length !spilling);
log " - %a ~> %d" Printreg.reg reg slot);
dedent ();
log "needs to spill %d registers:" (List.length !spilling);
indent ();
List.iter !spilling ~f:(fun (_reg, interval) ->
log ~indent:2 " - %a" Interval.print interval);
log " - %a" Interval.print interval);
dedent ();
dedent ();
Cfg.iter_blocks (Cfg_with_infos.cfg cfg_with_infos)
~f:(fun (_ : Label.t) (block : Cfg.basic_block) ->
let occurs =
Expand All @@ -231,15 +259,17 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
if occurs
then (
let dummy_liveness_for_log = InstructionId.Tbl.create 12 in
log ~indent:0 "block %a has an occurrence of a spilling register"
Label.format block.start;
log_body_and_terminator ~indent:1 block.body block.terminator
dummy_liveness_for_log)));
log "block %a has an occurrence of a spilling register" Label.format
block.start;
indent ();
log_body_and_terminator block.body block.terminator
dummy_liveness_for_log;
dedent ())));
match
rewrite state cfg_with_infos
~spilled_nodes:(List.map spilled_nodes ~f:fst)
with
| false -> if gi_debug then log ~indent:1 "(end of main)"
| false -> if gi_debug then log "(end of main)"
| true -> main ~round:(succ round) ~flat state cfg_with_infos)

let run : Cfg_with_infos.t -> Cfg_with_infos.t =
Expand All @@ -255,7 +285,7 @@ let run : Cfg_with_infos.t -> Cfg_with_infos.t =
the creation of the state to `prelude`. *)
let all_temporaries = Reg.Set.union cfg_infos.arg cfg_infos.res in
let initial_temporaries = Reg.Set.cardinal all_temporaries in
if gi_debug then log ~indent:0 "#temporaries=%d" initial_temporaries;
if gi_debug then log "#temporaries=%d" initial_temporaries;
let state =
State.make ~stack_slots ~initial_temporaries
~last_used:cfg_infos.max_instruction_id
Expand All @@ -276,7 +306,11 @@ let run : Cfg_with_infos.t -> Cfg_with_infos.t =
| Random_for_testing -> Spilling_heuristics.random ()
in
main ~round:1 ~flat state cfg_with_infos;
if gi_debug then log_cfg_with_infos ~indent:1 cfg_with_infos;
if gi_debug
then (
indent ();
log_cfg_with_infos cfg_with_infos;
dedent ());
Regalloc_rewrite.postlude
(module State)
(module Utils)
Expand Down
Loading