To generate I6 routines of imperative code.


§1.

void I6TargetCode::create_generator(code_generator *gtr) {
    METHOD_ADD(gtr, DECLARE_FUNCTION_MTID, I6TargetCode::declare_function);
    METHOD_ADD(gtr, PLACE_LABEL_MTID, I6TargetCode::place_label);
    METHOD_ADD(gtr, EVALUATE_LABEL_MTID, I6TargetCode::evaluate_label);
    METHOD_ADD(gtr, PLACE_PROVENANCE_MTID, I6TargetCode::place_provenance);
    METHOD_ADD(gtr, INVOKE_PRIMITIVE_MTID, I6TargetCode::invoke_primitive);
    METHOD_ADD(gtr, INVOKE_FUNCTION_MTID, I6TargetCode::invoke_function);
    METHOD_ADD(gtr, INVOKE_OPCODE_MTID, I6TargetCode::invoke_opcode);
    METHOD_ADD(gtr, ASSEMBLY_MARKER_MTID, I6TargetCode::assembly_marker);
}

§2. Functions. Inform 6 originated as an assembler briefly called "zass", and its assembly-language character can still be seen in the way functions are declared:

[ FunctionName local1 local2 local3 ... localn;
    ...
];

Here local1, local2, ..., localn are all of the local variables accessible from the function; the earliest will be used as call parameters, all subsequent ones being initially zero.

void I6TargetCode::declare_function(code_generator *gtr, code_generation *gen,
    vanilla_function *vf) {
    segmentation_pos saved = CodeGen::select(gen, functions_I7CGS);
    if (vf == NULL) internal_error("no vg");
    text_stream *fn_name = vf->identifier;
    text_stream *OUT = CodeGen::current(gen);
    Open the function2.1;

    if (Str::eq(fn_name, I"Main"))                 Inject code at the top of Main2.3;
    if (Str::eq(fn_name, I"DebugAction"))          Inject code at the top of DebugAction2.4;
    if (Str::eq(fn_name, I"DebugAttribute"))       Inject code at the top of DebugAttribute2.5;
    if (Str::eq(fn_name, I"DebugProperty"))        Inject code at the top of DebugProperty2.6;
    if (Str::eq(fn_name, I"PLATFORM_SPECIFIC_STARTUP_R")) Inject code at the top of PLATFORM_SPECIFIC_STARTUP_R2.7;

    Vanilla::node(gen, vf->function_body);  This compiles the body of the function

    Close the function2.2;
    CodeGen::deselect(gen, saved);
}

§2.1. Open the function2.1 =

    WRITE("[ %S", fn_name);
    text_stream *var_name;
    LOOP_OVER_LINKED_LIST(var_name, text_stream, vf->locals)
        WRITE(" %S", var_name);
    WRITE(";\n"); INDENT;

§2.2. Close the function2.2 =

    OUTDENT; WRITE("];\n");

§2.3. A few functions will be sneakily rewritten in passing. This is done to handle specific features of the Z or Glulx virtual machines which do not meaningfully exist in any wider cross-platform way. Although this could all be done by having a slightly more elaborate linker and then including the code below in kits (as was indeed done during 2020), it's really better that the Inter tree not have to refer to eldritch Z-only symbols like #largest_object or Glulx-only symbols like #g$self.

Inject code at the top of Main2.3 =

    WRITE("#ifdef TARGET_ZCODE; max_z_object = #largest_object - 255; #endif;\n");

§2.4. Inject code at the top of DebugAction2.4 =

    WRITE("#ifdef TARGET_GLULX;\n");
    WRITE("if (a < 4096) {\n");
    WRITE("    if (a < 0 || a >= #identifiers_table-->7) print \"<invalid action \", a, \">\";\n");
    WRITE("    else {\n");
    WRITE("        str = #identifiers_table-->6;\n");
    WRITE("        str = str-->a;\n");
    WRITE("        if (str) print (string) str; else print \"<unnamed action \", a, \">\";\n");
    WRITE("        return;\n");
    WRITE("    }\n");
    WRITE("}\n");
    WRITE("#endif;\n");
    WRITE("#ifdef TARGET_ZCODE;\n");
    WRITE("if (a < 4096) {\n");
    WRITE("    anames = #identifiers_table;\n");
    WRITE("    anames = anames + 2*(anames-->0) + 2*48;\n");
    WRITE("    print (string) anames-->a;\n");
    WRITE("    return;\n");
    WRITE("}\n");
    WRITE("#endif;\n");

§2.5. Inject code at the top of DebugAttribute2.5 =

    I6_GEN_DATA(DebugAttribute_seen) = TRUE;
    WRITE("#ifdef TARGET_GLULX;\n");
    WRITE("if (a < 0 || a >= NUM_ATTR_BYTES*8) print \"<invalid attribute \", a, \">\";\n");
    WRITE("else {\n");
    WRITE("    str = #identifiers_table-->4;\n");
    WRITE("    str = str-->a;\n");
    WRITE("    if (str) print (string) str; else print \"<unnamed attribute \", a, \">\";\n");
    WRITE("}\n");
    WRITE("return;\n");
    WRITE("#endif;\n");
    WRITE("#ifdef TARGET_ZCODE;\n");
    WRITE("if (a < 0 || a >= 48) print \"<invalid attribute \", a, \">\";\n");
    WRITE("else {\n");
    WRITE("    anames = #identifiers_table; anames = anames + 2*(anames-->0);\n");
    WRITE("    print (string) anames-->a;\n");
    WRITE("}\n");
    WRITE("return;\n");
    WRITE("#endif;\n");

§2.6. Inject code at the top of DebugProperty2.6 =

    WRITE("print (property) p;\n");
    WRITE("return;\n");

§2.7. This enables a speed optimisation in the Glulx virtual machine which reimplements some of the veneer functions in "hardware". If it weren't here, or if the Gestalt said that the VM didn't support this after all, no harm would be done except for a slight slowdown.

At the suggestion of Adrian Welcker, the code below uses the new accelerated function numbers 8 to 13 in place of the previously valid 2 to 7, which are new in Glulx 3.1.3. This is a trade-off: it means they behave correctly if the Inform 6 constant NUM_ATTR_BYTES is altered — in effect, it's getting around a bug in the previous Glulx spec — but on the other hand, these accelerated functions do not exist in earlier Glulx implementations. However, takeup of 3.1.3 has been swift. (See Jira bug I7-2328 and I7-1162.)

