X-Git-Url: https://jxself.org/git/?p=inform.git;a=blobdiff_plain;f=expressc.c;fp=expressc.c;h=0000000000000000000000000000000000000000;hp=e6db119c32cd23378932b4eff41b98a60a483847;hb=81ffe9a7de1db0b3a318a053b38882d1b7ab304c;hpb=d1090135a32de7b38b48c55d4e21f95da4c405bc diff --git a/expressc.c b/expressc.c deleted file mode 100644 index e6db119..0000000 --- a/expressc.c +++ /dev/null @@ -1,2920 +0,0 @@ -/* ------------------------------------------------------------------------- */ -/* "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 = ""; - 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 = ""; - 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' 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 = ""; - 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 = ""; - 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' 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= 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 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 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) -{ -} - -/* ========================================================================= */