## register-spilling-g.pkg
#
# This package manages the spill/reload process.
# The reason this is detached from the main module is that
# I can't understand the old code.
#
# Okay, now I understand the code.
#
# The new code does things slightly differently.
# Here, we are given an op and a list of registers to spill
# and reload. We rewrite the op until all instances of these
# registers are rewritten.
#
# (12/13/99) Some major caveats when spill coalescing/coloring is used:
# When parallel copies are generated and spill coalescing/coloring is used,
# two special cases have to be identified:
#
# Case 1 (spill_loc dst = spill_loc src)
# Suppose we have a parallel copy
# (u, v) <- (x, y)
# where u has to be spilled and y has to reloaded. When both
# u and y are mapped to location M. The following wrong code may
# be generated:
# M <- x (spill u)
# v <- M (reload y)
# This is incorrect. Instead, we generate a dummy copy and
# delay the spill after the reload, like this:
#
# tmp <- x (save value of u)
# v <- M (reload y)
# M <- tmp (spill u)
# Case 2 (spill_loc copy_tmp = spill_loc src)
# Another case that can cause problems is when the spill location of
# the copy temporary is the same as that of one of the sources:
#
# (a, b, v) <- (b, a, u) where spill_loc (u) = spill_loc (tmp) = v
#
# The incorrect code is
# (a, b) <- (b, a)
# v <- M
# But then the shuffle code for the copy can clobber the location M.
#
# tmp <- M
# (a, b) <- (b, a)
# v <- tmp
#
# (Note that spill_loc copy_tmp = spill_loc src can never happen)
#
# -- Allen Leung
# Compiled by:
#
src/lib/compiler/back/low/lib/lowhalf.lib### "As soon as we started programming,
### we found to our surprise that it
### wasn't as easy to get programs right
### as we had thought.
###
### "Debugging had to be discovered.
###
### "I can remember the exact instant
### when I realized that a large part
### of my life from then on was going
### to be spent finding mistakes in
### my own programs."
###
### -- Maurice Wilkes, 1949
stipulate
package iht = int_hashtable; # int_hashtable is from
src/lib/src/int-hashtable.pkg package irc = iterated_register_coalescing; # iterated_register_coalescing is from
src/lib/compiler/back/low/regor/iterated-register-coalescing.pkg package lem = lowhalf_error_message; # lowhalf_error_message is from
src/lib/compiler/back/low/control/lowhalf-error-message.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from
src/lib/prettyprint/big/src/standard-prettyprinter.pkg package rkj = registerkinds_junk; # registerkinds_junk is from
src/lib/compiler/back/low/code/registerkinds-junk.pkg #
debug = FALSE;
herein
# We are invoked from:
#
#
src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg #
src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg #
src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg #
# See also:
#
#
src/lib/compiler/back/low/regor/register-spilling-with-renaming-g.pkg #
generic package register_spilling_g (
# ===================
#
package mu: Machcode_Universals; # Machcode_Universals is from
src/lib/compiler/back/low/code/machcode-universals.api package ae: Machcode_Codebuffer_Pp # Machcode_Codebuffer_Pp is from
src/lib/compiler/back/low/emit/machcode-codebuffer-pp.api where
mcf == mu::mcf; # "mcf" == "machcode_form" (abstract machine code).
)
: (weak) Register_Spilling # Register_Spilling is from
src/lib/compiler/back/low/regor/register-spilling.api {
# Export to client packages:
#
package mcf = mu::mcf; # "mcf" == "machcode_form" (abstract machine code).
package rgk = mcf::rgk; # "rgk" == "registerkinds".
package cig = irc::cig; # "cig" == "codetemp_interference_graph".
stipulate
fun error msg
=
lem::error("register_spilling", msg);
ra_keep_dead_copies
=
lowhalf_control::make_bool
(
"ra_keep_dead_copies",
"Dead copies are not removed when spilling"
);
fun dec1 n
=
unt::to_int_x (unt::from_int n - 0u1);
fun dec { block, op }
=
{ block, op=>dec1 op };
package rst = regor_spill_types_g( mcf ); # regor_spill_types_g is from
src/lib/compiler/back/low/regor/regor-spill-types-g.pkg herein
include package rst; # Export it all to client packages.
fun uniq codetemps # This has the effect of sorting by color and dropping any duplicated colors.
=
rkj::sortuniq_colored_codetemps codetemps;
i2s = int::to_string;
fun pt2s { block, op }
=
"b" + i2s block + ":" + i2s op;
# spilled_copy_tmps = Lowhalf_control::get_counter "ra-spilled-copy-temps";
# The following function performs spilling.
#
fun spill_rewrite
{ graph as cig::CODETEMP_INTERFERENCE_GRAPH { show_reg, spilled_regs, node_hashtable, mode, ... },
spill: Spill,
spill_copy_tmp: Spill_Copy_Tmp,
spill_src: Spill_Src,
rename_src: Rename_Src,
reload: Reload,
reload_dst: Reload_Dst,
copy_instr: Copy_Instr,
registerkind,
spill_set, reload_set, kill_set
}
=
spill_rewrite
where
# Must do this to make sure
# the interference graph is
# reflected to the registers:
irc::update_register_aliases graph;
get_spill_loc = irc::spill_loc graph;
fun spill_loc_of (rkj::CODETEMP_INFO { id, ... } ) = get_spill_loc id;
spill_locs_of = map spill_loc_of;
getnode = (\\ rkj::CODETEMP_INFO { id, ... } = iht::get node_hashtable id);
op_def_use = mu::def_use registerkind;
# Merge prohibited registers:
#
enter_spill = iht::set spilled_regs;
add_prohibition = apply (\\ register = enter_spill (rkj::interkind_register_id_of register, TRUE));
get_spills = cig::ppt_hashtable::find spill_set;
get_spills = \\ p = case (get_spills p)
THE s => s;
NULL => [];
esac;
get_reloads = cig::ppt_hashtable::find reload_set;
get_reloads = \\ p = case (get_reloads p)
THE s => s;
NULL => [];
esac;
get_kills = cig::ppt_hashtable::find kill_set;
get_kills = \\ p = case (get_kills p)
THE s => s;
NULL => [];
esac;
fun get_loc (cig::NODE { color=>REF (cig::ALIASED n), ... }) => get_loc n;
get_loc (cig::NODE { color=>REF (cig::RAMREG(_, m)), ... }) => cig::SPILL_TO_RAMREG m;
get_loc (cig::NODE { color=>REF (cig::SPILL_LOC s), ... }) => cig::SPILL_TO_FRESH_FRAME_SLOT s;
get_loc (cig::NODE { color=>REF (cig::SPILLED), id, ... }) => cig::SPILL_TO_FRESH_FRAME_SLOT id;
get_loc (cig::NODE { color=>REF (cig::CODETEMP), id, ... }) => cig::SPILL_TO_FRESH_FRAME_SLOT id;
#
get_loc _ => error "get_loc";
end;
fun print_regs regs
=
apply (\\ r = print (rkj::register_to_string r + " [" + irc::spill_loc_to_string graph (rkj::universal_register_id_of r) + "] "))
regs;
parallel_copies
=
unt::bitwise_and (irc::has_parallel_copies, mode) != 0u0;
fun chase (rkj::CODETEMP_INFO { color=>REF (rkj::ALIASED c), ... } )
=>
chase c;
#
chase other => other;
end;
fun register_id (rkj::CODETEMP_INFO { id, ... } )
=
id;
fun same_register (rkj::CODETEMP_INFO { id=>x, ... }, rkj::CODETEMP_INFO { id=>y, ... } )
=
x == y;
fun same (x, reg_to_spill)
=
same_register (chase x, reg_to_spill);
# Rewrite the op given
# that a bunch of registers have
# to be spilled and reloaded.
#
fun spill_rewrite { pt, ops, notes }
=
loop (reverse ops, pt, [])
where
# Insert reloading code for an op.
# Note: reload code goes after the op, if any.
#
fun reload_instr (op, reg_to_spill, spill_loc)
=
{ my { code, prohibitions, make_reg }
=
reload { instruction => op, reg=>reg_to_spill, spill_loc, notes };
add_prohibition prohibitions;
code;
};
# Renaming the source for an op.
#
fun rename_instr (op, reg_to_spill, to_src)
=
{ my { code, prohibitions, make_reg }
=
rename_src { instruction => op, from_src=>reg_to_spill, to_src };
add_prohibition prohibitions;
code;
};
# Remove uses of regToSpill from a set of parallel copies.
# If there are multiple uses, then return multiple moves.
#
fun extract_uses (reg_to_spill, rds, rss)
=
loop (rds, rss, [], [], [])
where
fun loop (rd ! rds, rs ! rss, new_rds, rds', rss')
=>
if (same (rs, reg_to_spill) )
loop (rds, rss, rd ! new_rds, rds', rss');
else
loop (rds, rss, new_rds, rd ! rds', rs ! rss');
fi;
loop(_, _, new_rds, rds', rss')
=>
(new_rds, rds', rss');
end;
end;
# Insert reload code for the sources of a copy.
# Transformation:
# d1..dn <- s1..sn
# =>
# d1..dn/r <- s1...sn/r.
# reload code
# reload copies
#
fun reload_copy_src (op, reg_to_spill, spill_loc)
=
{ my (dst, src)
=
mu::move_dst_src op;
my (rds, copy_dst, copy_src)
=
extract_uses (reg_to_spill, dst, src);
fun process_moves ([], reload_code)
=>
reload_code;
process_moves (rd ! rds, reload_code)
=>
{ code =
reload_dst
{ spill_loc,
reg => reg_to_spill,
dst => rd,
notes
};
process_moves (rds, code@reload_code);
};
end;
reload_code = process_moves (rds, []);
case copy_dst
[] => reload_code;
_ => copy_instr((copy_dst, copy_src), op) @ reload_code;
esac;
};
# Insert reload code
#
fun reload (op, reg_to_spill, spill_loc)
=
mu::move_instruction op
?? reload_copy_src (op, reg_to_spill, spill_loc)
:: reload_instr (op, reg_to_spill, spill_loc);
# Check whether the id is in a list
#
fun contains_id (id,[])
=>
FALSE;
contains_id (id: rkj::Universal_Register_Id, r ! rs)
=>
r == id or contains_id (id, rs);
end;
fun spill_conflict (cig::SPILL_TO_FRESH_FRAME_SLOT loc, rs) => contains_id (-loc, rs);
spill_conflict (cig::SPILL_TO_RAMREG (rkj::CODETEMP_INFO { id, ... } ), rs) => contains_id ( id, rs);
end;
fun contains (r',[])
=>
FALSE;
contains (r', r ! rs)
=>
same_register (r', r)
or
contains (r', rs);
end;
# Insert spill code for an op.
# Spill code occur after the op.
# If the value in regToSpill is never used, the client also
# has the opportunity to remove the op.
#
fun spill_instr (op, reg_to_spill, spill_loc, kill)
=
code
where
my { code, prohibitions, make_reg }
=
spill { instruction => op, kill, spill_loc, notes, reg => reg_to_spill };
add_prohibition prohibitions;
end;
# Remove the definition regToSpill <- from
# parallel copies rds <- rss.
# Note, there is a guarantee that regToSpill is not aliased
# to another register in the rds set.
#
fun extract_def (reg_to_spill, rds, rss, kill)
=
loop (rds, rss, [], [])
where
fun loop (rd ! rds, rs ! rss, rds', rss')
=>
if (spill_loc_of rd == spill_loc_of rs )
(rs, rds@rds', rss@rss', TRUE);
elif (same (rd, reg_to_spill) )
(rs, rds@rds', rss@rss', kill);
else
loop (rds, rss, rd ! rds', rs ! rss');
fi;
loop _
=>
{ print("rds=");
apply
(\\ r = print (rkj::register_to_string r + ":" +
i2s (spill_loc_of r) + " ")
)
rds;
print("\nrss=");
apply
(\\ r = print (rkj::register_to_string r + ":" +
i2s (spill_loc_of r) + " ")
)
rss;
print "\n";
error("extractDef: " + rkj::register_to_string reg_to_spill);
};
end;
end;
# Insert spill code for a destination of a copy
# suppose d = r and we have a copy d <- s in
# d1...dn <- s1...sn
#
# d1...dn <- s1...sn
# =>
# spill s to spill_loc
# d1...dn/d <- s1...sn/s
#
# However, if the spill code may ovewrite the spill location
# shared by other uses, we do the following less
# efficient scheme:
#
# # save the result of d
# d1...dn, tmp <- s1...sn, s
# spill tmp to spill_loc # spill d
#
fun spill_copy_dst (op, reg_to_spill, spill_loc, kill, don't_overwrite)
=
{ my (dst, src)
=
mu::move_dst_src op;
my (mv_src, copy_dst, copy_src, kill)
=
extract_def (reg_to_spill, dst, src, kill);
copy = case copy_dst
[] => [];
_ => copy_instr((copy_dst, copy_src), op);
esac;
if (kill and not *ra_keep_dead_copies)
# Kill the move:
( # print ("Copy " + int::to_string (hd mvDst) + " <- " +
# int::to_string (hd mvSrc) + " removed\n");
copy
);
# normal spill
elif (spill_conflict (spill_loc, don't_overwrite))
# Cycle found
# print("Register r" + int::to_string regToSpill +
# " overwrites [" + int::to_string spill_loc + "]\n")
tmp = rgk::clone_codetemp_info reg_to_spill; # new temporary
copy = copy_instr((tmp ! copy_dst, mv_src ! copy_src),
op);
spill_code = spill_src { src=>tmp, reg=>reg_to_spill,
spill_loc,
notes };
copy @ spill_code;
else
# Spill the move op:
#
spill_code = spill_src { src=>mv_src, reg=>reg_to_spill,
spill_loc,
notes };
spill_code @ copy;
fi;
};
# Insert spill code for a copy
#
fun spill_copy (op, reg_to_spill, spill_loc, kill, don't_overwrite)
=
case (mu::move_tmp_r op)
#
NULL => spill_copy_dst (op, reg_to_spill, spill_loc, kill,
don't_overwrite);
THE tmp
=>
if (same (tmp, reg_to_spill))
# spilledCopyTmps := *spilledCopyTmps + 1;
[ spill_copy_tmp
{ copy => op,
reg => reg_to_spill,
spill_loc,
notes
}
];
else
spill_copy_dst (op, reg_to_spill, spill_loc, kill, don't_overwrite);
fi;
esac;
# Insert spill code:
#
fun spill (op, reg_to_spill, spill_loc, kill_set, don't_overwrite)
=
{ kill = contains (reg_to_spill, kill_set);
if (mu::move_instruction op) spill_copy (op, reg_to_spill, spill_loc, kill, don't_overwrite);
else spill_instr (op, reg_to_spill, spill_loc, kill);
fi;
};
fun contains ([], reg) => FALSE;
contains (r ! rs, reg) => same (r, reg) or contains (rs, reg);
end;
fun has_def (i, reg) = contains(#1 (op_def_use i), reg);
fun has_use (i, reg) = contains(#2 (op_def_use i), reg);
fun spill_one_reg ([], _, _, _, _)
=>
[];
spill_one_reg (i ! ops, r, spill_loc, kill_set, don't_overwrite)
=>
if (has_def (i, r))
#
spill_one_reg (spill (i, r, spill_loc, kill_set, don't_overwrite) @ ops, r, spill_loc, kill_set, don't_overwrite);
else
i ! spill_one_reg (ops, r, spill_loc, kill_set, don't_overwrite);
fi;
end;
fun reload_one_reg ([], _, _)
=>
[];
reload_one_reg (i ! ops, r, spill_loc)
=>
if (has_use (i, r))
#
reload_one_reg (reload (i, r, spill_loc) @ ops, r, spill_loc);
else
i ! reload_one_reg (ops, r, spill_loc);
fi;
end;
# This function spills a set of registers for an op
#
fun spill_all (ops, [], kill_set, don't_overwrite)
=>
ops;
spill_all (ops, r ! rs, kill_set, don't_overwrite)
=>
{ node = getnode r;
spill_loc = get_loc node;
spill_all(
spill_one_reg (ops, r, spill_loc, kill_set, don't_overwrite),
rs, kill_set, don't_overwrite);
};
end;
# This function reloads a set of registers for an op
#
fun reload_all (ops, [])
=>
ops;
reload_all (ops, r ! rs)
=>
{ node = getnode r;
spill_loc = get_loc node;
reload_all (reload_one_reg (ops, r, spill_loc), rs);
};
end;
fun loop ([], pt, new_ops)
=>
new_ops;
loop (op ! rest, pt, new_ops) # 'pt' is a program point -- a particular instruction within a particular basic block.
=>
{ spill_regs = get_spills pt;
reload_regs = get_reloads pt;
#
case (spill_regs, reload_regs)
#
([], [])
=>
loop (rest, dec pt, op ! new_ops);
_ =>
# Eliminate duplicates from
# the spill/reload candidates
#
{ kill_regs = get_kills pt;
spill_regs = uniq spill_regs;
reload_regs = uniq reload_regs;
# Spill locations that we can't
# overwrite if we are spilling
# a parallel copy:
#
don't_overwrite
=
parallel_copies
?? spill_locs_of reload_regs
:: [];
ops = spill_all ([op], spill_regs, kill_regs, don't_overwrite);
if debug
#
print("pt=" + pt2s pt + "\n");
case spill_regs
#
[] => ();
_ => { print("Spilling ");
print_regs spill_regs;
print "\n";
};
esac;
case reload_regs
#
[] => ();
#
_ => { print("Reloading ");
print_regs reload_regs;
print "\n";
};
esac;
print "Before:";
print (pp::prettyprint_to_string [] {.
buf = ae::make_codebuffer #pp [];
buf.put_op op;
});
fi;
ops = reload_all (ops, reload_regs);
if debug
#
print "After:";
print (pp::prettyprint_to_string [] {.
buf = ae::make_codebuffer #pp [];
apply buf.put_op ops;
});
print "------------------\n";
fi;
fun cat ([], l) => l;
cat (a ! b, l) => cat (b, a ! l);
end;
loop (rest, dec pt, cat (ops, new_ops));
};
esac;
};
end;
end;
end;
end; # stipulate
}; # package
end; # stipulate