Inject code at the top of PLATFORM_SPECIFIC_STARTUP_R2.7 =

    WRITE("#ifdef TARGET_GLULX;\n");
    WRITE("@gestalt GLULX_GESTALT_Acceleration 0 res;\n");
    WRITE("if (res == 0) rfalse;\n");
    WRITE("addr = #classes_table;\n");
    WRITE("@accelparam 0 addr;\n");
    WRITE("@accelparam 1 INDIV_PROP_START;\n");
    WRITE("@accelparam 2 Class;\n");
    WRITE("@accelparam 3 Object;\n");
    WRITE("@accelparam 4 Routine;\n");
    WRITE("@accelparam 5 String;\n");
    WRITE("addr = #globals_array + WORDSIZE * #g$self;\n");
    WRITE("@accelparam 6 addr;\n");
    WRITE("@accelparam 7 NUM_ATTR_BYTES;\n");
    WRITE("addr = #cpv__start;\n");
    WRITE("@accelparam 8 addr;\n");
    WRITE("@accelfunc 1 Z__Region;\n");
    WRITE("@accelfunc 8 CP__Tab;\n");
    WRITE("@accelfunc 9 RA__Pr;\n");
    WRITE("@accelfunc 10 RL__Pr;\n");
    WRITE("@accelfunc 11 OC__Cl;\n");
    WRITE("@accelfunc 12 RV__Pr;\n");
    WRITE("@accelfunc 13 OP__Pr;\n");
    WRITE("#endif;\n");
    WRITE("rfalse;\n");

§3. Labels. Labels in Inform 6 are jump destinations, much as in C they are goto destinations. A full stop indicates where they are positioned:

    if (whatever) jump Catastrophe;
        ...
    .Catastrophe;
        ...

Inter identifiers for labels also start with full stops. So:

void I6TargetCode::place_label(code_generator *gtr, code_generation *gen,
    text_stream *label_name) {
    text_stream *OUT = CodeGen::current(gen);
    WRITE("%S;\n", label_name);
}
void I6TargetCode::evaluate_label(code_generator *gtr, code_generation *gen,
    text_stream *label_name) {
    text_stream *OUT = CodeGen::current(gen);
    LOOP_THROUGH_TEXT(pos, label_name)
        if (Str::get(pos) != '.')
            PUT(Str::get(pos));
}

§4. Origsource references.

The conversion of filenames to I6 string literals doesn't really account for special characters. We're leaving it up to the end user to decode all of I6's confusing escape sequences. But at least we guarantee that the I6 compiler won't choke on the directive.

void I6TargetCode::place_provenance(code_generator *gtr, code_generation *gen,
    text_provenance *source_loc) {
    if (I6_GEN_DATA(write_orig_source_directives)) {
        text_stream *OUT = CodeGen::current(gen);
        if (Provenance::is_somewhere(*source_loc)) {
            WRITE("#OrigSource ");
            Generators::compile_literal_text(gen, source_loc->textual_filename, TRUE);
            if (source_loc->line_number > 0)
                WRITE(" %d;\n", source_loc->line_number);
            else
                WRITE(";\n");
        }
        else {
            WRITE("#OrigSource;\n");
        }
    }
}

§5. Function invocations. Or in other words, function calls. These are easy: the syntax is exactly what it would be for C.

void I6TargetCode::invoke_function(code_generator *gtr, code_generation *gen,
    inter_tree_node *P, vanilla_function *vf, int void_context) {
    text_stream *OUT = CodeGen::current(gen);
    WRITE("%S(", vf->identifier);
    int c = 0;
    LOOP_THROUGH_INTER_CHILDREN(F, P) {
        if (c++ > 0) WRITE(", ");
        Vanilla::node(gen, F);
    }
    WRITE(")");
    if (void_context) WRITE(";\n");
}

§6. Assembly language. In general, we make no attempt to police the supposedly valid assembly language given to us here. Glulx has one set, Z another. Any assembly language in the Inter tree results from kit material; and if the author of such a kit tries to use an invalid opcode, then the result won't compile under I6, but none of that is our business here.

The @aread opcode is a valid Z-machine opcode, but owing to the way I6 handles the irreconcilable change in syntax for the same opcode in V3 and V4-5 of the Z-machine specification, there is no good way to assemble it using @ notation unless we want to save the result. (See the Z-Machine Standards Document.) As a dodge, we use the Inform 6 statement read X Y instead.

void I6TargetCode::invoke_opcode(code_generator *gtr, code_generation *gen,
    text_stream *opcode, int operand_count, inter_tree_node **operands,
    inter_tree_node *label, int label_sense) {
    text_stream *OUT = CodeGen::current(gen);
    if (Str::eq(opcode, I"@aread")) WRITE("read");
    else WRITE("%S", opcode);
    for (int opc = 0; opc < operand_count; opc++) {
        WRITE(" ");
        Vanilla::node(gen, operands[opc]);
    }
    if (label) {
        WRITE(" ?");
        if (label_sense == FALSE) WRITE("~");
        Vanilla::node(gen, label);
    }
    WRITE(";\n");
}

void I6TargetCode::assembly_marker(code_generator *gtr, code_generation *gen, inter_ti marker) {
    text_stream *OUT = CodeGen::current(gen);
    switch (marker) {
        case ASM_ARROW_ASMMARKER: WRITE("->"); break;
        case ASM_SP_ASMMARKER: WRITE("sp"); break;
        case ASM_RTRUE_ASMMARKER: WRITE("?rtrue"); break;
        case ASM_RFALSE_ASMMARKER: WRITE("?rfalse"); break;
        case ASM_NEG_ASMMARKER: WRITE("~"); break;
        case ASM_NEG_RTRUE_ASMMARKER: WRITE("?~rtrue"); break;
        case ASM_NEG_RFALSE_ASMMARKER: WRITE("?~rfalse"); break;
        default:
            WRITE_TO(STDERR, "Unimplemented assembly marker is '%d'\n", marker);
            internal_error("unimplemented assembly marker");
    }
}

§7. Primitives.

void I6TargetCode::invoke_primitive(code_generator *gtr, code_generation *gen,
    inter_symbol *prim_name, inter_tree_node *P, int void_context) {
    inter_tree *I = gen->from;
    text_stream *OUT = CodeGen::current(gen);
    inter_ti bip = Primitives::to_BIP(I, prim_name);

    int suppress_terminal_semicolon = (void_context)?FALSE:TRUE;
    switch (bip) {
        Basic arithmetic and logical operations7.1;
        Storing or otherwise changing values7.2;
        VM stack access7.5;
        Control structures7.6;
        Indirect function calls7.7;
        Method calls7.8;
        Property value access7.3;
        Textual output7.9;
        The VM object tree7.10;
        default:
            WRITE_TO(STDERR, "Unimplemented primitive is '%S'\n",
                InterSymbol::identifier(prim_name));
            internal_error("unimplemented prim");
    }
    if (suppress_terminal_semicolon == FALSE) WRITE(";\n");
}

