diff --git a/inform7/Internal/Miscellany/inform7_clib.c b/inform7/Internal/Miscellany/inform7_clib.c index 71e3ce448..2d95be7cb 100644 --- a/inform7/Internal/Miscellany/inform7_clib.c +++ b/inform7/Internal/Miscellany/inform7_clib.c @@ -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) { diff --git a/inform7/Internal/Miscellany/inform7_clib.h b/inform7/Internal/Miscellany/inform7_clib.h index 49feb2c65..4a5d0d17f 100644 --- a/inform7/Internal/Miscellany/inform7_clib.h +++ b/inform7/Internal/Miscellany/inform7_clib.h @@ -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); diff --git a/inter/final-module/Chapter 5/C Assembly.w b/inter/final-module/Chapter 5/C Assembly.w index 9fdd1b479..e869bb03d 100644 --- a/inter/final-module/Chapter 5/C Assembly.w +++ b/inter/final-module/Chapter 5/C Assembly.w @@ -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"); } = diff --git a/inter/final-module/Chapter 5/C Conditions.w b/inter/final-module/Chapter 5/C Conditions.w index 51dde42df..8fea648cc 100644 --- a/inter/final-module/Chapter 5/C Conditions.w +++ b/inter/final-module/Chapter 5/C Conditions.w @@ -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: @; break; - case NE_BIP: @; break; - case GT_BIP: @; break; - case GE_BIP: @; break; - case LT_BIP: @; break; - case LE_BIP: @; break; - case OFCLASS_BIP: @; break; - case IN_BIP: @; break; - case NOTIN_BIP: @; 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; } -@ = - 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(", "); - } - @; + 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(", "); + @; WRITE(", "); - @; - 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"); - } + @; + 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); + @; + WRITE(", "); + @; WRITE(")"); if (positive == FALSE) WRITE(" == 0"); WRITE(")"); } else { - WRITE("("); @; - 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; - } - @; WRITE(")"); + WRITE("("); @; + WRITE(" %S ", test_operator); + @; WRITE(")"); } } -@ = +@ = if (X) Vanilla::node(gen, X); else WRITE("proc->state.tmp[0]"); -@ = +@ = Vanilla::node(gen, Y); diff --git a/inter/final-module/Chapter 5/C Object Model.w b/inter/final-module/Chapter 5/C Object Model.w index 60e583db8..55d9efe1a 100644 --- a/inter/final-module/Chapter 5/C Object Model.w +++ b/inter/final-module/Chapter 5/C Object Model.w @@ -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) diff --git a/inter/final-module/Chapter 5/C Program Control.w b/inter/final-module/Chapter 5/C Program Control.w index 2a19052a8..1e9630f99 100644 --- a/inter/final-module/Chapter 5/C Program Control.w +++ b/inter/final-module/Chapter 5/C Program Control.w @@ -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: @; 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: @; break; + case IFDEBUG_BIP: @; break; + case IFSTRICT_BIP: @; break; + case IFELSE_BIP: @; 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: @; break; + case DO_BIP: @; break; + case FOR_BIP: @; break; + case OBJECTLOOP_BIP: @; break; + case OBJECTLOOPX_BIP: @; break; + case LOOP_BIP: @; break; + case SWITCH_BIP: @; break; + case CASE_BIP: @; break; + case DEFAULT_BIP: @; 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: @; break; - case IFDEBUG_BIP: @; break; - case IFSTRICT_BIP: @; break; - case IFELSE_BIP: @; break; - case WHILE_BIP: @; break; - case DO_BIP: @; break; - case FOR_BIP: @; break; - case OBJECTLOOP_BIP: @; break; - case OBJECTLOOPX_BIP: @; break; - case LOOP_BIP: @; break; - case SWITCH_BIP: @; break; - case CASE_BIP: @; break; - case ALTERNATIVECASE_BIP: VNODE_1C; WRITE(", "); VNODE_2C; break; - case DEFAULT_BIP: @; 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: + @; break; + case ALTERNATIVECASE_BIP: internal_error("misplaced !alternativecase"); break; default: internal_error("unimplemented prim"); } return suppress_terminal_semicolon; } -@ = - 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; - } - @ = 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 @ = 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 @ = 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:|. + @ = CProgramControl::caser(gen, InterTree::first_child(P)); INDENT; VNODE_2C; WRITE(";\n"); WRITE("break;\n"); OUTDENT; suppress_terminal_semicolon = TRUE; -@ = - 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(": "); } + +@ = + WRITE("default:\n"); INDENT; VNODE_1C; WRITE(";\n"); WRITE("break;\n"); OUTDENT; + suppress_terminal_semicolon = TRUE; + +@ = + 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"); + }