mirror of
https://github.com/ganelson/inform.git
synced 2024-07-05 08:34:22 +03:00
Tidied up conditions and program control
This commit is contained in:
parent
b246e007fc
commit
3201cd9d77
|
@ -392,11 +392,11 @@ void i7_opcode_restart(i7process_t *proc) {
|
||||||
printf("(RESTART is not implemented on this C program.)\n");
|
printf("(RESTART is not implemented on this C program.)\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t y) {
|
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t *y) {
|
||||||
printf("(RESTORE is not implemented on this C program.)\n");
|
printf("(RESTORE is not implemented on this C program.)\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t y) {
|
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t *y) {
|
||||||
printf("(SAVE is not implemented on this C program.)\n");
|
printf("(SAVE is not implemented on this C program.)\n");
|
||||||
}
|
}
|
||||||
void i7_opcode_streamnum(i7process_t *proc, i7word_t x) {
|
void i7_opcode_streamnum(i7process_t *proc, i7word_t x) {
|
||||||
|
|
|
@ -117,8 +117,8 @@ void i7_opcode_saveundo(i7process_t *proc, i7word_t *x);
|
||||||
void i7_opcode_hasundo(i7process_t *proc, i7word_t *x);
|
void i7_opcode_hasundo(i7process_t *proc, i7word_t *x);
|
||||||
void i7_opcode_discardundo(i7process_t *proc);
|
void i7_opcode_discardundo(i7process_t *proc);
|
||||||
void i7_opcode_restart(i7process_t *proc);
|
void i7_opcode_restart(i7process_t *proc);
|
||||||
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t y);
|
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t *y);
|
||||||
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t y);
|
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t *y);
|
||||||
void i7_opcode_streamnum(i7process_t *proc, i7word_t x);
|
void i7_opcode_streamnum(i7process_t *proc, i7word_t x);
|
||||||
void i7_opcode_streamchar(i7process_t *proc, i7word_t x);
|
void i7_opcode_streamchar(i7process_t *proc, i7word_t x);
|
||||||
void i7_opcode_streamunichar(i7process_t *proc, i7word_t x);
|
void i7_opcode_streamunichar(i7process_t *proc, i7word_t x);
|
||||||
|
|
|
@ -197,10 +197,10 @@ C_supported_opcode *CAssembly::find_opcode(code_generation *gen, text_stream *na
|
||||||
CAssembly::new_opcode(gen, I"@quit", -1, -1, -1);
|
CAssembly::new_opcode(gen, I"@quit", -1, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@random", 2, -1, -1);
|
CAssembly::new_opcode(gen, I"@random", 2, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@restart", -1, -1, -1);
|
CAssembly::new_opcode(gen, I"@restart", -1, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@restore", -1, -1, -1);
|
CAssembly::new_opcode(gen, I"@restore", 2, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@restoreundo", 1, -1, -1);
|
CAssembly::new_opcode(gen, I"@restoreundo", 1, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@return", -1, -1, -1);
|
CAssembly::new_opcode(gen, I"@return", -1, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@save", -1, -1, -1);
|
CAssembly::new_opcode(gen, I"@save", 2, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@saveundo", 1, -1, -1);
|
CAssembly::new_opcode(gen, I"@saveundo", 1, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@setiosys", -1, -1, -1);
|
CAssembly::new_opcode(gen, I"@setiosys", -1, -1, -1);
|
||||||
CAssembly::new_opcode(gen, I"@setrandom", -1, -1, -1);
|
CAssembly::new_opcode(gen, I"@setrandom", -1, -1, -1);
|
||||||
|
@ -553,8 +553,8 @@ but not so simple to restart execution as if from a clean process start.
|
||||||
|
|
||||||
= (text to inform7_clib.h)
|
= (text to inform7_clib.h)
|
||||||
void i7_opcode_restart(i7process_t *proc);
|
void i7_opcode_restart(i7process_t *proc);
|
||||||
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t y);
|
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t *y);
|
||||||
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t y);
|
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t *y);
|
||||||
=
|
=
|
||||||
|
|
||||||
= (text to inform7_clib.c)
|
= (text to inform7_clib.c)
|
||||||
|
@ -562,11 +562,11 @@ void i7_opcode_restart(i7process_t *proc) {
|
||||||
printf("(RESTART is not implemented on this C program.)\n");
|
printf("(RESTART is not implemented on this C program.)\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t y) {
|
void i7_opcode_restore(i7process_t *proc, i7word_t x, i7word_t *y) {
|
||||||
printf("(RESTORE is not implemented on this C program.)\n");
|
printf("(RESTORE is not implemented on this C program.)\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t y) {
|
void i7_opcode_save(i7process_t *proc, i7word_t x, i7word_t *y) {
|
||||||
printf("(SAVE is not implemented on this C program.)\n");
|
printf("(SAVE is not implemented on this C program.)\n");
|
||||||
}
|
}
|
||||||
=
|
=
|
||||||
|
|
|
@ -2,41 +2,79 @@
|
||||||
|
|
||||||
Evaluating conditions.
|
Evaluating conditions.
|
||||||
|
|
||||||
@
|
@ This section implements the primitives which evaluate conditions. |!propertyvalue|
|
||||||
|
might seem a surprising inclusion in the list: as the name suggests, this finds
|
||||||
|
a property value. But although it is often used in a value context, it's also used
|
||||||
|
as a condition. For example, if kit code (written in Inform 6 notation) does this:
|
||||||
|
= (text as Inform 6)
|
||||||
|
if (obj has concealed) ...
|
||||||
|
=
|
||||||
|
then the condition amounts to an |inv !propertyvalue|. Now, since any value can
|
||||||
|
be used as a condition, this may still not seem to mean that |!propertyvalue|
|
||||||
|
belongs here; but consider that it is also legal to write --
|
||||||
|
= (text as Inform 6)
|
||||||
|
if (obj has concealed or scenery) ...
|
||||||
|
=
|
||||||
|
Here the |inv !propertyvalue| involves an |inv !alternative| in its children,
|
||||||
|
and handling that requires the mechanism below.
|
||||||
|
|
||||||
=
|
=
|
||||||
int CConditions::invoke_primitive(code_generation *gen, inter_ti bip, inter_tree_node *P) {
|
int CConditions::invoke_primitive(code_generation *gen, inter_ti bip, inter_tree_node *P) {
|
||||||
text_stream *OUT = CodeGen::current(gen);
|
text_stream *OUT = CodeGen::current(gen);
|
||||||
switch (bip) {
|
switch (bip) {
|
||||||
case NOT_BIP: WRITE("(!("); VNODE_1C; WRITE("))"); break;
|
case NOT_BIP:
|
||||||
case AND_BIP: WRITE("(("); VNODE_1C; WRITE(") && ("); VNODE_2C; WRITE("))"); break;
|
WRITE("(!("); VNODE_1C; WRITE("))"); break;
|
||||||
case OR_BIP: WRITE("(("); VNODE_1C; WRITE(") || ("); VNODE_2C; WRITE("))"); break;
|
case AND_BIP:
|
||||||
|
WRITE("(("); VNODE_1C; WRITE(") && ("); VNODE_2C; WRITE("))"); break;
|
||||||
|
case OR_BIP:
|
||||||
|
WRITE("(("); VNODE_1C; WRITE(") || ("); VNODE_2C; WRITE("))"); break;
|
||||||
case PROPERTYEXISTS_BIP:
|
case PROPERTYEXISTS_BIP:
|
||||||
C_GEN_DATA(objdata.value_ranges_needed) = TRUE;
|
C_GEN_DATA(objdata.value_ranges_needed) = TRUE;
|
||||||
C_GEN_DATA(objdata.value_property_holders_needed) = TRUE;
|
C_GEN_DATA(objdata.value_property_holders_needed) = TRUE;
|
||||||
WRITE("(i7_provides_gprop(proc, "); VNODE_1C; WRITE(", ");
|
WRITE("(i7_provides_gprop(proc, "); VNODE_1C; WRITE(", ");
|
||||||
VNODE_2C; WRITE(", "); VNODE_3C;
|
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", ");
|
||||||
WRITE(", i7_mgl_OBJECT_TY, i7_mgl_value_ranges, i7_mgl_value_property_holders, i7_mgl_A_door_to, i7_mgl_COL_HSIZE))");
|
WRITE("i7_mgl_OBJECT_TY, i7_mgl_value_ranges, i7_mgl_value_property_holders, ");
|
||||||
|
WRITE("i7_mgl_A_door_to, i7_mgl_COL_HSIZE))");
|
||||||
break;
|
break;
|
||||||
case EQ_BIP: @<Generate comparison@>; break;
|
case EQ_BIP: case NE_BIP: case GT_BIP: case GE_BIP: case LT_BIP: case LE_BIP:
|
||||||
case NE_BIP: @<Generate comparison@>; break;
|
case OFCLASS_BIP: case IN_BIP: case NOTIN_BIP:
|
||||||
case GT_BIP: @<Generate comparison@>; break;
|
CConditions::comparison_r(gen, bip, NULL,
|
||||||
case GE_BIP: @<Generate comparison@>; break;
|
InterTree::first_child(P), InterTree::second_child(P), 0);
|
||||||
case LT_BIP: @<Generate comparison@>; break;
|
break;
|
||||||
case LE_BIP: @<Generate comparison@>; break;
|
case PROPERTYVALUE_BIP:
|
||||||
case OFCLASS_BIP: @<Generate comparison@>; break;
|
CConditions::comparison_r(gen, bip, InterTree::first_child(P),
|
||||||
case IN_BIP: @<Generate comparison@>; break;
|
InterTree::second_child(P), InterTree::third_child(P), 0);
|
||||||
case NOTIN_BIP: @<Generate comparison@>; break;
|
break;
|
||||||
case ALTERNATIVE_BIP: internal_error("loose ALTERNATIVE_BIP primitive node"); break;
|
case ALTERNATIVE_BIP:
|
||||||
default: return NOT_APPLICABLE;
|
internal_error("misplaced !alternative in Inter tree"); break;
|
||||||
|
default: return NOT_APPLICABLE;
|
||||||
}
|
}
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
|
|
||||||
@<Generate comparison@> =
|
@ The following recursive mechanism exists because of the need to support
|
||||||
CConditions::comparison_r(gen, bip, NULL, InterTree::first_child(P), InterTree::second_child(P), 0);
|
alternative choices in Inter conditions, as here:
|
||||||
|
= (text as Inter)
|
||||||
|
inv !if
|
||||||
|
inv !eq
|
||||||
|
val K_number x
|
||||||
|
inv !alternative
|
||||||
|
val K_number 4
|
||||||
|
val K_number 8
|
||||||
|
...
|
||||||
|
=
|
||||||
|
This is the equivalent of writing |if (x == 4 or 8) ...| in Inform 6, but C does
|
||||||
|
not have an |or| operator like that. We could with care sometimes compile this
|
||||||
|
as |if ((x == 4) || (x == 8))|, but if evaluating |x| has side-effects, or is
|
||||||
|
slow, this will cause problems. Instead we compile |if (t = x, ((t == 4) || (t == 8)))|
|
||||||
|
where |t| is temporary storage.
|
||||||
|
|
||||||
@ =
|
Note that |!ne| and |!notin| interpret |!alternative| in a de Morgan-like way,
|
||||||
|
so that we compile |if ((x != 4) && (x != 8))| rather than |if ((x != 4) || (x != 8))|.
|
||||||
|
The former is equivalent to negating |!eq| on the same choices, which is what we want;
|
||||||
|
the latter would be universally true, which is useless.
|
||||||
|
|
||||||
|
=
|
||||||
void CConditions::comparison_r(code_generation *gen,
|
void CConditions::comparison_r(code_generation *gen,
|
||||||
inter_ti bip, inter_tree_node *K, inter_tree_node *X, inter_tree_node *Y, int depth) {
|
inter_ti bip, inter_tree_node *K, inter_tree_node *X, inter_tree_node *Y, int depth) {
|
||||||
if (Y->W.data[ID_IFLD] == INV_IST) {
|
if (Y->W.data[ID_IFLD] == INV_IST) {
|
||||||
|
@ -45,7 +83,9 @@ void CConditions::comparison_r(code_generation *gen,
|
||||||
inter_ti ybip = Primitives::to_bip(gen->from, prim);
|
inter_ti ybip = Primitives::to_bip(gen->from, prim);
|
||||||
if (ybip == ALTERNATIVE_BIP) {
|
if (ybip == ALTERNATIVE_BIP) {
|
||||||
text_stream *OUT = CodeGen::current(gen);
|
text_stream *OUT = CodeGen::current(gen);
|
||||||
if (depth == 0) { WRITE("(proc->state.tmp[0] = "); Vanilla::node(gen, X); WRITE(", ("); }
|
if (depth == 0) {
|
||||||
|
WRITE("(proc->state.tmp[0] = "); Vanilla::node(gen, X); WRITE(", (");
|
||||||
|
}
|
||||||
CConditions::comparison_r(gen, bip, K, NULL, InterTree::first_child(Y), depth+1);
|
CConditions::comparison_r(gen, bip, K, NULL, InterTree::first_child(Y), depth+1);
|
||||||
if ((bip == NE_BIP) || (bip == NOTIN_BIP)) WRITE(" && ");
|
if ((bip == NE_BIP) || (bip == NOTIN_BIP)) WRITE(" && ");
|
||||||
else WRITE(" || ");
|
else WRITE(" || ");
|
||||||
|
@ -57,38 +97,47 @@ void CConditions::comparison_r(code_generation *gen,
|
||||||
}
|
}
|
||||||
text_stream *OUT = CodeGen::current(gen);
|
text_stream *OUT = CodeGen::current(gen);
|
||||||
int positive = TRUE;
|
int positive = TRUE;
|
||||||
text_stream *test_fn = CObjectModel::test_with_function(bip, &positive);
|
text_stream *test_fn = NULL, *test_operator = NULL;
|
||||||
if (Str::len(test_fn) > 0) {
|
switch (bip) {
|
||||||
WRITE("(%S(proc, ", test_fn);
|
case OFCLASS_BIP: positive = TRUE; test_fn = I"i7_ofclass"; break;
|
||||||
if (bip == PROPERTYVALUE_BIP) {
|
case IN_BIP: positive = TRUE; test_fn = I"i7_in"; break;
|
||||||
Vanilla::node(gen, K);
|
case NOTIN_BIP: positive = FALSE; test_fn = I"i7_in"; break;
|
||||||
WRITE(", ");
|
case EQ_BIP: test_operator = I"=="; break;
|
||||||
}
|
case NE_BIP: test_operator = I"!="; break;
|
||||||
@<Compile first compared@>;
|
case GT_BIP: test_operator = I">"; break;
|
||||||
|
case GE_BIP: test_operator = I">="; break;
|
||||||
|
case LT_BIP: test_operator = I"<"; break;
|
||||||
|
case LE_BIP: test_operator = I"<="; break;
|
||||||
|
case PROPERTYVALUE_BIP: break;
|
||||||
|
default: internal_error("unsupported condition"); break;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (bip == PROPERTYVALUE_BIP) {
|
||||||
|
WRITE("(i7_read_gprop(proc, ", test_fn);
|
||||||
|
Vanilla::node(gen, K); WRITE(", ");
|
||||||
|
@<Compile first comparand@>;
|
||||||
WRITE(", ");
|
WRITE(", ");
|
||||||
@<Compile second compared@>;
|
@<Compile second comparand@>;
|
||||||
if (bip == PROPERTYVALUE_BIP) {
|
WRITE(", i7_mgl_OBJECT_TY, i7_mgl_value_ranges, i7_mgl_value_property_holders, ");
|
||||||
WRITE(", i7_mgl_OBJECT_TY, i7_mgl_value_ranges, i7_mgl_value_property_holders, i7_mgl_A_door_to, i7_mgl_COL_HSIZE");
|
WRITE("i7_mgl_A_door_to, i7_mgl_COL_HSIZE");
|
||||||
}
|
WRITE("))");
|
||||||
|
} else if (Str::len(test_fn) > 0) {
|
||||||
|
WRITE("(%S(proc, ", test_fn);
|
||||||
|
@<Compile first comparand@>;
|
||||||
|
WRITE(", ");
|
||||||
|
@<Compile second comparand@>;
|
||||||
WRITE(")");
|
WRITE(")");
|
||||||
if (positive == FALSE) WRITE(" == 0");
|
if (positive == FALSE) WRITE(" == 0");
|
||||||
WRITE(")");
|
WRITE(")");
|
||||||
} else {
|
} else {
|
||||||
WRITE("("); @<Compile first compared@>;
|
WRITE("("); @<Compile first comparand@>;
|
||||||
switch (bip) {
|
WRITE(" %S ", test_operator);
|
||||||
case EQ_BIP: WRITE(" == "); break;
|
@<Compile second comparand@>; WRITE(")");
|
||||||
case NE_BIP: WRITE(" != "); break;
|
|
||||||
case GT_BIP: WRITE(" > "); break;
|
|
||||||
case GE_BIP: WRITE(" >= "); break;
|
|
||||||
case LT_BIP: WRITE(" < "); break;
|
|
||||||
case LE_BIP: WRITE(" <= "); break;
|
|
||||||
}
|
|
||||||
@<Compile second compared@>; WRITE(")");
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@<Compile first compared@> =
|
@<Compile first comparand@> =
|
||||||
if (X) Vanilla::node(gen, X); else WRITE("proc->state.tmp[0]");
|
if (X) Vanilla::node(gen, X); else WRITE("proc->state.tmp[0]");
|
||||||
|
|
||||||
@<Compile second compared@> =
|
@<Compile second comparand@> =
|
||||||
Vanilla::node(gen, Y);
|
Vanilla::node(gen, Y);
|
||||||
|
|
|
@ -736,8 +736,6 @@ int CObjectModel::invoke_primitive(code_generation *gen, inter_ti bip, inter_tre
|
||||||
switch (bip) {
|
switch (bip) {
|
||||||
case PROPERTYARRAY_BIP: WRITE("i7_prop_addr(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
case PROPERTYARRAY_BIP: WRITE("i7_prop_addr(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
||||||
case PROPERTYLENGTH_BIP: WRITE("i7_prop_len(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
case PROPERTYLENGTH_BIP: WRITE("i7_prop_len(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
||||||
case PROPERTYVALUE_BIP: CConditions::comparison_r(gen, bip, InterTree::first_child(P), InterTree::second_child(P), InterTree::third_child(P), 0);
|
|
||||||
break;
|
|
||||||
case MESSAGE0_BIP: WRITE("i7_mcall_0(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(")"); break;
|
case MESSAGE0_BIP: WRITE("i7_mcall_0(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(")"); break;
|
||||||
case MESSAGE1_BIP: WRITE("i7_mcall_1(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", ");
|
case MESSAGE1_BIP: WRITE("i7_mcall_1(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", ");
|
||||||
VNODE_3C; WRITE(")"); break;
|
VNODE_3C; WRITE(")"); break;
|
||||||
|
@ -839,19 +837,6 @@ i7word_t i7_prop_addr(i7process_t *proc, i7word_t K, i7word_t obj, i7word_t pr_a
|
||||||
}
|
}
|
||||||
=
|
=
|
||||||
|
|
||||||
@h Special object-related conditions.
|
|
||||||
|
|
||||||
=
|
|
||||||
text_stream *CObjectModel::test_with_function(inter_ti bip, int *positive) {
|
|
||||||
switch (bip) {
|
|
||||||
case OFCLASS_BIP: *positive = TRUE; return I"i7_ofclass"; break;
|
|
||||||
case PROPERTYVALUE_BIP: *positive = TRUE; return I"i7_read_gprop"; break;
|
|
||||||
case IN_BIP: *positive = TRUE; return I"i7_in"; break;
|
|
||||||
case NOTIN_BIP: *positive = FALSE; return I"i7_in"; break;
|
|
||||||
}
|
|
||||||
*positive = NOT_APPLICABLE; return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
@
|
@
|
||||||
|
|
||||||
= (text to inform7_clib.h)
|
= (text to inform7_clib.h)
|
||||||
|
|
|
@ -2,7 +2,9 @@
|
||||||
|
|
||||||
Generating C code to effect loops, branches and the like.
|
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 *cgt) {
|
void CProgramControl::initialise(code_generator *cgt) {
|
||||||
|
@ -28,88 +30,66 @@ void CProgramControl::invoke_primitive(code_generator *cgt, code_generation *gen
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int CProgramControl::compile_control_primitive(code_generation *gen, inter_ti bip, inter_tree_node *P) {
|
@ 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;
|
int suppress_terminal_semicolon = FALSE;
|
||||||
text_stream *OUT = CodeGen::current(gen);
|
text_stream *OUT = CodeGen::current(gen);
|
||||||
inter_tree *I = gen->from;
|
inter_tree *I = gen->from;
|
||||||
switch (bip) {
|
switch (bip) {
|
||||||
case PUSH_BIP: WRITE("i7_push(proc, "); VNODE_1C; WRITE(")"); break;
|
case PUSH_BIP: WRITE("i7_push(proc, "); VNODE_1C; WRITE(")"); break;
|
||||||
case PULL_BIP: VNODE_1C; WRITE(" = i7_pull(proc)"); break;
|
case PULL_BIP: VNODE_1C; WRITE(" = i7_pull(proc)"); break;
|
||||||
case BREAK_BIP: WRITE("break"); break;
|
case IF_BIP: @<Generate primitive for if@>; break;
|
||||||
case CONTINUE_BIP: WRITE("continue"); break;
|
case IFDEBUG_BIP: @<Generate primitive for ifdebug@>; break;
|
||||||
case RETURN_BIP: @<Generate primitive for return@>; break;
|
case IFSTRICT_BIP: @<Generate primitive for ifstrict@>; break;
|
||||||
case JUMP_BIP: WRITE("goto "); VNODE_1C; break;
|
case IFELSE_BIP: @<Generate primitive for ifelse@>; break;
|
||||||
case QUIT_BIP: WRITE("exit(0)"); break;
|
case BREAK_BIP: WRITE("break"); break;
|
||||||
case RESTORE_BIP: break; /* we won't support this in C */
|
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 LOOP_BIP: @<Generate primitive for loop@>; 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 INDIRECT0_BIP: case INDIRECT0V_BIP:
|
case INDIRECT0_BIP: case INDIRECT0V_BIP:
|
||||||
WRITE("i7_call_0(proc, "); VNODE_1C; WRITE(")"); break;
|
WRITE("i7_call_0(proc, "); VNODE_1C; WRITE(")"); break;
|
||||||
case INDIRECT1_BIP: case INDIRECT1V_BIP:
|
case INDIRECT1_BIP: case INDIRECT1V_BIP:
|
||||||
WRITE("i7_call_1(proc, "); VNODE_1C; WRITE(", ");
|
WRITE("i7_call_1(proc, "); VNODE_1C; WRITE(", ");
|
||||||
VNODE_2C; WRITE(")"); break;
|
VNODE_2C; WRITE(")"); break;
|
||||||
case INDIRECT2_BIP: case INDIRECT2V_BIP:
|
case INDIRECT2_BIP: case INDIRECT2V_BIP:
|
||||||
WRITE("i7_call_2(proc, "); VNODE_1C; WRITE(", ");
|
WRITE("i7_call_2(proc, "); VNODE_1C; WRITE(", ");
|
||||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
||||||
case INDIRECT3_BIP: case INDIRECT3V_BIP:
|
case INDIRECT3_BIP: case INDIRECT3V_BIP:
|
||||||
WRITE("i7_call_3(proc, "); VNODE_1C; WRITE(", ");
|
WRITE("i7_call_3(proc, "); VNODE_1C; WRITE(", ");
|
||||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(")"); break;
|
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(")"); break;
|
||||||
case INDIRECT4_BIP: case INDIRECT4V_BIP:
|
case INDIRECT4_BIP: case INDIRECT4V_BIP:
|
||||||
WRITE("i7_call_4(proc, "); VNODE_1C; WRITE(", ");
|
WRITE("i7_call_4(proc, "); VNODE_1C; WRITE(", ");
|
||||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
||||||
VNODE_5C; WRITE(")"); break;
|
VNODE_5C; WRITE(")"); break;
|
||||||
case INDIRECT5_BIP: case INDIRECT5V_BIP:
|
case INDIRECT5_BIP: case INDIRECT5V_BIP:
|
||||||
WRITE("i7_call_5(proc, "); VNODE_1C; WRITE(", ");
|
WRITE("i7_call_5(proc, "); VNODE_1C; WRITE(", ");
|
||||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
||||||
VNODE_5C; WRITE(", "); VNODE_6C; WRITE(")"); break;
|
VNODE_5C; WRITE(", "); VNODE_6C; WRITE(")"); break;
|
||||||
|
case EXTERNALCALL_BIP:
|
||||||
case EXTERNALCALL_BIP: {
|
@<Generate primitive for externalcall@>; break;
|
||||||
inter_tree_node *N = InterTree::first_child(P);
|
|
||||||
if ((N) && (N->W.data[ID_IFLD] == VAL_IST) && (N->W.data[VAL1_VAL_IFLD] == LITERAL_TEXT_IVAL)) {
|
|
||||||
text_stream *glob_text = Inter::Warehouse::get_text(InterTree::warehouse(I), N->W.data[VAL1_VAL_IFLD + 1]);
|
|
||||||
WRITE("%S(proc, ", CFunctionModel::external_function(gen, glob_text)); VNODE_2C; WRITE(")");
|
|
||||||
} else {
|
|
||||||
internal_error("unimplemented form of !externalcall");
|
|
||||||
}
|
|
||||||
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 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 LOOP_BIP: @<Generate primitive for loop@>; break;
|
|
||||||
case SWITCH_BIP: @<Generate primitive for switch@>; break;
|
|
||||||
case CASE_BIP: @<Generate primitive for case@>; break;
|
|
||||||
case ALTERNATIVECASE_BIP: VNODE_1C; WRITE(", "); VNODE_2C; break;
|
|
||||||
case DEFAULT_BIP: @<Generate primitive for default@>; break;
|
|
||||||
|
|
||||||
|
case ALTERNATIVECASE_BIP: internal_error("misplaced !alternativecase"); break;
|
||||||
default: internal_error("unimplemented prim");
|
default: internal_error("unimplemented prim");
|
||||||
}
|
}
|
||||||
return suppress_terminal_semicolon;
|
return suppress_terminal_semicolon;
|
||||||
}
|
}
|
||||||
|
|
||||||
@<Generate primitive for return@> =
|
|
||||||
int rboolean = NOT_APPLICABLE;
|
|
||||||
inter_tree_node *V = InterTree::first_child(P);
|
|
||||||
if (V->W.data[ID_IFLD] == VAL_IST) {
|
|
||||||
inter_ti val1 = V->W.data[VAL1_VAL_IFLD];
|
|
||||||
inter_ti val2 = V->W.data[VAL2_VAL_IFLD];
|
|
||||||
if (val1 == LITERAL_IVAL) {
|
|
||||||
if (val2 == 0) rboolean = FALSE;
|
|
||||||
if (val2 == 1) rboolean = TRUE;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
switch (rboolean) {
|
|
||||||
case FALSE: WRITE("return 0"); break;
|
|
||||||
case TRUE: WRITE("return 1"); break;
|
|
||||||
case NOT_APPLICABLE: WRITE("return (i7word_t) "); Vanilla::node(gen, V); break;
|
|
||||||
}
|
|
||||||
|
|
||||||
@<Generate primitive for if@> =
|
@<Generate primitive for if@> =
|
||||||
WRITE("if ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C;
|
WRITE("if ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C;
|
||||||
OUTDENT; WRITE("}\n");
|
OUTDENT; WRITE("}\n");
|
||||||
|
@ -138,7 +118,9 @@ int CProgramControl::compile_control_primitive(code_generation *gen, inter_ti bi
|
||||||
@<Generate primitive for for@> =
|
@<Generate primitive for for@> =
|
||||||
WRITE("for (");
|
WRITE("for (");
|
||||||
inter_tree_node *INIT = InterTree::first_child(P);
|
inter_tree_node *INIT = InterTree::first_child(P);
|
||||||
if (!((INIT->W.data[ID_IFLD] == VAL_IST) && (INIT->W.data[VAL1_VAL_IFLD] == LITERAL_IVAL) && (INIT->W.data[VAL2_VAL_IFLD] == 1))) VNODE_1C;
|
if (!((INIT->W.data[ID_IFLD] == VAL_IST) &&
|
||||||
|
(INIT->W.data[VAL1_VAL_IFLD] == LITERAL_IVAL) &&
|
||||||
|
(INIT->W.data[VAL2_VAL_IFLD] == 1))) VNODE_1C;
|
||||||
WRITE(";"); VNODE_2C;
|
WRITE(";"); VNODE_2C;
|
||||||
WRITE(";");
|
WRITE(";");
|
||||||
inter_tree_node *U = InterTree::third_child(P);
|
inter_tree_node *U = InterTree::third_child(P);
|
||||||
|
@ -151,7 +133,8 @@ int CProgramControl::compile_control_primitive(code_generation *gen, inter_ti bi
|
||||||
@<Generate primitive for objectloop@> =
|
@<Generate primitive for objectloop@> =
|
||||||
int in_flag = FALSE;
|
int in_flag = FALSE;
|
||||||
inter_tree_node *U = InterTree::third_child(P);
|
inter_tree_node *U = InterTree::third_child(P);
|
||||||
if ((U->W.data[ID_IFLD] == INV_IST) && (U->W.data[METHOD_INV_IFLD] == INVOKED_PRIMITIVE)) {
|
if ((U->W.data[ID_IFLD] == INV_IST) &&
|
||||||
|
(U->W.data[METHOD_INV_IFLD] == INVOKED_PRIMITIVE)) {
|
||||||
inter_symbol *prim = Inter::Inv::invokee(U);
|
inter_symbol *prim = Inter::Inv::invokee(U);
|
||||||
if ((prim) && (Primitives::to_bip(I, prim) == IN_BIP)) in_flag = TRUE;
|
if ((prim) && (Primitives::to_bip(I, prim) == IN_BIP)) in_flag = TRUE;
|
||||||
}
|
}
|
||||||
|
@ -188,15 +171,24 @@ int CProgramControl::compile_control_primitive(code_generation *gen, inter_ti bi
|
||||||
WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n");
|
WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n");
|
||||||
suppress_terminal_semicolon = TRUE;
|
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@> =
|
@<Generate primitive for case@> =
|
||||||
CProgramControl::caser(gen, InterTree::first_child(P));
|
CProgramControl::caser(gen, InterTree::first_child(P));
|
||||||
INDENT; VNODE_2C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
|
INDENT; VNODE_2C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
|
||||||
suppress_terminal_semicolon = TRUE;
|
suppress_terminal_semicolon = TRUE;
|
||||||
|
|
||||||
@<Generate primitive for default@> =
|
|
||||||
WRITE("default:\n"); INDENT; VNODE_1C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
|
|
||||||
suppress_terminal_semicolon = TRUE;
|
|
||||||
|
|
||||||
@ =
|
@ =
|
||||||
void CProgramControl::caser(code_generation *gen, inter_tree_node *X) {
|
void CProgramControl::caser(code_generation *gen, inter_tree_node *X) {
|
||||||
if (X->W.data[ID_IFLD] == INV_IST) {
|
if (X->W.data[ID_IFLD] == INV_IST) {
|
||||||
|
@ -215,3 +207,19 @@ void CProgramControl::caser(code_generation *gen, inter_tree_node *X) {
|
||||||
Vanilla::node(gen, X);
|
Vanilla::node(gen, X);
|
||||||
WRITE(": ");
|
WRITE(": ");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@<Generate primitive for default@> =
|
||||||
|
WRITE("default:\n"); INDENT; VNODE_1C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
|
||||||
|
suppress_terminal_semicolon = TRUE;
|
||||||
|
|
||||||
|
@<Generate primitive for externalcall@> =
|
||||||
|
inter_tree_node *N = InterTree::first_child(P);
|
||||||
|
if ((N) && (N->W.data[ID_IFLD] == VAL_IST) &&
|
||||||
|
(N->W.data[VAL1_VAL_IFLD] == LITERAL_TEXT_IVAL)) {
|
||||||
|
text_stream *glob_text = Inter::Warehouse::get_text(
|
||||||
|
InterTree::warehouse(I), N->W.data[VAL1_VAL_IFLD + 1]);
|
||||||
|
WRITE("%S(proc, ", CFunctionModel::external_function(gen, glob_text));
|
||||||
|
VNODE_2C; WRITE(")");
|
||||||
|
} else {
|
||||||
|
internal_error("unimplemented form of !externalcall");
|
||||||
|
}
|
||||||
|
|
Loading…
Reference in a new issue