§7.1. Mostly easy, because the Inter primitives here were so closely modelled on their Inform 6 analogues in the first place.

For example, although !alternative is a very unusual linguistic feature — it allows alternatives in several conditions, e.g., if (x == 1 or 2 or 3) ... — it corresponds directly to the or keyword of Inform 6, so generating it is trivial.

Basic arithmetic and logical operations7.1 =

    case PLUS_BIP:          WRITE("("); VNODE_1C; WRITE(" + "); VNODE_2C; WRITE(")"); break;
    case MINUS_BIP:         WRITE("("); VNODE_1C; WRITE(" - "); VNODE_2C; WRITE(")"); break;
    case UNARYMINUS_BIP:    Handle unary minus7.1.1; break;
    case TIMES_BIP:         WRITE("("); VNODE_1C; WRITE("*"); VNODE_2C; WRITE(")"); break;
    case DIVIDE_BIP:        WRITE("("); VNODE_1C; WRITE("/"); VNODE_2C; WRITE(")"); break;
    case MODULO_BIP:        WRITE("("); VNODE_1C; WRITE("%%"); VNODE_2C; WRITE(")"); break;
    case BITWISEAND_BIP:    WRITE("(("); VNODE_1C; WRITE(")&("); VNODE_2C; WRITE("))"); break;
    case BITWISEOR_BIP:     WRITE("(("); VNODE_1C; WRITE(")|("); VNODE_2C; WRITE("))"); break;
    case BITWISENOT_BIP:    WRITE("(~("); VNODE_1C; 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 EQ_BIP:            WRITE("("); VNODE_1C; WRITE(" == "); VNODE_2C; WRITE(")"); break;
    case NE_BIP:            WRITE("("); VNODE_1C; WRITE(" ~= "); VNODE_2C; WRITE(")"); break;
    case GT_BIP:            WRITE("("); VNODE_1C; WRITE(" > "); VNODE_2C; WRITE(")"); break;
    case GE_BIP:            WRITE("("); VNODE_1C; WRITE(" >= "); VNODE_2C; WRITE(")"); break;
    case LT_BIP:            WRITE("("); VNODE_1C; WRITE(" < "); VNODE_2C; WRITE(")"); break;
    case LE_BIP:            WRITE("("); VNODE_1C; WRITE(" <= "); VNODE_2C; WRITE(")"); break;
    case OFCLASS_BIP:       WRITE("("); VNODE_1C; WRITE(" ofclass "); VNODE_2C; WRITE(")"); break;
    case IN_BIP:            WRITE("("); VNODE_1C; WRITE(" in "); VNODE_2C; WRITE(")"); break;
    case NOTIN_BIP:         WRITE("("); VNODE_1C; WRITE(" notin "); VNODE_2C; WRITE(")"); break;
    case LOOKUP_BIP:        WRITE("("); VNODE_1C; WRITE("-->("); VNODE_2C; WRITE("))"); break;
    case LOOKUPBYTE_BIP:    WRITE("("); VNODE_1C; WRITE("->("); VNODE_2C; WRITE("))"); break;
    case ALTERNATIVE_BIP:   VNODE_1C; WRITE(" or "); VNODE_2C; break;
    case SEQUENTIAL_BIP:    WRITE("("); VNODE_1C; WRITE(","); VNODE_2C; WRITE(")"); break;
    case TERNARYSEQUENTIAL_BIP: Generate primitive for ternarysequential7.1.2; break;
    case RANDOM_BIP:        WRITE("random("); VNODE_1C; WRITE(")"); break;

§7.1.1. In general, Inform 6 is able to constant-fold, that is, to evaluate expressions between constants at compile time: for example, 5+6 will be compiled as 11, not as code to add 5 to 6. But in just a few contexts, notably as case values in switch statements, constants won't fold. This in particular affects unary minus, so that (-(23)) is not syntactically valid as a switch case. So we omit the brackets for applications of unary minus which are simple enough to do so. (See Jira bug I7-2304.)

Handle unary minus7.1.1 =

    if (Inode::get_construct_ID(InterTree::first_child(P)) == VAL_IST) {
        WRITE("-"); VNODE_1C;
    } else {
        WRITE("(-("); VNODE_1C; WRITE("))");
    }

§7.1.2. But the unfortunate !ternarysequential a b c needs some gymnastics. It would be trivial to generate to C with the serial comma operator: (a, b, c) evaluates a, then throws that away and evaluates b, then throws that away too and returns the value of c.

The same effect is annoyingly difficult to get out of the sometimes shaky I6 compiler's expression parser. I6 does support the comma operator, so at first sight (a, b, c) ought to work in I6, too. And it does, right up to the point where some of the token values themselves include invocations of functions. It is a known infelicity of the I6 syntax analyser that it won't always allow the serial comma to be mixed in the same expression with the function argument comma: for example in the case (a(b, c), d), where the first comma constructs a list of arguments and the second is the operator. (Many such expressions work fine in I6 — but not all.)

That being so, we use the following circumlocution:

    (c) + 0*((b) + (a))

Because I6 evaluates the leaves in an expression tree right-to-left, not left-to-right, the parameter assignments happen first, then the conditions, then the result.

Generate primitive for ternarysequential7.1.2 =

    WRITE("(\n"); INDENT;
    WRITE("! This evaluates last\n"); VNODE_3C;
    OUTDENT; WRITE("+\n"); INDENT;
    WRITE("0*(\n"); INDENT;
    WRITE("! This evaluates second\n");
    WRITE("((\n"); INDENT; VNODE_2C;
    OUTDENT; WRITE("\n))\n");
    OUTDENT; WRITE("+\n"); INDENT;
    WRITE("! This evaluate first\n");
    WRITE("("); VNODE_1C; WRITE(")");
    OUTDENT; WRITE(")\n");
    OUTDENT; WRITE(")\n");

§7.2. These are the seven primitives which change a storage item given by a reference, which is always the first child of the primitive node. It might, for example, be a global variable, or a memory location.

