## check-heapcleaner-calls-g.pkg
#
# Nomenclature: In this file "gc" == "garbage collector".
#
# This module checks that no other values aside from
# the standard GC calling convention registers, can be live across
# a call GC instruction. Call GC blocks and instructions are assumed
# to be marked with the special CALL_HEAPCLEANER annotation.
#
# Our entrypoint
#
# check_heapcleaner_calls
#
# is a no-op unless
#
# *do_cleaning_check_on_machcode_controlflow_graph
#
# is TRUE. (Defaults to FALSE.)
# Compiled by:
# src/lib/compiler/core.sublibstipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package ih = int_hashtable; # int_hashtable is from src/lib/src/int-hashtable.pkg package lhn = lowhalf_notes; # lowhalf_notes is from src/lib/compiler/back/low/code/lowhalf-notes.pkg package odg = oop_digraph; # oop_digraph is from src/lib/graph/oop-digraph.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package cv = compiler_verbosity; # compiler_verbosity is from src/lib/compiler/front/basics/main/compiler-verbosity.pkg package rkj = registerkinds_junk; # registerkinds_junk is from src/lib/compiler/back/low/code/registerkinds-junk.pkg Npp = pp::Npp; # Null_Or(pp::Prettyprinter)
herein
# This generic is invoked (only) from:
#
# src/lib/compiler/back/low/main/main/backend-lowhalf-g.pkg #
generic package check_heapcleaner_calls_g (
# =========================
#
package ae: Machcode_Codebuffer_Pp; # Machcode_Codebuffer_Pp is from src/lib/compiler/back/low/emit/machcode-codebuffer-pp.api # # "ae" == "asmcode_emitter".
package mcg: Machcode_Controlflow_Graph # Machcode_Controlflow_Graph is from src/lib/compiler/back/low/mcg/machcode-controlflow-graph.api where
mcf == ae::mcf # "mcf" == "machcode_form" (abstract machine code).
also pop == ae::cst::pop; # "pop" == "pseudo_op".
package mu: Machcode_Universals # Machcode_Universals is from src/lib/compiler/back/low/code/machcode-universals.api where
mcf == mcg::mcf; # "mcf" == "machcode_form" (abstract machine code).
package pri: Platform_Register_Info; # Platform_Register_Info is from src/lib/compiler/back/low/main/nextcode/platform-register-info.api root_registers: List( pri::tcf::Int_Expression );
)
: (weak) Check_Heapcleaner_Calls # Check_Heapcleaner_Calls is from src/lib/compiler/back/low/main/nextcode/check-heapcleaner-calls.api {
# Export to client packages:
#
package mcg = mcg;
stipulate
package liv = liveness_g( mcg ); # liveness_g is from src/lib/compiler/back/low/regor/liveness-g.pkg package cls = rkj::cls; # "cls" == "codetemplists".
package tcf = pri::tcf; # "tcf" == "treecode_form".
herein
# List of registers which are gc roots
# *and* global registers:
#
gc_roots
=
rkj::cos::make_colorset (
#
list::fold_backward
#
\\ (tcf::CODETEMP_INFO(_, r), sss) => r ! sss;
(_, sss) => sss;
end
#
( pri::global_int_registers
@ pri::global_float_registers
)
#
root_registers
);
# Def/use for integer and floating point registers
#
def_use_for_int_registers = mu::def_use rkj::INT_REGISTER;
def_use_for_float_registers = mu::def_use rkj::FLOAT_REGISTER;
# Flag for debugging this phase
#
debug_check_gc
=
lowhalf_control::make_bool # lowhalf_control is from src/lib/compiler/back/low/control/lowhalf-control.pkg (
"debug_check_gc",
"Check GC debugging"
);
do_cleaning_check_on_machcode_controlflow_graph
=
lowhalf_control::make_bool ("do_cleaning_check_on_machcode_controlflow_graph", "Turn on GC checking");
fun show_block (mcg::BBLOCK { ops, ... } ) # Dump a basic block of ops (abstract machine instructions).
=
{
# buf = asm_stream::with_stream fil::stdout ae::make_codebuffer [];
# apply buf.put_op (reverse *ops);
text = pp::prettyprint_to_string [] {.
pp = #pp;
buf = ae::make_codebuffer pp [];
apply buf.put_op (reverse *ops);
};
print text;
};
fun show_op op # Dump one instruction.
=
{
# buf = asm_stream::with_stream fil::stdout ae::make_codebuffer [];
# buf.put_op op;
text = pp::prettyprint_to_string [] {.
pp = #pp;
buf = ae::make_codebuffer pp [];
buf.put_op op;
};
print text;
};
# Check gc
#
fun check_it (mcg as odg::DIGRAPH graph)
=
{ # def/use for one instruction:
#
fun def_use i
=
{ my (d1, u1) = def_use_for_int_registers i;
my (d2, u2) = def_use_for_float_registers i;
(d1@d2, u1@u2);
};
# Compute liveness for all register kinds
#
my { live_in, live_out }
=
liv::liveness
{
def_use => def_use_for_int_registers,
get_codetemps_of_our_kind => cls::get_all_codetemps_from_codetemplists # Is this a bug? Formally, we're returning all kinds, but apparent field intention is to have only one kind.
}
mcg;
fun registers_to_string sss # Pretty-print a list of registers.
=
cls::codetemplists_to_string (list::fold_backward cls::add_codetemp_to_appropriate_kindlist cls::empty_codetemplists sss);
fun is_heapcleaner_call i # Check if an instruction is a call-heapcleaner instruction
=
{ (mu::get_notes i) -> (_, a);
#
lhn::call_heapcleaner.is_in a;
};
# Check a call-heapcleaner instruction:
#
fun check_heapcleaner_call (op, live_out, live_in, block)
=
{ if *debug_check_gc
#
print ("live in=" + registers_to_string (live_in) + "\n");
show_op op;
print ("live out=" + registers_to_string (live_out) + "\n");
fi;
live_across = rkj::cos::difference_of_colorsets (live_out, gc_roots);
if (not (rkj::cos::colorset_is_empty live_across))
#
print("_______________________________________\n");
print("WARNING: error in GC protocol:\n");
print ("gc roots+global=" + registers_to_string (gc_roots) + "\n");
print ("live in=" + registers_to_string (live_in) + "\n");
show_op op;
print ("live out=" + registers_to_string (live_out) + "\n");
print ("In block:\n");
show_block (block);
print("_______________________________________\n");
error_message::impossible("CheckGC::gc protocol error");
fi;
};
# Scan a heapcleaner block backwards and get for CALL-HEAPCLEANER ops:
#
fun scan_block (b, block as mcg::BBLOCK { ops, ... } )
=
{ live = ih::get live_out b;
fun scan (live, i ! is)
=>
{ live' = liv::live_step def_use (i, live);
#
if (is_heapcleaner_call i) check_heapcleaner_call (i, live, live', block); fi;
#
scan (live', is);
};
scan (live, []) => ();
end;
if *debug_check_gc
#
print ("Liveout=" + registers_to_string (live) + "\n");
#
show_block block;
fi;
scan (live, *ops);
};
fun is_call_heapcleaner_bblock (b, mcg::BBLOCK { notes, ... } ) # Heapcleaner-invocation bblocks are marked with the special annotation CALL_HEAPCLEANER.
=
lhn::call_heapcleaner.is_in *notes;
fun check_block (b, b') # Check call-heapcleaner bblocks.
=
if (is_call_heapcleaner_bblock (b, b'))
#
scan_block (b, b');
fi;
graph.forall_nodes check_block; # Locate and check all blocks in the flowgraph.
};
fun check_heapcleaner_calls (npp:Npp, cv: cv::Compiler_Verbosity) machcode_controlflow_graph # Main entry point.
=
{ if *do_cleaning_check_on_machcode_controlflow_graph
#
check_it machcode_controlflow_graph;
fi;
machcode_controlflow_graph;
};
end;
};
end;