/* If an error arises, this function shall perform the necessary dumping, and
increment global_errfl. Other procedures check this variable occasionally,
and if it isn't zero, call abend(). */
var global_errfl = 0;
func error (message, ...) {
putln ("Error : ", message); // Print a general description of the problem.
// Do any dumping necessary to roughly locate the problem.
if (#args != 0)
for (var i = 0; i < #args; i++)
try {putln(args[i]);} catch (except (). error (). invcall (). partype)
{println(args[i]);}
global_errfl++; // Increment the global error counter.
}
// For fatal errors :
func fatal_error (message, ...) {
putln ("Fatal Error : ", message);
if (#args != 0)
for (var i = 0; i < #args; i++)
try {putln (args[i]);}
catch (except (). error (). invcall (). partype ())
{println (args[i]);}
exit (3);
}
// To assist with abnormal endings.
func abend (message) {
putln (global_errfl, message, "error" @ (global_errfl == 1 ? "." : "s."));
exit (2);
}
// To print out abstract nodes in a readable manner:
func print_anode (node_to_print, tablevel = 0, tabchar = ' ') {
for (var i = 0; i < tablevel; i++) put (tabchar);
put (node_to_print.name, " ");
if (node_to_print.name == "$nil") println ();
else if (node_to_print.name == "$term")
putln (node_to_print.transl.code, ":",
node_to_print.transl.type0, ":",
sprint (node_to_print.transl.value));
else {
putln ("(");
for (i = 0; i < #node_to_print.transl; i++)
print_anode (node_to_print.transl [i], tablevel + 2, tabchar);
for (i = 0; i < tablevel; i++) put (tabchar);
putln (")");
}
}
// For printing objects of class expr().
func print_expression (expr, tablevel = 0, tabchar = ' ') {
for (var i = 0; i < tablevel; i++) put (tabchar);
if (expr == nil) return;
if (expr.opr == "num") putln (sprint (expr.opa1), " : ", sprint (expr.opa2));
else if (expr.opr == "var") {
put ("$", sprint (expr.opa1));
if (!(expr.opa2.opr == "num" && expr.opa2.opa1 == "0")) {
putln (" [");
print_expression (expr.opa2, tablevel + 2, tabchar);
for (i = 0; i < tablevel; i++) put (tabchar);
putln ("]");
} else putln ();
} else {
putln (expr.opr, " (");
print_expression (expr.opa1, tablevel + 2, tabchar);
print_expression (expr.opa2, tablevel + 2, tabchar);
for (i = 0; i < tablevel; i++) put (tabchar);
putln (")");
}
}
// This function is used to print an instruction:
func print_instruction (instruction, tablevel = 0, tabchar = ' ') {
for (var i = 0; i < tablevel; i++) put (tabchar);
if (instruction.name == "empty") putln ("-");
else {
put (instruction.name, " ");
if (instruction.name == "block") {
putln ("{");
for (i in instruction.args [0].vartable) {
for (var j = 0; j < tablevel + 2; j++) put (tabchar);
putln ("$", sprint (i), " : ", instruction.args [0].vartable {i}.type0,
instruction.args [0].vartable {i}.arrfl ?
" [" @ instruction.args [0].vartable {i}.arrfl @ "]" : "");
}
for (i = 0; i < #instruction.args [0].exec; i++)
print_instruction (instruction.args [0].exec [i],
tablevel + 2, tabchar);
for (i = 0; i < tablevel; i++) put (tabchar);
putln ("}");
} else if (instruction.name == "for") {
putln ();
for (i = 0; i < tablevel + 2; i++) put (tabchar);
putln ("Initialization : ");
print_instruction (instruction.args [0], tablevel + 2, tabchar);
for (i = 0; i < tablevel + 2; i++) put (tabchar);
putln ("---");
for (i = 0; i < tablevel + 2; i++) put (tabchar);
putln ("Condition : ");
print_expression (instruction.args [1], tablevel + 2, tabchar);
for (i = 0; i < tablevel + 2; i++) put (tabchar);
putln ("Body : ");
print_instruction (instruction.args [3], tablevel + 2, tabchar);
for (i = 0; i < tablevel + 2; i++) put (tabchar);
put ("Increment : ");
print_instruction (instruction.args [2]);
} else if (instruction.name == "cond") {
putln ();
for (i = 0; i < #instruction.args; i += 2) {
print_expression (instruction.args [i], tablevel + 2, tabchar);
print_instruction (instruction.args [i + 1], tablevel + 2, tabchar);
if (i < #instruction.args - 1) {
for (var j = 0; j < tablevel; j++) put (tabchar);
putln ("---");
}
}
} else if (instruction.name == "assign") {
put ("$", sprint (instruction.args [0]));
if (!(instruction.args [1].opr == "num" &&
instruction.args [1].opa1 == "0")) {
putln (" [");
print_expression (instruction.args [1], tablevel + 2, tabchar);
for (i = 0; i < tablevel; i++) put (tabchar);
putln ("]");
} else putln ();
print_expression (instruction.args [2], tablevel + 2, tabchar);
} else if (instruction.name == "put") {
putln ();
for (i = 0; i < #instruction.args; i++)
print_expression (instruction.args [i], tablevel + 2, tabchar);
}
}
}