Storing or otherwise changing values7.2 =

    case STORE_BIP:         Perform a store7.2.1; break;
    case PREINCREMENT_BIP:  Perform a store7.2.1; break;
    case POSTINCREMENT_BIP: Perform a store7.2.1; break;
    case PREDECREMENT_BIP:  Perform a store7.2.1; break;
    case POSTDECREMENT_BIP: Perform a store7.2.1; break;
    case SETBIT_BIP:        Perform a store7.2.1; break;
    case CLEARBIT_BIP:      Perform a store7.2.1; break;

§7.2.1. Perform a store7.2.1 =

    inter_tree_node *storage_ref = InterTree::first_child(P);
    if (storage_ref->W.instruction[0] == REFERENCE_IST)
        storage_ref = InterTree::first_child(storage_ref);
    if ((ReferenceInstruction::node_is_ref_to(gen->from, InterTree::first_child(P),
        PROPERTYVALUE_BIP)) &&
        (I6TargetCode::pval_case(storage_ref) != I6G_CAN_PROVE_IS_OBJ_PROPERTY) &&
        (I6TargetCode::pval_case(storage_ref) != I6G_CAN_PROVE_IS_PERHAPS_UNPOSSESSED_PROPERTY)) {
        Alter a property value7.2.1.2;
    } else {
        Alter some other storage7.2.1.1;
    }

§7.2.1.1. The easy case first: here, whatever the storage is (for example, a variable), it's one that we can simply treat as an lvalue in Inform 6 (for example, by giving its variable name). For example, the memory location A-->3 can be assigned to, or can have ++ or -- applied to it in I6.

Note that this case even includes some property values: if we can see that P is the explicit name of a property we are storing in a VM-property, then we can use O.P as an Inform 6 lvalue, and all is well, and we then end up with code such as ++(O.P).

Alter some other storage7.2.1.1 =

    switch (bip) {
        case PREINCREMENT_BIP:  WRITE("++("); VNODE_1C; WRITE(")"); break;
        case POSTINCREMENT_BIP: WRITE("("); VNODE_1C; WRITE(")++"); break;
        case PREDECREMENT_BIP:  WRITE("--("); VNODE_1C; WRITE(")"); break;
        case POSTDECREMENT_BIP: WRITE("("); VNODE_1C; WRITE(")--"); break;
        case STORE_BIP:         WRITE("("); VNODE_1C; WRITE(" = "); VNODE_2C; WRITE(")"); break;
        case SETBIT_BIP:        VNODE_1C; WRITE(" = "); VNODE_1C; WRITE(" | "); VNODE_2C; break;
        case CLEARBIT_BIP:      VNODE_1C; WRITE(" = "); VNODE_1C; WRITE(" &~ ("); VNODE_2C; WRITE(")"); break;
    }

§7.2.1.2. But not all property values can be written as Inform 6 lvalues. If the I7 property P is being stored as a VM-attribute A, then there is no lvalue which expresses the value of A for an object O: instead one must use give O A to set it, give O ~A to unset it, and (O has A) to test it. And there will also be cases where P cannot be identified at compile-time, so that we have no way to know whether it will be stored as a VM-attribute or not.

To handle these two cases, then, we will compile an attempt to store or modify a property value either as a give statement — if we can prove P is being stored in a VM-attribute — or else as a function call to a general-purpose function called _final_change_property.

Alter a property value7.2.1.2 =

    inter_tree_node *VP = InterTree::second_child(P);
    int set = NOT_APPLICABLE;
    if (Inode::is(VP, VAL_IST)) {
        inter_pair val = ValInstruction::value(VP);
        if (InterValuePairs::is_number(val)) {
            if (InterValuePairs::is_zero(val)) set = FALSE;
            else if (InterValuePairs::is_one(val)) set = TRUE;
        }
    }

    int c = I6TargetCode::pval_case(storage_ref);
    if ((c == I6G_CAN_PROVE_IS_OBJ_ATTRIBUTE) && (bip == STORE_BIP) && (set == TRUE)) {
        WRITE("give "); Vanilla::node(gen, InterTree::second_child(storage_ref));
        WRITE(" %S", I6TargetCode::inner_name(gen, InterTree::third_child(storage_ref)));
    } else if ((c == I6G_CAN_PROVE_IS_OBJ_ATTRIBUTE) && (bip == STORE_BIP) && (set == FALSE)) {
        WRITE("give "); Vanilla::node(gen, InterTree::second_child(storage_ref));
        WRITE(" ~%S", I6TargetCode::inner_name(gen, InterTree::third_child(storage_ref)));
    } else {
        WRITE("(");
        switch (bip) {
            case STORE_BIP:         WRITE("_final_store_property"); break;
            case PREINCREMENT_BIP:  WRITE("_final_preinc_property"); break;
            case POSTINCREMENT_BIP: WRITE("_final_postinc_property"); break;
            case PREDECREMENT_BIP:  WRITE("_final_predec_property"); break;
            case POSTDECREMENT_BIP: WRITE("_final_postdec_property"); break;
            case SETBIT_BIP:        WRITE("_final_setbit_property"); break;
            case CLEARBIT_BIP:      WRITE("_final_clearbit_property"); break;
        }
        WRITE("(");
        Vanilla::node(gen, InterTree::first_child(storage_ref));
        WRITE(",");
        Vanilla::node(gen, InterTree::second_child(storage_ref));
        WRITE(",");
        Vanilla::node(gen, InterTree::third_child(storage_ref));
        switch (bip) {
            case STORE_BIP:         WRITE(", "); VNODE_2C; break;
            case SETBIT_BIP:        WRITE(", "); VNODE_2C; break;
            case CLEARBIT_BIP:      WRITE(", "); VNODE_2C; break;
        }
        WRITE("))");
    }

§7.3. Reading property values is easier. The general case, similarly, is to call a function for this, but an important optimisation collapses this to the use of the has or . operators in I6 where we can prove at compile-time that the property in question is stored as a VM-attribute (resp., a VM-property) of what is definitely a VM-object. This optimisation results in faster code.

