## iterated-register-coalescing.pkg
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib# Based on the paper:
# Iterated register coalescing
# Lal George, Andrew W. Appel
# TOPLAS 1996
# Volume 18 Issue 3, May 1996
# http://www.cs.cmu.edu/afs/cs/academic/class/15745-s07/www/papers/george.pdf
#
#
# Overview
# ========
# This implementation of iterated coalescing differs from the old one in
# various substantial ways:
#
# 1. The move list is prioritized. Higher ranking moves are coalesced first.
# This tends to favor coalescing of moves that has higher priority.
#
# 2. The freeze list is prioritized. Lower ranking nodes are unfrozen
# first. Since freeze disable moves, this tends to disable moves
# of low priority.
#
# 3. The simplify worklist is not kept explicitly during the
# simplify/coalesce/freeze phases. Instead, whenever a non-move
# related node with degree < K is discovered, we call simplify
# to remove it from the graph immediately.
#
# I think this has a few advantages.
# (a) There is less bookkeeping.
# (b) Simplify adds coalescable moves to the move list.
# By doing simplify eagerly, moves are added to the move list
# faster, allowing higher ranking moves to ``preempt'' low
# ranking moves.
#
# 4. Support for register pairs
#
# Important Invariants
# ====================
# 1. Adjacency list
# a. All nodes on the adjacency list are distinct
# b. nodes with color ALIASED or REMOVED are NOT consider to be
# on the adjacency list
# c. If a node x is cig::COLORED, then we DON'T keep track of
# its adjacency list
# d. When a node has been removed, there aren't any moves associated
# with it.
# 2. Moves
# a. Moves marked cig::WORKLIST are on the worklist.
# b. Moves marked MOVE are NOT on the worklist.
# c. Moves marked LOST are frozen and are in fact never considered again.
# d. Moves marked CONSTRAINED cannot be coalesced because the src and dst
# interfere
# e. Moves marked COALESCED have been coalesced.
# f. The movecnt in a node is always the number of nodes
# currently marked as cig::WORKLIST or MOVE, i.e. the moves that
# are associated with the node. When this is zero, the node is
# considered to be non-move related.
# g. Moves on the move worklist are always distinct.
# 3.
#
# Allen.
### "If you want to build a ship,
### don't drum up people together
### to collect wood and don't assign
### them tasks and work, but rather
### teach them to long for the endless
### immensity of the sea."
###
### -- Antoine de Saint-Exupery
stipulate
package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package geh = graph_by_edge_hashtable; # graph_by_edge_hashtable is from src/lib/std/src/graph-by-edge-hashtable.pkg package iht = int_hashtable; # int_hashtable is from src/lib/src/int-hashtable.pkg package lem = lowhalf_error_message; # lowhalf_error_message is from src/lib/compiler/back/low/control/lowhalf-error-message.pkg package lhc = lowhalf_control; # lowhalf_control is from src/lib/compiler/back/low/control/lowhalf-control.pkg package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package rkj = registerkinds_junk; # registerkinds_junk is from src/lib/compiler/back/low/code/registerkinds-junk.pkg package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkg package w = unt; # unt is from src/lib/std/unt.pkg package w8 = one_byte_unt; # one_byte_unt is from src/lib/std/one-byte-unt.pkg # For debugging, uncomment unsafe.
#
package uwv = unsafe::rw_vector;
package uw8a= unsafe::rw_vector_of_one_byte_unts; # unsafe is from src/lib/std/src/unsafe/unsafe.pkgherein
# This package gets referenced in:
#
# src/lib/compiler/back/low/regor/register-spilling-g.pkg # src/lib/compiler/back/low/regor/register-spilling-with-renaming-g.pkg # src/lib/compiler/back/low/regor/register-spilling-per-chaitin-heuristic.pkg # src/lib/compiler/back/low/regor/register-spilling-per-chow-hennessy-heuristic.pkg # src/lib/compiler/back/low/regor/register-spilling-per-improved-chaitin-heuristic-g.pkg # src/lib/compiler/back/low/regor/register-spilling-per-improved-chow-hennessy-heuristic-g.pkg # src/lib/compiler/back/low/regor/register-spilling-per-improved-chow-hennessy-heuristic-g.pkg #
# src/lib/compiler/back/low/regor/cluster-regor-g.pkg # src/lib/compiler/back/low/regor/solve-register-allocation-problems-by-recursive-partition-g.pkg # src/lib/compiler/back/low/regor/solve-register-allocation-problems-by-iterated-coalescing-g.pkg # src/lib/compiler/back/low/regor/regor-ram-merging-g.pkg # src/lib/compiler/back/low/regor/regor-deadcode-zapper-g.pkg #
# src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg # src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg #
package iterated_register_coalescing
: (weak) Iterated_Register_Coalescing # Iterated_Register_Coalescing is from src/lib/compiler/back/low/regor/iterated-register-coalescing.api {
# Export to client packages:
#
package cig = codetemp_interference_graph; # codetemp_interference_graph is from src/lib/compiler/back/low/regor/codetemp-interference-graph.pkg #
debug = FALSE;
tally = FALSE;
verbose = lhc::make_bool ("verbose", "Register-allocator chattiness");
ra_spill_coalescing
=
lhc::make_counter (
"ra_spill_coalescing",
"RA spill coalescing counter"
);
ra_spill_propagation
=
lhc::make_counter (
"ra_spill_propagation",
"RA spill propagation counter"
);
/*
good_briggs = LowhalfControl::getCounter "good_briggs"
bad_briggs = LowhalfControl::getCounter "bad_briggs"
good_george = LowhalfControl::getCounter "good_george"
bad_george = LowhalfControl::getCounter "bad_george"
good_freeze = LowhalfControl::getCounter "good_freeze"
bad_freeze = LowhalfControl::getCounter "bad_freeze"
*/
no_optimization = 0ux0;
biased_selection = 0ux1;
dead_copy_elim = 0ux2;
compute_span = 0ux4;
save_copy_temps = 0ux8;
has_parallel_copies = 0ux10;
spill_coalescing = 0ux100;
spill_coloring = 0ux200;
spill_propagation = 0ux400;
memory_coalescing
=
spill_coalescing + spill_coloring + spill_propagation;
stipulate
fun is_on (flag, mask)
=
unt::bitwise_and (flag, mask) != 0u0;
fun error msg
=
lem::error("iterated_register_coalescing", msg);
fun cat ([], b) => b;
cat (x ! a, b) => cat (a, x ! b);
end;
herein
package fz
=
regor_leftist_tree_priority_queue_g ( # regor_leftist_tree_priority_queue_g is from src/lib/compiler/back/low/regor/regor-leftist-tree-priority-queue-g.pkg Element = cig::Node;
fun less ( cig::NODE { movecost=>REF p1, ... },
cig::NODE { movecost=>REF p2, ... }
)
=
p1 <= p2;
);
package mv
=
regor_leftist_tree_priority_queue_g ( # regor_leftist_tree_priority_queue_g is from src/lib/compiler/back/low/regor/regor-leftist-tree-priority-queue-g.pkg Element = cig::Move;
fun less ( cig::MOVE_INT { cost=>p1, ... },
cig::MOVE_INT { cost=>p2, ... }
)
=
p1 >= p2;
);
Move_Queue = mv::Priority_Queue;
Freeze_Queue = fz::Priority_Queue;
# Utility functions
#
fun chase (cig::NODE { color=>REF (cig::ALIASED r), ... } )
=>
chase r;
chase x => x;
end;
fun register_id (rkj::CODETEMP_INFO { id, ... } ) = id;
fun col2s col
=
case col
#
cig::CODETEMP => "";
cig::REMOVED => "r";
cig::ALIASED _ => "a";
cig::COLORED c => "[" + int::to_string c + "]";
cig::RAMREG (_, m) => "m" + "{ " + rkj::register_to_string m + "}";
cig::SPILLED => "s";
cig::SPILL_LOC c => "s" + "{ " + int::to_string c + "}";
esac;
fun node2s (cig::NODE { register, color, ... } )
=
int::to_string (register_id register) + col2s *color;
fun show _ (node as cig::NODE { priority, ... } )
=
node2s node + if *verbose "(" + f8b::to_string *priority + ")";
else "";
fi;
# Dump the interference graph
#
fun dump_codetemp_interference_graph (cig as cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, show_reg, hardware_registers_we_may_use, ... } ) stream
=
{ fun pr s = fil::write (stream, s);
#
show = show cig;
fun pr_move (cig::MOVE_INT { src_reg, dst_reg, status=>REF (cig::WORKLIST | cig::BRIGGS_MOVE | cig::GEORGE_MOVE), cost, ... } )
=>
pr (node2s (chase dst_reg) + " <- " + node2s (chase src_reg) + "(" + f8b::to_string (cost) + ") ");
pr_move _ => ();
end;
fun pr_interferes_with (n, n' as cig::NODE { interferes_with, degree, uses, defs, color, movecnt, movelist, ... } )
=
{ pr (show n');
if *verbose pr(" deg=" + int::to_string *degree); fi;
case *color
#
cig::ALIASED n
=>
{ pr " => ";
pr (show n);
pr "\n";
};
_ =>
{ pr(" <-->");
apply
(\\ n = { pr " "; pr (show n);})
*interferes_with;
pr "\n";
if (*verbose and *movecnt > 0)
#
pr("\tmoves " + int::to_string *movecnt + ": ");
apply pr_move *movelist;
pr "\n";
fi;
};
esac;
};
pr("=========== hardware_registers_we_may_use=" + int::to_string hardware_registers_we_may_use + " ===========\n");
apply
pr_interferes_with
#
(lms::sort_list
#
(\\ ((x, _), (y, _)) = x > y)
#
(iht::keyvals_list node_hashtable)
);
};
# Function to create new nodes.
# Note: it is up to the caller to remove all
# globally allocated registers (such as esp and edi on intel32):
#
fun new_nodes (cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, codetemp_id_if_above, ... } )
=
def_use
where
getnode = iht::get node_hashtable;
addnode = iht::set node_hashtable;
fun color_of (rkj::CODETEMP_INFO { color => REF (rkj::MACHINE r), ... } )
=>
r;
color_of (rkj::CODETEMP_INFO { id, ... } )
=>
id;
end;
fun get_node (register as rkj::CODETEMP_INFO { color, ... } )
=
(getnode (color_of register))
except
_ = { reg = color_of register;
color = case *color
#
rkj::MACHINE r => cig::COLORED r;
rkj::CODETEMP => cig::CODETEMP;
rkj::ALIASED _ => error "get_node: cig::ALIASED";
rkj::SPILLED => error "get_node: cig::SPILLED";
esac;
node = cig::NODE
{ id => reg,
register,
#
color => REF color,
degree => REF 0,
movecnt => REF 0,
#
movecost => REF 0.0,
priority => REF 0.0,
#
interferes_with => REF [],
movelist => REF [],
defs => REF [],
uses => REF []
};
addnode (reg, node);
node;
};
fun def_use { defs, uses, pt, cost }
=
{
fun def register
=
{ (get_node register) -> node as cig::NODE { priority, defs, ... };
priority := *priority + cost;
defs := pt ! *defs;
node;
};
fun use register
=
{ (get_node register) -> node as cig::NODE { priority, uses, ... };
priority := *priority + cost;
uses := pt ! *uses;
};
list::apply use uses;
list::map def defs;
};
end;
# Add an edge (x, y) to the interference graph.
# Nop if the edge already exists.
# Note: adjacency lists of colored nodes are not stored
# within the interference graph to save space.
# Now we allow spilled node to be added to the edge; these do not
# count toward the degree.
#
fun add_edge (cig::CODETEMP_INTERFERENCE_GRAPH { edge_hashtable, ... } )
=
{ insert_edge = geh::insert_edge *edge_hashtable;
\\ (x as cig::NODE { id=>xn, color=>colx, interferes_with=>adjx, degree=>degx, ... },
y as cig::NODE { id=>yn, color=>coly, interferes_with=>adjy, degree=>degy, ... }
)
=>
if (xn == yn)
();
elif (insert_edge (xn, yn) )
#
case (*colx, *coly)
(cig::CODETEMP, cig::CODETEMP) => { adjx := y ! *adjx; degx := *degx+1;
adjy := x ! *adjy; degy := *degy+1;};
(cig::CODETEMP, cig::COLORED _) => { adjx := y ! *adjx; degx := *degx+1;};
(cig::CODETEMP, cig::RAMREG _) => { adjx := y ! *adjx; adjy := x ! *adjy;};
(cig::CODETEMP, cig::SPILL_LOC _) => { adjx := y ! *adjx; adjy := x ! *adjy;};
(cig::CODETEMP, cig::SPILLED) => ();
(cig::COLORED _, cig::CODETEMP) => { adjy := x ! *adjy; degy := *degy+1;};
(cig::COLORED _, cig::COLORED _) => (); # x!=y, can't alias
(cig::COLORED _, cig::RAMREG _) => (); # x!=y, can't alias
(cig::COLORED _, cig::SPILL_LOC _) => (); # x!=y, can't alias
(cig::COLORED _, cig::SPILLED) => ();
(cig::RAMREG _, cig::CODETEMP) => { adjx := y ! *adjx; adjy := x ! *adjy;};
(cig::RAMREG _, cig::COLORED _) => (); # x!=y, can't alias
(cig::RAMREG _, cig::RAMREG _) => (); # x!=y, can't alias
(cig::RAMREG _, cig::SPILL_LOC _) => (); # x!=y, can't alias
(cig::RAMREG _, cig::SPILLED) => ();
(cig::SPILL_LOC _, cig::CODETEMP) => { adjx := y ! *adjx; adjy := x ! *adjy;};
(cig::SPILL_LOC _, cig::COLORED _) => (); # x!=y, can't alias
(cig::SPILL_LOC _, cig::RAMREG _) => (); # x!=y, can't alias
(cig::SPILL_LOC _, cig::SPILL_LOC _) => (); # x!=y, can't alias
(cig::SPILL_LOC _, cig::SPILLED) => (); # x!=y, can't alias
(cig::SPILLED, _) => ();
(colx, coly) =>
error("addEdge x=" + int::to_string xn + col2s colx + " y=" + int::to_string yn + col2s coly);
esac;
# edge already there
fi;
end;
};
fun is_fixed_mem (cig::SPILL_LOC _) => TRUE;
is_fixed_mem (cig::RAMREG _) => TRUE;
is_fixed_mem (cig::SPILLED) => TRUE;
is_fixed_mem _ => FALSE;
end;
fun is_fixed (cig::COLORED _) => TRUE;
is_fixed c => is_fixed_mem (c);
end;
# Initialize a list of worklists
#
fun init_work_lists
( cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, hardware_registers_we_may_use, edge_hashtable, pseudo_count, codetemp_id_if_above, dead_copies, mem_moves, mode, ... } )
{ moves }
=
{
# Filter moves that already have an interference
# Also initialize the movelist and
# movecnt fields:
#
edge_exists = geh::edge_exists *edge_hashtable;
fun set_info (cig::NODE { color=>REF cig::CODETEMP, movecost, movecnt, movelist, ... },
mv, cost)
=>
{ movelist := mv ! *movelist;
movecnt := *movecnt + 1;
movecost := *movecost + cost;
};
set_info _ => ();
end;
# Filter moves that cannot be coalesced
#
fun filter ([], mvs', mem)
=>
(mvs', mem);
filter ( (mv as cig::MOVE_INT { src_reg as cig::NODE { id=>x, color=>REF col_src, ... },
dst_reg as cig::NODE { id=>y, color=>REF col_dst, ... },
cost,
...
}
) ! mvs,
mvs',
mem
)
=>
if (is_fixed col_src and is_fixed col_dst)
#
filter (mvs, mvs', mem);
elif (is_fixed_mem col_src or is_fixed_mem col_dst)
filter (mvs, mvs', mv ! mem);
elif (edge_exists (x, y))
filter (mvs, mvs', mem);
else
set_info (src_reg, mv, cost);
set_info (dst_reg, mv, cost);
filter (mvs, mv::add (mv, mvs'), mem);
fi;
end;
# Like filter but does dead copy elimination:
#
fun filter_dead ([], mvs', mem, dead)
=>
(mvs', mem, dead);
filter_dead
( (mv as
cig::MOVE_INT
{ src_reg as cig::NODE { id=>x, color as REF col_src, priority, interferes_with, uses, ... },
dst_reg as cig::NODE { id=>y, color=>REF col_dst, register=>registery, defs=>dst_defs, uses=>dst_uses, ... },
cost,
...
}
) ! mvs,
mvs',
mem,
dead
)
=>
if (is_fixed col_src and is_fixed col_dst)
filter_dead (mvs, mvs', mem, dead);
elif (is_fixed_mem col_src or is_fixed_mem col_dst )
filter_dead (mvs, mvs', mv ! mem, dead);
else
case (col_src, col_dst, dst_defs, dst_uses)
#
(_, cig::CODETEMP, REF [pt], REF [])
=>
# Eliminate dead copy:
#
{ fun dec_degree []
=>
();
dec_degree (cig::NODE { color=>REF cig::CODETEMP, degree, ... } ! interferes_with)
=>
{ degree := *degree - 1;
dec_degree interferes_with;
};
dec_degree(_ ! interferes_with)
=>
dec_degree interferes_with;
end;
fun elim_uses ([], _, uses, priority, cost)
=>
(uses, priority);
elim_uses (pt ! pts, pt': cig::Program_Point, uses, priority, cost)
=>
if (pt == pt') elim_uses (pts, pt', uses, priority-cost, cost);
else elim_uses (pts, pt', pt ! uses, priority, cost);
fi;
end;
my (uses', priority')
=
elim_uses(*uses, pt, [], *priority, cost);
priority := priority';
uses := uses';
color := cig::ALIASED src_reg;
dec_degree *interferes_with;
filter_dead (mvs, mvs', mem, registery ! dead);
};
_ =>
# Normal moves
#
if (edge_exists (x, y)) # moves that interfere
#
filter_dead (mvs, mvs', mem, dead);
else
set_info (src_reg, mv, cost);
set_info (dst_reg, mv, cost);
filter_dead (mvs, mv::add (mv, mvs'), mem, dead);
fi;
esac;
fi;
end;
# Scan all nodes in the graph and check
# which worklist they should go in:
#
fun collect ([], simp, fz, moves, spill, pseudos)
=>
{ pseudo_count := pseudos;
{ simplify_worklist => simp,
move_worklist => moves,
freeze_worklist => fz,
spill_worklist => spill
};
};
collect (node ! rest, simp, fz, moves, spill, pseudos)
=>
case node
#
cig::NODE { color=>REF cig::CODETEMP, movecnt, degree, ... }
=>
if (*degree >= hardware_registers_we_may_use)
#
collect (rest, simp, fz, moves, node ! spill, pseudos+1);
elif (*movecnt > 0)
collect (rest, simp, fz::add (node, fz),
moves, spill, pseudos+1);
else
collect (rest, node ! simp, fz, moves, spill,
pseudos+1);
fi;
_ =>
collect (rest, simp, fz, moves, spill, pseudos);
esac;
end;
# First build the move priority queue:
#
my (mvs, mem)
=
if (is_on (mode, dead_copy_elim))
my (mvs, mem, dead) = filter_dead (moves, mv::EMPTY, [], []);
dead_copies := dead; (mvs, mem);
else
filter (moves, mv::EMPTY, []);
fi;
mem_moves := mem; # memory moves
collect (iht::vals_list node_hashtable, [], fz::EMPTY, mvs, [], 0);
};
# Return a regmap that returns the current spill location
# during spilling.
#
fun spill_loc (cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, ... } )
=
get'
where
getnode = iht::get node_hashtable;
fun num (cig::NODE { color=>REF (cig::ALIASED n), ... }) => num n;
num (cig::NODE { color=>REF (cig::SPILLED), id, ... }) => id;
num (cig::NODE { color=>REF (cig::SPILL_LOC s), ... }) => -s;
num (cig::NODE { color=>REF (cig::RAMREG (m, _)), ... }) => m;
num (cig::NODE { id, ... }) => id;
end;
fun get' r
=
num (getnode r)
except
_ = r;
end;
fun spill_loc_to_string (cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, ... } )
=
get'
where
getnode = iht::get node_hashtable;
fun num (cig::NODE { color=>REF (cig::ALIASED n), ... }) => num n;
num (cig::NODE { color=>REF (cig::SPILLED), register, ... }) => "spilled " + rkj::register_to_string register;
num (cig::NODE { color=>REF (cig::SPILL_LOC s), ... }) => "frame " + int::to_string s;
num (cig::NODE { color=>REF (cig::RAMREG(_, m)), ... }) => "memreg " + rkj::register_to_string m;
num (cig::NODE { id, ... }) => "error " + int::to_string id;
end;
fun get' r
=
num (getnode r);
end;
# Core phases:
# Simplify, coalesce, freeze.
#
# NOTE: When a node's color is REMOVED or cig::ALIASED,
# it is not considered to be part of the interferes_with list
#
# 1. The move list has no duplicates.
# 2. The freeze list may have duplicates.
#
fun iterated_coalescing_phases
(cig as cig::CODETEMP_INTERFERENCE_GRAPH { hardware_registers_we_may_use, edge_hashtable, spill_flag, trail, mode, pseudo_count, ... } )
=
{ edge_exists = geh::edge_exists *edge_hashtable;
add_edge = add_edge cig;
show = show cig;
memory_coalescing_on = is_on (mode, memory_coalescing);
# SIMPLIFY node:
# Precondition: Node must be part
# of the interference graph (cig::CODETEMP)
#
fun simplify
( node as cig::NODE { color, interferes_with, degree, /*pair,*/... },
mv, fz, stack
)
=
{ if debug print("Simplifying " + show node + "\n"); fi;
fun forall_interferes_with ([], mv, fz, stack)
=>
(mv, fz, stack);
forall_interferes_with ((n as cig::NODE { color=>REF cig::CODETEMP, degree as REF d, ... } ) ! interferes_with,
mv, fz, stack)
=>
if (d == hardware_registers_we_may_use)
#
(low_degree (n, mv, fz, stack))
->
(mv, fz, stack);
forall_interferes_with (interferes_with, mv, fz, stack);
else
degree := d - 1;
forall_interferes_with (interferes_with, mv, fz, stack);
fi;
forall_interferes_with (_ ! interferes_with, mv, fz, stack)
=>
forall_interferes_with (interferes_with, mv, fz, stack);
end;
color := cig::REMOVED;
pseudo_count := *pseudo_count - 1;
forall_interferes_with (*interferes_with, mv, fz, node ! stack); # Push onto stack.
} # fun simplify
also
fun simplify_all ([], mv, fz, stack)
=>
(mv, fz, stack);
simplify_all (node ! simp, mv, fz, stack)
=>
{ my (mv, fz, stack)
=
simplify (node, mv, fz, stack);
simplify_all (simp, mv, fz, stack);
};
end
# Decrement the degree of a pseudo node.
# precondition: node must be part of the interference graph
# If the degree of the node is now k-1.
# Then if (a) the node is move related, freeze it.
# (b) the node is non-move related, simplify it
#
# node -- the node to decrement degree
# mv -- queue of move candidates to be coalesced
# fz -- queue of freeze candidates
# stack -- stack of removed nodes
#
also
fun low_degree
(node as cig::NODE { degree as REF d, movecnt, interferes_with, color, ... }, /* FALSE, */ mv, fz, stack)
=
# Normal edge.
{ if debug print("DecDegree " + show node + " d=" + int::to_string (d - 1) + "\n"); fi;
degree := hardware_registers_we_may_use - 1;
# node is now low degree!!!
mv = enable_moves (*interferes_with, mv);
if (*movecnt > 0) (mv, fz::add (node, fz), stack); # Move related.
else simplify (node, mv, fz, stack); # Non-move related, simplify now.
fi;
}
# | decDegree (node as cig::NODE { degree as REF d, movecnt, interferes_with, color, ... },
# TRUE, mv, fz, stack) = # register pair edge
# (degree := d - 2;
# if d >= k and *degree < k then
# # node is now low degree!!!
# let mv = enableMoves (node ! *interferes_with, mv)
# in if *movecnt > 0 then # move related
# (mv, fz::add (node, fz), stack)
# else # non-move related, simplify now!
# simplify (node, mv, fz, stack)
# end
# else
# (mv, fz, stack)
# )
# Enable moves:
# given: a list of nodes (some of which are not in the graph)
# do: all moves associated with these nodes are inserted
# into the move worklist
#
also
fun enable_moves ([], mv)
=>
mv;
enable_moves (n ! ns, mv)
=>
{ # Add valid moves onto the worklist.
# There are no duplicates on the move worklist.
#
fun add_mv ([], ns, mv)
=>
enable_moves (ns, mv);
add_mv((m as cig::MOVE_INT { status, hicount as REF hi, ... } ) ! rest, ns, mv)
=>
case *status
(cig::BRIGGS_MOVE | cig::GEORGE_MOVE)
=>
# Decrements hi, when hi <= 0 enable move
if (hi <= 1)
status := cig::WORKLIST;
add_mv (rest, ns, mv::add (m, mv));
else
hicount := hi - 1;
add_mv (rest, ns, mv);
fi;
_ =>
add_mv (rest, ns, mv);
esac;
end;
# Make sure the nodes are
# actually in the graph:
#
case n
#
cig::NODE { movelist, color=>REF cig::CODETEMP, movecnt, ... }
=>
if (*movecnt > 0) # Is it move related?
add_mv (*movelist, ns, mv);
else
enable_moves (ns, mv);
fi;
_ => enable_moves (ns, mv);
esac;
};
end; # fun enable_moves
# Brigg's conservative coalescing test:
# given: an unconstrained move (x, y)
# return: TRUE or FALSE
#
fun conservative (hicount,
x as cig::NODE { degree=>REF dx, interferes_with=>xadj, /* pair=px, */ ... },
y as cig::NODE { degree=>REF dy, interferes_with=>yadj, /* pair=py, */ ... } )
=
dx + dy < hardware_registers_we_may_use
or
{ # hi -- is the number of nodes with deg > k (without duplicates)
# n -- the number of nodes that have deg = k but not neighbors
# of both x and y
# We use the movecnt as a flag indicating whether
# a node has been visited. A negative count is used to mark
# a visited node.
#
fun undo ([], extra_hi)
=>
extra_hi <= 0 or { hicount := extra_hi; FALSE;};
undo (movecnt ! tr, extra_hi)
=>
{ movecnt := -1 - *movecnt;
undo (tr, extra_hi);
};
end;
fun loop ([], [], hi, n, tr) => undo (tr, (hi + n) - hardware_registers_we_may_use + 1);
loop ([], yadj, hi, n, tr) => loop (yadj, [], hi, n, tr);
loop (cig::NODE { color, movecnt as REF m, degree=>REF deg, ... } ! vs, yadj, hi, n, tr)
=>
case *color
#
cig::COLORED _
=>
if (m < 0)
# node has been visited before
loop (vs, yadj, hi, n, tr);
else
movecnt := -1 - m; # mark as visited
loop (vs, yadj, hi+1, n, movecnt ! tr);
fi;
cig::CODETEMP
=>
if (deg < hardware_registers_we_may_use)
#
loop (vs, yadj, hi, n, tr);
elif (m >= 0)
# Node has never been visited before:
movecnt := -1 - m; # Mark as visited.
if (deg == hardware_registers_we_may_use) loop (vs, yadj, hi, n+1, movecnt ! tr);
else loop (vs, yadj, hi+1, n, movecnt ! tr);
fi;
# node has been visited before
elif (deg == hardware_registers_we_may_use) loop (vs, yadj, hi, n - 1, tr);
else loop (vs, yadj, hi, n, tr);
fi;
_ => loop (vs, yadj, hi, n, tr); # REMOVED/cig::ALIASED
esac;
end;
loop (*xadj, *yadj, 0, 0, []);
}; # fun conservative
# Heuristic used to determine whether a codetemp and hardware register
# can be coalesced.
# Precondition:
# The two nodes are assumed not to interfere.
#
fun safe (hicount, reg, cig::NODE { interferes_with, ... } )
=
loop (*interferes_with, 0)
where
fun loop ([], hi)
=>
hi == 0 or { hicount := hi; FALSE;};
loop (n ! interferes_with, hi)
=>
case n
# Note: We only have to consider pseudo nodes and not
# nodes that are removed, since removed nodes either have
# deg < k or else optimistic spilling must be in effect:
#
cig::NODE { degree, id, color=>REF (cig::CODETEMP | cig::REMOVED), ... }
=>
(*degree < hardware_registers_we_may_use
or edge_exists (reg, id))
?? loop (interferes_with, hi )
:: loop (interferes_with, hi+1);
_ => loop (interferes_with, hi);
esac;
end;
end;
# Decrement the active move count of a node.
# When the move count reaches 0 and the degree < k
# simplify the node immediately.
# Precondition: node must be a node in the interference graph
# The node can become a non-move related node.
#
fun dec_move_count
( node as cig::NODE { movecnt, color=>REF cig::CODETEMP, degree, movecost, ... },
count, cost, mv, fz, stack
)
=>
{ new_count = *movecnt - count;
movecnt := new_count;
movecost := *movecost - cost;
if (new_count == 0
and *degree < hardware_registers_we_may_use) # low degree and movecnt == 0
#
(simplify (node, mv, fz, stack));
else
(mv, fz, stack);
fi;
};
dec_move_count(_, _, _, mv, fz, stack)
=>
(mv, fz, stack);
end;
# Combine two nodes u and v into one.
# v is replaced by u
# u is the new combined node
# Precondition: u != v and u and v must be unconstrained
#
# u, v -- two nodes to be merged, must be distinct!
# coloingv -- is u a colored node?
# mvcost -- the cost of the move that has been eliminated
# mv -- the queue of moves
# fz -- the queue of freeze candidates
# stack -- stack of removed nodes
#
fun combine (u, v, coloringv, mvcost, mv, fz, stack)
=
{ v -> cig::NODE { color=>vcol, priority=>pv, movecnt=>cntv, movelist=>movev, interferes_with=>adjv, defs=>defsv, uses=>usesv, degree=>degv, ... };
u -> cig::NODE { color=>ucol, priority=>pu, movecnt=>cntu, movelist=>moveu, interferes_with=>adju, defs=>defsu, uses=>usesu, degree=>degu, ... };
# Merge movelists together,
# taking the opportunity
# to prune the lists:
#
fun merge_move_list ([], mv)
=>
mv;
merge_move_list ((m as cig::MOVE_INT { status, hicount, src_reg, dst_reg, ... } ) ! rest, mv)
=>
case *status
#
cig::BRIGGS_MOVE
=>
# If we are changing a copy from v <-> w to uv <-> w
# makes sure we reset its trigger count, so that it
# will be tested next.
#
{ if coloringv
status := cig::GEORGE_MOVE;
hicount := 0;
if debug print ("New george " + show src_reg + "<->" + show dst_reg + "\n"); fi;
fi;
merge_move_list (rest, m ! mv);
};
cig::GEORGE_MOVE
=>
# If u is colored and v is not,
# then the move v <-> w
# becomes uv <-> w
# where w is colored.
# This can always be discarded.
#
if coloringv merge_move_list (rest, mv);
else merge_move_list (rest, m ! mv);
fi;
cig::WORKLIST
=>
merge_move_list (rest, m ! mv);
_ =>
merge_move_list (rest, mv);
esac;
end;
# Form combined node.
# Add the interferes_with list of v to u:
#
fun union ([], mv, fz, stack)
=>
(mv, fz, stack);
union((t as cig::NODE { color, degree, ... } ) ! interferes_with, mv, fz, stack)
=>
case *color
#
(cig::COLORED _ | cig::SPILL_LOC _ | cig::RAMREG _ | cig::SPILLED)
=>
{ add_edge (t, u);
union (interferes_with, mv, fz, stack);
};
cig::CODETEMP
=>
{ add_edge (t, u);
d = *degree;
if (d == hardware_registers_we_may_use)
#
my (mv, fz, stack)
=
low_degree (t, mv, fz, stack);
union (interferes_with, mv, fz, stack);
else
degree := d - 1;
union (interferes_with, mv, fz, stack);
fi;
};
_ => union (interferes_with, mv, fz, stack);
esac;
end;
vcol := cig::ALIASED u;
#
# Combine the priority of both:
# Note that since the mvcost has been counted twice
# in the original priority, we substract it twice
# from the new priority.
pu := *pu + *pv - mvcost - mvcost;
#
# Combine the def/use pts of both nodes.
# Strictly speaking, the def/use points of the move
# should also be removed. But since we never spill
# a coalesced node and only spilling makes use of these
# def/use points, we are safe for now.
#
# New comment: with spill propagation, it is necessary
# to keep track of the spilled program points.
if memory_coalescing_on
defsu := cat (*defsu, *defsv);
usesu := cat (*usesu, *usesv);
fi;
case *ucol
#
cig::CODETEMP
=>
{ if (*cntv > 0) moveu := merge_move_list(*movev, *moveu); fi;
movev := []; # XXX kill the list to free space
cntu := *cntu + *cntv;
};
_ => ();
esac;
cntv := 0;
removing_hi
=
*degv >= hardware_registers_we_may_use
and
(*degu >= hardware_registers_we_may_use or coloringv);
# Update the move count of the combined node:
#
my (mv, fz, stack)
=
union(*adjv, mv, fz, stack);
my (mv, fz, stack)
=
dec_move_count (u, 2, mvcost + mvcost, mv, fz, stack);
# If either v or u are high degree then at least one high degree
# node is removed from the neighbors of uv after coalescing
#
mv = if removing_hi enable_moves(*adju, mv); else mv;fi;
coalesce (mv, fz, stack);
}
# COALESCE:
# Repeat coalescing and simplification until mv is empty.
#
also
fun coalesce (mv::EMPTY, fz, stack)
=>
(fz, stack);
coalesce (mv::TREE (cig::MOVE_INT { src_reg, dst_reg, status, hicount, cost, ... }, _, l, r), fz, stack)
=>
{ # coalesce_count := *coalesce_count + 1
(chase src_reg) -> u;
(chase dst_reg) -> v as cig::NODE { color=>REF vcol, ... };
# Make u the colored one:
#
my ( u as cig::NODE { id=>u', color=>REF ucol, ... },
v as cig::NODE { id=>v', color=>REF vcol, ... }
)
=
case vcol cig::COLORED _ => (v, u);
_ => (u, v);
esac;
if debug print ("Coalescing " + show u + "<->" + show v + " (" + f8b::to_string cost + ")"); fi;
mv = mv::merge (l, r);
fun coalesce_it (status, v)
=
{ status := cig::COALESCED;
if *spill_flag trail := cig::UNDO (v, status, *trail); fi;
};
if (u' == v') # Trivial move
#
if debug print(" Trivial\n"); fi;
coalesce_it (status, v);
coalesce (dec_move_count (u, 2, cost+cost, mv, fz, stack));
else
case vcol
cig::COLORED _
=>
# Two colored nodes cannot be coalesced:
#
{ status := cig::CONSTRAINED;
if debug print(" Both Colored\n"); fi;
coalesce (mv, fz, stack);
};
_ =>
if (edge_exists (u', v') )
#
# U and v interfere.
status := cig::CONSTRAINED;
if debug print(" Interfere\n"); fi;
my (mv, fz, stack) = (dec_move_count (u, 1, cost, mv, fz, stack));
coalesce (dec_move_count (v, 1, cost, mv, fz, stack));
else
case ucol
#
cig::COLORED _ # u is colored, v is not
=>
if (safe (hicount, u', v) )
if debug print(" Safe\n"); fi;
# if tally then good_george := *good_george+1
coalesce_it (status, v);
combine (u, v, TRUE, cost, mv, fz, stack);
else
# Remove it from the move list:
status := cig::GEORGE_MOVE;
# if tally then bad_george := *bad_george + 1
if debug print(" Unsafe\n"); fi;
coalesce (mv, fz, stack);
fi;
_ => # u, v are not colored
if (conservative (hicount, u, v) )
#
if debug print(" OK\n"); fi;
# if tally then good_briggs := *good_briggs+1
coalesce_it (status, v);
combine (u, v, FALSE, cost, mv, fz, stack);
else
# Conservative test failed.
# Remove it from the move list:
status := cig::BRIGGS_MOVE;
# if tally then bad_briggs := *bad_briggs + 1
if debug print(" Non-conservative\n"); fi;
coalesce (mv, fz, stack);
fi;
esac;
fi;
esac;
fi;
};
end; # fun coalesce
# Mark a node n as frozen:
# Go thru all the moves (n, m), decrement the move count of m
# precondition: degree must be < k
# movecnt must be > 0
# node -- the node to be frozen
# fz -- a queue of freeze candidates
# stack -- stack of removed nodes
#
fun mark_as_frozen
(
node as cig::NODE { id=>me, degree, interferes_with, movelist, movecnt as REF mc, ... },
fz, stack
)
=
{ if debug print("Mark as frozen " + int::to_string me + "\n"); fi;
# Eliminate all moves,
# return a list of nodes that
# can be simplified:
#
fun elim_moves ([], simp)
=>
simp;
elim_moves (cig::MOVE_INT { status, src_reg, dst_reg, ... } ! mvs, simp)
=>
case *status
#
cig::WORKLIST
=>
error "elimMoves";
(cig::BRIGGS_MOVE | cig::GEORGE_MOVE) # Mark move as lost.
=>
{ status := cig::LOST;
(chase src_reg) -> src as cig::NODE { id=>s, ... };
you = (s == me) ?? chase dst_reg
:: src;
case you
#
cig::NODE { color=>REF (cig::COLORED _), ... }
=>
elim_moves (mvs, simp);
cig::NODE { movecnt as REF c, degree, ... } # pseudo
=>
{ movecnt := c - 1;
(c == 1 and *degree < hardware_registers_we_may_use)
?? elim_moves (mvs, you ! simp)
:: elim_moves (mvs, simp);
};
esac;
};
_ => elim_moves (mvs, simp);
esac;
end;
# Note:
# We are removing a high degree node,
# so try to enable all moves
# associated with its neighbors.
#
mv = if (*degree >= hardware_registers_we_may_use) enable_moves (*interferes_with, mv::EMPTY);
else mv::EMPTY;
fi;
if (mc == 0)
#
simplify (node, mv, fz, stack);
else
movecnt := 0;
simplify_all (node ! elim_moves(*movelist, []), mv, fz, stack);
fi;
};
# FREEZE:
# Repeat picking
# a node with degree < k from the freeze list and freeze it.
# fz -- queue of freezable nodes
# stack -- stack of removed nodes
# undo -- trail of coalesced moves after potential spill
#
fun freeze (fz, stack)
=
loop (fz, fz::EMPTY, stack)
where
fun loop (fz::EMPTY, fz::EMPTY, stack)
=>
stack;
loop (fz::EMPTY, new_fz, _)
=>
error "no freeze candidate";
loop (fz::TREE (node, _, l, r), new_fz, stack)
=>
{ fz = fz::merge (l, r);
case node
#
# This node has not been simplified
# This must be a move-related node.
#
cig::NODE { color=>REF cig::CODETEMP, degree, ... }
=>
if (*degree >= hardware_registers_we_may_use) # Can't be frozen yet?
#
# if tally then bad_freeze := *bad_freeze+1; fi;
loop (fz, fz::add (node, new_fz), stack);
else
# Freeze node.
if debug print("Freezing " + show node + "\n"); fi;
# if tally then good_freeze := *good_freeze + 1
my (mv, fz, stack)
=
mark_as_frozen (node, fz, stack);
my (fz, stack)
=
coalesce (mv, fz, stack);
# print("[freezing again " + int::to_string *blocked + "]");
loop (fz::merge (fz, new_fz), fz::EMPTY, stack);
fi;
_ =>
{ # if tally then bad_freeze := *bad_freeze + 1
loop (fz, new_fz, stack);
};
esac;
};
end;
# print("[freezing " + int::to_string *blocked + "]");
end;
# Sort simplify worklist in increasing degree.
# Matula and Beck suggest that we should always
# first remove the node with the lowest degree.
# This is an approximation of that idea.
# buckets = rwv::rw_vector (k, []) : rwv::Rw_Vector( List( cig::node ) )
# fun sortByDegree nodes =
# let fun insert [] = ()
# | insert((n as cig::NODE { degree=REF deg, ... } ) ! rest) =
# (uwv::set (buckets, deg, n ! uwv::sub (buckets, deg)); insert rest)
# fun collect (-1, L) = L
# | collect (deg, L) = collect (deg - 1, cat (uwv::sub (buckets, deg), L))
# in insert nodes;
# collect (k - 1, [])
# end
# Iterate over simplify, coalesce, freeze
#
fun iterate { simplify_worklist, move_worklist, freeze_worklist, stack }
=
{ # Simplify everything:
my (mv, fz, stack)
=
simplify_all( /* sort_by_degree */ simplify_worklist, move_worklist, freeze_worklist, stack);
my (fz, stack)
=
coalesce (mv, fz, stack);
stack = freeze (fz, stack);
{ stack };
};
{ mark_as_frozen, iterate };
};
# The main entry point for the
# iterated coalescing algorithm:
#
fun iterated_coalescing codetemp_interference_graph
=
(iterated_coalescing_phases codetemp_interference_graph).iterate;
# Potential Spill:
# Find some node on the spill list and just optimistically
# remove it from the graph.
#
fun potential_spill_node (cig as cig::CODETEMP_INTERFERENCE_GRAPH { spill_flag, ... } )
=
{
my { mark_as_frozen, ... }
=
iterated_coalescing_phases cig;
\\ { node, cost, stack }
=
{ spill_flag := TRUE; # Potential spill found.
my (mv, fz, stack)
=
mark_as_frozen (node, fz::EMPTY, stack);
if (cost < 0.0)
my cig::NODE { color, ... } = node;
color := cig::SPILLED;
fi;
{ move_worklist=>mv, freeze_worklist=>fz, stack };
};
};
# SELECT:
# Using optimistic spilling
#
fun select
(cig as cig::CODETEMP_INTERFERENCE_GRAPH { pick_available_hardware_register, trail, codetemp_id_if_above, spill_flag, register_is_taken,true_value, mode, ... } )
{ stack }
=
{ fun undo_coalesced cig::END
=>
();
undo_coalesced (cig::UNDO (cig::NODE { id, color, ... }, status, trail))
=>
{ status := cig::BRIGGS_MOVE;
if (id >= codetemp_id_if_above) color := cig::CODETEMP; fi;
undo_coalesced trail;
};
end;
show = show cig;
# Fast coloring, assume no spilling can occur
#
fun fastcoloring ([], true_value)
=>
([], true_value);
fastcoloring((node as cig::NODE { color, /* pair, */ interferes_with, ... } ) ! stack, true_value)
=>
{ # Set up the register_is_taken rw_vector:
#
fun fill_in__register_is_taken__vector []
=>
();
fill_in__register_is_taken__vector (r ! rs)
=>
mark r
where
fun mark (cig::NODE { color=>REF (cig::COLORED c), ... } )
=>
{ uwv::set (register_is_taken, c, true_value);
fill_in__register_is_taken__vector rs;
};
mark (cig::NODE { color=>REF (cig::ALIASED n), ... } )
=>
mark n;
mark _
=>
fill_in__register_is_taken__vector rs;
end;
end;
end;
fill_in__register_is_taken__vector *interferes_with;
color := cig::COLORED
(pick_available_hardware_register # pick_available_hardware_register_by_round_robin_g is from src/lib/compiler/back/low/regor/pick-available-hardware-register-by-round-robin-g.pkg {
preferred_registers => [],
register_is_taken,
true_value
}
);
fastcoloring (stack, true_value+1);
};
end;
# Briggs' optimistic spilling heuristic
#
fun optimistic ([], spills, true_value)
=>
(spills, true_value);
optimistic((node as cig::NODE { color=>REF (cig::SPILLED), ... } ) ! stack, spills, true_value)
=>
optimistic (stack, node ! spills, true_value);
optimistic((node as cig::NODE { color as REF cig::REMOVED, /* pair, */ interferes_with, ... } ) ! stack, spills, true_value)
=>
{ # Set up the register_is_taken rw_vector:
#
fun fill_in__register_is_taken__vector []
=>
();
fill_in__register_is_taken__vector (r ! rs)
=>
mark r
where
fun mark (cig::NODE { color=>REF (cig::COLORED c), ... } )
=>
{ uwv::set (register_is_taken, c, true_value);
fill_in__register_is_taken__vector rs;
};
mark (cig::NODE { color=>REF (cig::ALIASED n), ... } )
=>
mark n;
mark _ => fill_in__register_is_taken__vector rs;
end;
end;
end;
fill_in__register_is_taken__vector *interferes_with;
spills
=
{ color' = pick_available_hardware_register # pick_available_hardware_register_by_round_robin_g is from src/lib/compiler/back/low/regor/pick-available-hardware-register-by-round-robin-g.pkg {
preferred_registers => [],
register_is_taken,
true_value
};
color := cig::COLORED color';
spills;
}
except
_ = node ! spills;
optimistic (stack, spills, true_value+1);
};
optimistic _
=>
error "optimistic";
end;
# Briggs' optimistic spilling heuristic, with biased coloring:
#
fun biased_coloring ([], spills, true_value)
=>
(spills, true_value);
biased_coloring((node as cig::NODE { color=>REF (cig::SPILLED), ... } ) ! stack, spills, true_value)
=>
biased_coloring (stack, node ! spills, true_value);
biased_coloring((node as cig::NODE { color=>REF (cig::SPILL_LOC _), ... } ) ! stack, spills, true_value)
=>
biased_coloring (stack, node ! spills, true_value);
biased_coloring((node as cig::NODE { color=>REF (cig::RAMREG _), ... } ) ! stack, spills, true_value)
=>
biased_coloring (stack, node ! spills, true_value);
biased_coloring
(
(node as cig::NODE { id, color, interferes_with, /* pair, */ movecnt, movelist, ... } ) ! stack,
spills,
true_value
)
=>
{ # Set up the register_is_taken rw_vector:
#
fun fill_in__register_is_taken__vector []
=>
();
fill_in__register_is_taken__vector (r ! rs)
=>
case (chase r)
#
cig::NODE { color=>REF (cig::COLORED c), ... }
=>
{ uwv::set (register_is_taken, c, true_value);
fill_in__register_is_taken__vector rs;
};
_ =>
fill_in__register_is_taken__vector rs;
esac;
end;
# Look at lost moves and
# see if it is possible to
# color the move with the same color
#
fun get_pref ([], pref)
=>
pref;
get_pref (cig::MOVE_INT { status=>REF (cig::LOST | cig::BRIGGS_MOVE | cig::GEORGE_MOVE), src_reg, dst_reg, ... } ! mvs, pref)
=>
{ (chase src_reg) -> src as cig::NODE { id=>s, ... };
other = (s == id) ?? chase dst_reg
:: src;
case other
#
cig::NODE { color=>REF (cig::COLORED c), ... }
=>
get_pref (mvs, c ! pref);
_ =>
get_pref (mvs, pref);
esac;
};
get_pref(_ ! mvs, pref)
=>
get_pref (mvs, pref);
end;
fill_in__register_is_taken__vector *interferes_with;
pref = get_pref (*movelist,[]);
spills
=
{ color' = pick_available_hardware_register # pick_available_hardware_register_by_round_robin_g is from src/lib/compiler/back/low/regor/pick-available-hardware-register-by-round-robin-g.pkg {
preferred_registers => [],
register_is_taken,
true_value
};
color := cig::COLORED color';
spills;
}
except
_ = node ! spills;
biased_coloring (stack, spills, true_value+1);
};
end; # fun biased_coloring
my (spills, new_true_value)
=
if (is_on (mode, biased_selection)) biased_coloring (stack, [], *true_value);
elif *spill_flag optimistic (stack, [], *true_value);
else fastcoloring (stack, *true_value);
fi;
true_value := new_true_value;
case spills
#
[] => { spills => [] };
spills
=>
{ fun undo []
=>
();
undo (cig::NODE { color, ... } ! nodes)
=>
{ color := cig::CODETEMP;
undo nodes;
};
end;
undo stack;
undo_coalesced *trail;
trail := cig::END;
{ spills };
};
esac;
}; # fun select
# Incorporate memory<->register moves
# into the interference graph:
#
fun init_mem_moves (cig::CODETEMP_INTERFERENCE_GRAPH { mem_moves, ... } )
=
{ fun move (cig::NODE { movelist, movecost, ... }, mv, cost)
=
{ movelist := mv ! *movelist;
movecost := cost + *movecost;
};
fun set_move (dst, src, mv, cost)
=
{ move (dst, mv, cost);
move (src, mv, cost);
};
fun init []
=>
();
init ((mv as cig::MOVE_INT { dst_reg, src_reg, cost, ... } ) ! mvs)
=>
{ (chase dst_reg) -> dst as cig::NODE { color=>REF dst_col, ... };
(chase src_reg) -> src as cig::NODE { color=>REF src_col, ... };
if (is_fixed_mem (src_col) and is_fixed_mem (dst_col) )
set_move (dst, src, mv, cost);
else
case (src_col, dst_col)
(cig::CODETEMP, _)
=>
if (is_fixed_mem dst_col) set_move (dst, src, mv, cost);
else error "init_mem_moves";
fi;
(_, cig::CODETEMP)
=>
if (is_fixed_mem src_col) set_move (dst, src, mv, cost);
else error "init_mem_moves";
fi;
(cig::COLORED _, _) => if (not (is_fixed_mem dst_col)) error "init_mem_moves"; fi;
(_, cig::COLORED _) => if (not (is_fixed_mem src_col)) error "init_mem_moves"; fi;
_ => error "init_mem_moves";
esac;
fi;
init mvs;
};
end;
moves = *mem_moves;
mem_moves := [];
init moves;
}; # fun init_mem_moves
# Compute savings due to memory<->register moves
#
fun move_savings (cig::CODETEMP_INTERFERENCE_GRAPH { mem_moves=>REF [], ... } )
=>
(\\ node = 0.0);
move_savings (cig::CODETEMP_INTERFERENCE_GRAPH { mem_moves, edge_hashtable, ... } )
=>
{ exception SAVINGS;
savings_map = iht::make_hashtable { size_hint => 32, not_found_exception => SAVINGS }
: iht::Hashtable { pinned: Int,
cost: cig::Cost
};
savings = iht::find savings_map;
savings = \\ r = case (savings r) NULL => { pinned=> -1, cost=>0.0 };
THE s => s;
esac;
add_savings = iht::set savings_map;
edge_exists = geh::edge_exists *edge_hashtable;
fun inc_savings (u, v, c)
=
{ (savings u) -> { pinned, cost };
if (pinned != -1 and v != pinned or edge_exists(u, v))
();
else
add_savings (u, { pinned=>v, cost=>cost + c + c } );
fi;
};
fun compute_savings []
=>
();
compute_savings (cig::MOVE_INT { dst_reg, src_reg, cost, ... } ! mvs)
=>
{ (chase src_reg) -> src as cig::NODE { id=>u, color=>cu, ... };
(chase dst_reg) -> dst as cig::NODE { id=>v, color=>cv, ... };
case (*cu, *cv)
#
(cu, cig::CODETEMP) => if (is_fixed_mem cu) inc_savings (v, u, cost); fi;
(cig::CODETEMP, cv) => if (is_fixed_mem cv) inc_savings (u, v, cost); fi;
_ => ();
esac;
compute_savings mvs;
};
end;
compute_savings *mem_moves;
\\ node = (savings node).cost;
};
end; # fun move_savings
# Update the color of registers:
#
fun update_register_colors (cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, dead_copies, ... } )
=
iht::apply recolor_node node_hashtable
where
fun color_register (rkj::CODETEMP_INFO { color, ... }, new_color)
=
color := new_color;
fun register_of (cig::NODE { register, ... } )
=
register;
fun recolor_node (cig::NODE { register, color=>REF (cig::COLORED c), ... } ) => color_register (register, rkj::MACHINE c);
recolor_node (cig::NODE { register, color=>REF (cig::ALIASED alias), ... } ) => color_register (register, rkj::ALIASED (register_of alias));
recolor_node (cig::NODE { register, color=>REF (cig::SPILLED), ... } ) => color_register (register, rkj::SPILLED);
recolor_node (cig::NODE { register, color=>REF (cig::SPILL_LOC s), ... } ) => color_register (register, rkj::SPILLED);
recolor_node (cig::NODE { register, color=>REF (cig::RAMREG (m, _)), ... } ) => color_register (register, rkj::MACHINE m);
#
recolor_node (cig::NODE { register, color=>REF (cig::CODETEMP), ... } ) => ();
recolor_node (_) => error ("update_register_colors");
end;
end;
# Update aliases before spill rewriting:
#
fun update_register_aliases (cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, dead_copies, ... } )
=
{ fun enter (rkj::CODETEMP_INFO { color, ... }, c)
=
color := c;
fun register_of (cig::NODE { register, ... } )
=
register;
fun set (cig::NODE { register, color=>REF (cig::COLORED c), ... } )
=>
();
set (cig::NODE { register, color=>REF (cig::ALIASED alias), ... } )
=>
enter (register, rkj::ALIASED (register_of alias));
set (cig::NODE { register, color=>REF (cig::SPILLED), ... } ) => ();
set (cig::NODE { register, color=>REF (cig::SPILL_LOC s), ... } ) => ();
set (cig::NODE { register, color=>REF (cig::RAMREG _), ... } ) => ();
set (cig::NODE { register, color=>REF cig::CODETEMP, ... } ) => ();
set (_)
=>
error "updateRegisterAliases";
end;
iht::apply set node_hashtable;
};
fun mark_dead_copies_as_spilled (cig::CODETEMP_INTERFERENCE_GRAPH { dead_copies, ... } )
=
case *dead_copies
#
[] => ();
#
dead_copies' => apply (\\ r = color_register (r, rkj::SPILLED))
dead_copies';
esac
where
fun color_register (rkj::CODETEMP_INFO { color, ... }, new_color)
=
color := new_color;
end;
# Clear the interference graph
# but keep the nodes:
#
fun clear_graph
(cig::CODETEMP_INTERFERENCE_GRAPH { edge_hashtable, get_next_codetemp_id_to_allot, trail, spill_flag, dead_copies, mem_moves, copy_tmps, ... }
)
=
{ hashchains_count_hint = geh::get_hashchains_count *edge_hashtable;
#
trail := cig::END;
spill_flag := FALSE;
dead_copies := [];
mem_moves := [];
copy_tmps := [];
edge_hashtable := geh::empty_graph; # WTF?
edge_hashtable := cig::make_edge_hashtable { hashchains_count_hint, max_codetemp_id=>get_next_codetemp_id_to_allot() };
};
fun clear_nodes (cig::CODETEMP_INTERFERENCE_GRAPH { node_hashtable, ... } )
=
iht::keyed_apply init node_hashtable
where
fun init (_, cig::NODE { priority, degree, interferes_with, movecnt, movelist, movecost, defs, uses, ... } )
=
{ priority := 0.0;
movecost := 0.0;
degree := 0;
movecnt := 0;
interferes_with := [];
movelist := [];
defs := [];
uses := [];
};
end;
end; # stipulate
}; # package iterated_register_coalescing
end; # stipulate
## COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.