mirror of
https://github.com/ganelson/inform.git
synced 2024-07-18 06:54:26 +03:00
187 lines
7 KiB
OpenEdge ABL
187 lines
7 KiB
OpenEdge ABL
[CProgramControl::] C Program Control.
|
|
|
|
Generating C code to effect loops, branches and the like.
|
|
|
|
@ This is as good a place as any to provide the general function for compiling
|
|
invocations of primitives. There are a lot of primitives, so the actual work is
|
|
distributed throughout this chapter.
|
|
|
|
=
|
|
void CProgramControl::initialise(code_generator *gtr) {
|
|
METHOD_ADD(gtr, INVOKE_PRIMITIVE_MTID, CProgramControl::invoke_primitive);
|
|
}
|
|
|
|
void CProgramControl::invoke_primitive(code_generator *gtr, code_generation *gen,
|
|
inter_symbol *prim_name, inter_tree_node *P, int void_context) {
|
|
inter_tree *I = gen->from;
|
|
inter_ti bip = Primitives::to_BIP(I, prim_name);
|
|
|
|
int r = CReferences::invoke_primitive(gen, bip, P);
|
|
if (r == NOT_APPLICABLE) r = CArithmetic::invoke_primitive(gen, bip, P);
|
|
if (r == NOT_APPLICABLE) r = CMemoryModel::invoke_primitive(gen, bip, P);
|
|
if (r == NOT_APPLICABLE) r = CFunctionModel::invoke_primitive(gen, bip, P);
|
|
if (r == NOT_APPLICABLE) r = CObjectModel::invoke_primitive(gen, bip, P);
|
|
if (r == NOT_APPLICABLE) r = CInputOutputModel::invoke_primitive(gen, bip, P);
|
|
if (r == NOT_APPLICABLE) r = CConditions::invoke_primitive(gen, bip, P);
|
|
if (r == NOT_APPLICABLE) r = CProgramControl::compile_control_primitive(gen, bip, P);
|
|
if ((void_context) && (r == FALSE)) {
|
|
text_stream *OUT = CodeGen::current(gen);
|
|
WRITE(";\n");
|
|
}
|
|
}
|
|
|
|
@ And the rest of this section implements the primitives to do with execution
|
|
control: branches, loops and so on.
|
|
|
|
=
|
|
int CProgramControl::compile_control_primitive(code_generation *gen, inter_ti bip,
|
|
inter_tree_node *P) {
|
|
int suppress_terminal_semicolon = FALSE;
|
|
text_stream *OUT = CodeGen::current(gen);
|
|
inter_tree *I = gen->from;
|
|
switch (bip) {
|
|
case PUSH_BIP: WRITE("i7_push(proc, "); VNODE_1C; WRITE(")"); break;
|
|
case PULL_BIP: VNODE_1C; WRITE(" = i7_pull(proc)"); break;
|
|
case IF_BIP: @<Generate primitive for if@>; break;
|
|
case IFDEBUG_BIP: @<Generate primitive for ifdebug@>; break;
|
|
case IFSTRICT_BIP: @<Generate primitive for ifstrict@>; break;
|
|
case IFELSE_BIP: @<Generate primitive for ifelse@>; break;
|
|
case BREAK_BIP: WRITE("break"); break;
|
|
case CONTINUE_BIP: WRITE("continue"); break;
|
|
case JUMP_BIP: WRITE("goto "); VNODE_1C; break;
|
|
case QUIT_BIP: WRITE("i7_benign_exit(proc)"); break;
|
|
case RESTORE_BIP: WRITE("i7_opcode_restore(proc, 0, NULL)"); break;
|
|
case RETURN_BIP: WRITE("return (i7word_t) "); VNODE_1C; break;
|
|
case WHILE_BIP: @<Generate primitive for while@>; break;
|
|
case DO_BIP: @<Generate primitive for do@>; break;
|
|
case FOR_BIP: @<Generate primitive for for@>; break;
|
|
case OBJECTLOOP_BIP: @<Generate primitive for objectloop@>; break;
|
|
case OBJECTLOOPX_BIP: @<Generate primitive for objectloopx@>; break;
|
|
case SWITCH_BIP: @<Generate primitive for switch@>; break;
|
|
case CASE_BIP: @<Generate primitive for case@>; break;
|
|
case DEFAULT_BIP: @<Generate primitive for default@>; break;
|
|
case ALTERNATIVECASE_BIP: internal_error("misplaced !alternativecase"); break;
|
|
default: internal_error("unimplemented prim");
|
|
}
|
|
return suppress_terminal_semicolon;
|
|
}
|
|
|
|
@<Generate primitive for if@> =
|
|
WRITE("if ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C;
|
|
OUTDENT; WRITE("}\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for ifdebug@> =
|
|
WRITE("#ifdef DEBUG\n"); INDENT; VNODE_1C; OUTDENT; WRITE("#endif\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for ifstrict@> =
|
|
WRITE("#ifdef STRICT_MODE\n"); INDENT; VNODE_1C; OUTDENT; WRITE("#endif\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for ifelse@> =
|
|
WRITE("if ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT;
|
|
WRITE("} else {\n"); INDENT; VNODE_3C; OUTDENT; WRITE("}\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for while@> =
|
|
WRITE("while ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for do@> =
|
|
WRITE("do {"); VNODE_2C; WRITE("} while (!(\n"); INDENT; VNODE_1C; OUTDENT; WRITE("))\n");
|
|
|
|
@<Generate primitive for for@> =
|
|
WRITE("for (");
|
|
inter_tree_node *INIT = InterTree::first_child(P);
|
|
if (!((Inode::is(INIT, VAL_IST)) &&
|
|
(InterValuePairs::is_number(ValInstruction::value(INIT))) &&
|
|
(InterValuePairs::to_number(ValInstruction::value(INIT)) == 1)))
|
|
VNODE_1C;
|
|
WRITE(";"); VNODE_2C;
|
|
WRITE(";");
|
|
inter_tree_node *U = InterTree::third_child(P);
|
|
if (Inode::isnt(U, VAL_IST))
|
|
Vanilla::node(gen, U);
|
|
WRITE(") {\n"); INDENT; VNODE_4C;
|
|
OUTDENT; WRITE("}\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for objectloop@> =
|
|
int in_flag = FALSE;
|
|
inter_tree_node *U = InterTree::third_child(P);
|
|
if ((Inode::is(U, INV_IST)) &&
|
|
(InvInstruction::method(U) == PRIMITIVE_INVMETH)) {
|
|
inter_symbol *prim = InvInstruction::primitive(U);
|
|
if ((prim) && (Primitives::to_BIP(I, prim) == IN_BIP)) in_flag = TRUE;
|
|
}
|
|
|
|
WRITE("for ("); VNODE_1C;
|
|
WRITE(" = 1; "); VNODE_1C;
|
|
WRITE(" < i7_max_objects; "); VNODE_1C;
|
|
WRITE("++) ");
|
|
if (in_flag == FALSE) {
|
|
WRITE("if (i7_ofclass(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(")) ");
|
|
}
|
|
WRITE("if (");
|
|
VNODE_3C;
|
|
WRITE(") {\n"); INDENT; VNODE_4C;
|
|
OUTDENT; WRITE("}\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for objectloopx@> =
|
|
WRITE("for ("); VNODE_1C;
|
|
WRITE(" = 1; "); VNODE_1C;
|
|
WRITE(" < i7_max_objects; "); VNODE_1C;
|
|
WRITE("++) ");
|
|
WRITE("if (i7_ofclass(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(")) ");
|
|
WRITE(" {\n"); INDENT; VNODE_3C;
|
|
OUTDENT; WRITE("}\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@<Generate primitive for switch@> =
|
|
WRITE("switch ("); VNODE_1C;
|
|
WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n");
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@ Inter permits multiple match values to be supplied for a single case in a
|
|
|!switch| primitive: but C does not allow this for its keyword |case|, so we
|
|
have to recurse downwards through the possibilities and preface each one by
|
|
|case:|. For example,
|
|
= (text as Inter)
|
|
inv !switch
|
|
inv !alternativecase
|
|
val K_number 3
|
|
val K_number 7
|
|
...
|
|
=
|
|
becomes |case 3: case 7:|.
|
|
|
|
@<Generate primitive for case@> =
|
|
CProgramControl::caser(gen, InterTree::first_child(P));
|
|
INDENT; VNODE_2C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
|
|
suppress_terminal_semicolon = TRUE;
|
|
|
|
@ =
|
|
void CProgramControl::caser(code_generation *gen, inter_tree_node *X) {
|
|
if (Inode::is(X, INV_IST)) {
|
|
if (InvInstruction::method(X) == PRIMITIVE_INVMETH) {
|
|
inter_symbol *prim = InvInstruction::primitive(X);
|
|
inter_ti xbip = Primitives::to_BIP(gen->from, prim);
|
|
if (xbip == ALTERNATIVECASE_BIP) {
|
|
CProgramControl::caser(gen, InterTree::first_child(X));
|
|
CProgramControl::caser(gen, InterTree::second_child(X));
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
text_stream *OUT = CodeGen::current(gen);
|
|
WRITE("case ");
|
|
Vanilla::node(gen, X);
|
|
WRITE(": ");
|
|
}
|
|
|
|
@<Generate primitive for default@> =
|
|
WRITE("default:\n"); INDENT; VNODE_1C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
|
|
suppress_terminal_semicolon = TRUE;
|