Property value access7.3 =

    case PROPERTYEXISTS_BIP:
        I6_GEN_DATA(value_ranges_needed) = TRUE;
        I6_GEN_DATA(value_property_holders_needed) = TRUE;
        WRITE("(_final_propertyexists("); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", ");
            VNODE_3C; WRITE("))"); break;
    case PROPERTYARRAY_BIP: WRITE("(_final_propertyarray("); VNODE_1C; WRITE(", ");
            VNODE_2C; WRITE(", "); VNODE_3C; WRITE("))"); break;
    case PROPERTYLENGTH_BIP: WRITE("(_final_propertylength("); VNODE_1C; WRITE(", ");
            VNODE_2C; WRITE(", "); VNODE_3C; WRITE("))"); break;
    case PROPERTYVALUE_BIP: {
        inter_tree_node *KP = InterTree::first_child(P);
        inter_tree_node *OP = InterTree::second_child(P);
        inter_tree_node *PP = InterTree::third_child(P);
        switch (I6TargetCode::pval_case(P)) {
            case I6G_CAN_PROVE_IS_OBJ_ATTRIBUTE:
                WRITE("("); VNODE_2C;
                WRITE(" has %S", I6TargetCode::inner_name(gen, PP)); WRITE(")"); break;
            case I6G_CAN_PROVE_IS_PERHAPS_UNPOSSESSED_PROPERTY:
                I6TargetCode::eval_property_list(gen, KP, OP, PP, 0); break;
            case I6G_CAN_PROVE_IS_OBJ_PROPERTY:
                WRITE("("); VNODE_2C;
                WRITE(".%S", I6TargetCode::inner_name(gen, PP)); WRITE(")"); break;
            case I6G_CANNOT_PROVE:
                I6_GEN_DATA(value_property_holders_needed) = TRUE;
                I6TargetCode::eval_property_list(gen, KP, OP, PP, 0); break;
        }
        break;
    }

§7.4. In the most general case of !propertyvalue, we will end up calling the function _final_propertyvalue. But we don't do so right away because, annoyingly, !propertyvalue can have !alternative children supplied. We might find this, for example:

inv !if
    inv !propertyvalue
        val K_object harmonium
        inv !alternative
            val K_value P_sonorous
            val K_value P_muted

...arising from kit code such as if (harmonium has sonorous or muted) .... This only seldom arises, so perhaps we can be given for handling it less than optimally in all cases. We turn it into:

    if (((or_tmp_var = harmonium) && (or_tmp_var has sonorous)) ||
        (or_tmp_var has muted))

Note that or_tmp_var is used here so that the left operand, i.e., the object, is evaluated only once — in case there are side-effects of the evaluation.

void I6TargetCode::eval_property_list(code_generation *gen, inter_tree_node *K,
    inter_tree_node *X, inter_tree_node *Y, int depth) {
    text_stream *OUT = CodeGen::current(gen);
    if (Inode::is(Y, INV_IST)) {
        if (InvInstruction::method(Y) == PRIMITIVE_INVMETH) {
            inter_symbol *prim = InvInstruction::primitive(Y);
            inter_ti ybip = Primitives::to_BIP(gen->from, prim);
            if (ybip == ALTERNATIVE_BIP) {
                if (depth == 0) { WRITE("((or_tmp_var = "); Vanilla::node(gen, X); WRITE(") && (("); }
                I6TargetCode::eval_property_list(gen, K, NULL, InterTree::first_child(Y), depth+1);
                WRITE(") || (");
                I6TargetCode::eval_property_list(gen, K, NULL, InterTree::second_child(Y), depth+1);
                if (depth == 0) { WRITE(")))"); }
                return;
            }
        }
    }
    switch (I6TargetCode::pval_case_inner(K, Y)) {
        case I6G_CAN_PROVE_IS_OBJ_ATTRIBUTE:
            WRITE("("); if (X) Vanilla::node(gen, X); else WRITE("or_tmp_var");
            WRITE(" has %S", I6TargetCode::inner_name(gen, Y)); WRITE(")"); break;
        case I6G_CAN_PROVE_IS_OBJ_PROPERTY:
            WRITE("("); if (X) Vanilla::node(gen, X); else WRITE("or_tmp_var");
            WRITE(".%S", I6TargetCode::inner_name(gen, Y)); WRITE(")"); break;
        case I6G_CAN_PROVE_IS_PERHAPS_UNPOSSESSED_PROPERTY:
        case I6G_CANNOT_PROVE:
            WRITE("_final_propertyvalue(");
            Vanilla::node(gen, K);
            WRITE(", ");
            if (X) Vanilla::node(gen, X); else WRITE("or_tmp_var");
            WRITE(", ");
            Vanilla::node(gen, Y);
            WRITE(")"); break;
    }
}

§7.5. VM stack access7.5 =

    case PUSH_BIP:          WRITE("@push "); VNODE_1C; break;
    case PULL_BIP:          WRITE("@pull "); VNODE_1C; break;

§7.6. Control structures7.6 =

    case BREAK_BIP:         WRITE("break"); break;
    case CONTINUE_BIP:      WRITE("continue"); break;
    case RETURN_BIP:        Generate primitive for return7.6.1; break;
    case JUMP_BIP:          WRITE("jump "); VNODE_1C; break;
    case QUIT_BIP:          WRITE("quit"); break;
    case RESTORE_BIP:       WRITE("restore "); VNODE_1C; break;
    case IF_BIP:            Generate primitive for if7.6.2; break;
    case IFDEBUG_BIP:       Generate primitive for ifdebug7.6.3; break;
    case IFSTRICT_BIP:      Generate primitive for ifstrict7.6.4; break;
    case IFELSE_BIP:        Generate primitive for ifelse7.6.5; break;
    case WHILE_BIP:         Generate primitive for while7.6.6; break;
    case DO_BIP:            Generate primitive for do7.6.7; break;
    case FOR_BIP:           Generate primitive for for7.6.8; break;
    case OBJECTLOOP_BIP:    Generate primitive for objectloop7.6.9; break;
    case OBJECTLOOPX_BIP:   Generate primitive for objectloopx7.6.10; break;
    case SWITCH_BIP:        Generate primitive for switch7.6.11; break;
    case CASE_BIP:          Generate primitive for case7.6.12; break;
    case ALTERNATIVECASE_BIP: VNODE_1C; WRITE(", "); VNODE_2C; break;
    case DEFAULT_BIP:       Generate primitive for default7.6.13; break;

§7.6.1. Generate primitive for return7.6.1 =

    int rboolean = NOT_APPLICABLE;
    inter_tree_node *V = InterTree::first_child(P);
    if (Inode::is(V, VAL_IST)) {
        inter_pair val = ValInstruction::value(V);
        if (InterValuePairs::is_zero(val)) rboolean = FALSE;
        else if (InterValuePairs::is_one(val)) rboolean = TRUE;
    }
    switch (rboolean) {
        case FALSE: WRITE("rfalse"); break;
        case TRUE: WRITE("rtrue"); break;
        case NOT_APPLICABLE: WRITE("return "); Vanilla::node(gen, V); break;
    }

§7.6.2. Generate primitive for if7.6.2 =

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

