// Here follows the internal representation of a GRIP program.
/* This is a variable cell class, designed for use with eval(). */
class component (value, type0) {
var arrfl = 0;
}
/* This is a simple instruction definition, with a descriptor and arguments. */
class instr (){
var name = "", args = [];
}
/* This is an expression class. Note that at most two operands are allowed. */
class expression (){
var opr, opa1, opa2;
}
/******************************************************************************
** This is the definition for the actual internal representation of the **
** program. Note that the high level structure is almost just an abstract **
** form of the source code. There are only two variables: exec, which is **
** a vector of instructions, and vartable, a table of component cells. **
** This class also contains a virtual machine capable of executing the code. **
******************************************************************************/
class prog () {
var exec = []; // The executable code.
var vartable = new {};
// The environment, statically derived during translation.
func eval (expr, dumpfl = 0) { // The expression evaluator.
var res; // The result is retained for debugging purposes.
if (dumpfl) putln ("@ Initiating expression evaluator.");
func ovrlap (type1, type2) // A function to derive the type of the result.
{ return type1 == "real" || type2 == "real" ? "real" : "integer"; }
if (expr.opr == "num") res = component(expr.opa1,expr.opa2);
/* Expression is a single constant */
else if (expr.opr == "var") {
var index = eval (expr.opa2, dumpfl).value;
res = vartable {expr.opa1};
if (type (res.value) == vector) {
// println (index, "--", #res.value);
if (index < 1 || index > #res.value) {
error ("Runtime error : Array index out of bounds.");
exit (2);
}
res = component (res.value [index - 1], res.type0);
}
}
// Variable reference.
else if (expr.opr == "neg") // Unary minus.
res = component (-eval (expr.opa1, dumpfl).value,
eval (expr.opa1, dumpfl).type0);
else if (expr.opr == "add") // Addition.
res = component (eval (expr.opa1, dumpfl).value +
eval (expr.opa2, dumpfl).value,
ovrlap (eval (expr.opa1, dumpfl).type0,
eval (expr.opa2, dumpfl).type0));
else if (expr.opr == "sub") // Subtraction.
res = component (eval (expr.opa1, dumpfl).value -
eval (expr.opa2, dumpfl).value,
ovrlap (eval (expr.opa1, dumpfl).type0,
eval (expr.opa2, dumpfl).type0));
else if (expr.opr == "mul") // Multiplication.
res = component (eval (expr.opa1, dumpfl).value *
eval (expr.opa2, dumpfl).value,
ovrlap (eval (expr.opa1, dumpfl).type0,
eval (expr.opa2, dumpfl).type0));
else if (expr.opr == "div") {// Division.
res = component (eval (expr.opa1, dumpfl).value /
eval (expr.opa2, dumpfl).value,
ovrlap (eval (expr.opa1, dumpfl).type0,
eval (expr.opa2, dumpfl).type0));
}
else if (expr.opr == "and") // Logical and.
res = component (eval (expr.opa1, dumpfl).value &&
eval (expr.opa2, dumpfl).value,
"integer");
else if (expr.opr == "or ") // Logical or.
res = component (eval (expr.opa1, dumpfl).value ||
eval (expr.opa2, dumpfl).value,
"integer");
else if (expr.opr == "not") // Logical negation
res = component (!eval (expr.opa1, dumpfl).value, "integer");
else if (expr.opr == "gtt") // Greater than.
res = component (eval (expr.opa1, dumpfl).value >
eval (expr.opa2, dumpfl).value,
"integer");
// The lack of a less than operation is for the fact that x y>x.
else if (expr.opr == "eqs") // Equals.
res = component (eval (expr.opa1, dumpfl).value ==
eval (expr.opa2, dumpfl).value,
"integer");
else {
// If opr is not one of the specified operations, then there is an
// error in the coding.
putln ("Fatal Error : Internal error in expression generator :");
print_expression (expr);
}
if (dumpfl) { // Dumping.
putln ("* Expression Dumping:\n", sprint (res.value), " : ",
sprint (res.type0));
if (expr.opr != "num") print_expression (expr);
putln ();
}
return res; // Now the result is made available to the client function.
}
/***********************************************************************
** This is the actual execution function. It invokes execinstr(), a **
** function internal to execute(), which may recursively invoke **
** itself, eval(), and execute() to evaluate expressions, or use **
** structures. **
***********************************************************************/
func execute (dumpfl, strdumpfl, edumpfl) {
if (dumpfl) putln ("& Entering execution phase.");
// Dumping for blocks :
if (dumpfl) {
putln ("* Preliminary dumping of variables for this block:\n",
vartable != {} ?
sprint (vartable) : "", "\n");
}
for (var instr = 0; instr < #exec; instr++) {
// Sequentially perform statements.
execinstr (exec [instr], strdumpfl, edumpfl);
/* Invoke execinstr() with the current instruction. */
}
if (global_errfl) abend (" runtime ");
/*******************************************************
** Implementation of execinstr(). Like eval(), it **
** chooses from a list of possible operations it can **
** do, and executes the corresponding procedure **
** needed to do the job. **
*******************************************************/
func execinstr (currinstr, dumpfl, edumpfl) {
// Dumping for instructions :
if (dumpfl) { putln ("@ Executing of instruction #",
instr + 1, ", value:");
print_instruction (currinstr);
}
if (currinstr.name == "cond") { /* Conditional branch. */
for (var current_option_number = 0;
current_option_number < #currinstr.args;
current_option_number += 2) {
/* This loop iterates through all of the
alternatives, checking each one. */
if (eval (currinstr.args [current_option_number], edumpfl).value) {
/* Check the current alternative. */
execinstr (currinstr.args [current_option_number + 1], dumpfl);
// True: Execute this branch.
break; // Exit the loop : No more altenatives need to be checked.
}
}
} else if (currinstr.name == "for") {
// C-style 'for' loop implementation. Note that this statement can
// loop at most 100,000 times.
var g = 0; // This variable is used for enforcing the iteration limit.
for (execinstr (currinstr.args [0], dumpfl); // Initialization.
eval (currinstr.args [1], edumpfl). value; // Condition.
execinstr (currinstr.args [2], dumpfl)) { // Increment.
execinstr (currinstr.args [3], dumpfl); // Execute the body.
g++; // Iteration count.
if (g > 99999) { // Kill the for loop if alloted
// iterations are used up.
if (dumpfl) putln ("! For loop ran out of iterations.");
putln ("Warning: Iteration limit exceeded: For loop killed.");
break; // Kill the loop.
}
}
} else if (currinstr.name == "assign") {
// Classical absolute assignment.
var res = eval (currinstr.args [2], edumpfl),
index = eval (currinstr.args [1], edumpfl).value,
ourtype;
// Ourtype is for real <- int compatibility.
if (vartable {currinstr.args [0]}.type0 == "real") ourtype = "real";
else ourtype = "integer";
var target = vartable {currinstr.args [0]};
if (type (target.value) != vector) {
// Is this an array? If no :
target.value = (ourtype == "real"
? float (res. value) : int (res. value));
} else { // If yes :
if (#target.value < index || index < 1) {
error ("Runtime error : Array index out of bounds.");
exit (2);
}
target.value [index - 1] = res.value;
}
vartable {currinstr.args [0]}.type0 = ourtype;
} else if (currinstr.name == "block") { // The compound statement.
currinstr.args [0].execute (dumpfl, dumpfl, edumpfl);
} else if (currinstr.name == "put") { // Output statement.
var put_objs = []; // So as not to intermingle output with dumpings.
for (var i = 0; i < #currinstr.args; i++)
put_objs @= eval (currinstr.args [i], edumpfl).value;
for (i = 0; i < #put_objs; i++)
put (put_objs [i]);
// Output the values of all expressions.
putln (); // Don't forget a newline.
} else if (currinstr.name == "empty") {
// The nil statement - does nothing.
} else { // Coding error.
putln ("Fatal Error : Internal parsing error : ",
"Illegal instruction generated as follows :");
print_instruction (currinstr.name, currinstr.args);
exit (3);
}
}
// Dumping for blocks :
if (dumpfl) {
putln ("* Dumping of variables for this block:\n", #vartable != 0 ?
sprint (vartable) : "", "\n");
}
} // End execute().
} // End class prog.