+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "expressc" : The expression code generator */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int vivc_flag; /* TRUE if the last code-generated
- expression produced a "value in void
- context" error: used to help the syntax
- analyser recover from unknown-keyword
- errors, since unknown keywords are
- treated as yet-to-be-defined constants
- and thus as values in void context */
-
-/* These data structures are global, because they're too useful to be
- static. */
-assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
- temp_var4, zero_operand, one_operand, two_operand, three_operand,
- four_operand, valueless_operand;
-
-static void make_operands(void)
-{
- if (!glulx_mode) {
- INITAOTV(&stack_pointer, VARIABLE_OT, 0);
- INITAOTV(&temp_var1, VARIABLE_OT, 255);
- INITAOTV(&temp_var2, VARIABLE_OT, 254);
- INITAOTV(&temp_var3, VARIABLE_OT, 253);
- INITAOTV(&temp_var4, VARIABLE_OT, 252);
- INITAOTV(&zero_operand, SHORT_CONSTANT_OT, 0);
- INITAOTV(&one_operand, SHORT_CONSTANT_OT, 1);
- INITAOTV(&two_operand, SHORT_CONSTANT_OT, 2);
- INITAOTV(&three_operand, SHORT_CONSTANT_OT, 3);
- INITAOTV(&four_operand, SHORT_CONSTANT_OT, 4);
- INITAOTV(&valueless_operand, OMITTED_OT, 0);
- }
- else {
- INITAOTV(&stack_pointer, LOCALVAR_OT, 0);
- INITAOTV(&temp_var1, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+0);
- INITAOTV(&temp_var2, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+1);
- INITAOTV(&temp_var3, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+2);
- INITAOTV(&temp_var4, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+3);
- INITAOTV(&zero_operand, ZEROCONSTANT_OT, 0);
- INITAOTV(&one_operand, BYTECONSTANT_OT, 1);
- INITAOTV(&two_operand, BYTECONSTANT_OT, 2);
- INITAOTV(&three_operand, BYTECONSTANT_OT, 3);
- INITAOTV(&four_operand, BYTECONSTANT_OT, 4);
- INITAOTV(&valueless_operand, OMITTED_OT, 0);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* The table of conditionals. (Only used in Glulx) */
-
-#define ZERO_CC (500)
-#define EQUAL_CC (502)
-#define LT_CC (504)
-#define GT_CC (506)
-#define HAS_CC (508)
-#define IN_CC (510)
-#define OFCLASS_CC (512)
-#define PROVIDES_CC (514)
-
-#define FIRST_CC (500)
-#define LAST_CC (515)
-
-typedef struct condclass_s {
- int32 posform; /* Opcode for the conditional in its positive form. */
- int32 negform; /* Opcode for the conditional in its negated form. */
-} condclass;
-
-condclass condclasses[] = {
- { jz_gc, jnz_gc },
- { jeq_gc, jne_gc },
- { jlt_gc, jge_gc },
- { jgt_gc, jle_gc },
- { -1, -1 },
- { -1, -1 },
- { -1, -1 },
- { -1, -1 }
-};
-
-/* ------------------------------------------------------------------------- */
-/* The table of operators.
-
- The ordering in this table is not significant except that it must match
- the #define's in "header.h" */
-
-operator operators[NUM_OPERATORS] =
-{
- /* ------------------------ */
- /* Level 0: , */
- /* ------------------------ */
-
- { 0, SEP_TT, COMMA_SEP, IN_U, L_A, 0, -1, -1, 0, 0, "comma" },
-
- /* ------------------------ */
- /* Level 1: = */
- /* ------------------------ */
-
- { 1, SEP_TT, SETEQUALS_SEP, IN_U, R_A, 1, -1, -1, 1, 0,
- "assignment operator '='" },
-
- /* ------------------------ */
- /* Level 2: ~~ && || */
- /* ------------------------ */
-
- { 2, SEP_TT, LOGAND_SEP, IN_U, L_A, 0, -1, -1, 0, LOGOR_OP,
- "logical conjunction '&&'" },
- { 2, SEP_TT, LOGOR_SEP, IN_U, L_A, 0, -1, -1, 0, LOGAND_OP,
- "logical disjunction '||'" },
- { 2, SEP_TT, LOGNOT_SEP, PRE_U, R_A, 0, -1, -1, 0, LOGNOT_OP,
- "logical negation '~~'" },
-
- /* ------------------------ */
- /* Level 3: == ~= */
- /* > >= < <= */
- /* has hasnt */
- /* in notin */
- /* provides */
- /* ofclass */
- /* ------------------------ */
-
- { 3, -1, -1, -1, 0, 0, 400 + jz_zc, ZERO_CC+0, 0, NONZERO_OP,
- "expression used as condition then negated" },
- { 3, -1, -1, -1, 0, 0, 800 + jz_zc, ZERO_CC+1, 0, ZERO_OP,
- "expression used as condition" },
- { 3, SEP_TT, CONDEQUALS_SEP, IN_U, 0, 0, 400 + je_zc, EQUAL_CC+0, 0, NOTEQUAL_OP,
- "'==' condition" },
- { 3, SEP_TT, NOTEQUAL_SEP, IN_U, 0, 0, 800 + je_zc, EQUAL_CC+1, 0, CONDEQUALS_OP,
- "'~=' condition" },
- { 3, SEP_TT, GE_SEP, IN_U, 0, 0, 800 + jl_zc, LT_CC+1, 0, LESS_OP,
- "'>=' condition" },
- { 3, SEP_TT, GREATER_SEP, IN_U, 0, 0, 400 + jg_zc, GT_CC+0, 0, LE_OP,
- "'>' condition" },
- { 3, SEP_TT, LE_SEP, IN_U, 0, 0, 800 + jg_zc, GT_CC+1, 0, GREATER_OP,
- "'<=' condition" },
- { 3, SEP_TT, LESS_SEP, IN_U, 0, 0, 400 + jl_zc, LT_CC+0, 0, GE_OP,
- "'<' condition" },
- { 3, CND_TT, HAS_COND, IN_U, 0, 0, 400 + test_attr_zc, HAS_CC+0, 0, HASNT_OP,
- "'has' condition" },
- { 3, CND_TT, HASNT_COND, IN_U, 0, 0, 800 + test_attr_zc, HAS_CC+1, 0, HAS_OP,
- "'hasnt' condition" },
- { 3, CND_TT, IN_COND, IN_U, 0, 0, 400 + jin_zc, IN_CC+0, 0, NOTIN_OP,
- "'in' condition" },
- { 3, CND_TT, NOTIN_COND, IN_U, 0, 0, 800 + jin_zc, IN_CC+1, 0, IN_OP,
- "'notin' condition" },
- { 3, CND_TT, OFCLASS_COND, IN_U, 0, 0, 600, OFCLASS_CC+0, 0, NOTOFCLASS_OP,
- "'ofclass' condition" },
- { 3, CND_TT, PROVIDES_COND, IN_U, 0, 0, 601, PROVIDES_CC+0, 0, NOTPROVIDES_OP,
- "'provides' condition" },
- { 3, -1, -1, -1, 0, 0, 1000, OFCLASS_CC+1, 0, OFCLASS_OP,
- "negated 'ofclass' condition" },
- { 3, -1, -1, -1, 0, 0, 1001, PROVIDES_CC+1, 0, PROVIDES_OP,
- "negated 'provides' condition" },
-
- /* ------------------------ */
- /* Level 4: or */
- /* ------------------------ */
-
- { 4, CND_TT, OR_COND, IN_U, L_A, 0, -1, -1, 0, 0, "'or'" },
-
- /* ------------------------ */
- /* Level 5: + binary - */
- /* ------------------------ */
-
- { 5, SEP_TT, PLUS_SEP, IN_U, L_A, 0, add_zc, add_gc, 0, 0, "'+'" },
- { 5, SEP_TT, MINUS_SEP, IN_U, L_A, 0, sub_zc, sub_gc, 0, 0, "'-'" },
-
- /* ------------------------ */
- /* Level 6: * / % */
- /* & | ~ */
- /* ------------------------ */
-
- { 6, SEP_TT, TIMES_SEP, IN_U, L_A, 0, mul_zc, mul_gc, 0, 0, "'*'" },
- { 6, SEP_TT, DIVIDE_SEP, IN_U, L_A, 0, div_zc, div_gc, 0, 0, "'/'" },
- { 6, SEP_TT, REMAINDER_SEP, IN_U, L_A, 0, mod_zc, mod_gc, 0, 0,
- "remainder after division '%'" },
- { 6, SEP_TT, ARTAND_SEP, IN_U, L_A, 0, and_zc, bitand_gc, 0, 0,
- "bitwise AND '&'" },
- { 6, SEP_TT, ARTOR_SEP, IN_U, L_A, 0, or_zc, bitor_gc, 0, 0,
- "bitwise OR '|'" },
- { 6, SEP_TT, ARTNOT_SEP, PRE_U, R_A, 0, -1, bitnot_gc, 0, 0,
- "bitwise NOT '~'" },
-
- /* ------------------------ */
- /* Level 7: -> --> */
- /* ------------------------ */
-
- { 7, SEP_TT, ARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "byte array operator '->'" },
- { 7, SEP_TT, DARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "word array operator '-->'" },
-
- /* ------------------------ */
- /* Level 8: unary - */
- /* ------------------------ */
-
- { 8, SEP_TT, UNARY_MINUS_SEP, PRE_U, R_A, 0, -1, neg_gc, 0, 0,
- "unary minus" },
-
- /* ------------------------ */
- /* Level 9: ++ -- */
- /* (prefix or postfix) */
- /* ------------------------ */
-
- { 9, SEP_TT, INC_SEP, PRE_U, R_A, 2, -1, -1, 1, 0,
- "pre-increment operator '++'" },
- { 9, SEP_TT, POST_INC_SEP, POST_U, R_A, 3, -1, -1, 1, 0,
- "post-increment operator '++'" },
- { 9, SEP_TT, DEC_SEP, PRE_U, R_A, 4, -1, -1, 1, 0,
- "pre-decrement operator '--'" },
- { 9, SEP_TT, POST_DEC_SEP, POST_U, R_A, 5, -1, -1, 1, 0,
- "post-decrement operator '--'" },
-
- /* ------------------------ */
- /* Level 10: .& .# */
- /* ..& ..# */
- /* ------------------------ */
-
- {10, SEP_TT, PROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property address operator '.&'" },
- {10, SEP_TT, PROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property length operator '.#'" },
- {10, SEP_TT, MPROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property address operator '..&'" },
- {10, SEP_TT, MPROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property length operator '..#'" },
-
- /* ------------------------ */
- /* Level 11: function ( */
- /* ------------------------ */
-
- {11, SEP_TT, OPENB_SEP, IN_U, L_A, 0, -1, -1, 1, 0,
- "function call" },
-
- /* ------------------------ */
- /* Level 12: . .. */
- /* ------------------------ */
-
- {12, SEP_TT, MESSAGE_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property selector '..'" },
- {12, SEP_TT, PROPERTY_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property selector '.'" },
-
- /* ------------------------ */
- /* Level 13: :: */
- /* ------------------------ */
-
- {13, SEP_TT, SUPERCLASS_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "superclass operator '::'" },
-
- /* ------------------------ */
- /* Miscellaneous operators */
- /* generated at lvalue */
- /* checking time */
- /* ------------------------ */
-
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> = */
- "byte array entry assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> = */
- "word array entry assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. = */
- "individual property assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . = */
- "common property assignment" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ -> */
- "byte array entry preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ --> */
- "word array entry preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ .. */
- "individual property preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ . */
- "common property preincrement" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- -> */
- "byte array entry predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- --> */
- "word array entry predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- .. */
- "individual property predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- . */
- "common property predecrement" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> ++ */
- "byte array entry postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> ++ */
- "word array entry postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. ++ */
- "individual property postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . ++ */
- "common property postincrement" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> -- */
- "byte array entry postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> -- */
- "word array entry postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. -- */
- "individual property postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . -- */
- "common property postdecrement" },
-
- {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x.y(args) */
- "call to common property" },
- {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x..y(args) */
- "call to individual property" },
-
- /* ------------------------ */
- /* And one Glulx-only op */
- /* which just pushes its */
- /* argument on the stack, */
- /* unchanged. */
- /* ------------------------ */
-
- {14, -1, -1, -1, -1, 0, -1, -1, 1, 0,
- "push on stack" }
-};
-
-/* --- Condition annotater ------------------------------------------------- */
-
-static void annotate_for_conditions(int n, int a, int b)
-{ int i, opnum = ET[n].operator_number;
-
- ET[n].label_after = -1;
- ET[n].to_expression = FALSE;
- ET[n].true_label = a;
- ET[n].false_label = b;
-
- if (ET[n].down == -1) return;
-
- if ((operators[opnum].precedence == 2)
- || (operators[opnum].precedence == 3))
- { if ((a == -1) && (b == -1))
- { if (opnum == LOGAND_OP)
- { b = next_label++;
- ET[n].false_label = b;
- ET[n].to_expression = TRUE;
- }
- else
- { a = next_label++;
- ET[n].true_label = a;
- ET[n].to_expression = TRUE;
- }
- }
- }
-
- switch(opnum)
- { case LOGAND_OP:
- if (b == -1)
- { b = next_label++;
- ET[n].false_label = b;
- ET[n].label_after = b;
- }
- annotate_for_conditions(ET[n].down, -1, b);
- if (b == ET[n].label_after)
- annotate_for_conditions(ET[ET[n].down].right, a, -1);
- else annotate_for_conditions(ET[ET[n].down].right, a, b);
- return;
- case LOGOR_OP:
- if (a == -1)
- { a = next_label++;
- ET[n].true_label = a;
- ET[n].label_after = a;
- }
- annotate_for_conditions(ET[n].down, a, -1);
- if (a == ET[n].label_after)
- annotate_for_conditions(ET[ET[n].down].right, -1, b);
- else annotate_for_conditions(ET[ET[n].down].right, a, b);
- return;
- }
-
- i = ET[n].down;
- while (i != -1)
- { annotate_for_conditions(i, -1, -1); i = ET[i].right; }
-}
-
-/* --- Code generator ------------------------------------------------------ */
-
-static void value_in_void_context_z(assembly_operand AO)
-{ char *t;
-
- ASSERT_ZCODE();
-
- switch(AO.type)
- { case LONG_CONSTANT_OT:
- case SHORT_CONSTANT_OT:
- t = "<constant>";
- if (AO.marker == SYMBOL_MV)
- t = (char *) (symbs[AO.value]);
- break;
- case VARIABLE_OT:
- t = variable_name(AO.value);
- break;
- default:
- compiler_error("Unable to print value in void context");
- t = "<expression>";
- break;
- }
- vivc_flag = TRUE;
-
- if (strcmp(t, "print_paddr") == 0)
- obsolete_warning("ignoring 'print_paddr': use 'print (string)' instead");
- else
- if (strcmp(t, "print_addr") == 0)
- obsolete_warning("ignoring 'print_addr': use 'print (address)' instead");
- else
- if (strcmp(t, "print_char") == 0)
- obsolete_warning("ignoring 'print_char': use 'print (char)' instead");
- else
- ebf_error("expression with side-effects", t);
-}
-
-static void write_result_z(assembly_operand to, assembly_operand from)
-{ if (to.value == from.value) return;
- if (to.value == 0) assemblez_1(push_zc, from);
- else assemblez_store(to, from);
-}
-
-static void pop_zm_stack(void)
-{ assembly_operand st;
- if (version_number < 5) assemblez_0(pop_zc);
- else
- { INITAOTV(&st, VARIABLE_OT, 0);
- assemblez_1_branch(jz_zc, st, -2, TRUE);
- }
-}
-
-static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
- assembly_operand AO3)
-{ int vr = 0;
-
- assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
- index_ao;
- int x = 0, y = 0, byte_flag = FALSE, read_flag = FALSE, from_module = FALSE;
-
- if (AO1.marker == ARRAY_MV)
- {
- INITAO(&zero_ao);
-
- if ((oc == loadb_zc) || (oc == storeb_zc)) byte_flag=TRUE;
- else byte_flag = FALSE;
- if ((oc == loadb_zc) || (oc == loadw_zc)) read_flag=TRUE;
- else read_flag = FALSE;
-
- zero_ao.type = SHORT_CONSTANT_OT;
- zero_ao.value = 0;
-
- size_ao = zero_ao; size_ao.value = -1;
- for (x=0; x<no_arrays; x++)
- { if (AO1.value == svals[array_symbols[x]])
- { size_ao.value = array_sizes[x]; y=x;
- }
- }
- if (size_ao.value==-1)
- from_module=TRUE;
- else {
- from_module=FALSE;
- type_ao = zero_ao; type_ao.value = array_types[y];
-
- if ((!is_systemfile()))
- { if (byte_flag)
- {
- if ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- warning("Using '->' to access a --> or table array");
- }
- else
- {
- if ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY))
- warning("Using '-->' to access a -> or string array");
- }
- }
- }
- }
-
-
- if ((!runtime_error_checking_switch) || (veneer_mode))
- { if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_2_to(oc, AO1, AO2, AO3);
- else
- assemblez_3(oc, AO1, AO2, AO3);
- return;
- }
-
- /* If we recognise AO1 as arising textually from a declared
- array, we can check bounds explicitly. */
-
- if ((AO1.marker == ARRAY_MV) && (!from_module))
- {
- int passed_label = next_label++, failed_label = next_label++,
- final_label = next_label++;
- /* Calculate the largest permitted array entry + 1
- Here "size_ao.value" = largest permitted entry of its own kind */
- max_ao = size_ao;
-
- if (byte_flag
- && ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY)))
- { max_ao.value = size_ao.value*2 + 1;
- type_ao.value += 8;
- }
- if ((!byte_flag)
- && ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY)
- || (array_types[y] == BUFFER_ARRAY)))
- { if ((size_ao.value % 2) == 0)
- max_ao.value = size_ao.value/2 - 1;
- else max_ao.value = (size_ao.value-1)/2;
- type_ao.value += 16;
- }
- max_ao.value++;
-
- if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
- if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
-
- /* Can't write to the size entry in a string or table */
- if (((array_types[y] == STRING_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- && (!read_flag))
- { if ((array_types[y] == TABLE_ARRAY) && byte_flag)
- zero_ao.value = 2;
- else zero_ao.value = 1;
- }
-
- en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
- switch(oc) { case loadb_zc: en_ao.value = ABOUNDS_RTE; break;
- case loadw_zc: en_ao.value = ABOUNDS_RTE+1; break;
- case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
- case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
-
- index_ao = AO2;
- if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
- { assemblez_store(temp_var2, AO2);
- assemblez_store(AO2, temp_var2);
- index_ao = temp_var2;
- }
- assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
- assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
- assemble_label_no(failed_label);
- an_ao = zero_ao; an_ao.value = y;
- assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
- index_ao, size_ao, type_ao, an_ao);
-
- /* We have to clear any of AO1, AO2, AO3 off the stack if
- present, so that we can achieve the same effect on the stack
- that executing the opcode would have had */
-
- if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
- if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
- if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
- { if ((oc == loadb_zc) || (oc == loadw_zc))
- { assemblez_store(AO3, zero_ao);
- }
- else pop_zm_stack();
- }
- assemblez_jump(final_label);
-
- assemble_label_no(passed_label);
- if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_2_to(oc, AO1, AO2, AO3);
- else
- assemblez_3(oc, AO1, AO2, AO3);
- assemble_label_no(final_label);
- return;
- }
-
- /* Otherwise, compile a call to the veneer which verifies that
- the proposed read/write is within dynamic Z-machine memory. */
-
- switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
- case loadw_zc: vr = RT__ChLDW_VR; break;
- case storeb_zc: vr = RT__ChSTB_VR; break;
- case storew_zc: vr = RT__ChSTW_VR; break;
- default: compiler_error("unknown array opcode");
- }
-
- if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
- else
- assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
-}
-
-static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
- int error_label, int rte_number)
-{ assembly_operand AO2, AO3;
- int check_sp = FALSE, passed_label, failed_label, last_label;
- if (veneer_mode) return AO1;
-
- /* Assemble to code to check that the operand AO1 is ofclass Object:
- if it is, execution should continue and the stack should be
- unchanged. Otherwise, call the veneer's run-time-error routine
- with the given error number, and then: if the label isn't -1,
- switch execution to this label, with the value popped from
- the stack if it was on the stack in the first place;
- if the label is -1, either replace the top of the stack with
- the constant 2, or return the operand (short constant) 2.
-
- The point of 2 is that object 2 is the class-object Object
- and therefore has no parent, child or sibling, so that the
- built-in tree functions will safely return 0 on this object. */
-
- /* Sometimes we can already see that the object number is valid. */
- if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
- && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
- return AO1;
-
- passed_label = next_label++;
- failed_label = next_label++;
- INITAOTV(&AO2, LONG_CONSTANT_OT, actual_largest_object_SC);
- AO2.marker = INCON_MV;
- INITAOTV(&AO3, SHORT_CONSTANT_OT, 5);
-
- if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
- || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
- || (rte_number == PROP_ADD_RTE))
- { /* Allow classes */
- AO3.value = 1;
- if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
- { /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assemblez_store(temp_var2, AO1);
- assemblez_store(AO1, temp_var2);
- assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
- assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
- }
- else
- { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
- assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
- }
- }
- else
- { if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
- { /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assemblez_store(temp_var2, AO1);
- assemblez_store(AO1, temp_var2);
- assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
- assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
- AO3.value = 1;
- assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
- }
- else
- { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
- assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
- AO3.value = 1;
- assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
- }
- }
-
- assemble_label_no(failed_label);
- INITAOTV(&AO2, SHORT_CONSTANT_OT, rte_number);
- if (version_number >= 5)
- assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
- else
- assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
-
- if (error_label != -1)
- { /* Jump to the error label */
- if (error_label == -3) assemblez_0(rfalse_zc);
- else if (error_label == -4) assemblez_0(rtrue_zc);
- else assemblez_jump(error_label);
- }
- else
- { if (check_sp)
- { /* Push the short constant 2 */
- INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
- assemblez_store(AO1, AO2);
- }
- else
- { /* Store either short constant 2 or the operand's value in
- the temporary variable */
- INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
- AO3 = temp_var2; assemblez_store(AO3, AO2);
- last_label = next_label++;
- assemblez_jump(last_label);
- assemble_label_no(passed_label);
- assemblez_store(AO3, AO1);
- assemble_label_no(last_label);
- return AO3;
- }
- }
- assemble_label_no(passed_label);
- return AO1;
-}
-
-static void compile_conditional_z(int oc,
- assembly_operand AO1, assembly_operand AO2, int label, int flag)
-{ assembly_operand AO3; int the_zc, error_label = label,
- va_flag = FALSE, va_label = 0;
-
- ASSERT_ZCODE();
-
- if (oc<200)
- { if ((runtime_error_checking_switch) && (oc == jin_zc))
- { if (flag) error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
- }
- if ((runtime_error_checking_switch) && (oc == test_attr_zc))
- { if (flag) error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
- switch(AO2.type)
- { case SHORT_CONSTANT_OT:
- case LONG_CONSTANT_OT:
- if (AO2.marker == 0)
- { if ((AO2.value < 0) || (AO2.value > 47))
- error("'has'/'hasnt' applied to illegal attribute number");
- break;
- }
- case VARIABLE_OT:
- { int pa_label = next_label++, fa_label = next_label++;
- assembly_operand en_ao, zero_ao, max_ao;
- assemblez_store(temp_var1, AO1);
- if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
- assemblez_store(AO1, temp_var1);
- assemblez_store(temp_var2, AO2);
- if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
- assemblez_store(AO2, temp_var2);
- INITAOT(&zero_ao, SHORT_CONSTANT_OT);
- zero_ao.value = 0;
- max_ao = zero_ao; max_ao.value = 48;
- assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
- assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
- assemble_label_no(fa_label);
- en_ao = zero_ao; en_ao.value = 19;
- assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
- en_ao, temp_var1, temp_var2);
- va_flag = TRUE; va_label = next_label++;
- assemblez_jump(va_label);
- assemble_label_no(pa_label);
- }
- }
- }
- assemblez_2_branch(oc, AO1, AO2, label, flag);
- if (error_label != label) assemble_label_no(error_label);
- if (va_flag) assemble_label_no(va_label);
- return;
- }
-
- INITAOTV(&AO3, VARIABLE_OT, 0);
-
- the_zc = (version_number == 3)?call_zc:call_vs_zc;
- if (oc == 201)
- assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
- else
- assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
-
- assemblez_1_branch(jz_zc, AO3, label, !flag);
-}
-
-static void value_in_void_context_g(assembly_operand AO)
-{ char *t;
-
- ASSERT_GLULX();
-
- switch(AO.type)
- { case CONSTANT_OT:
- case HALFCONSTANT_OT:
- case BYTECONSTANT_OT:
- case ZEROCONSTANT_OT:
- t = "<constant>";
- if (AO.marker == SYMBOL_MV)
- t = (char *) (symbs[AO.value]);
- break;
- case GLOBALVAR_OT:
- case LOCALVAR_OT:
- t = variable_name(AO.value);
- break;
- default:
- compiler_error("Unable to print value in void context");
- t = "<expression>";
- break;
- }
- vivc_flag = TRUE;
-
- ebf_error("expression with side-effects", t);
-}
-
-static void write_result_g(assembly_operand to, assembly_operand from)
-{ if (to.value == from.value && to.type == from.type) return;
- assembleg_store(to, from);
-}
-
-static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
- assembly_operand AO3)
-{ int vr = 0;
- int data_len, read_flag;
- assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
- index_ao, five_ao;
- int passed_label, failed_label, final_label, x = 0, y = 0;
-
- if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
- else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
- else data_len = 4;
-
- if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
- read_flag = TRUE;
- else
- read_flag = FALSE;
-
- if (AO1.marker == ARRAY_MV)
- {
- INITAO(&zero_ao);
-
- size_ao = zero_ao; size_ao.value = -1;
- for (x=0; x<no_arrays; x++)
- { if (AO1.value == svals[array_symbols[x]])
- { size_ao.value = array_sizes[x]; y=x;
- }
- }
- if (size_ao.value==-1) compiler_error("Array size can't be found");
-
- type_ao = zero_ao; type_ao.value = array_types[y];
-
- if ((!is_systemfile()))
- { if (data_len == 1)
- {
- if ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- warning("Using '->' to access a --> or table array");
- }
- else
- {
- if ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY))
- warning("Using '-->' to access a -> or string array");
- }
- }
- }
-
-
- if ((!runtime_error_checking_switch) || (veneer_mode))
- {
- assembleg_3(oc, AO1, AO2, AO3);
- return;
- }
-
- /* If we recognise AO1 as arising textually from a declared
- array, we can check bounds explicitly. */
-
- if (AO1.marker == ARRAY_MV)
- {
- /* Calculate the largest permitted array entry + 1
- Here "size_ao.value" = largest permitted entry of its own kind */
- max_ao = size_ao;
- if (data_len == 1
- && ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY)))
- { max_ao.value = size_ao.value*4 + 3;
- type_ao.value += 8;
- }
- if (data_len == 4
- && ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY)
- || (array_types[y] == BUFFER_ARRAY)))
- { max_ao.value = (size_ao.value-3)/4;
- type_ao.value += 16;
- }
- max_ao.value++;
-
- /* Can't write to the size entry in a string or table */
- if (((array_types[y] == STRING_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- && (!read_flag))
- { if ((array_types[y] == TABLE_ARRAY) && data_len == 1)
- zero_ao.value = 4;
- else zero_ao.value = 1;
- }
-
- en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
-
- switch(oc) { case aloadb_gc: en_ao.value = ABOUNDS_RTE; break;
- case aload_gc: en_ao.value = ABOUNDS_RTE+1; break;
- case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
- case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
-
- set_constant_ot(&zero_ao);
- set_constant_ot(&size_ao);
- set_constant_ot(&max_ao);
- set_constant_ot(&type_ao);
- set_constant_ot(&en_ao);
-
- /* If we recognize A02 as a constant, we can do the test right
- now. */
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
- error("Array reference is out-of-bounds");
- }
- assembleg_3(oc, AO1, AO2, AO3);
- return;
- }
-
- passed_label = next_label++;
- failed_label = next_label++;
- final_label = next_label++;
-
- index_ao = AO2;
- if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
- { assembleg_store(temp_var2, AO2); /* ### could peek */
- assembleg_store(AO2, temp_var2);
- index_ao = temp_var2;
- }
- assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
- assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
- assemble_label_no(failed_label);
-
- an_ao = zero_ao; an_ao.value = y;
- set_constant_ot(&an_ao);
- five_ao = zero_ao; five_ao.value = 5;
- set_constant_ot(&five_ao);
-
- /* Call the error veneer routine. */
- assembleg_store(stack_pointer, an_ao);
- assembleg_store(stack_pointer, type_ao);
- assembleg_store(stack_pointer, size_ao);
- assembleg_store(stack_pointer, index_ao);
- assembleg_store(stack_pointer, en_ao);
- assembleg_3(call_gc, veneer_routine(RT__Err_VR),
- five_ao, zero_operand);
-
- /* We have to clear any of AO1, AO2, AO3 off the stack if
- present, so that we can achieve the same effect on the stack
- that executing the opcode would have had */
-
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
- assembleg_2(copy_gc, stack_pointer, zero_operand);
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
- assembleg_2(copy_gc, stack_pointer, zero_operand);
- if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
- { if ((oc == aloadb_gc) || (oc == aload_gc))
- { assembleg_store(AO3, zero_ao);
- }
- else assembleg_2(copy_gc, stack_pointer, zero_operand);
- }
- assembleg_jump(final_label);
-
- assemble_label_no(passed_label);
- assembleg_3(oc, AO1, AO2, AO3);
- assemble_label_no(final_label);
- return;
- }
-
- /* Otherwise, compile a call to the veneer which verifies that
- the proposed read/write is within dynamic Z-machine memory. */
-
- switch(oc) {
- case aloadb_gc: vr = RT__ChLDB_VR; break;
- case aload_gc: vr = RT__ChLDW_VR; break;
- case astoreb_gc: vr = RT__ChSTB_VR; break;
- case astore_gc: vr = RT__ChSTW_VR; break;
- default: compiler_error("unknown array opcode");
- }
-
- if ((oc == aloadb_gc) || (oc == aload_gc))
- assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
- else
- assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
-}
-
-static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
- int error_label, int rte_number)
-{
- assembly_operand AO, AO2, AO3;
- int ln;
- int check_sp = FALSE, passed_label, failed_label, last_label;
-
- if (veneer_mode)
- return AO1;
-
- /* Assemble to code to check that the operand AO1 is ofclass Object:
- if it is, execution should continue and the stack should be
- unchanged. Otherwise, call the veneer's run-time-error routine
- with the given error number, and then: if the label isn't -1,
- switch execution to this label, with the value popped from
- the stack if it was on the stack in the first place;
- if the label is -1, either replace the top of the stack with
- the constant symbol (class-object) Object.
-
- The Object has no parent, child or sibling, so that the
- built-in tree functions will safely return 0 on this object. */
-
- /* Sometimes we can already see that the object number is valid. */
- if (AO1.marker == OBJECT_MV &&
- ((AO1.value >= 1) && (AO1.value <= no_objects))) {
- return AO1;
- }
-
- passed_label = next_label++;
- failed_label = next_label++;
-
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
- /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assembleg_store(temp_var2, stack_pointer);
- assembleg_store(stack_pointer, temp_var2);
- AO = temp_var2;
- }
- else {
- AO = AO1;
- }
-
- if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
- || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
- || (rte_number == PROP_ADD_RTE)) {
- /* Allow classes */
- /* Test if zero... */
- assembleg_1_branch(jz_gc, AO, failed_label);
- /* Test if first byte is 0x70... */
- assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
- INITAO(&AO3);
- AO3.value = 0x70; /* type byte -- object */
- set_constant_ot(&AO3);
- assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
- }
- else {
- /* Test if zero... */
- assembleg_1_branch(jz_gc, AO, failed_label);
- /* Test if first byte is 0x70... */
- assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
- INITAO(&AO3);
- AO3.value = 0x70; /* type byte -- object */
- set_constant_ot(&AO3);
- assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
- /* Test if inside the "Class" object... */
- INITAOTV(&AO3, BYTECONSTANT_OT, GOBJFIELD_PARENT());
- assembleg_3(aload_gc, AO, AO3, stack_pointer);
- ln = symbol_index("Class", -1);
- AO3.value = svals[ln];
- AO3.marker = OBJECT_MV;
- AO3.type = CONSTANT_OT;
- assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
- }
-
- assemble_label_no(failed_label);
- INITAO(&AO2);
- AO2.value = rte_number;
- set_constant_ot(&AO2);
- assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
-
- if (error_label != -1) {
- /* Jump to the error label */
- if (error_label == -3) assembleg_1(return_gc, zero_operand);
- else if (error_label == -4) assembleg_1(return_gc, one_operand);
- else assembleg_jump(error_label);
- }
- else {
- /* Build the symbol for "Object" */
- ln = symbol_index("Object", -1);
- AO2.value = svals[ln];
- AO2.marker = OBJECT_MV;
- AO2.type = CONSTANT_OT;
- if (check_sp) {
- /* Push "Object" */
- assembleg_store(AO1, AO2);
- }
- else {
- /* Store either "Object" or the operand's value in the temporary
- variable. */
- assembleg_store(temp_var2, AO2);
- last_label = next_label++;
- assembleg_jump(last_label);
- assemble_label_no(passed_label);
- assembleg_store(temp_var2, AO1);
- assemble_label_no(last_label);
- return temp_var2;
- }
- }
-
- assemble_label_no(passed_label);
- return AO1;
-}
-
-static void compile_conditional_g(condclass *cc,
- assembly_operand AO1, assembly_operand AO2, int label, int flag)
-{ assembly_operand AO4;
- int the_zc, error_label = label,
- va_flag = FALSE, va_label = 0;
-
- ASSERT_GLULX();
-
- the_zc = (flag ? cc->posform : cc->negform);
-
- if (the_zc == -1) {
- switch ((cc-condclasses)*2 + 500) {
-
- case HAS_CC:
- if (runtime_error_checking_switch) {
- if (flag)
- error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
- error("'has'/'hasnt' applied to illegal attribute number");
- }
- }
- else {
- int pa_label = next_label++, fa_label = next_label++;
- assembly_operand en_ao, max_ao;
-
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
- assembleg_2(stkpeek_gc, zero_operand, temp_var1);
- assembleg_2(stkpeek_gc, one_operand, temp_var2);
- }
- else {
- assembleg_2(stkpeek_gc, zero_operand, temp_var1);
- assembleg_store(temp_var2, AO2);
- }
- }
- else {
- assembleg_store(temp_var1, AO1);
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
- assembleg_2(stkpeek_gc, zero_operand, temp_var2);
- }
- else {
- assembleg_store(temp_var2, AO2);
- }
- }
-
- INITAO(&max_ao);
- max_ao.value = NUM_ATTR_BYTES*8;
- set_constant_ot(&max_ao);
- assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
- assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
- assemble_label_no(fa_label);
- INITAO(&en_ao);
- en_ao.value = 19; /* INVALIDATTR_RTE */
- set_constant_ot(&en_ao);
- assembleg_store(stack_pointer, temp_var2);
- assembleg_store(stack_pointer, temp_var1);
- assembleg_store(stack_pointer, en_ao);
- assembleg_3(call_gc, veneer_routine(RT__Err_VR),
- three_operand, zero_operand);
- va_flag = TRUE;
- va_label = next_label++;
- assembleg_jump(va_label);
- assemble_label_no(pa_label);
- }
- }
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- AO2.value += 8;
- set_constant_ot(&AO2);
- }
- else {
- INITAO(&AO4);
- AO4.value = 8;
- AO4.type = BYTECONSTANT_OT;
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
- assembleg_0(stkswap_gc);
- assembleg_3(add_gc, AO2, AO4, stack_pointer);
- assembleg_0(stkswap_gc);
- }
- else {
- assembleg_3(add_gc, AO2, AO4, stack_pointer);
- }
- AO2 = stack_pointer;
- }
- assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
-
- case IN_CC:
- if (runtime_error_checking_switch) {
- if (flag)
- error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
- }
- INITAO(&AO4);
- AO4.value = GOBJFIELD_PARENT();
- AO4.type = BYTECONSTANT_OT;
- assembleg_3(aload_gc, AO1, AO4, stack_pointer);
- AO1 = stack_pointer;
- the_zc = (flag ? jeq_gc : jne_gc);
- break;
-
- case OFCLASS_CC:
- assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
-
- case PROVIDES_CC:
- assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
-
- default:
- error("condition not yet supported in Glulx");
- return;
- }
- }
-
- if (the_zc == jnz_gc || the_zc == jz_gc)
- assembleg_1_branch(the_zc, AO1, label);
- else
- assembleg_2_branch(the_zc, AO1, AO2, label);
- if (error_label != label) assemble_label_no(error_label);
- if (va_flag) assemble_label_no(va_label);
-}
-
-static void value_in_void_context(assembly_operand AO)
-{
- if (!glulx_mode)
- value_in_void_context_z(AO);
- else
- value_in_void_context_g(AO);
-}
-
-
-extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
- int error_label, int rte_number)
-{
- if (!glulx_mode)
- return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
- else
- return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
-}
-
-static void generate_code_from(int n, int void_flag)
-{
- /* When void, this must not leave anything on the stack. */
-
- int i, j, below, above, opnum, arity; assembly_operand Result;
-
- below = ET[n].down; above = ET[n].up;
- if (below == -1)
- { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
- value_in_void_context(ET[n].value);
- return;
- }
-
- opnum = ET[n].operator_number;
-
- if (opnum == COMMA_OP)
- { generate_code_from(below, TRUE);
- generate_code_from(ET[below].right, void_flag);
- ET[n].value = ET[ET[below].right].value;
- goto OperatorGenerated;
- }
-
- if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
- { generate_code_from(below, FALSE);
- generate_code_from(ET[below].right, FALSE);
- goto OperatorGenerated;
- }
-
- if (opnum == -1)
- {
- /* Signifies a SETEQUALS_OP which has already been done */
-
- ET[n].down = -1; return;
- }
-
- /* Note that (except in the cases of comma and logical and/or) it
- is essential to code generate the operands right to left, because
- of the peculiar way the Z-machine's stack works:
-
- @sub sp sp -> a;
-
- (for instance) pulls to the first operand, then the second. So
-
- @mul a 2 -> sp;
- @add b 7 -> sp;
- @sub sp sp -> a;
-
- calculates (b+7)-(a*2), not the other way around (as would be more
- usual in stack machines evaluating expressions written in reverse
- Polish notation). (Basically this is because the Z-machine was
- designed to implement a LISP-like language naturally expressed
- in forward Polish notation: (PLUS 3 4), for instance.) */
-
- /* And the Glulx machine follows the Z-machine in this respect. */
-
- i=below; arity = 0;
- while (i != -1)
- { i = ET[i].right; arity++;
- }
- for (j=arity;j>0;j--)
- { int k = 1;
- i = below;
- while (k<j)
- { k++; i = ET[i].right;
- }
- generate_code_from(i, FALSE);
- }
-
-
- /* Check this again, because code generation lower down may have
- stubbed it into -1 */
-
- if (ET[n].operator_number == -1)
- { ET[n].down = -1; return;
- }
-
- if (!glulx_mode) {
-
- if (operators[opnum].opcode_number_z >= 400)
- {
- /* Conditional terms such as '==': */
-
- int a = ET[n].true_label, b = ET[n].false_label,
- branch_away, branch_other,
- make_jump_away = FALSE, make_branch_label = FALSE;
- int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
-
- if (oc >= 400) { oc = oc - 400; flag = FALSE; }
-
- if ((oc == je_zc) && (arity == 2))
- { i = ET[ET[n].down].right;
- if ((ET[i].value.value == zero_operand.value)
- && (ET[i].value.type == zero_operand.type))
- oc = jz_zc;
- }
-
- /* If the condition has truth state flag, branch to
- label a, and if not, to label b. Possibly one of a, b
- equals -1, meaning "continue from this instruction".
-
- branch_away is the label which is a branch away (the one
- which isn't immediately after) and flag is the truth
- state to branch there.
-
- Note that when multiple instructions are needed (because
- of the use of the 'or' operator) the branch_other label
- is created if need be.
- */
-
- /* Reduce to the case where the branch_away label does exist: */
-
- if (a == -1) { a = b; b = -1; flag = !flag; }
-
- branch_away = a; branch_other = b;
- if (branch_other != -1) make_jump_away = TRUE;
-
- if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
- {
- /* In this case, we have an 'or' situation where multiple
- instructions are needed and where the overall condition
- is negated. That is, we have, e.g.
-
- if not (A cond B or C or D) then branch_away
-
- which we transform into
-
- if (A cond B) then branch_other
- if (A cond C) then branch_other
- if not (A cond D) then branch_away
- .branch_other */
-
- if (branch_other == -1)
- { branch_other = next_label++; make_branch_label = TRUE;
- }
- }
-
- if (oc == jz_zc)
- assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
- else
- { assembly_operand left_operand;
-
- if (arity == 2)
- compile_conditional_z(oc, ET[below].value,
- ET[ET[below].right].value, branch_away, flag);
- else
- { /* The case of a condition using "or".
- First: if the condition tests the stack pointer,
- and it can't always be done in a single test, move
- the value off the stack and into temporary variable
- storage. */
-
- if (((ET[below].value.type == VARIABLE_OT)
- && (ET[below].value.value == 0))
- && ((oc != je_zc) || (arity>4)) )
- { INITAOTV(&left_operand, VARIABLE_OT, 255);
- assemblez_store(left_operand, ET[below].value);
- }
- else left_operand = ET[below].value;
- i = ET[below].right; arity--;
-
- /* "left_operand" now holds the quantity to be tested;
- "i" holds the right operand reached so far;
- "arity" the number of right operands. */
-
- while (i != -1)
- { if ((oc == je_zc) && (arity>1))
- {
- /* je_zc is an especially good case since the
- Z-machine implements "or" for up to three
- right operands automatically, though it's an
- especially bad case to generate code for! */
-
- if (arity == 2)
- { assemblez_3_branch(je_zc,
- left_operand, ET[i].value,
- ET[ET[i].right].value, branch_away, flag);
- i = ET[i].right; arity--;
- }
- else
- { if ((arity == 3) || flag)
- assemblez_4_branch(je_zc, left_operand,
- ET[i].value,
- ET[ET[i].right].value,
- ET[ET[ET[i].right].right].value,
- branch_away, flag);
- else
- assemblez_4_branch(je_zc, left_operand,
- ET[i].value,
- ET[ET[i].right].value,
- ET[ET[ET[i].right].right].value,
- branch_other, !flag);
- i = ET[ET[i].right].right; arity -= 2;
- }
- }
- else
- { /* Otherwise we can compare the left_operand with
- only one right operand at the time. There are
- two cases: it's the last right operand, or it
- isn't. */
-
- if ((arity == 1) || flag)
- compile_conditional_z(oc, left_operand,
- ET[i].value, branch_away, flag);
- else
- compile_conditional_z(oc, left_operand,
- ET[i].value, branch_other, !flag);
- }
- i = ET[i].right; arity--;
- }
-
- }
- }
-
- /* NB: These two conditions cannot both occur, fortunately! */
-
- if (make_branch_label) assemble_label_no(branch_other);
- if (make_jump_away) assemblez_jump(branch_other);
-
- goto OperatorGenerated;
- }
-
- }
- else {
- if (operators[opnum].opcode_number_g >= FIRST_CC
- && operators[opnum].opcode_number_g <= LAST_CC) {
- /* Conditional terms such as '==': */
-
- int a = ET[n].true_label, b = ET[n].false_label;
- int branch_away, branch_other, flag,
- make_jump_away = FALSE, make_branch_label = FALSE;
- int ccode = operators[opnum].opcode_number_g;
- condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
- flag = (ccode & 1) ? 0 : 1;
-
- /* If the comparison is "equal to (constant) 0", change it
- to the simple "zero" test. Unfortunately, this doesn't
- work for the commutative form "(constant) 0 is equal to".
- At least I don't think it does. */
-
- if ((cc == &condclasses[1]) && (arity == 2)) {
- i = ET[ET[n].down].right;
- if ((ET[i].value.value == 0)
- && (ET[i].value.marker == 0)
- && is_constant_ot(ET[i].value.type)) {
- cc = &condclasses[0];
- }
- }
-
- /* If the condition has truth state flag, branch to
- label a, and if not, to label b. Possibly one of a, b
- equals -1, meaning "continue from this instruction".
-
- branch_away is the label which is a branch away (the one
- which isn't immediately after) and flag is the truth
- state to branch there.
-
- Note that when multiple instructions are needed (because
- of the use of the 'or' operator) the branch_other label
- is created if need be.
- */
-
- /* Reduce to the case where the branch_away label does exist: */
-
- if (a == -1) { a = b; b = -1; flag = !flag; }
-
- branch_away = a; branch_other = b;
- if (branch_other != -1) make_jump_away = TRUE;
-
- if ((arity > 2) && (flag == FALSE)) {
- /* In this case, we have an 'or' situation where multiple
- instructions are needed and where the overall condition
- is negated. That is, we have, e.g.
-
- if not (A cond B or C or D) then branch_away
-
- which we transform into
-
- if (A cond B) then branch_other
- if (A cond C) then branch_other
- if not (A cond D) then branch_away
- .branch_other */
-
- if (branch_other == -1) {
- branch_other = next_label++; make_branch_label = TRUE;
- }
- }
-
- if (cc == &condclasses[0]) {
- assembleg_1_branch((flag ? cc->posform : cc->negform),
- ET[below].value, branch_away);
- }
- else {
- if (arity == 2) {
- compile_conditional_g(cc, ET[below].value,
- ET[ET[below].right].value, branch_away, flag);
- }
- else {
- /* The case of a condition using "or".
- First: if the condition tests the stack pointer,
- and it can't always be done in a single test, move
- the value off the stack and into temporary variable
- storage. */
-
- assembly_operand left_operand;
- if (((ET[below].value.type == LOCALVAR_OT)
- && (ET[below].value.value == 0))) {
- assembleg_store(temp_var1, ET[below].value);
- left_operand = temp_var1;
- }
- else {
- left_operand = ET[below].value;
- }
- i = ET[below].right;
- arity--;
-
- /* "left_operand" now holds the quantity to be tested;
- "i" holds the right operand reached so far;
- "arity" the number of right operands. */
-
- while (i != -1) {
- /* We can compare the left_operand with
- only one right operand at the time. There are
- two cases: it's the last right operand, or it
- isn't. */
-
- if ((arity == 1) || flag)
- compile_conditional_g(cc, left_operand,
- ET[i].value, branch_away, flag);
- else
- compile_conditional_g(cc, left_operand,
- ET[i].value, branch_other, !flag);
-
- i = ET[i].right;
- arity--;
- }
- }
- }
-
- /* NB: These two conditions cannot both occur, fortunately! */
-
- if (make_branch_label) assemble_label_no(branch_other);
- if (make_jump_away) assembleg_jump(branch_other);
-
- goto OperatorGenerated;
- }
-
- }
-
- /* The operator is now definitely one which produces a value */
-
- if (void_flag && (!(operators[opnum].side_effect)))
- error_named("Evaluating this has no effect:",
- operators[opnum].description);
-
- /* Where shall we put the resulting value? (In Glulx, this could
- be smarter, and peg the result into ZEROCONSTANT.) */
-
- if (void_flag) Result = temp_var1; /* Throw it away */
- else
- { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
- {
- /* If the node above is "set variable equal to", then
- make that variable the place to put the result, and
- delete the SETEQUALS_OP node since its effect has already
- been accomplished. */
-
- ET[above].operator_number = -1;
- Result = ET[ET[above].down].value;
- ET[above].value = Result;
- }
- else Result = stack_pointer; /* Otherwise, put it on the stack */
- }
-
- if (!glulx_mode) {
-
- if (operators[opnum].opcode_number_z != -1)
- {
- /* Operators directly translatable into Z-code opcodes: infix ops
- take two operands whereas pre/postfix operators take only one */
-
- if (operators[opnum].usage == IN_U)
- { int o_n = operators[opnum].opcode_number_z;
- if (runtime_error_checking_switch && (!veneer_mode)
- && ((o_n == div_zc) || (o_n == mod_zc)))
- { assembly_operand by_ao, error_ao; int ln;
- by_ao = ET[ET[below].right].value;
- if ((by_ao.value != 0) && (by_ao.marker == 0)
- && ((by_ao.type == SHORT_CONSTANT_OT)
- || (by_ao.type == LONG_CONSTANT_OT)))
- assemblez_2_to(o_n, ET[below].value,
- by_ao, Result);
- else
- {
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, by_ao);
- ln = next_label++;
- assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
- INITAOT(&error_ao, SHORT_CONSTANT_OT);
- error_ao.value = DBYZERO_RTE;
- assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
- error_ao);
- assemblez_inc(temp_var2);
- assemble_label_no(ln);
- assemblez_2_to(o_n, temp_var1, temp_var2, Result);
- }
- }
- else {
- assemblez_2_to(o_n, ET[below].value,
- ET[ET[below].right].value, Result);
- }
- }
- else
- assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
- Result);
- }
- else
- switch(opnum)
- { case ARROW_OP:
- access_memory_z(loadb_zc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case DARROW_OP:
- access_memory_z(loadw_zc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case UNARY_MINUS_OP:
- assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
- break;
- case ARTNOT_OP:
- assemblez_1_to(not_zc, ET[below].value, Result);
- break;
-
- case PROP_ADD_OP:
- { assembly_operand AO = ET[below].value;
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
- assemblez_2_to(get_prop_addr_zc, AO,
- ET[ET[below].right].value, temp_var1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
-
- case PROP_NUM_OP:
- { assembly_operand AO = ET[below].value;
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
- assemblez_2_to(get_prop_addr_zc, AO,
- ET[ET[below].right].value, temp_var1);
- assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
- assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
- assemble_label_no(next_label-1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
-
- case PROPERTY_OP:
- { assembly_operand AO = ET[below].value;
-
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
- AO, ET[ET[below].right].value, temp_var1);
- else
- assemblez_2_to(get_prop_zc, AO,
- ET[ET[below].right].value, temp_var1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
-
- case MESSAGE_OP:
- j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
- goto GenFunctionCallZ;
- case MPROP_ADD_OP:
- j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
- goto GenFunctionCallZ;
- case MPROP_NUM_OP:
- j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_SETEQUALS_OP:
- j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_INC_OP:
- j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_DEC_OP:
- j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_POST_INC_OP:
- j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_POST_DEC_OP:
- j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
- goto GenFunctionCallZ;
- case SUPERCLASS_OP:
- j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
- goto GenFunctionCallZ;
- case PROP_CALL_OP:
- j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_CALL_OP:
- j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
- goto GenFunctionCallZ;
-
-
- case FCALL_OP:
- j = 0;
-
- if ((ET[below].value.type == VARIABLE_OT)
- && (ET[below].value.value >= 256))
- { int sf_number = ET[below].value.value - 256;
-
- i = ET[below].right;
- if (i == -1)
- { error("Argument to system function missing");
- AI.operand[0] = one_operand;
- AI.operand_count = 1;
- }
- else
- { j=0;
- while (i != -1) { j++; i = ET[i].right; }
-
- if (((sf_number != INDIRECT_SYSF) &&
- (sf_number != RANDOM_SYSF) && (j > 1))
- || ((sf_number == INDIRECT_SYSF) && (j>7)))
- { j=1;
- error("System function given with too many arguments");
- }
- if (sf_number != RANDOM_SYSF)
- { int jcount;
- i = ET[below].right;
- for (jcount = 0; jcount < j; jcount++)
- { AI.operand[jcount] = ET[i].value;
- i = ET[i].right;
- }
- AI.operand_count = j;
- }
- }
- AI.store_variable_number = Result.value;
- AI.branch_label_number = -1;
-
- switch(sf_number)
- { case RANDOM_SYSF:
- if (j>1)
- { assembly_operand AO, AO2; int arg_c, arg_et;
- INITAOTV(&AO, SHORT_CONSTANT_OT, j);
- INITAOT(&AO2, LONG_CONSTANT_OT);
- AO2.value = begin_word_array();
- AO2.marker = ARRAY_MV;
-
- for (arg_c=0, arg_et = ET[below].right;arg_c<j;
- arg_c++, arg_et = ET[arg_et].right)
- { if (ET[arg_et].value.type == VARIABLE_OT)
- error("Only constants can be used as possible 'random' results");
- array_entry(arg_c, ET[arg_et].value);
- }
- finish_array(arg_c);
-
- assemblez_1_to(random_zc, AO, temp_var1);
- assemblez_dec(temp_var1);
- assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
- }
- else
- assemblez_1_to(random_zc,
- ET[ET[below].right].value, Result);
- break;
-
- case PARENT_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- PARENT_RTE);
- assemblez_1_to(get_parent_zc, AO, Result);
- }
- break;
-
- case ELDEST_SYSF:
- case CHILD_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
- assemblez_objcode(get_child_zc,
- AO, Result, -2, TRUE);
- }
- break;
-
- case YOUNGER_SYSF:
- case SIBLING_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==SIBLING_SYSF)
- ?SIBLING_RTE:YOUNGER_RTE);
- assemblez_objcode(get_sibling_zc,
- AO, Result, -2, TRUE);
- }
- break;
-
- case INDIRECT_SYSF:
- j=0; i = ET[below].right;
- goto IndirectFunctionCallZ;
-
- case CHILDREN_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- CHILDREN_RTE);
- assemblez_store(temp_var1, zero_operand);
- assemblez_objcode(get_child_zc,
- AO, stack_pointer, next_label+1, FALSE);
- assemble_label_no(next_label);
- assemblez_inc(temp_var1);
- assemblez_objcode(get_sibling_zc,
- stack_pointer, stack_pointer,
- next_label, TRUE);
- assemble_label_no(next_label+1);
- assemblez_store(temp_var2, stack_pointer);
- if (!void_flag) write_result_z(Result, temp_var1);
- next_label += 2;
- }
- break;
-
- case YOUNGEST_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- assemblez_objcode(get_child_zc,
- AO, temp_var1, next_label+1, FALSE);
- assemblez_1(push_zc, temp_var1);
- assemble_label_no(next_label);
- assemblez_store(temp_var1, stack_pointer);
- assemblez_objcode(get_sibling_zc,
- temp_var1, stack_pointer, next_label, TRUE);
- assemble_label_no(next_label+1);
- if (!void_flag) write_result_z(Result, temp_var1);
- next_label += 2;
- }
- break;
-
- case ELDER_SYSF:
- assemblez_store(temp_var1, ET[ET[below].right].value);
- if (runtime_error_checking_switch)
- check_nonzero_at_runtime(temp_var1, -1,
- ELDER_RTE);
- assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
- assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
- assemblez_store(temp_var2, temp_var3);
- assemblez_store(temp_var3, zero_operand);
- assemblez_objcode(get_child_zc,
- temp_var2, temp_var2, next_label, TRUE);
- assemble_label_no(next_label++);
- assemblez_2_branch(je_zc, temp_var1, temp_var2,
- next_label, TRUE);
- assemblez_store(temp_var3, temp_var2);
- assemblez_objcode(get_sibling_zc,
- temp_var2, temp_var2, next_label - 1, TRUE);
- assemble_label_no(next_label++);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case METACLASS_SYSF:
- assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
- veneer_routine(Metaclass_VR),
- ET[ET[below].right].value, Result);
- break;
-
- case GLK_SYSF:
- error("The glk() system function does not exist in Z-code");
- break;
- }
- break;
- }
-
- GenFunctionCallZ:
-
- i = below;
-
- IndirectFunctionCallZ:
-
- while ((i != -1) && (j<8))
- { AI.operand[j++] = ET[i].value;
- i = ET[i].right;
- }
-
- if ((j > 4) && (version_number == 3))
- { error("A function may be called with at most 3 arguments");
- j = 4;
- }
- if ((j==8) && (i != -1))
- { error("A function may be called with at most 7 arguments");
- }
-
- AI.operand_count = j;
-
- if ((void_flag) && (version_number >= 5))
- { AI.store_variable_number = -1;
- switch(j)
- { case 1: AI.internal_number = call_1n_zc; break;
- case 2: AI.internal_number = call_2n_zc; break;
- case 3: case 4: AI.internal_number = call_vn_zc; break;
- case 5: case 6: case 7: case 8:
- AI.internal_number = call_vn2_zc; break;
- }
- }
- else
- { AI.store_variable_number = Result.value;
- if (version_number == 3)
- AI.internal_number = call_zc;
- else
- switch(j)
- { case 1: AI.internal_number = call_1s_zc; break;
- case 2: AI.internal_number = call_2s_zc; break;
- case 3: case 4: AI.internal_number = call_vs_zc; break;
- case 5: case 6: case 7: case 8:
- AI.internal_number = call_vs2_zc; break;
- }
- }
-
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
- break;
-
- case SETEQUALS_OP:
- assemblez_store(ET[below].value,
- ET[ET[below].right].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
-
- case PROPERTY_SETEQUALS_OP:
- if (!void_flag)
- { if (runtime_error_checking_switch)
- assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
- ET[below].value, ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value, Result);
- else
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- assemblez_3(put_prop_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- }
- else
- { if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- ET[below].value, ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- else assemblez_3(put_prop_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- }
- break;
- case ARROW_SETEQUALS_OP:
- if (!void_flag)
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_z(storeb_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- else access_memory_z(storeb_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case DARROW_SETEQUALS_OP:
- if (!void_flag)
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_z(storew_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- else
- access_memory_z(storew_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case INC_OP:
- assemblez_inc(ET[below].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
- case DEC_OP:
- assemblez_dec(ET[below].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
- case POST_INC_OP:
- if (!void_flag) write_result_z(Result, ET[below].value);
- assemblez_inc(ET[below].value);
- break;
- case POST_DEC_OP:
- if (!void_flag) write_result_z(Result, ET[below].value);
- assemblez_dec(ET[below].value);
- break;
-
- case ARROW_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case ARROW_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case ARROW_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case ARROW_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case DARROW_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case DARROW_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case PROPERTY_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case PROPERTY_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case PROPERTY_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case PROPERTY_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- default:
- printf("** Trouble op = %d i.e. '%s' **\n",
- opnum, operators[opnum].description);
- compiler_error("Expr code gen: Can't generate yet");
- }
- }
- else {
- assembly_operand AO, AO2;
- if (operators[opnum].opcode_number_g != -1)
- {
- /* Operators directly translatable into opcodes: infix ops
- take two operands whereas pre/postfix operators take only one */
-
- if (operators[opnum].usage == IN_U)
- { int o_n = operators[opnum].opcode_number_g;
- if (runtime_error_checking_switch && (!veneer_mode)
- && ((o_n == div_gc) || (o_n == mod_gc)))
- { assembly_operand by_ao, error_ao; int ln;
- by_ao = ET[ET[below].right].value;
- if ((by_ao.value != 0) && (by_ao.marker == 0)
- && is_constant_ot(by_ao.type))
- assembleg_3(o_n, ET[below].value,
- by_ao, Result);
- else
- { assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, by_ao);
- ln = next_label++;
- assembleg_1_branch(jnz_gc, temp_var2, ln);
- INITAO(&error_ao);
- error_ao.value = DBYZERO_RTE;
- set_constant_ot(&error_ao);
- assembleg_call_1(veneer_routine(RT__Err_VR),
- error_ao, zero_operand);
- assembleg_store(temp_var2, one_operand);
- assemble_label_no(ln);
- assembleg_3(o_n, temp_var1, temp_var2, Result);
- }
- }
- else
- assembleg_3(o_n, ET[below].value,
- ET[ET[below].right].value, Result);
- }
- else
- assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
- Result);
- }
- else
- switch(opnum)
- {
-
- case PUSH_OP:
- if (ET[below].value.type == Result.type
- && ET[below].value.value == Result.value
- && ET[below].value.marker == Result.marker)
- break;
- assembleg_2(copy_gc, ET[below].value, Result);
- break;
-
- case UNARY_MINUS_OP:
- assembleg_2(neg_gc, ET[below].value, Result);
- break;
- case ARTNOT_OP:
- assembleg_2(bitnot_gc, ET[below].value, Result);
- break;
-
- case ARROW_OP:
- access_memory_g(aloadb_gc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case DARROW_OP:
- access_memory_g(aload_gc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
-
- case SETEQUALS_OP:
- assembleg_store(ET[below].value,
- ET[ET[below].right].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
-
- case ARROW_SETEQUALS_OP:
- if (!void_flag)
- { assembleg_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_g(astoreb_gc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_g(Result, temp_var1);
- }
- else access_memory_g(astoreb_gc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case DARROW_SETEQUALS_OP:
- if (!void_flag)
- { assembleg_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_g(astore_gc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_g(Result, temp_var1);
- }
- else
- access_memory_g(astore_gc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case INC_OP:
- assembleg_inc(ET[below].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
- case DEC_OP:
- assembleg_dec(ET[below].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
- case POST_INC_OP:
- if (!void_flag) write_result_g(Result, ET[below].value);
- assembleg_inc(ET[below].value);
- break;
- case POST_DEC_OP:
- if (!void_flag) write_result_g(Result, ET[below].value);
- assembleg_dec(ET[below].value);
- break;
-
- case ARROW_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case ARROW_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case ARROW_POST_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case ARROW_POST_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case DARROW_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case DARROW_POST_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_POST_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case PROPERTY_OP:
- case MESSAGE_OP:
- AO = veneer_routine(RV__Pr_VR);
- goto TwoArgFunctionCall;
- case MPROP_ADD_OP:
- case PROP_ADD_OP:
- AO = veneer_routine(RA__Pr_VR);
- goto TwoArgFunctionCall;
- case MPROP_NUM_OP:
- case PROP_NUM_OP:
- AO = veneer_routine(RL__Pr_VR);
- goto TwoArgFunctionCall;
-
- case PROP_CALL_OP:
- case MESSAGE_CALL_OP:
- AO2 = veneer_routine(CA__Pr_VR);
- i = below;
- goto DoFunctionCall;
-
- case MESSAGE_INC_OP:
- case PROPERTY_INC_OP:
- AO = veneer_routine(IB__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_DEC_OP:
- case PROPERTY_DEC_OP:
- AO = veneer_routine(DB__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_POST_INC_OP:
- case PROPERTY_POST_INC_OP:
- AO = veneer_routine(IA__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_POST_DEC_OP:
- case PROPERTY_POST_DEC_OP:
- AO = veneer_routine(DA__Pr_VR);
- goto TwoArgFunctionCall;
- case SUPERCLASS_OP:
- AO = veneer_routine(RA__Sc_VR);
- goto TwoArgFunctionCall;
-
- TwoArgFunctionCall:
- {
- assembly_operand AO2 = ET[below].value;
- assembly_operand AO3 = ET[ET[below].right].value;
- if (void_flag)
- assembleg_call_2(AO, AO2, AO3, zero_operand);
- else
- assembleg_call_2(AO, AO2, AO3, Result);
- }
- break;
-
- case PROPERTY_SETEQUALS_OP:
- case MESSAGE_SETEQUALS_OP:
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = veneer_routine(RT__ChPS_VR);
- else
- AO = veneer_routine(WV__Pr_VR);
-
- {
- assembly_operand AO2 = ET[below].value;
- assembly_operand AO3 = ET[ET[below].right].value;
- assembly_operand AO4 = ET[ET[ET[below].right].right].value;
- if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
- /* Rightmost is on the stack; reduce to previous case. */
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- /* both already on stack. */
- }
- else {
- assembleg_store(stack_pointer, AO3);
- assembleg_0(stkswap_gc);
- }
- }
- else {
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- assembleg_store(stack_pointer, AO2);
- }
- else {
- assembleg_store(stack_pointer, AO3);
- assembleg_store(stack_pointer, AO2);
- }
- }
- }
- else {
- /* We have to get the rightmost on the stack, below the
- others. */
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- assembleg_store(stack_pointer, AO4);
- assembleg_2(stkroll_gc, three_operand, one_operand);
- }
- else {
- assembleg_store(stack_pointer, AO4);
- assembleg_0(stkswap_gc);
- assembleg_store(stack_pointer, AO2);
- }
- }
- else {
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- assembleg_store(stack_pointer, AO4);
- assembleg_store(stack_pointer, AO3);
- assembleg_2(stkroll_gc, three_operand, two_operand);
- }
- else {
- assembleg_store(stack_pointer, AO4);
- assembleg_store(stack_pointer, AO3);
- assembleg_store(stack_pointer, AO2);
- }
- }
- }
- if (void_flag)
- assembleg_3(call_gc, AO, three_operand, zero_operand);
- else
- assembleg_3(call_gc, AO, three_operand, Result);
- }
- break;
-
- case FCALL_OP:
- j = 0;
-
- if (ET[below].value.type == SYSFUN_OT)
- { int sf_number = ET[below].value.value;
-
- i = ET[below].right;
- if (i == -1)
- { error("Argument to system function missing");
- AI.operand[0] = one_operand;
- AI.operand_count = 1;
- }
- else
- { j=0;
- while (i != -1) { j++; i = ET[i].right; }
-
- if (((sf_number != INDIRECT_SYSF) &&
- (sf_number != GLK_SYSF) &&
- (sf_number != RANDOM_SYSF) && (j > 1)))
- { j=1;
- error("System function given with too many arguments");
- }
- if (sf_number != RANDOM_SYSF)
- { int jcount;
- i = ET[below].right;
- for (jcount = 0; jcount < j; jcount++)
- { AI.operand[jcount] = ET[i].value;
- i = ET[i].right;
- }
- AI.operand_count = j;
- }
- }
-
- switch(sf_number)
- {
- case RANDOM_SYSF:
- if (j>1)
- { assembly_operand AO, AO2;
- int arg_c, arg_et;
- INITAO(&AO);
- AO.value = j;
- set_constant_ot(&AO);
- INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
- AO2.marker = ARRAY_MV;
-
- for (arg_c=0, arg_et = ET[below].right;arg_c<j;
- arg_c++, arg_et = ET[arg_et].right)
- { if (ET[arg_et].value.type == LOCALVAR_OT
- || ET[arg_et].value.type == GLOBALVAR_OT)
- error("Only constants can be used as possible 'random' results");
- array_entry(arg_c, ET[arg_et].value);
- }
- finish_array(arg_c);
-
- assembleg_2(random_gc, AO, stack_pointer);
- assembleg_3(aload_gc, AO2, stack_pointer, Result);
- }
- else {
- assembleg_2(random_gc,
- ET[ET[below].right].value, stack_pointer);
- assembleg_3(add_gc, stack_pointer, one_operand,
- Result);
- }
- break;
-
- case PARENT_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- PARENT_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
-
- case ELDEST_SYSF:
- case CHILD_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
-
- case YOUNGER_SYSF:
- case SIBLING_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==SIBLING_SYSF)
- ?SIBLING_RTE:YOUNGER_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
-
- case CHILDREN_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- CHILDREN_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_store(temp_var1, zero_operand);
- assembleg_3(aload_gc, AO, AO2, temp_var2);
- AO2.value = GOBJFIELD_SIBLING();
- assemble_label_no(next_label);
- assembleg_1_branch(jz_gc, temp_var2, next_label+1);
- assembleg_3(add_gc, temp_var1, one_operand,
- temp_var1);
- assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- next_label += 2;
- if (!void_flag)
- write_result_g(Result, temp_var1);
- }
- break;
-
- case INDIRECT_SYSF:
- i = ET[below].right;
- goto IndirectFunctionCallG;
-
- case GLK_SYSF:
- AO2 = veneer_routine(Glk__Wrap_VR);
- i = ET[below].right;
- goto DoFunctionCall;
-
- case METACLASS_SYSF:
- assembleg_call_1(veneer_routine(Metaclass_VR),
- ET[ET[below].right].value, Result);
- break;
-
- case YOUNGEST_SYSF:
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_3(aload_gc, AO, AO2, temp_var1);
- AO2.value = GOBJFIELD_SIBLING();
- assembleg_1_branch(jz_gc, temp_var1, next_label+1);
- assemble_label_no(next_label);
- assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
- assembleg_1_branch(jz_gc, temp_var2, next_label+1);
- assembleg_store(temp_var1, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- if (!void_flag)
- write_result_g(Result, temp_var1);
- next_label += 2;
- break;
-
- case ELDER_SYSF:
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- assembleg_store(temp_var3, AO);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
- assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
- assembleg_1_branch(jz_gc, temp_var1, next_label+2);
- AO2.value = GOBJFIELD_CHILD();
- assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
- assembleg_1_branch(jz_gc, temp_var1, next_label+2);
- assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
- next_label+1);
- assemble_label_no(next_label);
- AO2.value = GOBJFIELD_SIBLING();
- assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
- assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
- next_label+2);
- assembleg_store(temp_var1, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- assembleg_store(temp_var1, zero_operand);
- assemble_label_no(next_label+2);
- if (!void_flag)
- write_result_g(Result, temp_var1);
- next_label += 3;
- break;
-
- default:
- error("*** system function not implemented ***");
- break;
-
- }
- break;
- }
-
- i = below;
-
- IndirectFunctionCallG:
-
- /* Get the function address. */
- AO2 = ET[i].value;
- i = ET[i].right;
-
- DoFunctionCall:
-
- {
- /* If all the function arguments are in local/global
- variables, we have to push them all on the stack.
- If all of them are on the stack, we have to do nothing.
- If some are and some aren't, we have a hopeless mess,
- and we should throw a compiler error.
- */
-
- int onstack = 0;
- int offstack = 0;
-
- /* begin part of patch G03701 */
- int nargs = 0;
- j = i;
- while (j != -1) {
- nargs++;
- j = ET[j].right;
- }
-
- if (nargs==0) {
- assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
- } else if (nargs==1) {
- assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
- } else if (nargs==2) {
- assembly_operand o1 = ET[i].value;
- assembly_operand o2 = ET[ET[i].right].value;
- assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
- } else if (nargs==3) {
- assembly_operand o1 = ET[i].value;
- assembly_operand o2 = ET[ET[i].right].value;
- assembly_operand o3 = ET[ET[ET[i].right].right].value;
- assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
- } else {
-
- j = 0;
- while (i != -1) {
- if (ET[i].value.type == LOCALVAR_OT
- && ET[i].value.value == 0) {
- onstack++;
- }
- else {
- assembleg_store(stack_pointer, ET[i].value);
- offstack++;
- }
- i = ET[i].right;
- j++;
- }
-
- if (onstack && offstack)
- error("*** Function call cannot be generated with mixed arguments ***");
- if (offstack > 1)
- error("*** Function call cannot be generated with more than one nonstack argument ***");
-
- INITAO(&AO);
- AO.value = j;
- set_constant_ot(&AO);
-
- if (void_flag)
- assembleg_3(call_gc, AO2, AO, zero_operand);
- else
- assembleg_3(call_gc, AO2, AO, Result);
-
- } /* else nargs>=4 */
- } /* DoFunctionCall: */
-
- break;
-
- default:
- printf("** Trouble op = %d i.e. '%s' **\n",
- opnum, operators[opnum].description);
- compiler_error("Expr code gen: Can't generate yet");
- }
- }
-
- ET[n].value = Result;
-
- OperatorGenerated:
-
- if (!glulx_mode) {
-
- if (ET[n].to_expression)
- {
- if (void_flag) {
- warning("Logical expression has no side-effects");
- if (ET[n].true_label != -1)
- assemble_label_no(ET[n].true_label);
- else
- assemble_label_no(ET[n].false_label);
- }
- else if (ET[n].true_label != -1)
- { assemblez_1(push_zc, zero_operand);
- assemblez_jump(next_label++);
- assemble_label_no(ET[n].true_label);
- assemblez_1(push_zc, one_operand);
- assemble_label_no(next_label-1);
- }
- else
- { assemblez_1(push_zc, one_operand);
- assemblez_jump(next_label++);
- assemble_label_no(ET[n].false_label);
- assemblez_1(push_zc, zero_operand);
- assemble_label_no(next_label-1);
- }
- ET[n].value = stack_pointer;
- }
- else
- if (ET[n].label_after != -1)
- assemble_label_no(ET[n].label_after);
-
- }
- else {
-
- if (ET[n].to_expression)
- {
- if (void_flag) {
- warning("Logical expression has no side-effects");
- if (ET[n].true_label != -1)
- assemble_label_no(ET[n].true_label);
- else
- assemble_label_no(ET[n].false_label);
- }
- else if (ET[n].true_label != -1)
- { assembleg_store(stack_pointer, zero_operand);
- assembleg_jump(next_label++);
- assemble_label_no(ET[n].true_label);
- assembleg_store(stack_pointer, one_operand);
- assemble_label_no(next_label-1);
- }
- else
- { assembleg_store(stack_pointer, one_operand);
- assembleg_jump(next_label++);
- assemble_label_no(ET[n].false_label);
- assembleg_store(stack_pointer, zero_operand);
- assemble_label_no(next_label-1);
- }
- ET[n].value = stack_pointer;
- }
- else
- if (ET[n].label_after != -1)
- assemble_label_no(ET[n].label_after);
-
- }
-
- ET[n].down = -1;
-}
-
-assembly_operand code_generate(assembly_operand AO, int context, int label)
-{
- /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
- QUANTITY_CONTEXT.
-
- If CONDITION_CONTEXT, then compile code branching to label number
- "label" if the condition is false: there's no return value.
- (Except that if label is -3 or -4 (internal codes for rfalse and
- rtrue rather than branch) then this is for branching when the
- condition is true. This is used for optimising code generation
- for "if" statements.)
-
- Otherwise return the assembly operand containing the result
- (probably the stack pointer variable but not necessarily:
- e.g. is would be short constant 2 from the expression "j++, 2") */
-
- vivc_flag = FALSE;
-
- if (AO.type != EXPRESSION_OT)
- { switch(context)
- { case VOID_CONTEXT:
- value_in_void_context(AO);
- AO.type = OMITTED_OT;
- AO.value = 0;
- break;
- case CONDITION_CONTEXT:
- if (!glulx_mode) {
- if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
- else assemblez_1_branch(jz_zc, AO, label, TRUE);
- }
- else {
- if (label < -2)
- assembleg_1_branch(jnz_gc, AO, label);
- else
- assembleg_1_branch(jz_gc, AO, label);
- }
- AO.type = OMITTED_OT;
- AO.value = 0;
- break;
- }
- return AO;
- }
-
- if (expr_trace_level >= 2)
- { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
- }
-
- if (context == CONDITION_CONTEXT)
- { if (label < -2) annotate_for_conditions(AO.value, label, -1);
- else annotate_for_conditions(AO.value, -1, label);
- }
- else annotate_for_conditions(AO.value, -1, -1);
-
- if (expr_trace_level >= 1)
- { printf("Code generation for expression in ");
- switch(context)
- { case VOID_CONTEXT: printf("void"); break;
- case CONDITION_CONTEXT: printf("condition"); break;
- case QUANTITY_CONTEXT: printf("quantity"); break;
- case ASSEMBLY_CONTEXT: printf("assembly"); break;
- case ARRAY_CONTEXT: printf("array initialisation"); break;
- default: printf("* ILLEGAL *"); break;
- }
- printf(" context with annotated tree:\n");
- show_tree(AO, TRUE);
- }
-
- generate_code_from(AO.value, (context==VOID_CONTEXT));
- return ET[AO.value].value;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_expressc_vars(void)
-{ make_operands();
-}
-
-extern void expressc_begin_pass(void)
-{
-}
-
-extern void expressc_allocate_arrays(void)
-{
-}
-
-extern void expressc_free_arrays(void)
-{
-}
-
-/* ========================================================================= */
projects / inform.git / blobdiff