§7.6.3. Generate primitive for ifdebug7.6.3 =

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

§7.6.4. Generate primitive for ifstrict7.6.4 =

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

§7.6.5. Generate primitive for ifelse7.6.5 =

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

§7.6.6. Generate primitive for while7.6.6 =

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

§7.6.7. Generate primitive for do7.6.7 =

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

§7.6.8. Generate primitive for for7.6.8 =

    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;

§7.6.9. Generate primitive for objectloop7.6.9 =

    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("objectloop ");
    if (in_flag == FALSE) {
        WRITE("("); VNODE_1C; WRITE(" ofclass "); VNODE_2C;
        WRITE(" && ");
    } VNODE_3C;
    if (in_flag == FALSE) {
        WRITE(")");
    }
    WRITE(" {\n"); INDENT; VNODE_4C;
    OUTDENT; WRITE("}\n");
    suppress_terminal_semicolon = TRUE;

§7.6.10. Generate primitive for objectloopx7.6.10 =

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

§7.6.11. Generate primitive for switch7.6.11 =

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

§7.6.12. Generate primitive for case7.6.12 =

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

§7.6.13. Generate primitive for default7.6.13 =

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

§7.7. In Inform 6, as in C, a function which returns a value can be called in a void context (in which case its return value is thrown away); the syntax for calling a void function is identical to that for calling a value-returning function, so we can treat INDIRECT0V_BIP as the same as INDIRECT0_BIP, and so on.

Indirect function calls7.7 =

    case INDIRECT0_BIP: case INDIRECT0V_BIP:
        WRITE("("); VNODE_1C; WRITE(")()"); break;
    case INDIRECT1_BIP: case INDIRECT1V_BIP:
        WRITE("("); VNODE_1C; WRITE(")("); VNODE_2C; WRITE(")"); break;
    case INDIRECT2_BIP: case INDIRECT2V_BIP:
        WRITE("("); VNODE_1C; WRITE(")("); VNODE_2C; WRITE(","); VNODE_3C; WRITE(")");
        break;
    case INDIRECT3_BIP: case INDIRECT3V_BIP:
        WRITE("("); VNODE_1C; WRITE(")("); VNODE_2C; WRITE(","); VNODE_3C; WRITE(",");
        VNODE_4C; WRITE(")"); break;
    case INDIRECT4_BIP: case INDIRECT4V_BIP:
        WRITE("("); VNODE_1C; WRITE(")("); VNODE_2C; WRITE(","); VNODE_3C; WRITE(",");
        VNODE_4C; WRITE(","); VNODE_5C; WRITE(")"); break;
    case INDIRECT5_BIP: case INDIRECT5V_BIP:
        WRITE("("); VNODE_1C; WRITE(")("); VNODE_2C; WRITE(","); VNODE_3C; WRITE(",");
        VNODE_4C; WRITE(","); VNODE_5C; WRITE(","); VNODE_6C; WRITE(")"); break;
    case INDIRECT6_BIP: case INDIRECT6V_BIP:
        WRITE("("); VNODE_1C; WRITE(")("); VNODE_2C; WRITE(","); VNODE_3C; WRITE(",");
        VNODE_4C; WRITE(","); VNODE_5C; WRITE(","); VNODE_6C; WRITE(","); VNODE_7C; WRITE(")"); break;
    case EXTERNALCALL_BIP:  internal_error("external calls impossible in Inform 6"); break;

§7.8. Message calls are handled with functions (see below) in case the user is trying to send a message to a property stored in an attribute, or something like that.

Method calls7.8 =

    case MESSAGE0_BIP:      WRITE("_final_message0("); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(")"); break;
    case MESSAGE1_BIP:      WRITE("_final_message1("); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", ");
                            VNODE_3C; WRITE(")"); break;
    case MESSAGE2_BIP:      WRITE("_final_message2("); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", ");
                            VNODE_3C; WRITE(","); VNODE_4C; WRITE(")"); break;
    case MESSAGE3_BIP:      WRITE("_final_message3("); VNODE_1C; WRITE(", "); VNODE_2C; WRITE(", ");
                            VNODE_3C; WRITE(","); VNODE_4C; WRITE(","); VNODE_5C; WRITE(")"); break;

§7.9. Note that the only styles permitted are those from the original Z-machine, which is about the level of technology of a 1970s teletype. The !style number must be a constant 1, 2 or 3, or else plain roman is all you get.

Textual output7.9 =

    case PRINT_BIP:         WRITE("print "); CodeGen::lt_mode(gen, PRINTING_LTM);
                            VNODE_1C; CodeGen::lt_mode(gen, REGULAR_LTM); break;
    case PRINTCHAR_BIP:     WRITE("print (char) "); VNODE_1C; break;
    case PRINTNL_BIP:       WRITE("new_line"); break;
    case PRINTOBJ_BIP:      WRITE("print (object) "); VNODE_1C; break;
    case PRINTNUMBER_BIP:   WRITE("print "); VNODE_1C; break;
    case PRINTDWORD_BIP:    WRITE("print (address) "); VNODE_1C; break;
    case PRINTSTRING_BIP:   WRITE("print (string) "); VNODE_1C; break;
    case BOX_BIP:           WRITE("box "); CodeGen::lt_mode(gen, BOX_LTM);
                            VNODE_1C; CodeGen::lt_mode(gen, REGULAR_LTM); break;
    case SPACES_BIP:        WRITE("spaces "); VNODE_1C; break;
    case FONT_BIP:
        WRITE("if ("); VNODE_1C; WRITE(") { font on; } else { font off; }");
        suppress_terminal_semicolon = TRUE;
        break;
    case STYLE_BIP: {
        inter_tree_node *N = InterTree::first_child(P);
        inter_pair pair = ValInstruction::value(N);
        inter_ti style = InterValuePairs::to_number(pair);
        switch (style) {
            case 1: WRITE("style bold"); break;
            case 2: WRITE("style underline"); break;
            case 3: WRITE("style reverse"); break;
            default: WRITE("style roman");
        }
        break;
    }
    case ENABLEPRINTING_BIP:
        WRITE("#ifdef TARGET_GLULX;\n");
        WRITE("@setiosys 2 0; ! Set to use Glk\n");
        WRITE("@push 201;     ! = GG_MAINWIN_ROCK;\n");
        WRITE("@push 3;       ! = wintype_TextBuffer\n");
        WRITE("@push 0;\n");
        WRITE("@push 0;\n");
        WRITE("@push 0;\n");
        WRITE("@glk 35 5 sp;  ! glk_window_open, pushing a window ID\n");
        WRITE("@glk 47 1 0;   ! glk_set_window to that window ID\n");
        WRITE("#endif;\n");
        break;

