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 *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");
    }
}

§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 SWITCH_BIP:          Generate primitive for switch2.10; break;
        case CASE_BIP:            Generate primitive for case2.11; break;
        case DEFAULT_BIP:         Generate primitive for default2.13; 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;

§2.2. Generate primitive for ifdebug2.2 =

    WRITE("#ifdef DEBUG\n"); INDENT; VNODE_1C; OUTDENT; WRITE("#endif\n");
    suppress_terminal_semicolon = TRUE;

§2.3. Generate primitive for ifstrict2.3 =

    WRITE("#ifdef STRICT_MODE\n"); INDENT; VNODE_1C; OUTDENT; WRITE("#endif\n");
    suppress_terminal_semicolon = TRUE;

§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;

§2.5. Generate primitive for while2.5 =

    WRITE("while ("); VNODE_1C; WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n");
    suppress_terminal_semicolon = TRUE;

§2.6. Generate primitive for do2.6 =

    WRITE("do {"); VNODE_2C; WRITE("} while (!(\n"); INDENT; VNODE_1C; OUTDENT; WRITE("))\n");

§2.7. Generate primitive for for2.7 =

    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;

§2.8. Generate primitive for objectloop2.8 =

    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;

§2.9. Generate primitive for objectloopx2.9 =

    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;

§2.10. Generate primitive for switch2.10 =

    WRITE("switch ("); VNODE_1C;
    WRITE(") {\n"); INDENT; VNODE_2C; OUTDENT; WRITE("}\n");
    suppress_terminal_semicolon = TRUE;

§2.11. 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.11 =

    CProgramControl::caser(gen,  InterTree::first_child(P));
    INDENT; VNODE_2C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
    suppress_terminal_semicolon = TRUE;

§2.12.

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(": ");
}

§2.13. Generate primitive for default2.13 =

    WRITE("default:\n"); INDENT; VNODE_1C; WRITE(";\n"); WRITE("break;\n"); OUTDENT;
    suppress_terminal_semicolon = TRUE;