


## print-machcode-controlflow-graph-g.pkg -- print flowgraph of target machine instructions.
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.libstipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkgherein
api Print_Machcode_Controlflow_Graph { # Used only within this file.
#
package ae: Machcode_Codebuffer; # Machcode_Codebuffer is from src/lib/compiler/back/low/emit/machcode-codebuffer.api 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" == "psuedo_op".
print_machcode_controlflow_graph
:
fil::Output_Stream
->
String
->
mcg::Machcode_Controlflow_Graph
->
Void;
prettyprint_machcode_controlflow_graph
:
prettyprinter::Prettyprinter
->
String
->
mcg::Machcode_Controlflow_Graph
->
Void;
};
end;
stipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package odg = oop_digraph; # oop_digraph is from src/lib/graph/oop-digraph.pkg package ptf = sfprintf; # sfprintf is from src/lib/src/sfprintf.pkg package rkj = registerkinds_junk; # registerkinds_junk is from src/lib/compiler/back/low/code/registerkinds-junk.pkgherein
# This generic is invoked in:
#
# src/lib/compiler/back/low/main/main/backend-lowhalf-g.pkg # src/lib/compiler/back/low/intel32/regor/regor-intel32-g.pkg #
generic package print_machcode_controlflow_graph_g (
# =================================
#
package ae: Machcode_Codebuffer; # Machcode_Codebuffer is from src/lib/compiler/back/low/emit/machcode-codebuffer.api 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".
)
: (weak) Print_Machcode_Controlflow_Graph # Print_Machcode_Controlflow_Graph is from src/lib/compiler/back/low/mcg/print-machcode-controlflow-graph-g.pkg {
# Export to client packages:
#
package ae = ae;
package mcg = mcg;
stipulate
i2s = int::to_string;
fun print_list stream list
=
iter list
where
fun pr str
=
fil::write (stream, str);
fun iter [] => ();
iter [i] => pr i;
iter (h ! t) => { pr (h + ", "); iter t;};
end;
end;
herein
fun print_machcode_controlflow_graph stream title (mcg' as odg::DIGRAPH mcg)
=
{ fun pr string # "pr" == "print"
=
fil::write (stream, string);
pr_list = print_list stream;
global_graph_notes = *(mcg::get_global_graph_notes mcg');
(asm_stream::with_stream stream ae::make_codebuffer global_graph_notes)
->
{ put_op, put_pseudo_op, put_private_label, put_bblock_note, ... };
fun show_freq (REF w)
=
ptf::sprintf' "[%f]" [ptf::FLOAT w];
fun show_edge (blknum, e)
=
ptf::sprintf' "%d:%s" [ptf::INT blknum, ptf::STRING (mcg::show_edge_info e)];
fun show_succ (_, x, e) = show_edge (x, e);
fun show_pred (x, _, e) = show_edge (x, e);
fun show_succs b
=
{ pr "\tsucc: ";
pr_list (map show_succ (mcg.out_edges b));
pr "\n";
};
fun show_preds b
=
{ pr "\tpred: ";
pr_list (map show_pred (mcg.in_edges b));
pr "\n";
};
fun print_block (_, mcg::BBLOCK { kind => mcg::START, id, execution_frequency, ... } )
=>
{ pr (ptf::sprintf' "ENTRY %d %s\n" [ptf::INT id, ptf::STRING (show_freq execution_frequency)]);
show_succs id;
};
print_block(_, mcg::BBLOCK { kind=>mcg::STOP, id, execution_frequency, ... } )
=>
{ pr (ptf::sprintf' "EXIT %d %s\n" [ptf::INT id, ptf::STRING (show_freq execution_frequency)]);
show_preds id;
};
print_block(_, mcg::BBLOCK { id, alignment_pseudo_op, execution_frequency, ops, notes, labels, ... } )
=>
{ pr (ptf::sprintf' "BLOCK %d %s\n" [ptf::INT id, ptf::STRING (show_freq execution_frequency)]);
case *alignment_pseudo_op
#
THE p => pr (mcg::pop::pseudo_op_to_string p + "\n");
NULL => ();
esac;
apply put_bblock_note *notes;
apply put_private_label *labels;
# pr ("\tlive in: " + rkj::cls::register_to_string *liveIn + "\n");
# pr ("\tlive out: " + rkj::cls::register_to_string *liveOut + "\n");
show_succs id;
show_preds id;
apply put_op (reverse *ops);
};
end;
fun print_data ()
=
{ mcg.graph_info -> mcg::GRAPH_INFO { dataseg_pseudo_ops, ... };
#
list::apply
(pr o mcg::pop::pseudo_op_to_string)
(reverse *dataseg_pseudo_ops);
};
pr (ptf::sprintf' "[ %s ]\n" [ptf::STRING title]);
apply put_bblock_note global_graph_notes;
# print_block entry;
asm_stream::with_stream stream mcg.forall_nodes print_block;
# print_block exit;
asm_stream::with_stream stream print_data ();
fil::flush stream;
}; # fun print_machcode_controlflow_graph
fun prettyprint_machcode_controlflow_graph (pp: prettyprinter::Prettyprinter) title (mcg' as odg::DIGRAPH mcg)
=
{
fun pr str
=
pp.put str;
fun pr_list list
=
iter list
where
fun iter [] => ();
iter [i] => pr i;
iter (h ! t) => { pr (h + ", "); iter t;};
end;
end;
global_graph_notes = *(mcg::get_global_graph_notes mcg');
pp -> { text_stream, ... };
stream
=
case text_stream
#
NULL => fil::stdout;
THE stream => stream;
esac;
pp.flush ();
(asm_stream::with_stream stream ae::make_codebuffer global_graph_notes)
->
buf;
# { put_op, put_pseudo_op, put_private_label, put_bblock_note, ... };
fil::flush stream;
fun show_freq (REF w)
=
ptf::sprintf' "[%f]" [ptf::FLOAT w];
fun show_edge (blknum, e)
=
ptf::sprintf' "%d:%s" [ptf::INT blknum, ptf::STRING (mcg::show_edge_info e)];
fun show_succ (_, x, e) = show_edge (x, e);
fun show_pred (x, _, e) = show_edge (x, e);
fun show_succs b
=
{ pr "\tsucc: ";
pr_list (map show_succ (mcg.out_edges b));
pr "\n";
};
fun show_preds b
=
{ pr "\tpred: ";
pr_list (map show_pred (mcg.in_edges b));
pr "\n";
};
fun print_block (_, mcg::BBLOCK { kind=>mcg::START, id, execution_frequency, ... } )
=>
{ pr (ptf::sprintf' "ENTRY %d %s\n" [ptf::INT id, ptf::STRING (show_freq execution_frequency)]);
show_succs id;
};
print_block(_, mcg::BBLOCK { kind=>mcg::STOP, id, execution_frequency, ... } )
=>
{ pr (ptf::sprintf' "EXIT %d %s\n" [ptf::INT id, ptf::STRING (show_freq execution_frequency)]);
show_preds id;
};
print_block(_, mcg::BBLOCK { id, alignment_pseudo_op, execution_frequency, ops, notes, labels, ... } )
=>
{ pr (ptf::sprintf' "BLOCK %d %s\n" [ptf::INT id, ptf::STRING (show_freq execution_frequency)]);
case *alignment_pseudo_op
#
THE p => pr (mcg::pop::pseudo_op_to_string p + "\n");
NULL => ();
esac;
apply buf.put_bblock_note *notes;
apply buf.put_private_label *labels;
# pr ("\tlive in: " + rkj::cls::register_to_string *live_in + "\n");
# pr ("\tlive out: " + rkj::cls::register_to_string *live_out + "\n");
show_succs id;
show_preds id;
apply buf.put_op (reverse *ops);
};
end;
fun print_data ()
=
{ mcg.graph_info -> mcg::GRAPH_INFO { dataseg_pseudo_ops, ... };
#
list::apply
(pr o mcg::pop::pseudo_op_to_string)
(reverse *dataseg_pseudo_ops);
};
pr (ptf::sprintf' "[ %s ]\n" [ptf::STRING title]);
apply buf.put_bblock_note global_graph_notes;
# print_block entry;
asm_stream::with_stream stream mcg.forall_nodes print_block;
# print_block exit;
asm_stream::with_stream stream print_data ();
fil::flush stream;
}; # fun print_machcode_controlflow_graph
end;
};
end;
## Copyright (c) 1997 Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