§7.10. The VM object tree7.10 =

    case MOVE_BIP:          WRITE("move "); VNODE_1C; WRITE(" to "); VNODE_2C; break;
    case REMOVE_BIP:        WRITE("remove "); VNODE_1C; break;
    case CHILD_BIP:         WRITE("child("); VNODE_1C; WRITE(")"); break;
    case CHILDREN_BIP:      WRITE("children("); VNODE_1C; WRITE(")"); break;
    case PARENT_BIP:        WRITE("parent("); VNODE_1C; WRITE(")"); break;
    case SIBLING_BIP:       WRITE("sibling("); VNODE_1C; WRITE(")"); break;
    case METACLASS_BIP:     WRITE("metaclass("); VNODE_1C; WRITE(")"); break;

§8. Support code for property accesses. In the following, prop_node is a VAL_IST identifying the property being accessed: we return the "inner name" as text, if we can find one. This will only happen if the node evaluates to a named symbol which is the name of a property. See Vanilla Objects for more on inner names.

text_stream *I6TargetCode::inner_name(code_generation *gen, inter_tree_node *prop_node) {
    inter_symbol *prop_symbol = NULL;
    if (Inode::is(prop_node, VAL_IST)) {
        inter_pair val = ValInstruction::value(prop_node);
        if (InterValuePairs::is_symbolic(val))
            prop_symbol = InterValuePairs::to_symbol_at(val, prop_node);
    }
    if ((prop_symbol) && (InterSymbol::get_flag(prop_symbol, ATTRIBUTE_MARK_ISYMF))) {
        return VanillaObjects::inner_property_name(gen, prop_symbol);
    } else if ((prop_symbol) && (Inode::is(prop_symbol->definition, PROPERTY_IST))) {
        return VanillaObjects::inner_property_name(gen, prop_symbol);
    } else {
        return NULL;
    }
}

§9. I6TargetCode::pval_case applies to a !propertyvalue invocation node. That has three children: the kind, the object/owner, and the property itself. We look at the node and try to see if it's one of the two easy cases which enable more efficient code to be compiled (see above): in fact, it almost always is.

define I6G_CAN_PROVE_IS_OBJ_ATTRIBUTE 1
define I6G_CAN_PROVE_IS_PERHAPS_UNPOSSESSED_PROPERTY 2
define I6G_CAN_PROVE_IS_OBJ_PROPERTY 3
define I6G_CANNOT_PROVE 4
int I6TargetCode::pval_case(inter_tree_node *P) {
    while (Inode::is(P, REFERENCE_IST)) P = InterTree::first_child(P);
    inter_tree_node *prop_node = InterTree::third_child(P);
    return I6TargetCode::pval_case_inner(InterTree::first_child(P), prop_node);
}

int I6TargetCode::pval_case_inner(inter_tree_node *kind_node, inter_tree_node *prop_node) {
    inter_symbol *kind_symbol = NULL;
    if (Inode::is(kind_node, VAL_IST)) {
        inter_pair val = ValInstruction::value(kind_node);
        if (InterValuePairs::is_symbolic(val))
            kind_symbol = InterValuePairs::to_symbol_at(val, kind_node);
    }
    if (Str::eq(InterSymbol::trans(kind_symbol), I"OBJECT_TY") == FALSE)
        return I6G_CANNOT_PROVE;

    inter_symbol *prop_symbol = NULL;
    if (Inode::is(prop_node, VAL_IST)) {
        inter_pair val = ValInstruction::value(prop_node);
        if (InterValuePairs::is_symbolic(val))
            prop_symbol = InterValuePairs::to_symbol_at(val, prop_node);
    }
    if ((prop_symbol) && (InterSymbol::get_flag(prop_symbol, ATTRIBUTE_MARK_ISYMF))) {
        return I6G_CAN_PROVE_IS_OBJ_ATTRIBUTE;
    } else if ((prop_symbol) && (InterSymbol::get_flag(prop_symbol, ATTRIBUTE_PROPERTY_MARK_ISYMF))) {
        return I6G_CAN_PROVE_IS_PERHAPS_UNPOSSESSED_PROPERTY;
    } else if ((prop_symbol) && (Inode::is(prop_symbol->definition, PROPERTY_IST))) {
        return I6G_CAN_PROVE_IS_OBJ_PROPERTY;
    } else {
        return I6G_CANNOT_PROVE;
    }
}

§10. The final functions. The generator above compiled calls to a handful of functions with names in the form _final_*; so these functions must clearly be supplied. It might seem that they ought to be included in, say, BasicInformKit and not here. But:

void I6TargetCode::end_generation(code_generator *gtr, code_generation *gen) {
    segmentation_pos saved = CodeGen::select(gen, functions_I7CGS);
    text_stream *OUT = CodeGen::current(gen);
    Most general implementation of !propertyvalue10.1;
    Most general implementation of !propertyexists10.2;
    Most general implementation of !propertyarray10.3;
    Most general implementation of !propertylength10.4;
    Most general implementation of writing to a property10.5;
    Implementation of !messageX10.6;
    CodeGen::deselect(gen, saved);
}

§10.1. See Inform 6 Objects for the runtime contents of the array of property metadata p. The following is more or less a safe general-purpose wrapper for the Inform 6 operator ., used as an rvalue, in cases where we cannot prove it would be safe to use . directly:

Most general implementation of !propertyvalue10.1 =

    WRITE("#ifdef BASICINFORMKIT;\n");
    WRITE("[ _final_propertyvalue K o p t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) { if (o has p) rtrue; rfalse; }\n");
    WRITE("            if (o provides p) return o.p;\n");
    WRITE("        }\n");
    WRITE("        rfalse;\n");
    WRITE("    } else {\n");
    WRITE("        t = value_property_holders-->K;\n");
    WRITE("        return (t.(p-->1))-->(o+COL_HSIZE);\n");
    WRITE("    }\n");
    WRITE("];\n");
    WRITE("#endif;\n");

§10.2. Similarly, this is a safe wrapper for provides:

