mirror of
https://github.com/ganelson/inform.git
synced 2024-07-01 06:24:58 +03:00
Tidied up conditions and program control
This commit is contained in:
Graham Nelson
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");
|
||||
}
|
||||
|
||||
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");
|
||||
}
|
||||
|
||||
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");
|
||||
}
|
||||
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_discardundo(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_save(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_streamnum(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);
|
||||
|
|
|
|||
|
|
@ -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"@random", 2, -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"@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"@setiosys", -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)
|
||||
void i7_opcode_restart(i7process_t *proc);
|
||||
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_restore(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)
|
||||
|
|
@ -562,11 +562,11 @@ void i7_opcode_restart(i7process_t *proc) {
|
|||
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");
|
||||
}
|
||||
|
||||
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");
|
||||
}
|
||||
=
|
||||
|
|
|
|||
|
|
@ -2,41 +2,79 @@
|
|||
|
||||
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) {
|
||||
text_stream *OUT = CodeGen::current(gen);
|
||||
switch (bip) {
|
||||
case NOT_BIP: WRITE("(!("); VNODE_1C; 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 NOT_BIP:
|
||||
WRITE("(!("); VNODE_1C; 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:
|
||||
C_GEN_DATA(objdata.value_ranges_needed) = TRUE;
|
||||
C_GEN_DATA(objdata.value_property_holders_needed) = TRUE;
|
||||
WRITE("(i7_provides_gprop(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C;
|
||||
WRITE(", i7_mgl_OBJECT_TY, i7_mgl_value_ranges, i7_mgl_value_property_holders, i7_mgl_A_door_to, i7_mgl_COL_HSIZE))");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", ");
|
||||
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;
|
||||
case EQ_BIP: @<Generate comparison@>; break;
|
||||
case NE_BIP: @<Generate comparison@>; break;
|
||||
case GT_BIP: @<Generate comparison@>; break;
|
||||
case GE_BIP: @<Generate comparison@>; break;
|
||||
case LT_BIP: @<Generate comparison@>; break;
|
||||
case LE_BIP: @<Generate comparison@>; break;
|
||||
case OFCLASS_BIP: @<Generate comparison@>; break;
|
||||
case IN_BIP: @<Generate comparison@>; break;
|
||||
case NOTIN_BIP: @<Generate comparison@>; break;
|
||||
case ALTERNATIVE_BIP: internal_error("loose ALTERNATIVE_BIP primitive node"); break;
|
||||
default: return NOT_APPLICABLE;
|
||||
case EQ_BIP: case NE_BIP: case GT_BIP: case GE_BIP: case LT_BIP: case LE_BIP:
|
||||
case OFCLASS_BIP: case IN_BIP: case NOTIN_BIP:
|
||||
CConditions::comparison_r(gen, bip, NULL,
|
||||
InterTree::first_child(P), InterTree::second_child(P), 0);
|
||||
break;
|
||||
case PROPERTYVALUE_BIP:
|
||||
CConditions::comparison_r(gen, bip, InterTree::first_child(P),
|
||||
InterTree::second_child(P), InterTree::third_child(P), 0);
|
||||
break;
|
||||
case ALTERNATIVE_BIP:
|
||||
internal_error("misplaced !alternative in Inter tree"); break;
|
||||
default: return NOT_APPLICABLE;
|
||||
}
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
@<Generate comparison@> =
|
||||
CConditions::comparison_r(gen, bip, NULL, InterTree::first_child(P), InterTree::second_child(P), 0);
|
||||
@ The following recursive mechanism exists because of the need to support
|
||||
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,
|
||||
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) {
|
||||
|
|
@ -45,7 +83,9 @@ void CConditions::comparison_r(code_generation *gen,
|
|||
inter_ti ybip = Primitives::to_bip(gen->from, prim);
|
||||
if (ybip == ALTERNATIVE_BIP) {
|
||||
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);
|
||||
if ((bip == NE_BIP) || (bip == NOTIN_BIP)) WRITE(" && ");
|
||||
else WRITE(" || ");
|
||||
|
|
@ -57,38 +97,47 @@ void CConditions::comparison_r(code_generation *gen,
|
|||
}
|
||||
text_stream *OUT = CodeGen::current(gen);
|
||||
int positive = TRUE;
|
||||
text_stream *test_fn = CObjectModel::test_with_function(bip, &positive);
|
||||
if (Str::len(test_fn) > 0) {
|
||||
WRITE("(%S(proc, ", test_fn);
|
||||
if (bip == PROPERTYVALUE_BIP) {
|
||||
Vanilla::node(gen, K);
|
||||
WRITE(", ");
|
||||
}
|
||||
@<Compile first compared@>;
|
||||
text_stream *test_fn = NULL, *test_operator = NULL;
|
||||
switch (bip) {
|
||||
case OFCLASS_BIP: positive = TRUE; test_fn = I"i7_ofclass"; break;
|
||||
case IN_BIP: positive = TRUE; test_fn = I"i7_in"; break;
|
||||
case NOTIN_BIP: positive = FALSE; test_fn = I"i7_in"; break;
|
||||
case EQ_BIP: test_operator = I"=="; break;
|
||||
case NE_BIP: test_operator = I"!="; break;
|
||||
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(", ");
|
||||
@<Compile second compared@>;
|
||||
if (bip == PROPERTYVALUE_BIP) {
|
||||
WRITE(", i7_mgl_OBJECT_TY, i7_mgl_value_ranges, i7_mgl_value_property_holders, i7_mgl_A_door_to, i7_mgl_COL_HSIZE");
|
||||
}
|
||||
@<Compile second comparand@>;
|
||||
WRITE(", i7_mgl_OBJECT_TY, i7_mgl_value_ranges, i7_mgl_value_property_holders, ");
|
||||
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(")");
|
||||
if (positive == FALSE) WRITE(" == 0");
|
||||
WRITE(")");
|
||||
} else {
|
||||
WRITE("("); @<Compile first compared@>;
|
||||
switch (bip) {
|
||||
case EQ_BIP: WRITE(" == "); break;
|
||||
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(")");
|
||||
WRITE("("); @<Compile first comparand@>;
|
||||
WRITE(" %S ", test_operator);
|
||||
@<Compile second comparand@>; WRITE(")");
|
||||
}
|
||||
}
|
||||
|
||||
@<Compile first compared@> =
|
||||
@<Compile first comparand@> =
|
||||
if (X) Vanilla::node(gen, X); else WRITE("proc->state.tmp[0]");
|
||||
|
||||
@<Compile second compared@> =
|
||||
@<Compile second comparand@> =
|
||||
Vanilla::node(gen, Y);
|
||||
|
|
|
|||
|
|
@ -736,8 +736,6 @@ int CObjectModel::invoke_primitive(code_generation *gen, inter_ti bip, inter_tre
|
|||
switch (bip) {
|
||||
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 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 MESSAGE1_BIP: WRITE("i7_mcall_1(proc, "); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", ");
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,9 @@
|
|||
|
||||
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) {
|
||||
|
|
@ -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;
|
||||
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 BREAK_BIP: WRITE("break"); break;
|
||||
case CONTINUE_BIP: WRITE("continue"); break;
|
||||
case RETURN_BIP: @<Generate primitive for return@>; break;
|
||||
case JUMP_BIP: WRITE("goto "); VNODE_1C; break;
|
||||
case QUIT_BIP: WRITE("exit(0)"); break;
|
||||
case RESTORE_BIP: break; /* we won't support this in C */
|
||||
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 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:
|
||||
WRITE("i7_call_0(proc, "); VNODE_1C; WRITE(")"); break;
|
||||
WRITE("i7_call_0(proc, "); VNODE_1C; WRITE(")"); break;
|
||||
case INDIRECT1_BIP: case INDIRECT1V_BIP:
|
||||
WRITE("i7_call_1(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(")"); break;
|
||||
WRITE("i7_call_1(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(")"); break;
|
||||
case INDIRECT2_BIP: case INDIRECT2V_BIP:
|
||||
WRITE("i7_call_2(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
||||
WRITE("i7_call_2(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(")"); break;
|
||||
case INDIRECT3_BIP: case INDIRECT3V_BIP:
|
||||
WRITE("i7_call_3(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(")"); break;
|
||||
WRITE("i7_call_3(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(")"); break;
|
||||
case INDIRECT4_BIP: case INDIRECT4V_BIP:
|
||||
WRITE("i7_call_4(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
||||
VNODE_5C; WRITE(")"); break;
|
||||
WRITE("i7_call_4(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
||||
VNODE_5C; WRITE(")"); break;
|
||||
case INDIRECT5_BIP: case INDIRECT5V_BIP:
|
||||
WRITE("i7_call_5(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
||||
VNODE_5C; WRITE(", "); VNODE_6C; WRITE(")"); break;
|
||||
|
||||
case EXTERNALCALL_BIP: {
|
||||
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;
|
||||
WRITE("i7_call_5(proc, "); VNODE_1C; WRITE(", ");
|
||||
VNODE_2C; WRITE(", "); VNODE_3C; WRITE(", "); VNODE_4C; WRITE(", ");
|
||||
VNODE_5C; WRITE(", "); VNODE_6C; WRITE(")"); break;
|
||||
case EXTERNALCALL_BIP:
|
||||
@<Generate primitive for externalcall@>; break;
|
||||
|
||||
case ALTERNATIVECASE_BIP: internal_error("misplaced !alternativecase"); break;
|
||||
default: internal_error("unimplemented prim");
|
||||
}
|
||||
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@> =
|
||||
WRITE("if ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C;
|
||||
OUTDENT; WRITE("}\n");
|
||||
|
|
@ -138,7 +118,9 @@ int CProgramControl::compile_control_primitive(code_generation *gen, inter_ti bi
|
|||
@<Generate primitive for for@> =
|
||||
WRITE("for (");
|
||||
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(";");
|
||||
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@> =
|
||||
int in_flag = FALSE;
|
||||
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);
|
||||
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");
|
||||
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;
|
||||
|
||||
@<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) {
|
||||
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);
|
||||
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