Generating C code to effect loops, branches and the like.
§1. 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) { METHOD_ADD(c_target, INVOKE_PRIMITIVE_MTID, CProgramControl::invoke_primitive); } void CProgramControl::invoke_primitive(code_generator *cgt, 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 = 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"); } }
§2. 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 if2.1; break; case IFDEBUG_BIP: Generate primitive for ifdebug2.2; break; case IFSTRICT_BIP: Generate primitive for ifstrict2.3; break; case IFELSE_BIP: Generate primitive for ifelse2.4; 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 while2.5; break; case DO_BIP: Generate primitive for do2.6; break; case FOR_BIP: Generate primitive for for2.7; break; case OBJECTLOOP_BIP: Generate primitive for objectloop2.8; break; case OBJECTLOOPX_BIP: Generate primitive for objectloopx2.9; break; case LOOP_BIP: Generate primitive for loop2.10; break; case SWITCH_BIP: Generate primitive for switch2.11; break; case CASE_BIP: Generate primitive for case2.12; break; case DEFAULT_BIP: Generate primitive for default2.14; break; case INDIRECT0_BIP: case INDIRECT0V_BIP: 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; case INDIRECT2_BIP: case INDIRECT2V_BIP: 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; 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; 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: Generate primitive for externalcall2.15; break; case ALTERNATIVECASE_BIP: internal_error("misplaced !alternativecase"); break; default: internal_error("unimplemented prim"); } return suppress_terminal_semicolon; }
§2.1. Generate primitive for if2.1 =
WRITE("if ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.2. Generate primitive for ifdebug2.2 =
WRITE("#ifdef DEBUG\n"); INDENT; VNODE_1C; OUTDENT; WRITE("#endif\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.3. Generate primitive for ifstrict2.3 =
WRITE("#ifdef STRICT_MODE\n"); INDENT; VNODE_1C; OUTDENT; WRITE("#endif\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.4. Generate primitive for ifelse2.4 =
WRITE("if ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("} else {\n"); INDENT; VNODE_3C; OUTDENT; WRITE("}\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.5. Generate primitive for while2.5 =
WRITE("while ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.6. Generate primitive for do2.6 =
WRITE("do {"); VNODE_2C; WRITE("} while (!(\n"); INDENT; VNODE_1C; OUTDENT; WRITE("))\n");
- This code is used in §2.
§2.7. Generate primitive for for2.7 =
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; WRITE(";"); VNODE_2C; WRITE(";"); inter_tree_node *U = InterTree::third_child(P); if (U->W.data[ID_IFLD] != VAL_IST) Vanilla::node(gen, U); WRITE(") {\n"); INDENT; VNODE_4C; OUTDENT; WRITE("}\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.8. Generate primitive for objectloop2.8 =
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)) { inter_symbol *prim = Inter::Inv::invokee(U); if ((prim) && (Primitives::to_bip(I, prim) == IN_BIP)) in_flag = TRUE; } WRITE("for (i7word_t "); 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;
- This code is used in §2.
§2.9. Generate primitive for objectloopx2.9 =
WRITE("for (i7word_t "); 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;
- This code is used in §2.
§2.10. Generate primitive for loop2.10 =
WRITE("{\n"); INDENT; VNODE_1C; OUTDENT; WRITE("}\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.11. Generate primitive for switch2.11 =
WRITE("switch ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n"); suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.12. 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,
inv !switch inv !alternativecase val K_number 3 val K_number 7 ...
becomes case 3: case 7:.
Generate primitive for case2.12 =
CProgramControl::caser(gen, InterTree::first_child(P)); INDENT; VNODE_2C; WRITE(";\n"); WRITE("break;\n"); OUTDENT; suppress_terminal_semicolon = TRUE;
- This code is used in §2.
void CProgramControl::caser(code_generation *gen, inter_tree_node *X) { if (X->W.data[ID_IFLD] == INV_IST) { if (X->W.data[METHOD_INV_IFLD] == INVOKED_PRIMITIVE) { inter_symbol *prim = Inter::Inv::invokee(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(": "); }
§2.14. Generate primitive for default2.14 =
WRITE("default:\n"); INDENT; VNODE_1C; WRITE(";\n"); WRITE("break;\n"); OUTDENT; suppress_terminal_semicolon = TRUE;
- This code is used in §2.
§2.15. Generate primitive for externalcall2.15 =
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"); }
- This code is used in §2.