## register-spilling-per-improved-chow-hennessy-heuristic-g.pkg
#
# This module implements a Chow-Hennessy-style spill heuristic
#
# See also:
# 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# Compiled by:
# src/lib/compiler/back/low/lib/register-spilling.libstipulate
package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package hpq = heap_priority_queue; # heap_priority_queue is from src/lib/src/heap-priority-queue.pkg package irc = iterated_register_coalescing; # iterated_register_coalescing is from src/lib/compiler/back/low/regor/iterated-register-coalescing.pkg package cig = codetemp_interference_graph; # codetemp_interference_graph is from src/lib/compiler/back/low/regor/codetemp-interference-graph.pkgherein
generic package register_spilling_per_improved_chow_hennessy_heuristic_g ( # Nowhere invoked.
# ========================================================
#
move_ratio: Float;
)
: (weak) Register_Spilling_Per_Xxx_Heuristic # Register_Spilling_Per_Xxx_Heuristic is from src/lib/compiler/back/low/regor/register-spilling-per-xxx-heuristic.api {
exception NO_CANDIDATE;
mode = irc::compute_span;
cache = REF NULL: Ref( Null_Or( hpq::Priority_Queue( (cig::Node, Float) ) ) ); # XXX BUGGO FIXME more icky thread-hostile global mutable state
fun init ()
=
cache := NULL;
# Potential spill phase.
# Find a cheap node to spill according to Chow Hennessy's heuristic.
#
fun choose_spill_node
{
codetemp_interference_graph as cig::CODETEMP_INTERFERENCE_GRAPH { span, ... },
has_been_spilled,
spill_worklist
}
=
{ fun chase (cig::NODE { color=>REF (cig::ALIASED n), ... } ) => chase n;
chase n => n;
end;
# Savings due to coalescing
# when a node is not spilled:
#
fun move_savings (cig::NODE { movecnt=>REF 0, ... } )
=>
0.0;
move_savings (cig::NODE { movelist, ... } )
=>
loop (*movelist, [])
where
fun loop ([], savings)
=>
fold_backward
(\\ ((_, a), b) = f8b::max (a, b))
0.0
savings;
loop (cig::MOVE_INT { status=>REF (cig::WORKLIST | cig::GEORGE_MOVE | cig::BRIGGS_MOVE), dst_reg, src_reg, cost, ... } ! mvs, savings)
=>
{ fun add (c,[])
=>
[(c, cost)];
add (c, (x as (c': Int, s)) ! savings)
=>
c == c' ?? (c', s+cost) ! savings
:: x ! add (c, savings);
end;
savings
=
case (chase dst_reg)
#
cig::NODE { color=>REF (cig::COLORED c), ... }
=>
add (c, savings);
_ =>
case (chase src_reg)
#
cig::NODE { color => REF (cig::COLORED c), ... }
=>
add (c, savings);
_ =>
savings;
esac;
esac;
loop (mvs, savings);
};
loop(_ ! mvs, savings)
=>
loop (mvs, savings);
end;
end;
end; # fun move_savings
# The spill worklist is maintained only lazily.
#
# So we have to prune away those nodes that are
# already removed from the interference graph.
#
# After pruning the worklist, it may be the
# case that there isn't anything to be spilled
# after all.
#
fun chow_hennessy spills
=
{ # Compute savings due to moves:
#
spill_savings = irc::move_savings codetemp_interference_graph;
lookup_span = int_hashtable::find (null_or::the *span);
lookup_span
=
\\ r = case (lookup_span r)
THE s => s;
NULL => 0.0;
esac;
span := NULL;
fun loop ([], lll, pruned)
=>
(lll, pruned);
loop (node ! rest, lll, pruned)
=>
case (chase node)
#
node as cig::NODE { id, priority, defs, uses, degree=>REF deg, color=>REF cig::CODETEMP, ... }
=>
if (has_been_spilled id)
#
loop (rest, lll, FALSE);
else
fun newnode ()
=
{ span = lookup_span id;
savings = spill_savings id;
spill_cost = *priority;
total_cost = spill_cost - savings;
# rank = ((float totalCost)+0.01) / float (span)
rank = (total_cost + 0.5 + move_savings (node))
/ (span + float deg);
loop (rest, (node, rank) ! lll, FALSE);
};
case (*defs, *uses)
#
(_, []) # One def no use.
=>
loop (rest, (node, -1.0 - float(deg)) ! lll, FALSE);
([d], [u]) # Defs after use; don't use
=>
{ fun plus ( { block, op }, n)
=
{ block, op => op+n };
(d == plus (u, 1) or d == plus (u, 2) )
?? loop (rest, lll, FALSE)
:: newnode ();
};
_ => newnode();
esac;
fi;
_ => loop (rest, lll, pruned); # Discard node
esac;
end;
loop (spills, [], TRUE);
};
fun choose_node heap
=
{ fun loop ()
=
{ (hpq::delete_min heap)
->
(node, cost);
case (chase node)
#
node as cig::NODE { color=>REF cig::CODETEMP, ... }
=>
{ node=>THE (node), cost, spill_worklist };
_ => loop();
esac;
};
loop();
}
except
_ = { node => NULL, cost => 0.0, spill_worklist => [] };
case *cache
#
THE heap
=>
choose_node heap;
NULL
=>
{ my (lll, pruned) = chow_hennessy (spill_worklist);
if pruned
# Done.
{ node => NULL,
cost => 0.0,
spill_worklist => []
};
else
case lll
#
[] => raise exception NO_CANDIDATE;
_ => { fun rank ( (_, x),
(_, y)
)
=
f8b::(<) (x, y);
heap = hpq::from_list rank lll;
cache := THE heap;
choose_node heap;
};
esac;
fi;
};
esac;
};
};
end;