Most general implementation of !propertyexists10.2 =

    WRITE("#ifdef BASICINFORMKIT;\n");
    WRITE("[ _final_propertyexists K o p holder;\n");
    WRITE("if (K == OBJECT_TY) {\n");
    WRITE("    if ((o) && (metaclass(o) == Object)) {\n");
    WRITE("        if ((p-->0 == 2) || (o provides p-->1)) {\n");
    WRITE("            rtrue;\n");
    WRITE("        } else {\n");
    WRITE("            rfalse;\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("        rfalse;\n");
    WRITE("    }\n");
    WRITE("} else {\n");
    WRITE("    if ((o >= 1) && (o <= value_ranges-->K)) {\n");
    WRITE("        holder = value_property_holders-->K;\n");
    WRITE("        if ((holder) && (holder provides p-->1)) {\n");
    WRITE("            rtrue;\n");
    WRITE("        } else {\n");
    WRITE("            rfalse;\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("        rfalse;\n");
    WRITE("    }\n");
    WRITE("}\n");
    WRITE("rfalse; ];\n");
    WRITE("#endif;\n");

§10.3. And this for .&. Note that we always return 0 if the owner is not an object.

Most general implementation of !propertyarray10.3 =

    WRITE("#ifdef BASICINFORMKIT;\n");
    WRITE("[ _final_propertyarray K o p v t;\n");
    WRITE("    if (K ~= OBJECT_TY) return 0;\n");
    WRITE("    t = p-->0; p = p-->1;\n");
    WRITE("    if (t == 2) return 0;\n");
    WRITE("    return o.&p;\n");
    WRITE("];\n");
    WRITE("#endif;\n");

§10.4. And this for .#. Again, we always return 0 if the owner is not an object.

Most general implementation of !propertylength10.4 =

    WRITE("#ifdef BASICINFORMKIT;\n");
    WRITE("[ _final_propertylength K o p v t;\n");
    WRITE("    if (K ~= OBJECT_TY) return 0;\n");
    WRITE("    t = p-->0; p = p-->1;\n");
    WRITE("    if (t == 2) return 0;\n");
    WRITE("    return o.#p;\n");
    WRITE("];\n");
    WRITE("#endif;\n");

§10.5. And this is a safe way to write to or otherwise alter O.P, laboriously written out as seven functions. (Speed is more important than conciseness here.)

Most general implementation of writing to a property10.5 =

    WRITE("#ifdef BASICINFORMKIT;\n");
    WRITE("[ _final_store_property K o p v t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) {\n");
    WRITE("                if (v) give o p; else give o ~p;\n");
    WRITE("            } else if (o provides p) {\n");
    WRITE("                o.p = v;\n");
    WRITE("            }\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("        ((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE) = v;\n");
    WRITE("    }\n");
    WRITE("];\n");
    WRITE("[ _final_preinc_property K o p t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) {\n");
    WRITE("                if (o has p) { give o ~p; rfalse; } give o p; rtrue;\n");
    WRITE("            } else if (o provides p) {\n");
    WRITE("                return ++(o.p);\n");
    WRITE("            }\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("       return ++(((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE));\n");
    WRITE("    }\n");
    WRITE("    return 0;\n");
    WRITE("];\n");
    WRITE("[ _final_predec_property K o p t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) {\n");
    WRITE("                if (o has p) { give o ~p; rfalse; } give o p; rtrue;\n");
    WRITE("            } else if (o provides p) {\n");
    WRITE("                return --(o.p);\n");
    WRITE("            }\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("       return --(((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE));\n");
    WRITE("    }\n");
    WRITE("    return 0;\n");
    WRITE("];\n");
    WRITE("[ _final_postinc_property K o p t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) {\n");
    WRITE("                if (o has p) { give o ~p; rtrue; } give o p; rfalse;\n");
    WRITE("            } else if (o provides p) {\n");
    WRITE("                return (o.p)++;\n");
    WRITE("            }\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("       return (((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE))++;\n");
    WRITE("    }\n");
    WRITE("    return 0;\n");
    WRITE("];\n");
    WRITE("[ _final_postdec_property K o p t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) {\n");
    WRITE("                if (o has p) { give o ~p; rtrue; } give o p; rfalse;\n");
    WRITE("            } else if (o provides p) {\n");
    WRITE("                return (o.p)--;\n");
    WRITE("            }\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("       return (((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE))--;\n");
    WRITE("    }\n");
    WRITE("    return 0;\n");
    WRITE("];\n");
    WRITE("[ _final_setbit_property K o p v t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) {\n");
    WRITE("                if (v & 1) give o p;\n");
    WRITE("            } else if (o provides p) {\n");
    WRITE("                o.p = o.p | v;\n");
    WRITE("            }\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("        ((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE) =\n");
    WRITE("            ((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE) | v;\n");
    WRITE("    }\n");
    WRITE("];\n");
    WRITE("[ _final_clearbit_property K o p v t;\n");
    WRITE("    if (K == OBJECT_TY) {\n");
    WRITE("        if (metaclass(o) == Object) {\n");
    WRITE("            t = p-->0; p = p-->1;\n");
    WRITE("            if (t == 2) {\n");
    WRITE("                if (v & 1) give o ~p;\n");
    WRITE("            } else if (o provides p) {\n");
    WRITE("                o.p = o.p & ~v;\n");
    WRITE("            }\n");
    WRITE("        }\n");
    WRITE("    } else {\n");
    WRITE("        ((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE) =\n");
    WRITE("            ((value_property_holders-->K).(p-->1))-->(o+COL_HSIZE) & ~v;\n");
    WRITE("    }\n");
    WRITE("];\n");
    WRITE("#endif;\n");

§10.6. It's not entirely clear what the result of trying to send a message to an either/or property ought to be: nobody should ever do that. We're going to say that it's 0 here.

Implementation of !messageX10.6 =

    WRITE("#ifdef BASICINFORMKIT;\n");
    WRITE("[ _final_message0 o p q x a rv;\n");
    WRITE("    if (p-->0 == 2) return 0;\n");
    WRITE("    q = p-->1; return o.q();\n");
    WRITE("];\n");
    WRITE("[ _final_message1 o p v1 q x a rv;\n");
    WRITE("    if (p-->0 == 2) return 0;\n");
    WRITE("    q = p-->1; return o.q(v1);\n");
    WRITE("];\n");
    WRITE("[ _final_message2 o p v1 v2 q x a rv;\n");
    WRITE("    if (p-->0 == 2) return 0;\n");
    WRITE("    q = p-->1; return o.q(v1, v2);\n");
    WRITE("];\n");
    WRITE("[ _final_message3 o p v1 v2 v3 q x a rv;\n");
    WRITE("    if (p-->0 == 2) return 0;\n");
    WRITE("    q = p-->1; return o.q(v1, v2, v3);\n");
    WRITE("];\n");
    WRITE("#endif;\n");