src/expressc.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "expressc" :  The expression code generator                             */
   3 /*                                                                           */
   4 /*   Part of Inform 6.40                                                     */
   5 /*   copyright (c) Graham Nelson 1993 - 2022                                 */
   6 /*                                                                           */
   7 /* Inform is free software: you can redistribute it and/or modify            */
   8 /* it under the terms of the GNU General Public License as published by      */
   9 /* the Free Software Foundation, either version 3 of the License, or         */
  10 /* (at your option) any later version.                                       */
  11 /*                                                                           */
  12 /* Inform is distributed in the hope that it will be useful,                 */
  13 /* but WITHOUT ANY WARRANTY; without even the implied warranty of            */
  14 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the              */
  15 /* GNU General Public License for more details.                              */
  16 /*                                                                           */
  17 /* You should have received a copy of the GNU General Public License         */
  18 /* along with Inform. If not, see https://gnu.org/licenses/                  */
  19 /*                                                                           */
  20 /* ------------------------------------------------------------------------- */
  21
  22 #include "header.h"
  23
  24 int vivc_flag;                      /*  TRUE if the last code-generated
  25                                         expression produced a "value in void
  26                                         context" error: used to help the syntax
  27                                         analyser recover from unknown-keyword
  28                                         errors, since unknown keywords are
  29                                         treated as yet-to-be-defined constants
  30                                         and thus as values in void context  */
  31
  32 /* These data structures are global, because they're too useful to be
  33    static. */
  34 assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
  35   temp_var4, zero_operand, one_operand, two_operand, three_operand,
  36   four_operand, valueless_operand;
  37
  38 static void make_operands(void)
  39 {
  40   if (!glulx_mode) {
  41     INITAOTV(&stack_pointer, VARIABLE_OT, 0);
  42     INITAOTV(&temp_var1, VARIABLE_OT, 255);
  43     INITAOTV(&temp_var2, VARIABLE_OT, 254);
  44     INITAOTV(&temp_var3, VARIABLE_OT, 253);
  45     INITAOTV(&temp_var4, VARIABLE_OT, 252);
  46     INITAOTV(&zero_operand, SHORT_CONSTANT_OT, 0);
  47     INITAOTV(&one_operand, SHORT_CONSTANT_OT, 1);
  48     INITAOTV(&two_operand, SHORT_CONSTANT_OT, 2);
  49     INITAOTV(&three_operand, SHORT_CONSTANT_OT, 3);
  50     INITAOTV(&four_operand, SHORT_CONSTANT_OT, 4);
  51     INITAOTV(&valueless_operand, OMITTED_OT, 0);
  52   }
  53   else {
  54     INITAOTV(&stack_pointer, LOCALVAR_OT, 0);
  55     INITAOTV(&temp_var1, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+0);
  56     INITAOTV(&temp_var2, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+1);
  57     INITAOTV(&temp_var3, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+2);
  58     INITAOTV(&temp_var4, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+3);
  59     INITAOTV(&zero_operand, ZEROCONSTANT_OT, 0);
  60     INITAOTV(&one_operand, BYTECONSTANT_OT, 1);
  61     INITAOTV(&two_operand, BYTECONSTANT_OT, 2);
  62     INITAOTV(&three_operand, BYTECONSTANT_OT, 3);
  63     INITAOTV(&four_operand, BYTECONSTANT_OT, 4);
  64     INITAOTV(&valueless_operand, OMITTED_OT, 0);
  65   }
  66 }
  67
  68 /* ------------------------------------------------------------------------- */
  69 /*  The table of conditionals. (Only used in Glulx)                          */
  70
  71 #define ZERO_CC (500)
  72 #define EQUAL_CC (502)
  73 #define LT_CC (504)
  74 #define GT_CC (506)
  75 #define HAS_CC (508)
  76 #define IN_CC (510)
  77 #define OFCLASS_CC (512)
  78 #define PROVIDES_CC (514)
  79
  80 #define FIRST_CC (500)
  81 #define LAST_CC (515)
  82
  83 typedef struct condclass_s {
  84   int32 posform; /* Opcode for the conditional in its positive form. */
  85   int32 negform; /* Opcode for the conditional in its negated form. */
  86 } condclass;
  87
  88 condclass condclasses[] = {
  89   { jz_gc, jnz_gc },
  90   { jeq_gc, jne_gc },
  91   { jlt_gc, jge_gc },
  92   { jgt_gc, jle_gc },
  93   { -1, -1 },
  94   { -1, -1 },
  95   { -1, -1 },
  96   { -1, -1 }
  97 };
  98
  99 /* ------------------------------------------------------------------------- */
 100 /*  The table of operators.
 101
 102     The ordering in this table is not significant except that it must match
 103     the #define's in "header.h"                                              */
 104
 105 operator operators[NUM_OPERATORS] =
 106 {
 107                          /* ------------------------ */
 108                          /*  Level 0:  ,             */
 109                          /* ------------------------ */
 110
 111   { 0, SEP_TT, COMMA_SEP,       IN_U, L_A, 0, -1, -1, 0, 0, "comma" },
 112
 113                          /* ------------------------ */
 114                          /*  Level 1:  =             */
 115                          /* ------------------------ */
 116
 117   { 1, SEP_TT, SETEQUALS_SEP,   IN_U, R_A, 1, -1, -1, 1, 0,
 118       "assignment operator '='" },
 119
 120                          /* ------------------------ */
 121                          /*  Level 2:  ~~  &&  ||    */
 122                          /* ------------------------ */
 123
 124   { 2, SEP_TT, LOGAND_SEP,      IN_U, L_A, 0, -1, -1, 0, LOGOR_OP,
 125       "logical conjunction '&&'" },
 126   { 2, SEP_TT, LOGOR_SEP,       IN_U, L_A, 0, -1, -1, 0, LOGAND_OP,
 127       "logical disjunction '||'" },
 128   { 2, SEP_TT, LOGNOT_SEP,     PRE_U, R_A, 0, -1, -1, 0, LOGNOT_OP,
 129       "logical negation '~~'" },
 130
 131                          /* ------------------------ */
 132                          /*  Level 3:  ==  ~=        */
 133                          /*            >  >=  <  <=  */
 134                          /*            has  hasnt    */
 135                          /*            in  notin     */
 136                          /*            provides      */
 137                          /*            ofclass       */
 138                          /* ------------------------ */
 139
 140   { 3,     -1, -1,                -1, 0, 0, 400 + jz_zc, ZERO_CC+0, 0, NONZERO_OP,
 141       "expression used as condition then negated" },
 142   { 3,     -1, -1,                -1, 0, 0, 800 + jz_zc, ZERO_CC+1, 0, ZERO_OP,
 143       "expression used as condition" },
 144   { 3, SEP_TT, CONDEQUALS_SEP,  IN_U, 0, 0, 400 + je_zc, EQUAL_CC+0, 0, NOTEQUAL_OP,
 145       "'==' condition" },
 146   { 3, SEP_TT, NOTEQUAL_SEP,    IN_U, 0, 0, 800 + je_zc, EQUAL_CC+1, 0, CONDEQUALS_OP,
 147       "'~=' condition" },
 148   { 3, SEP_TT, GE_SEP,          IN_U, 0, 0, 800 + jl_zc, LT_CC+1, 0, LESS_OP,
 149       "'>=' condition" },
 150   { 3, SEP_TT, GREATER_SEP,     IN_U, 0, 0, 400 + jg_zc, GT_CC+0, 0, LE_OP,
 151       "'>' condition" },
 152   { 3, SEP_TT, LE_SEP,          IN_U, 0, 0, 800 + jg_zc, GT_CC+1, 0, GREATER_OP,
 153       "'<=' condition" },
 154   { 3, SEP_TT, LESS_SEP,        IN_U, 0, 0, 400 + jl_zc, LT_CC+0, 0, GE_OP,
 155       "'<' condition" },
 156   { 3, CND_TT, HAS_COND,        IN_U, 0, 0, 400 + test_attr_zc, HAS_CC+0, 0, HASNT_OP,
 157       "'has' condition" },
 158   { 3, CND_TT, HASNT_COND,      IN_U, 0, 0, 800 + test_attr_zc, HAS_CC+1, 0, HAS_OP,
 159       "'hasnt' condition" },
 160   { 3, CND_TT, IN_COND,         IN_U, 0, 0, 400 + jin_zc, IN_CC+0, 0, NOTIN_OP,
 161       "'in' condition" },
 162   { 3, CND_TT, NOTIN_COND,      IN_U, 0, 0, 800 + jin_zc, IN_CC+1, 0, IN_OP,
 163       "'notin' condition" },
 164   { 3, CND_TT, OFCLASS_COND,    IN_U, 0, 0, 600, OFCLASS_CC+0, 0, NOTOFCLASS_OP,
 165       "'ofclass' condition" },
 166   { 3, CND_TT, PROVIDES_COND,   IN_U, 0, 0, 601, PROVIDES_CC+0, 0, NOTPROVIDES_OP,
 167       "'provides' condition" },
 168   { 3,     -1, -1,                -1, 0, 0, 1000, OFCLASS_CC+1, 0, OFCLASS_OP,
 169       "negated 'ofclass' condition" },
 170   { 3,     -1, -1,                -1, 0, 0, 1001, PROVIDES_CC+1, 0, PROVIDES_OP,
 171       "negated 'provides' condition" },
 172
 173                          /* ------------------------ */
 174                          /*  Level 4:  or            */
 175                          /* ------------------------ */
 176
 177   { 4, CND_TT, OR_COND,         IN_U, L_A, 0, -1, -1, 0, 0, "'or'" },
 178
 179                          /* ------------------------ */
 180                          /*  Level 5:  +  binary -   */
 181                          /* ------------------------ */
 182
 183   { 5, SEP_TT, PLUS_SEP,        IN_U, L_A, 0, add_zc, add_gc, 0, 0, "'+'" },
 184   { 5, SEP_TT, MINUS_SEP,       IN_U, L_A, 0, sub_zc, sub_gc, 0, 0, "'-'" },
 185
 186                          /* ------------------------ */
 187                          /*  Level 6:  *  /  %       */
 188                          /*            &  |  ~       */
 189                          /* ------------------------ */
 190
 191   { 6, SEP_TT, TIMES_SEP,       IN_U, L_A, 0, mul_zc, mul_gc, 0, 0, "'*'" },
 192   { 6, SEP_TT, DIVIDE_SEP,      IN_U, L_A, 0, div_zc, div_gc, 0, 0, "'/'" },
 193   { 6, SEP_TT, REMAINDER_SEP,   IN_U, L_A, 0, mod_zc, mod_gc, 0, 0,
 194       "remainder after division '%'" },
 195   { 6, SEP_TT, ARTAND_SEP,      IN_U, L_A, 0, and_zc, bitand_gc, 0, 0,
 196       "bitwise AND '&'" },
 197   { 6, SEP_TT, ARTOR_SEP,       IN_U, L_A, 0, or_zc, bitor_gc, 0, 0,
 198       "bitwise OR '|'" },
 199   { 6, SEP_TT, ARTNOT_SEP,     PRE_U, R_A, 0, -1, bitnot_gc, 0, 0,
 200       "bitwise NOT '~'" },
 201
 202                          /* ------------------------ */
 203                          /*  Level 7:  ->  -->       */
 204                          /* ------------------------ */
 205
 206   { 7, SEP_TT, ARROW_SEP,       IN_U, L_A, 0, -1, -1, 0, 0,
 207       "byte array operator '->'" },
 208   { 7, SEP_TT, DARROW_SEP,      IN_U, L_A, 0, -1, -1, 0, 0,
 209       "word array operator '-->'" },
 210
 211                          /* ------------------------ */
 212                          /*  Level 8:  unary -       */
 213                          /* ------------------------ */
 214
 215   { 8, SEP_TT, UNARY_MINUS_SEP, PRE_U, R_A, 0, -1, neg_gc, 0, 0,
 216       "unary minus" },
 217
 218                          /* ------------------------ */
 219                          /*  Level 9:  ++  --        */
 220                          /*  (prefix or postfix)     */
 221                          /* ------------------------ */
 222
 223   { 9, SEP_TT, INC_SEP,         PRE_U, R_A, 2, -1, -1, 1, 0,
 224       "pre-increment operator '++'" },
 225   { 9, SEP_TT, POST_INC_SEP,   POST_U, R_A, 3, -1, -1, 1, 0,
 226       "post-increment operator '++'" },
 227   { 9, SEP_TT, DEC_SEP,         PRE_U, R_A, 4, -1, -1, 1, 0,
 228       "pre-decrement operator '--'" },
 229   { 9, SEP_TT, POST_DEC_SEP,   POST_U, R_A, 5, -1, -1, 1, 0,
 230       "post-decrement operator '--'" },
 231
 232                          /* ------------------------ */
 233                          /*  Level 10: .&  .#        */
 234                          /*            ..&  ..#      */
 235                          /* ------------------------ */
 236
 237   {10, SEP_TT, PROPADD_SEP,     IN_U, L_A, 0, -1, -1, 0, 0,
 238       "property address operator '.&'" },
 239   {10, SEP_TT, PROPNUM_SEP,     IN_U, L_A, 0, -1, -1, 0, 0,
 240       "property length operator '.#'" },
 241   {10, SEP_TT, MPROPADD_SEP,    IN_U, L_A, 0, -1, -1, 0, 0,
 242       "individual property address operator '..&'" },
 243   {10, SEP_TT, MPROPNUM_SEP,    IN_U, L_A, 0, -1, -1, 0, 0,
 244       "individual property length operator '..#'" },
 245
 246                          /* ------------------------ */
 247                          /*  Level 11:  function (   */
 248                          /* ------------------------ */
 249
 250   {11, SEP_TT, OPENB_SEP,       IN_U, L_A, 0, -1, -1, 1, 0,
 251       "function call" },
 252
 253                          /* ------------------------ */
 254                          /*  Level 12:  .  ..        */
 255                          /* ------------------------ */
 256
 257   {12, SEP_TT, MESSAGE_SEP,     IN_U, L_A, 0, -1, -1, 0, 0,
 258       "individual property selector '..'" },
 259   {12, SEP_TT, PROPERTY_SEP,    IN_U, L_A, 0, -1, -1, 0, 0,
 260       "property selector '.'" },
 261
 262                          /* ------------------------ */
 263                          /*  Level 13:  ::           */
 264                          /* ------------------------ */
 265
 266   {13, SEP_TT, SUPERCLASS_SEP,  IN_U, L_A, 0, -1, -1, 0, 0,
 267       "superclass operator '::'" },
 268
 269                          /* ------------------------ */
 270                          /*  Miscellaneous operators */
 271                          /*  generated at lvalue     */
 272                          /*  checking time           */
 273                          /* ------------------------ */
 274
 275   { 1,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      ->   =   */
 276       "byte array entry assignment" },
 277   { 1,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      -->  =   */
 278       "word array entry assignment" },
 279   { 1,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      ..   =   */
 280       "individual property assignment" },
 281   { 1,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      .    =   */
 282       "common property assignment" },
 283
 284   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   ++ ->       */
 285       "byte array entry preincrement" },
 286   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   ++ -->      */
 287       "word array entry preincrement" },
 288   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   ++ ..       */
 289       "individual property preincrement" },
 290   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   ++ .        */
 291       "common property preincrement" },
 292
 293   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   -- ->       */
 294       "byte array entry predecrement" },
 295   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   -- -->      */
 296       "word array entry predecrement" },
 297   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   -- ..       */
 298       "individual property predecrement" },
 299   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   -- .        */
 300       "common property predecrement" },
 301
 302   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      ->  ++   */
 303       "byte array entry postincrement" },
 304   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      --> ++   */
 305       "word array entry postincrement" },
 306   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      ..  ++   */
 307       "individual property postincrement" },
 308   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      .   ++   */
 309       "common property postincrement" },
 310
 311   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      ->  --   */
 312       "byte array entry postdecrement" },
 313   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      --> --   */
 314       "word array entry postdecrement" },
 315   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      ..  --   */
 316       "individual property postdecrement" },
 317   { 9,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*      .   --   */
 318       "common property postdecrement" },
 319
 320   {11,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   x.y(args)   */
 321       "call to common property" },
 322   {11,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0, /*   x..y(args)  */
 323       "call to individual property" },
 324
 325                          /* ------------------------ */
 326                          /*  And one Glulx-only op   */
 327                          /*  which just pushes its   */
 328                          /*  argument on the stack,  */
 329                          /*  unchanged.              */
 330                          /* ------------------------ */
 331
 332   {14,     -1, -1,              -1,   -1,  0, -1, -1, 1, 0,
 333       "push on stack" }
 334 };
 335
 336 /* --- Condition annotater ------------------------------------------------- */
 337
 338 static void annotate_for_conditions(int n, int a, int b)
 339 {   int i, opnum = ET[n].operator_number;
 340
 341     ET[n].label_after = -1;
 342     ET[n].to_expression = FALSE;
 343     ET[n].true_label = a;
 344     ET[n].false_label = b;
 345
 346     if (ET[n].down == -1) return;
 347
 348     if ((operators[opnum].precedence == 2)
 349         || (operators[opnum].precedence == 3))
 350     {   if ((a == -1) && (b == -1))
 351         {   if (opnum == LOGAND_OP)
 352             {   b = next_label++;
 353                 ET[n].false_label = b;
 354                 ET[n].to_expression = TRUE;
 355             }
 356             else
 357             {   a = next_label++;
 358                 ET[n].true_label = a;
 359                 ET[n].to_expression = TRUE;
 360             }
 361         }
 362     }
 363
 364     switch(opnum)
 365     {   case LOGAND_OP:
 366             if (b == -1)
 367             {   b = next_label++;
 368                 ET[n].false_label = b;
 369                 ET[n].label_after = b;
 370             }
 371             annotate_for_conditions(ET[n].down, -1, b);
 372             if (b == ET[n].label_after)
 373                  annotate_for_conditions(ET[ET[n].down].right, a, -1);
 374             else annotate_for_conditions(ET[ET[n].down].right, a, b);
 375             return;
 376         case LOGOR_OP:
 377             if (a == -1)
 378             {   a = next_label++;
 379                 ET[n].true_label = a;
 380                 ET[n].label_after = a;
 381             }
 382             annotate_for_conditions(ET[n].down, a, -1);
 383             if (a == ET[n].label_after)
 384                  annotate_for_conditions(ET[ET[n].down].right, -1, b);
 385             else annotate_for_conditions(ET[ET[n].down].right, a, b);
 386             return;
 387     }
 388
 389     i = ET[n].down;
 390     while (i != -1)
 391     {   annotate_for_conditions(i, -1, -1); i = ET[i].right; }
 392 }
 393
 394 /* --- Code generator ------------------------------------------------------ */
 395
 396 static void value_in_void_context_z(assembly_operand AO)
 397 {   char *t;
 398
 399     ASSERT_ZCODE();
 400
 401     switch(AO.type)
 402     {   case LONG_CONSTANT_OT:
 403         case SHORT_CONSTANT_OT:
 404             t = "<constant>";
 405             if (AO.marker == SYMBOL_MV)
 406                 t = (symbols[AO.value].name);
 407             break;
 408         case VARIABLE_OT:
 409             t = variable_name(AO.value);
 410             break;
 411         default:
 412             compiler_error("Unable to print value in void context");
 413             t = "<expression>";
 414             break;
 415     }
 416     vivc_flag = TRUE;
 417
 418     if (strcmp(t, "print_paddr") == 0)
 419     obsolete_warning("ignoring 'print_paddr': use 'print (string)' instead");
 420     else
 421     if (strcmp(t, "print_addr") == 0)
 422     obsolete_warning("ignoring 'print_addr': use 'print (address)' instead");
 423     else
 424     if (strcmp(t, "print_char") == 0)
 425     obsolete_warning("ignoring 'print_char': use 'print (char)' instead");
 426     else
 427     ebf_error("expression with side-effects", t);
 428 }
 429
 430 static void write_result_z(assembly_operand to, assembly_operand from)
 431 {   if (to.value == from.value) return;
 432     if (to.value == 0) assemblez_1(push_zc, from);
 433     else               assemblez_store(to, from);
 434 }
 435
 436 static void pop_zm_stack(void)
 437 {   assembly_operand st;
 438     if (version_number < 5) assemblez_0(pop_zc);
 439     else
 440     {   INITAOTV(&st, VARIABLE_OT, 0);
 441         assemblez_1_branch(jz_zc, st, -2, TRUE);
 442     }
 443 }
 444
 445 static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
 446     assembly_operand AO3)
 447 {   int vr = 0;
 448
 449     assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
 450         index_ao;
 451     int x = 0, y = 0, byte_flag = FALSE, read_flag = FALSE, from_module = FALSE;
 452
 453     INITAO(&zero_ao);
 454     INITAO(&size_ao);
 455     INITAO(&type_ao);
 456
 457     if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
 458     {
 459         if ((oc == loadb_zc) || (oc == storeb_zc)) byte_flag=TRUE;
 460         else byte_flag = FALSE;
 461         if ((oc == loadb_zc) || (oc == loadw_zc)) read_flag=TRUE;
 462         else read_flag = FALSE;
 463
 464         zero_ao.type = SHORT_CONSTANT_OT;
 465         zero_ao.value = 0;
 466
 467         size_ao = zero_ao; size_ao.value = -1;
 468         for (x=0; x<no_arrays; x++)
 469         {   if (((AO1.marker == ARRAY_MV) == (!arrays[x].loc))
 470                 && (AO1.value == symbols[arrays[x].symbol].value))
 471             {   size_ao.value = arrays[x].size; y=x;
 472             }
 473         }
 474
 475         if (arrays[y].loc && !read_flag) {
 476             error("Cannot write to a static array");
 477         }
 478
 479         if (size_ao.value==-1)
 480             from_module=TRUE;
 481         else {
 482             from_module=FALSE;
 483             type_ao = zero_ao; type_ao.value = arrays[y].type;
 484
 485             if ((!is_systemfile()))
 486             {   if (byte_flag)
 487                 {
 488                     if ((arrays[y].type == WORD_ARRAY)
 489                         || (arrays[y].type == TABLE_ARRAY))
 490                         warning("Using '->' to access a --> or table array");
 491                 }
 492                 else
 493                 {
 494                     if ((arrays[y].type == BYTE_ARRAY)
 495                         || (arrays[y].type == STRING_ARRAY))
 496                     warning("Using '-->' to access a -> or string array");
 497                 }
 498             }
 499         }
 500     }
 501
 502
 503     if ((!runtime_error_checking_switch) || (veneer_mode))
 504     {   if ((oc == loadb_zc) || (oc == loadw_zc))
 505             assemblez_2_to(oc, AO1, AO2, AO3);
 506         else
 507             assemblez_3(oc, AO1, AO2, AO3);
 508         return;
 509     }
 510
 511     /* If we recognise AO1 as arising textually from a declared
 512        array, we can check bounds explicitly. */
 513
 514     if ((AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV) && (!from_module))
 515     {
 516         int passed_label = next_label++, failed_label = next_label++,
 517             final_label = next_label++;
 518         /* Calculate the largest permitted array entry + 1
 519            Here "size_ao.value" = largest permitted entry of its own kind */
 520         max_ao = size_ao;
 521
 522         if (byte_flag
 523             && ((arrays[y].type == WORD_ARRAY)
 524                 || (arrays[y].type == TABLE_ARRAY)))
 525         {   max_ao.value = size_ao.value*2 + 1;
 526             type_ao.value += 8;
 527         }
 528         if ((!byte_flag)
 529             && ((arrays[y].type == BYTE_ARRAY)
 530                 || (arrays[y].type == STRING_ARRAY)
 531                 || (arrays[y].type == BUFFER_ARRAY)))
 532         {   if ((size_ao.value % 2) == 0)
 533                  max_ao.value = size_ao.value/2 - 1;
 534             else max_ao.value = (size_ao.value-1)/2;
 535             type_ao.value += 16;
 536         }
 537         max_ao.value++;
 538
 539         if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
 540         if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
 541
 542         /* Can't write to the size entry in a string or table */
 543         if (((arrays[y].type == STRING_ARRAY)
 544              || (arrays[y].type == TABLE_ARRAY))
 545             && (!read_flag))
 546         {   if ((arrays[y].type == TABLE_ARRAY) && byte_flag)
 547                 zero_ao.value = 2;
 548             else zero_ao.value = 1;
 549         }
 550
 551         en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
 552         switch(oc) { case loadb_zc:  en_ao.value = ABOUNDS_RTE; break;
 553                      case loadw_zc:  en_ao.value = ABOUNDS_RTE+1; break;
 554                      case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
 555                      case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
 556
 557         index_ao = AO2;
 558         if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
 559         {   assemblez_store(temp_var2, AO2);
 560             assemblez_store(AO2, temp_var2);
 561             index_ao = temp_var2;
 562         }
 563         assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
 564         assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
 565         assemble_label_no(failed_label);
 566         an_ao = zero_ao; an_ao.value = y;
 567         assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
 568             index_ao, size_ao, type_ao, an_ao);
 569
 570         /* We have to clear any of AO1, AO2, AO3 off the stack if
 571            present, so that we can achieve the same effect on the stack
 572            that executing the opcode would have had */
 573
 574         if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
 575         if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
 576         if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
 577         {   if ((oc == loadb_zc) || (oc == loadw_zc))
 578             {   assemblez_store(AO3, zero_ao);
 579             }
 580             else pop_zm_stack();
 581         }
 582         assemblez_jump(final_label);
 583
 584         assemble_label_no(passed_label);
 585         if ((oc == loadb_zc) || (oc == loadw_zc))
 586             assemblez_2_to(oc, AO1, AO2, AO3);
 587         else
 588             assemblez_3(oc, AO1, AO2, AO3);
 589         assemble_label_no(final_label);
 590         return;
 591     }
 592
 593     /* Otherwise, compile a call to the veneer which verifies that
 594        the proposed read/write is within dynamic Z-machine memory. */
 595
 596     switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
 597                  case loadw_zc: vr = RT__ChLDW_VR; break;
 598                  case storeb_zc: vr = RT__ChSTB_VR; break;
 599                  case storew_zc: vr = RT__ChSTW_VR; break;
 600                  default: compiler_error("unknown array opcode");
 601     }
 602
 603     if ((oc == loadb_zc) || (oc == loadw_zc))
 604         assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
 605     else
 606         assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
 607 }
 608
 609 static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
 610         int error_label, int rte_number)
 611 {   assembly_operand AO2, AO3;
 612     int check_sp = FALSE, passed_label, failed_label, last_label;
 613     if (veneer_mode) return AO1;
 614
 615     /*  Assemble to code to check that the operand AO1 is ofclass Object:
 616         if it is, execution should continue and the stack should be
 617         unchanged.  Otherwise, call the veneer's run-time-error routine
 618         with the given error number, and then: if the label isn't -1,
 619         switch execution to this label, with the value popped from
 620         the stack if it was on the stack in the first place;
 621         if the label is -1, either replace the top of the stack with
 622         the constant 2, or return the operand (short constant) 2.
 623
 624         The point of 2 is that object 2 is the class-object Object
 625         and therefore has no parent, child or sibling, so that the
 626         built-in tree functions will safely return 0 on this object. */
 627
 628     /*  Sometimes we can already see that the object number is valid. */
 629     if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
 630         && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
 631         return AO1;
 632
 633     passed_label = next_label++;
 634     failed_label = next_label++;
 635     INITAOTV(&AO2, LONG_CONSTANT_OT, actual_largest_object_SC);
 636     AO2.marker = INCON_MV;
 637     INITAOTV(&AO3, SHORT_CONSTANT_OT, 5);
 638
 639     if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
 640         || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
 641         || (rte_number == PROP_ADD_RTE))
 642     {   /* Allow classes */
 643         AO3.value = 1;
 644         if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
 645         {   /* That is, if AO1 is the stack pointer */
 646             check_sp = TRUE;
 647             assemblez_store(temp_var2, AO1);
 648             assemblez_store(AO1, temp_var2);
 649             assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
 650             assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
 651         }
 652         else
 653         {   assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
 654             assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
 655         }
 656     }
 657     else
 658     {   if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
 659         {   /* That is, if AO1 is the stack pointer */
 660             check_sp = TRUE;
 661             assemblez_store(temp_var2, AO1);
 662             assemblez_store(AO1, temp_var2);
 663             assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
 664             assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
 665             AO3.value = 1;
 666             assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
 667         }
 668         else
 669         {   assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
 670             assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
 671             AO3.value = 1;
 672             assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
 673         }
 674     }
 675
 676     assemble_label_no(failed_label);
 677     INITAOTV(&AO2, SHORT_CONSTANT_OT, rte_number);
 678     if (version_number >= 5)
 679       assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
 680     else
 681       assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
 682
 683     if (error_label != -1)
 684     {   /* Jump to the error label */
 685         if (error_label == -3) assemblez_0(rfalse_zc);
 686         else if (error_label == -4) assemblez_0(rtrue_zc);
 687         else assemblez_jump(error_label);
 688     }
 689     else
 690     {   if (check_sp)
 691         {   /* Push the short constant 2 */
 692             INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
 693             assemblez_store(AO1, AO2);
 694         }
 695         else
 696         {   /* Store either short constant 2 or the operand's value in
 697                the temporary variable */
 698             INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
 699             AO3 = temp_var2; assemblez_store(AO3, AO2);
 700             last_label = next_label++;
 701             assemblez_jump(last_label);
 702             assemble_label_no(passed_label);
 703             assemblez_store(AO3, AO1);
 704             assemble_label_no(last_label);
 705             return AO3;
 706         }
 707     }
 708     assemble_label_no(passed_label);
 709     return AO1;
 710 }
 711
 712 static void compile_conditional_z(int oc,
 713     assembly_operand AO1, assembly_operand AO2, int label, int flag)
 714 {   assembly_operand AO3; int the_zc, error_label = label,
 715     va_flag = FALSE, va_label = 0;
 716
 717     ASSERT_ZCODE();
 718
 719     switch (oc) {
 720     case test_attr_zc:
 721         check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
 722         check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
 723         break;
 724     case jin_zc:
 725         check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
 726         check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
 727         break;
 728     case 200:
 729         /* first argument can be anything */
 730         check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
 731         break;
 732     case 201:
 733         /* first argument can be anything */
 734         check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
 735         break;
 736     }
 737
 738     if (oc<200)
 739     {   if ((runtime_error_checking_switch) && (oc == jin_zc))
 740         {   if (flag) error_label = next_label++;
 741             AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
 742         }
 743         if ((runtime_error_checking_switch) && (oc == test_attr_zc))
 744         {   if (flag) error_label = next_label++;
 745             AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
 746             switch(AO2.type)
 747             {   case SHORT_CONSTANT_OT:
 748                 case LONG_CONSTANT_OT:
 749                     if (AO2.marker == 0)
 750                     {   if ((AO2.value < 0) || (AO2.value > 47))
 751                 error("'has'/'hasnt' applied to illegal attribute number");
 752                         break;
 753                     }
 754                 case VARIABLE_OT:
 755                 {   int pa_label = next_label++, fa_label = next_label++;
 756                     assembly_operand en_ao, zero_ao, max_ao;
 757                     assemblez_store(temp_var1, AO1);
 758                     if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
 759                         assemblez_store(AO1, temp_var1);
 760                     assemblez_store(temp_var2, AO2);
 761                     if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
 762                         assemblez_store(AO2, temp_var2);
 763                     INITAOT(&zero_ao, SHORT_CONSTANT_OT);
 764                     zero_ao.value = 0;
 765                     max_ao = zero_ao; max_ao.value = 48;
 766                     assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
 767                     assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
 768                     assemble_label_no(fa_label);
 769                     en_ao = zero_ao; en_ao.value = 19;
 770                     assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
 771                         en_ao, temp_var1, temp_var2);
 772                     va_flag = TRUE; va_label = next_label++;
 773                     assemblez_jump(va_label);
 774                     assemble_label_no(pa_label);
 775                 }
 776             }
 777         }
 778         assemblez_2_branch(oc, AO1, AO2, label, flag);
 779         if (error_label != label) assemble_label_no(error_label);
 780         if (va_flag) assemble_label_no(va_label);
 781         return;
 782     }
 783
 784     INITAOTV(&AO3, VARIABLE_OT, 0);
 785
 786     the_zc = (version_number == 3)?call_zc:call_vs_zc;
 787     if (oc == 201)
 788     assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
 789     else
 790     assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
 791
 792     assemblez_1_branch(jz_zc, AO3, label, !flag);
 793 }
 794
 795 static void value_in_void_context_g(assembly_operand AO)
 796 {   char *t;
 797
 798     ASSERT_GLULX();
 799
 800     switch(AO.type)
 801     {   case CONSTANT_OT:
 802         case HALFCONSTANT_OT:
 803         case BYTECONSTANT_OT:
 804         case ZEROCONSTANT_OT:
 805             t = "<constant>";
 806             if (AO.marker == SYMBOL_MV)
 807                 t = (symbols[AO.value].name);
 808             break;
 809         case GLOBALVAR_OT:
 810         case LOCALVAR_OT:
 811             t = variable_name(AO.value);
 812             break;
 813         default:
 814             compiler_error("Unable to print value in void context");
 815             t = "<expression>";
 816             break;
 817     }
 818     vivc_flag = TRUE;
 819
 820     ebf_error("expression with side-effects", t);
 821 }
 822
 823 static void write_result_g(assembly_operand to, assembly_operand from)
 824 {   if (to.value == from.value && to.type == from.type) return;
 825     assembleg_store(to, from);
 826 }
 827
 828 static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
 829     assembly_operand AO3)
 830 {   int vr = 0;
 831     int data_len, read_flag;
 832     assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
 833         index_ao, five_ao;
 834     int passed_label, failed_label, final_label, x = 0, y = 0;
 835
 836     if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
 837     else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
 838     else data_len = 4;
 839
 840     if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
 841       read_flag = TRUE;
 842     else
 843       read_flag = FALSE;
 844
 845     INITAO(&zero_ao);
 846     INITAO(&size_ao);
 847     INITAO(&type_ao);
 848
 849     if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
 850     {
 851         size_ao = zero_ao; size_ao.value = -1;
 852         for (x=0; x<no_arrays; x++)
 853         {   if (((AO1.marker == ARRAY_MV) == (!arrays[x].loc))
 854                 && (AO1.value == symbols[arrays[x].symbol].value))
 855             {   size_ao.value = arrays[x].size; y=x;
 856             }
 857         }
 858         if (size_ao.value==-1) compiler_error("Array size can't be found");
 859
 860         type_ao = zero_ao; type_ao.value = arrays[y].type;
 861
 862         if (arrays[y].loc && !read_flag) {
 863             error("Cannot write to a static array");
 864         }
 865
 866         if ((!is_systemfile()))
 867         {   if (data_len == 1)
 868             {
 869                 if ((arrays[y].type == WORD_ARRAY)
 870                     || (arrays[y].type == TABLE_ARRAY))
 871                     warning("Using '->' to access a --> or table array");
 872             }
 873             else
 874             {
 875                 if ((arrays[y].type == BYTE_ARRAY)
 876                     || (arrays[y].type == STRING_ARRAY))
 877                  warning("Using '-->' to access a -> or string array");
 878             }
 879         }
 880     }
 881
 882
 883     if ((!runtime_error_checking_switch) || (veneer_mode))
 884     {
 885         assembleg_3(oc, AO1, AO2, AO3);
 886         return;
 887     }
 888
 889     /* If we recognise AO1 as arising textually from a declared
 890        array, we can check bounds explicitly. */
 891
 892     if (AO1.marker == ARRAY_MV || AO1.marker == STATIC_ARRAY_MV)
 893     {
 894         /* Calculate the largest permitted array entry + 1
 895            Here "size_ao.value" = largest permitted entry of its own kind */
 896         max_ao = size_ao;
 897         if (data_len == 1
 898             && ((arrays[y].type == WORD_ARRAY)
 899                 || (arrays[y].type == TABLE_ARRAY)))
 900         {   max_ao.value = size_ao.value*4 + 3;
 901             type_ao.value += 8;
 902         }
 903         if (data_len == 4
 904             && ((arrays[y].type == BYTE_ARRAY)
 905                 || (arrays[y].type == STRING_ARRAY)
 906                 || (arrays[y].type == BUFFER_ARRAY)))
 907         {   max_ao.value = (size_ao.value-3)/4;
 908             type_ao.value += 16;
 909         }
 910         max_ao.value++;
 911
 912         /* Can't write to the size entry in a string or table */
 913         if (((arrays[y].type == STRING_ARRAY)
 914              || (arrays[y].type == TABLE_ARRAY))
 915             && (!read_flag))
 916         {   if ((arrays[y].type == TABLE_ARRAY) && data_len == 1)
 917                 zero_ao.value = 4;
 918             else zero_ao.value = 1;
 919         }
 920
 921         en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
 922
 923         switch(oc) { case aloadb_gc:  en_ao.value = ABOUNDS_RTE; break;
 924                      case aload_gc:  en_ao.value = ABOUNDS_RTE+1; break;
 925                      case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
 926                      case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
 927
 928         set_constant_ot(&zero_ao);
 929         set_constant_ot(&size_ao);
 930         set_constant_ot(&max_ao);
 931         set_constant_ot(&type_ao);
 932         set_constant_ot(&en_ao);
 933
 934         /* If we recognize A02 as a constant, we can do the test right
 935            now. */
 936         if (is_constant_ot(AO2.type) && AO2.marker == 0) {
 937             if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
 938               error("Array reference is out-of-bounds");
 939             }
 940             assembleg_3(oc, AO1, AO2, AO3);
 941             return;
 942         }
 943
 944         passed_label = next_label++;
 945         failed_label = next_label++;
 946         final_label = next_label++;
 947
 948         index_ao = AO2;
 949         if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
 950         {   assembleg_store(temp_var2, AO2); /* ### could peek */
 951             assembleg_store(AO2, temp_var2);
 952             index_ao = temp_var2;
 953         }
 954         assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
 955         assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
 956         assemble_label_no(failed_label);
 957
 958         an_ao = zero_ao; an_ao.value = y;
 959         set_constant_ot(&an_ao);
 960         five_ao = zero_ao; five_ao.value = 5;
 961         set_constant_ot(&five_ao);
 962
 963         /* Call the error veneer routine. */
 964         assembleg_store(stack_pointer, an_ao);
 965         assembleg_store(stack_pointer, type_ao);
 966         assembleg_store(stack_pointer, size_ao);
 967         assembleg_store(stack_pointer, index_ao);
 968         assembleg_store(stack_pointer, en_ao);
 969         assembleg_3(call_gc, veneer_routine(RT__Err_VR),
 970             five_ao, zero_operand);
 971
 972         /* We have to clear any of AO1, AO2, AO3 off the stack if
 973            present, so that we can achieve the same effect on the stack
 974            that executing the opcode would have had */
 975
 976         if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
 977             assembleg_2(copy_gc, stack_pointer, zero_operand);
 978         if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
 979             assembleg_2(copy_gc, stack_pointer, zero_operand);
 980         if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
 981         {   if ((oc == aloadb_gc) || (oc == aload_gc))
 982             {   assembleg_store(AO3, zero_ao);
 983             }
 984             else assembleg_2(copy_gc, stack_pointer, zero_operand);
 985         }
 986         assembleg_jump(final_label);
 987
 988         assemble_label_no(passed_label);
 989         assembleg_3(oc, AO1, AO2, AO3);
 990         assemble_label_no(final_label);
 991         return;
 992     }
 993
 994     /* Otherwise, compile a call to the veneer which verifies that
 995        the proposed read/write is within dynamic Z-machine memory. */
 996
 997     switch(oc) {
 998         case aloadb_gc: vr = RT__ChLDB_VR; break;
 999         case aload_gc: vr = RT__ChLDW_VR; break;
1000         case astoreb_gc: vr = RT__ChSTB_VR; break;
1001         case astore_gc: vr = RT__ChSTW_VR; break;
1002         default: compiler_error("unknown array opcode");
1003     }
1004
1005     if ((oc == aloadb_gc) || (oc == aload_gc))
1006       assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
1007     else
1008       assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
1009 }
1010
1011 static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
1012         int error_label, int rte_number)
1013 {
1014   assembly_operand AO, AO2, AO3;
1015   int ln;
1016   int check_sp = FALSE, passed_label, failed_label, last_label;
1017   int pre_unreach;
1018
1019   if (veneer_mode)
1020     return AO1;
1021
1022   /*  Assemble to code to check that the operand AO1 is ofclass Object:
1023       if it is, execution should continue and the stack should be
1024       unchanged.  Otherwise, call the veneer's run-time-error routine
1025       with the given error number, and then: if the label isn't -1,
1026       switch execution to this label, with the value popped from
1027       the stack if it was on the stack in the first place;
1028       if the label is -1, either replace the top of the stack with
1029       the constant symbol (class-object) Object.
1030
1031       The Object has no parent, child or sibling, so that the
1032       built-in tree functions will safely return 0 on this object. */
1033
1034   /*  Sometimes we can already see that the object number is valid. */
1035   if (AO1.marker == OBJECT_MV &&
1036     ((AO1.value >= 1) && (AO1.value <= no_objects))) {
1037     return AO1;
1038   }
1039
1040   pre_unreach = execution_never_reaches_here;
1041
1042   passed_label = next_label++;
1043   failed_label = next_label++;
1044
1045   if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
1046     /* That is, if AO1 is the stack pointer */
1047     check_sp = TRUE;
1048     assembleg_store(temp_var2, stack_pointer);
1049     assembleg_store(stack_pointer, temp_var2);
1050     AO = temp_var2;
1051   }
1052   else {
1053     AO = AO1;
1054   }
1055
1056   if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
1057     || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
1058     || (rte_number == PROP_ADD_RTE)) {
1059     /* Allow classes */
1060     /* Test if zero... */
1061     assembleg_1_branch(jz_gc, AO, failed_label);
1062     if (!pre_unreach && execution_never_reaches_here)
1063         execution_never_reaches_here |= EXECSTATE_NOWARN;
1064     /* Test if first byte is 0x70... */
1065     assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1066     INITAO(&AO3);
1067     AO3.value = 0x70; /* type byte -- object */
1068     set_constant_ot(&AO3);
1069     assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
1070   }
1071   else {
1072     /* Test if zero... */
1073     assembleg_1_branch(jz_gc, AO, failed_label);
1074     if (!pre_unreach && execution_never_reaches_here)
1075         execution_never_reaches_here |= EXECSTATE_NOWARN;
1076     /* Test if first byte is 0x70... */
1077     assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
1078     INITAO(&AO3);
1079     AO3.value = 0x70; /* type byte -- object */
1080     set_constant_ot(&AO3);
1081     assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
1082     /* Test if inside the "Class" object... */
1083     INITAOTV(&AO3, BYTECONSTANT_OT, GOBJFIELD_PARENT());
1084     assembleg_3(aload_gc, AO, AO3, stack_pointer);
1085     ln = symbol_index("Class", -1);
1086     AO3.value = symbols[ln].value;
1087     AO3.marker = OBJECT_MV;
1088     AO3.type = CONSTANT_OT;
1089     assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
1090   }
1091
1092   assemble_label_no(failed_label);
1093   INITAO(&AO2);
1094   AO2.value = rte_number;
1095   set_constant_ot(&AO2);
1096   assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
1097
1098   if (error_label != -1) {
1099     /* Jump to the error label */
1100     if (error_label == -3) assembleg_1(return_gc, zero_operand);
1101     else if (error_label == -4) assembleg_1(return_gc, one_operand);
1102     else assembleg_jump(error_label);
1103   }
1104   else {
1105     /* Build the symbol for "Object" */
1106     ln = symbol_index("Object", -1);
1107     AO2.value = symbols[ln].value;
1108     AO2.marker = OBJECT_MV;
1109     AO2.type = CONSTANT_OT;
1110     if (check_sp) {
1111       /* Push "Object" */
1112       assembleg_store(AO1, AO2);
1113     }
1114     else {
1115       /* Store either "Object" or the operand's value in the temporary
1116          variable. */
1117       assembleg_store(temp_var2, AO2);
1118       last_label = next_label++;
1119       assembleg_jump(last_label);
1120       assemble_label_no(passed_label);
1121       assembleg_store(temp_var2, AO1);
1122       assemble_label_no(last_label);
1123       return temp_var2;
1124     }
1125   }
1126
1127   assemble_label_no(passed_label);
1128   return AO1;
1129 }
1130
1131 static void compile_conditional_g(condclass *cc,
1132     assembly_operand AO1, assembly_operand AO2, int label, int flag)
1133 {   assembly_operand AO4;
1134     int the_zc, error_label = label,
1135     va_flag = FALSE, va_label = 0;
1136
1137     ASSERT_GLULX();
1138
1139     the_zc = (flag ? cc->posform : cc->negform);
1140
1141     if (the_zc == -1) {
1142       switch ((cc-condclasses)*2 + 500) {
1143
1144       case HAS_CC:
1145         check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
1146         check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
1147         if (runtime_error_checking_switch) {
1148           if (flag)
1149             error_label = next_label++;
1150           AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
1151           if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1152             if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
1153               error("'has'/'hasnt' applied to illegal attribute number");
1154             }
1155           }
1156           else {
1157             int pa_label = next_label++, fa_label = next_label++;
1158             assembly_operand en_ao, max_ao;
1159
1160             if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1161               if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1162                 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1163                 assembleg_2(stkpeek_gc, one_operand, temp_var2);
1164               }
1165               else {
1166                 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1167                 assembleg_store(temp_var2, AO2);
1168               }
1169             }
1170             else {
1171               assembleg_store(temp_var1, AO1);
1172               if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1173                 assembleg_2(stkpeek_gc, zero_operand, temp_var2);
1174               }
1175               else {
1176                 assembleg_store(temp_var2, AO2);
1177               }
1178             }
1179
1180             INITAO(&max_ao);
1181             max_ao.value = NUM_ATTR_BYTES*8;
1182             set_constant_ot(&max_ao);
1183             assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
1184             assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
1185             assemble_label_no(fa_label);
1186             INITAO(&en_ao);
1187             en_ao.value = 19; /* INVALIDATTR_RTE */
1188             set_constant_ot(&en_ao);
1189             assembleg_store(stack_pointer, temp_var2);
1190             assembleg_store(stack_pointer, temp_var1);
1191             assembleg_store(stack_pointer, en_ao);
1192             assembleg_3(call_gc, veneer_routine(RT__Err_VR),
1193               three_operand, zero_operand);
1194             va_flag = TRUE;
1195             va_label = next_label++;
1196             assembleg_jump(va_label);
1197             assemble_label_no(pa_label);
1198           }
1199         }
1200         if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1201           AO2.value += 8;
1202           set_constant_ot(&AO2);
1203         }
1204         else {
1205           INITAO(&AO4);
1206           AO4.value = 8;
1207           AO4.type = BYTECONSTANT_OT;
1208           if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1209             if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
1210               assembleg_0(stkswap_gc);
1211             assembleg_3(add_gc, AO2, AO4, stack_pointer);
1212             assembleg_0(stkswap_gc);
1213           }
1214           else {
1215             assembleg_3(add_gc, AO2, AO4, stack_pointer);
1216           }
1217           AO2 = stack_pointer;
1218         }
1219         assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
1220         the_zc = (flag ? jnz_gc : jz_gc);
1221         AO1 = stack_pointer;
1222         break;
1223
1224       case IN_CC:
1225         check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
1226         check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
1227         if (runtime_error_checking_switch) {
1228           if (flag)
1229             error_label = next_label++;
1230           AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
1231         }
1232         INITAO(&AO4);
1233         AO4.value = GOBJFIELD_PARENT();
1234         AO4.type = BYTECONSTANT_OT;
1235         assembleg_3(aload_gc, AO1, AO4, stack_pointer);
1236         AO1 = stack_pointer;
1237         the_zc = (flag ? jeq_gc : jne_gc);
1238         break;
1239
1240       case OFCLASS_CC:
1241         /* first argument can be anything */
1242         check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
1243         assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
1244         the_zc = (flag ? jnz_gc : jz_gc);
1245         AO1 = stack_pointer;
1246         break;
1247
1248       case PROVIDES_CC:
1249         /* first argument can be anything */
1250         check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
1251         assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
1252         the_zc = (flag ? jnz_gc : jz_gc);
1253         AO1 = stack_pointer;
1254         break;
1255
1256       default:
1257         error("condition not yet supported in Glulx");
1258         return;
1259       }
1260     }
1261
1262     if (the_zc == jnz_gc || the_zc == jz_gc)
1263       assembleg_1_branch(the_zc, AO1, label);
1264     else
1265       assembleg_2_branch(the_zc, AO1, AO2, label);
1266     if (error_label != label) assemble_label_no(error_label);
1267     if (va_flag) assemble_label_no(va_label);
1268 }
1269
1270 static void value_in_void_context(assembly_operand AO)
1271 {
1272   if (!glulx_mode)
1273     value_in_void_context_z(AO);
1274   else
1275     value_in_void_context_g(AO);
1276 }
1277
1278
1279 extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
1280   int error_label, int rte_number)
1281 {
1282   if (!glulx_mode)
1283     return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
1284   else
1285     return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
1286 }
1287
1288 static void generate_code_from(int n, int void_flag)
1289 {
1290     /*  When void, this must not leave anything on the stack. */
1291
1292     int i, j, below, above, opnum, arity; assembly_operand Result;
1293
1294     below = ET[n].down; above = ET[n].up;
1295     if (below == -1)
1296     {   if ((void_flag) && (ET[n].value.type != OMITTED_OT))
1297             value_in_void_context(ET[n].value);
1298         return;
1299     }
1300
1301     opnum = ET[n].operator_number;
1302
1303     if (opnum == COMMA_OP)
1304     {   generate_code_from(below, TRUE);
1305         generate_code_from(ET[below].right, void_flag);
1306         ET[n].value = ET[ET[below].right].value;
1307         goto OperatorGenerated;
1308     }
1309
1310     if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
1311     {   generate_code_from(below, FALSE);
1312         if (execution_never_reaches_here) {
1313             /* If the condition never falls through to here, then it
1314                was an "... && 0 && ..." test. Our convention is to skip
1315                the "not reached" warnings for this case. */
1316             execution_never_reaches_here |= EXECSTATE_NOWARN;
1317         }
1318         generate_code_from(ET[below].right, FALSE);
1319         goto OperatorGenerated;
1320     }
1321
1322     if (opnum == -1)
1323     {
1324         /*  Signifies a SETEQUALS_OP which has already been done */
1325
1326         ET[n].down = -1; return;
1327     }
1328
1329     /*  Note that (except in the cases of comma and logical and/or) it
1330         is essential to code generate the operands right to left, because
1331         of the peculiar way the Z-machine's stack works:
1332
1333             @sub sp sp -> a;
1334
1335         (for instance) pulls to the first operand, then the second.  So
1336
1337             @mul a 2 -> sp;
1338             @add b 7 -> sp;
1339             @sub sp sp -> a;
1340
1341         calculates (b+7)-(a*2), not the other way around (as would be more
1342         usual in stack machines evaluating expressions written in reverse
1343         Polish notation).  (Basically this is because the Z-machine was
1344         designed to implement a LISP-like language naturally expressed
1345         in forward Polish notation: (PLUS 3 4), for instance.)               */
1346
1347     /*  And the Glulx machine follows the Z-machine in this respect. */
1348
1349     i=below; arity = 0;
1350     while (i != -1)
1351     {   i = ET[i].right; arity++;
1352     }
1353     for (j=arity;j>0;j--)
1354     {   int k = 1;
1355         i = below;
1356         while (k<j)
1357         {   k++; i = ET[i].right;
1358         }
1359         generate_code_from(i, FALSE);
1360     }
1361
1362
1363     /*  Check this again, because code generation lower down may have
1364         stubbed it into -1  */
1365
1366     if (ET[n].operator_number == -1)
1367     {   ET[n].down = -1; return;
1368     }
1369
1370   if (!glulx_mode) {
1371
1372     if (operators[opnum].opcode_number_z >= 400)
1373     {
1374         /*  Conditional terms such as '==': */
1375
1376         int a = ET[n].true_label, b = ET[n].false_label,
1377             branch_away, branch_other,
1378             make_jump_away = FALSE, make_branch_label = FALSE;
1379         int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
1380
1381         if (oc >= 400) { oc = oc - 400; flag = FALSE; }
1382
1383         if ((oc == je_zc) && (arity == 2))
1384         {   i = ET[ET[n].down].right;
1385             if ((ET[i].value.value == zero_operand.value)
1386                 && (ET[i].value.type == zero_operand.type))
1387                 oc = jz_zc;
1388         }
1389
1390         /*  If the condition has truth state flag, branch to
1391             label a, and if not, to label b.  Possibly one of a, b
1392             equals -1, meaning "continue from this instruction".
1393
1394             branch_away is the label which is a branch away (the one
1395             which isn't immediately after) and flag is the truth
1396             state to branch there.
1397
1398             Note that when multiple instructions are needed (because
1399             of the use of the 'or' operator) the branch_other label
1400             is created if need be.
1401         */
1402
1403         /*  Reduce to the case where the branch_away label does exist:  */
1404
1405         if (a == -1) { a = b; b = -1; flag = !flag; }
1406
1407         branch_away = a; branch_other = b;
1408         if (branch_other != -1) make_jump_away = TRUE;
1409
1410         if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
1411         {
1412             /*  In this case, we have an 'or' situation where multiple
1413                 instructions are needed and where the overall condition
1414                 is negated.  That is, we have, e.g.
1415
1416                    if not (A cond B or C or D) then branch_away
1417
1418                 which we transform into
1419
1420                    if (A cond B) then branch_other
1421                    if (A cond C) then branch_other
1422                    if not (A cond D) then branch_away
1423                   .branch_other                                          */
1424
1425             if (branch_other == -1)
1426             {   branch_other = next_label++; make_branch_label = TRUE;
1427             }
1428         }
1429
1430         if (oc == jz_zc)
1431             assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
1432         else
1433         {   assembly_operand left_operand;
1434
1435             if (arity == 2)
1436                 compile_conditional_z(oc, ET[below].value,
1437                     ET[ET[below].right].value, branch_away, flag);
1438             else
1439             {   /*  The case of a condition using "or".
1440                     First: if the condition tests the stack pointer,
1441                     and it can't always be done in a single test, move
1442                     the value off the stack and into temporary variable
1443                     storage.  */
1444
1445                 if (((ET[below].value.type == VARIABLE_OT)
1446                      && (ET[below].value.value == 0))
1447                     && ((oc != je_zc) || (arity>4)) )
1448                 {   INITAOTV(&left_operand, VARIABLE_OT, 255);
1449                     assemblez_store(left_operand, ET[below].value);
1450                 }
1451                 else left_operand = ET[below].value;
1452                 i = ET[below].right; arity--;
1453
1454                 /*  "left_operand" now holds the quantity to be tested;
1455                     "i" holds the right operand reached so far;
1456                     "arity" the number of right operands.  */
1457
1458                 while (i != -1)
1459                 {   if ((oc == je_zc) && (arity>1))
1460                     {
1461                         /*  je_zc is an especially good case since the
1462                             Z-machine implements "or" for up to three
1463                             right operands automatically, though it's an
1464                             especially bad case to generate code for!  */
1465
1466                         if (arity == 2)
1467                         {   assemblez_3_branch(je_zc,
1468                               left_operand, ET[i].value,
1469                               ET[ET[i].right].value, branch_away, flag);
1470                             i = ET[i].right; arity--;
1471                         }
1472                         else
1473                         {   if ((arity == 3) || flag)
1474                               assemblez_4_branch(je_zc, left_operand,
1475                                 ET[i].value,
1476                                 ET[ET[i].right].value,
1477                                 ET[ET[ET[i].right].right].value,
1478                                 branch_away, flag);
1479                             else
1480                               assemblez_4_branch(je_zc, left_operand,
1481                                 ET[i].value,
1482                                 ET[ET[i].right].value,
1483                                 ET[ET[ET[i].right].right].value,
1484                                 branch_other, !flag);
1485                             i = ET[ET[i].right].right; arity -= 2;
1486                         }
1487                     }
1488                     else
1489                     {   /*  Otherwise we can compare the left_operand with
1490                             only one right operand at the time.  There are
1491                             two cases: it's the last right operand, or it
1492                             isn't.  */
1493
1494                         if ((arity == 1) || flag)
1495                             compile_conditional_z(oc, left_operand,
1496                                 ET[i].value, branch_away, flag);
1497                         else
1498                             compile_conditional_z(oc, left_operand,
1499                                 ET[i].value, branch_other, !flag);
1500                     }
1501                     i = ET[i].right; arity--;
1502                 }
1503
1504             }
1505         }
1506
1507         /*  NB: These two conditions cannot both occur, fortunately!  */
1508
1509         if (make_branch_label) assemble_label_no(branch_other);
1510         if (make_jump_away) assemblez_jump(branch_other);
1511
1512         goto OperatorGenerated;
1513     }
1514
1515   }
1516   else {
1517     if (operators[opnum].opcode_number_g >= FIRST_CC
1518       && operators[opnum].opcode_number_g <= LAST_CC) {
1519       /*  Conditional terms such as '==': */
1520
1521       int a = ET[n].true_label, b = ET[n].false_label;
1522       int branch_away, branch_other, flag,
1523         make_jump_away = FALSE, make_branch_label = FALSE;
1524       int ccode = operators[opnum].opcode_number_g;
1525       condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
1526       flag = (ccode & 1) ? 0 : 1;
1527
1528       /*  If the comparison is "equal to (constant) 0", change it
1529           to the simple "zero" test. Unfortunately, this doesn't
1530           work for the commutative form "(constant) 0 is equal to".
1531           At least I don't think it does. */
1532
1533       if ((cc == &condclasses[1]) && (arity == 2)) {
1534         i = ET[ET[n].down].right;
1535         if ((ET[i].value.value == 0)
1536           && (ET[i].value.marker == 0)
1537           && is_constant_ot(ET[i].value.type)) {
1538           cc = &condclasses[0];
1539         }
1540       }
1541
1542       /*  If the condition has truth state flag, branch to
1543           label a, and if not, to label b.  Possibly one of a, b
1544           equals -1, meaning "continue from this instruction".
1545
1546           branch_away is the label which is a branch away (the one
1547           which isn't immediately after) and flag is the truth
1548           state to branch there.
1549
1550           Note that when multiple instructions are needed (because
1551           of the use of the 'or' operator) the branch_other label
1552           is created if need be.
1553       */
1554
1555       /*  Reduce to the case where the branch_away label does exist:  */
1556
1557       if (a == -1) { a = b; b = -1; flag = !flag; }
1558
1559       branch_away = a; branch_other = b;
1560       if (branch_other != -1) make_jump_away = TRUE;
1561
1562       if ((arity > 2) && (flag == FALSE)) {
1563         /*  In this case, we have an 'or' situation where multiple
1564             instructions are needed and where the overall condition
1565             is negated.  That is, we have, e.g.
1566
1567             if not (A cond B or C or D) then branch_away
1568
1569             which we transform into
1570
1571             if (A cond B) then branch_other
1572             if (A cond C) then branch_other
1573             if not (A cond D) then branch_away
1574             .branch_other                                          */
1575
1576         if (branch_other == -1) {
1577           branch_other = next_label++; make_branch_label = TRUE;
1578         }
1579       }
1580
1581       if (cc == &condclasses[0]) {
1582         assembleg_1_branch((flag ? cc->posform : cc->negform),
1583           ET[below].value, branch_away);
1584       }
1585       else {
1586         if (arity == 2) {
1587           compile_conditional_g(cc, ET[below].value,
1588             ET[ET[below].right].value, branch_away, flag);
1589         }
1590         else {
1591           /*  The case of a condition using "or".
1592               First: if the condition tests the stack pointer,
1593               and it can't always be done in a single test, move
1594               the value off the stack and into temporary variable
1595               storage.  */
1596
1597           assembly_operand left_operand;
1598           if (((ET[below].value.type == LOCALVAR_OT)
1599             && (ET[below].value.value == 0))) {
1600             assembleg_store(temp_var1, ET[below].value);
1601             left_operand = temp_var1;
1602           }
1603           else {
1604             left_operand = ET[below].value;
1605           }
1606           i = ET[below].right;
1607           arity--;
1608
1609           /*  "left_operand" now holds the quantity to be tested;
1610               "i" holds the right operand reached so far;
1611               "arity" the number of right operands.  */
1612
1613           while (i != -1) {
1614             /*  We can compare the left_operand with
1615             only one right operand at the time.  There are
1616             two cases: it's the last right operand, or it
1617             isn't.  */
1618
1619             if ((arity == 1) || flag)
1620               compile_conditional_g(cc, left_operand,
1621             ET[i].value, branch_away, flag);
1622             else
1623               compile_conditional_g(cc, left_operand,
1624             ET[i].value, branch_other, !flag);
1625
1626             i = ET[i].right;
1627             arity--;
1628           }
1629         }
1630       }
1631
1632       /*  NB: These two conditions cannot both occur, fortunately!  */
1633
1634       if (make_branch_label) assemble_label_no(branch_other);
1635       if (make_jump_away) assembleg_jump(branch_other);
1636
1637       goto OperatorGenerated;
1638     }
1639
1640   }
1641
1642     /*  The operator is now definitely one which produces a value  */
1643
1644     if (void_flag && (!(operators[opnum].side_effect)))
1645         error_named("Evaluating this has no effect:",
1646             operators[opnum].description);
1647
1648     /*  Where shall we put the resulting value? (In Glulx, this could
1649         be smarter, and peg the result into ZEROCONSTANT.) */
1650
1651     if (void_flag) Result = temp_var1;  /*  Throw it away  */
1652     else
1653     {   if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
1654         {
1655             /*  If the node above is "set variable equal to", then
1656                 make that variable the place to put the result, and
1657                 delete the SETEQUALS_OP node since its effect has already
1658                 been accomplished.  */
1659
1660             ET[above].operator_number = -1;
1661             Result = ET[ET[above].down].value;
1662             ET[above].value = Result;
1663         }
1664         else Result = stack_pointer;  /*  Otherwise, put it on the stack  */
1665     }
1666
1667   if (!glulx_mode) {
1668
1669     if (operators[opnum].opcode_number_z != -1)
1670     {
1671         /*  Operators directly translatable into Z-code opcodes: infix ops
1672             take two operands whereas pre/postfix operators take only one */
1673
1674         if (operators[opnum].usage == IN_U)
1675         {   int o_n = operators[opnum].opcode_number_z;
1676             if (runtime_error_checking_switch && (!veneer_mode)
1677                 && ((o_n == div_zc) || (o_n == mod_zc)))
1678             {   assembly_operand by_ao, error_ao; int ln;
1679                 by_ao = ET[ET[below].right].value;
1680                 if ((by_ao.value != 0) && (by_ao.marker == 0)
1681                     && ((by_ao.type == SHORT_CONSTANT_OT)
1682                         || (by_ao.type == LONG_CONSTANT_OT)))
1683                     assemblez_2_to(o_n, ET[below].value,
1684                         by_ao, Result);
1685                 else
1686                 {
1687                     assemblez_store(temp_var1, ET[below].value);
1688                     assemblez_store(temp_var2, by_ao);
1689                     ln = next_label++;
1690                     assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
1691                     INITAOT(&error_ao, SHORT_CONSTANT_OT);
1692                     error_ao.value = DBYZERO_RTE;
1693                     assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
1694                         error_ao);
1695                     assemblez_inc(temp_var2);
1696                     assemble_label_no(ln);
1697                     assemblez_2_to(o_n, temp_var1, temp_var2, Result);
1698                 }
1699             }
1700             else {
1701             assemblez_2_to(o_n, ET[below].value,
1702                 ET[ET[below].right].value, Result);
1703             }
1704         }
1705         else
1706             assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
1707                 Result);
1708     }
1709     else
1710     switch(opnum)
1711     {   case ARROW_OP:
1712              access_memory_z(loadb_zc, ET[below].value,
1713                                      ET[ET[below].right].value, Result);
1714              break;
1715         case DARROW_OP:
1716              access_memory_z(loadw_zc, ET[below].value,
1717                                      ET[ET[below].right].value, Result);
1718              break;
1719         case UNARY_MINUS_OP:
1720              assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
1721              break;
1722         case ARTNOT_OP:
1723              assemblez_1_to(not_zc, ET[below].value, Result);
1724              break;
1725
1726         case PROP_ADD_OP:
1727              {   assembly_operand AO = ET[below].value;
1728                  check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1729                  check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1730                  if (runtime_error_checking_switch && (!veneer_mode))
1731                      AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
1732                  assemblez_2_to(get_prop_addr_zc, AO,
1733                      ET[ET[below].right].value, temp_var1);
1734                  if (!void_flag) write_result_z(Result, temp_var1);
1735              }
1736              break;
1737
1738         case PROP_NUM_OP:
1739              {   assembly_operand AO = ET[below].value;
1740                  check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1741                  check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1742                  if (runtime_error_checking_switch && (!veneer_mode))
1743                      AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
1744                  assemblez_2_to(get_prop_addr_zc, AO,
1745                      ET[ET[below].right].value, temp_var1);
1746                  assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
1747                  assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
1748                  assemble_label_no(next_label-1);
1749                  if (!void_flag) write_result_z(Result, temp_var1);
1750              }
1751              break;
1752
1753         case PROPERTY_OP:
1754              {
1755                  check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1756                  check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1757                  if (runtime_error_checking_switch && (!veneer_mode))
1758                        assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
1759                          ET[below].value, ET[ET[below].right].value, temp_var1);
1760                  else
1761                  assemblez_2_to(get_prop_zc, ET[below].value,
1762                      ET[ET[below].right].value, temp_var1);
1763                  if (!void_flag) write_result_z(Result, temp_var1);
1764              }
1765              break;
1766
1767         case MESSAGE_OP:
1768              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1769              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1770              j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
1771              goto GenFunctionCallZ;
1772         case MPROP_ADD_OP:
1773              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1774              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1775              j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
1776              goto GenFunctionCallZ;
1777         case MPROP_NUM_OP:
1778              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1779              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1780              j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
1781              goto GenFunctionCallZ;
1782         case MESSAGE_SETEQUALS_OP:
1783              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1784              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1785              j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
1786              goto GenFunctionCallZ;
1787         case MESSAGE_INC_OP:
1788              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
1789              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
1790              j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
1791              goto GenFunctionCallZ;
1792         case MESSAGE_DEC_OP:
1793              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
1794              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
1795              j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
1796              goto GenFunctionCallZ;
1797         case MESSAGE_POST_INC_OP:
1798              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
1799              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
1800              j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
1801              goto GenFunctionCallZ;
1802         case MESSAGE_POST_DEC_OP:
1803              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
1804              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
1805              j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
1806              goto GenFunctionCallZ;
1807         case SUPERCLASS_OP:
1808              j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
1809              goto GenFunctionCallZ;
1810         case PROP_CALL_OP:
1811              check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1812              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1813              j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1814              goto GenFunctionCallZ;
1815         case MESSAGE_CALL_OP:
1816              check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1817              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1818              j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1819              goto GenFunctionCallZ;
1820
1821
1822         case FCALL_OP:
1823              j = 0;
1824
1825              if ((ET[below].value.type == VARIABLE_OT)
1826                  && (ET[below].value.value >= 256))
1827              {   int sf_number = ET[below].value.value - 256;
1828
1829                  i = ET[below].right;
1830                  if (i == -1)
1831                  {   error("Argument to system function missing");
1832                      AI.operand[0] = one_operand;
1833                      AI.operand_count = 1;
1834                  }
1835                  else
1836                  {   j=0;
1837                      while (i != -1) { j++; i = ET[i].right; }
1838
1839                      if (((sf_number != INDIRECT_SYSF) &&
1840                          (sf_number != RANDOM_SYSF) && (j > 1))
1841                          || ((sf_number == INDIRECT_SYSF) && (j>7)))
1842                      {   j=1;
1843                          error("System function given with too many arguments");
1844                      }
1845                      if (sf_number != RANDOM_SYSF)
1846                      {   int jcount;
1847                          i = ET[below].right;
1848                          for (jcount = 0; jcount < j; jcount++)
1849                          {   AI.operand[jcount] = ET[i].value;
1850                              i = ET[i].right;
1851                          }
1852                          AI.operand_count = j;
1853                      }
1854                  }
1855                  AI.store_variable_number = Result.value;
1856                  AI.branch_label_number = -1;
1857
1858                  switch(sf_number)
1859                  {   case RANDOM_SYSF:
1860                          if (j>1)
1861                          {  assembly_operand AO, AO2; int arg_c, arg_et;
1862                             INITAOTV(&AO, SHORT_CONSTANT_OT, j);
1863                             INITAOT(&AO2, LONG_CONSTANT_OT);
1864                             AO2.value = begin_word_array();
1865                             AO2.marker = ARRAY_MV;
1866
1867                             for (arg_c=0, arg_et = ET[below].right;arg_c<j;
1868                                  arg_c++, arg_et = ET[arg_et].right)
1869                             {   if (ET[arg_et].value.type == VARIABLE_OT)
1870               error("Only constants can be used as possible 'random' results");
1871                                 array_entry(arg_c, FALSE, ET[arg_et].value);
1872                             }
1873                             finish_array(arg_c, FALSE);
1874
1875                             assemblez_1_to(random_zc, AO, temp_var1);
1876                             assemblez_dec(temp_var1);
1877                             assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
1878                          }
1879                          else
1880                          assemblez_1_to(random_zc,
1881                              ET[ET[below].right].value, Result);
1882                          break;
1883
1884                      case PARENT_SYSF:
1885                          {  assembly_operand AO;
1886                             AO = ET[ET[below].right].value;
1887                             if (runtime_error_checking_switch)
1888                                 AO = check_nonzero_at_runtime(AO, -1,
1889                                     PARENT_RTE);
1890                             assemblez_1_to(get_parent_zc, AO, Result);
1891                          }
1892                          break;
1893
1894                      case ELDEST_SYSF:
1895                      case CHILD_SYSF:
1896                          {  assembly_operand AO;
1897                             AO = ET[ET[below].right].value;
1898                             if (runtime_error_checking_switch)
1899                                AO = check_nonzero_at_runtime(AO, -1,
1900                                (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
1901                             assemblez_objcode(get_child_zc,
1902                                AO, Result, -2, TRUE);
1903                          }
1904                          break;
1905
1906                      case YOUNGER_SYSF:
1907                      case SIBLING_SYSF:
1908                          {  assembly_operand AO;
1909                             AO = ET[ET[below].right].value;
1910                             if (runtime_error_checking_switch)
1911                                AO = check_nonzero_at_runtime(AO, -1,
1912                                (sf_number==SIBLING_SYSF)
1913                                    ?SIBLING_RTE:YOUNGER_RTE);
1914                             assemblez_objcode(get_sibling_zc,
1915                                AO, Result, -2, TRUE);
1916                          }
1917                          break;
1918
1919                      case INDIRECT_SYSF:
1920                          j=0; i = ET[below].right;
1921                          check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
1922                          goto IndirectFunctionCallZ;
1923
1924                      case CHILDREN_SYSF:
1925                          {  assembly_operand AO;
1926                              AO = ET[ET[below].right].value;
1927                              if (runtime_error_checking_switch)
1928                                  AO = check_nonzero_at_runtime(AO, -1,
1929                                      CHILDREN_RTE);
1930                              assemblez_store(temp_var1, zero_operand);
1931                              assemblez_objcode(get_child_zc,
1932                                  AO, stack_pointer, next_label+1, FALSE);
1933                              assemble_label_no(next_label);
1934                              assemblez_inc(temp_var1);
1935                              assemblez_objcode(get_sibling_zc,
1936                                  stack_pointer, stack_pointer,
1937                                  next_label, TRUE);
1938                              assemble_label_no(next_label+1);
1939                              assemblez_store(temp_var2, stack_pointer);
1940                              if (!void_flag) write_result_z(Result, temp_var1);
1941                              next_label += 2;
1942                          }
1943                          break;
1944
1945                      case YOUNGEST_SYSF:
1946                          {  assembly_operand AO;
1947                              AO = ET[ET[below].right].value;
1948                              if (runtime_error_checking_switch)
1949                                  AO = check_nonzero_at_runtime(AO, -1,
1950                                      YOUNGEST_RTE);
1951                              assemblez_objcode(get_child_zc,
1952                                  AO, temp_var1, next_label+1, FALSE);
1953                              assemblez_1(push_zc, temp_var1);
1954                              assemble_label_no(next_label);
1955                              assemblez_store(temp_var1, stack_pointer);
1956                              assemblez_objcode(get_sibling_zc,
1957                                  temp_var1, stack_pointer, next_label, TRUE);
1958                              assemble_label_no(next_label+1);
1959                              if (!void_flag) write_result_z(Result, temp_var1);
1960                              next_label += 2;
1961                          }
1962                          break;
1963
1964                      case ELDER_SYSF:
1965                          assemblez_store(temp_var1, ET[ET[below].right].value);
1966                          if (runtime_error_checking_switch)
1967                              check_nonzero_at_runtime(temp_var1, -1,
1968                                  ELDER_RTE);
1969                          assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
1970                          assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
1971                          assemblez_store(temp_var2, temp_var3);
1972                          assemblez_store(temp_var3, zero_operand);
1973                          assemblez_objcode(get_child_zc,
1974                              temp_var2, temp_var2, next_label, TRUE);
1975                          assemble_label_no(next_label++);
1976                          assemblez_2_branch(je_zc, temp_var1, temp_var2,
1977                              next_label, TRUE);
1978                          assemblez_store(temp_var3, temp_var2);
1979                          assemblez_objcode(get_sibling_zc,
1980                              temp_var2, temp_var2, next_label - 1, TRUE);
1981                          assemble_label_no(next_label++);
1982                          if (!void_flag) write_result_z(Result, temp_var3);
1983                          break;
1984
1985                      case METACLASS_SYSF:
1986                          assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
1987                              veneer_routine(Metaclass_VR),
1988                              ET[ET[below].right].value, Result);
1989                          break;
1990
1991                      case GLK_SYSF:
1992                          error("The glk() system function does not exist in Z-code");
1993                          break;
1994                  }
1995                  break;
1996              }
1997              check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
1998
1999              GenFunctionCallZ:
2000
2001              i = below;
2002
2003              IndirectFunctionCallZ:
2004
2005              while ((i != -1) && (j<8))
2006              {   AI.operand[j++] = ET[i].value;
2007                  i = ET[i].right;
2008              }
2009
2010              if ((j > 4) && (version_number == 3))
2011              {   error("A function may be called with at most 3 arguments");
2012                  j = 4;
2013              }
2014              if ((j==8) && (i != -1))
2015              {   error("A function may be called with at most 7 arguments");
2016              }
2017
2018              AI.operand_count = j;
2019
2020              if ((void_flag) && (version_number >= 5))
2021              {   AI.store_variable_number = -1;
2022                  switch(j)
2023                  {   case 1: AI.internal_number = call_1n_zc; break;
2024                      case 2: AI.internal_number = call_2n_zc; break;
2025                      case 3: case 4: AI.internal_number = call_vn_zc; break;
2026                      case 5: case 6: case 7: case 8:
2027                          AI.internal_number = call_vn2_zc; break;
2028                  }
2029              }
2030              else
2031              {   AI.store_variable_number = Result.value;
2032                  if (version_number == 3)
2033                      AI.internal_number = call_zc;
2034                  else
2035                  switch(j)
2036                  {   case 1: AI.internal_number = call_1s_zc; break;
2037                      case 2: AI.internal_number = call_2s_zc; break;
2038                      case 3: case 4: AI.internal_number = call_vs_zc; break;
2039                      case 5: case 6: case 7: case 8:
2040                          AI.internal_number = call_vs2_zc; break;
2041                  }
2042              }
2043
2044              AI.branch_label_number = -1;
2045              assemblez_instruction(&AI);
2046              break;
2047
2048         case SETEQUALS_OP:
2049              assemblez_store(ET[below].value,
2050                  ET[ET[below].right].value);
2051              if (!void_flag) write_result_z(Result, ET[below].value);
2052              break;
2053
2054         case PROPERTY_SETEQUALS_OP:
2055              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2056              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2057              if (!void_flag)
2058              {   if (runtime_error_checking_switch)
2059                      assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
2060                          ET[below].value, ET[ET[below].right].value,
2061                          ET[ET[ET[below].right].right].value, Result);
2062                  else
2063                  {   assemblez_store(temp_var1,
2064                          ET[ET[ET[below].right].right].value);
2065                      assemblez_3(put_prop_zc, ET[below].value,
2066                          ET[ET[below].right].value,
2067                          temp_var1);
2068                      write_result_z(Result, temp_var1);
2069                  }
2070              }
2071              else
2072              {   if (runtime_error_checking_switch && (!veneer_mode))
2073                      assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2074                          ET[below].value, ET[ET[below].right].value,
2075                          ET[ET[ET[below].right].right].value);
2076                  else assemblez_3(put_prop_zc, ET[below].value,
2077                      ET[ET[below].right].value,
2078                      ET[ET[ET[below].right].right].value);
2079              }
2080              break;
2081         case ARROW_SETEQUALS_OP:
2082              if (!void_flag)
2083              {   assemblez_store(temp_var1,
2084                      ET[ET[ET[below].right].right].value);
2085                  access_memory_z(storeb_zc, ET[below].value,
2086                      ET[ET[below].right].value,
2087                      temp_var1);
2088                  write_result_z(Result, temp_var1);
2089              }
2090              else access_memory_z(storeb_zc, ET[below].value,
2091                      ET[ET[below].right].value,
2092                      ET[ET[ET[below].right].right].value);
2093              break;
2094
2095         case DARROW_SETEQUALS_OP:
2096              if (!void_flag)
2097              {   assemblez_store(temp_var1,
2098                      ET[ET[ET[below].right].right].value);
2099                  access_memory_z(storew_zc, ET[below].value,
2100                      ET[ET[below].right].value,
2101                      temp_var1);
2102                  write_result_z(Result, temp_var1);
2103              }
2104              else
2105                  access_memory_z(storew_zc, ET[below].value,
2106                      ET[ET[below].right].value,
2107                      ET[ET[ET[below].right].right].value);
2108              break;
2109
2110         case INC_OP:
2111              assemblez_inc(ET[below].value);
2112              if (!void_flag) write_result_z(Result, ET[below].value);
2113              break;
2114         case DEC_OP:
2115              assemblez_dec(ET[below].value);
2116              if (!void_flag) write_result_z(Result, ET[below].value);
2117              break;
2118         case POST_INC_OP:
2119              if (!void_flag) write_result_z(Result, ET[below].value);
2120              assemblez_inc(ET[below].value);
2121              break;
2122         case POST_DEC_OP:
2123              if (!void_flag) write_result_z(Result, ET[below].value);
2124              assemblez_dec(ET[below].value);
2125              break;
2126
2127         case ARROW_INC_OP:
2128              assemblez_store(temp_var1, ET[below].value);
2129              assemblez_store(temp_var2, ET[ET[below].right].value);
2130              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2131              assemblez_inc(temp_var3);
2132              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2133              if (!void_flag) write_result_z(Result, temp_var3);
2134              break;
2135
2136         case ARROW_DEC_OP:
2137              assemblez_store(temp_var1, ET[below].value);
2138              assemblez_store(temp_var2, ET[ET[below].right].value);
2139              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2140              assemblez_dec(temp_var3);
2141              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2142              if (!void_flag) write_result_z(Result, temp_var3);
2143              break;
2144
2145         case ARROW_POST_INC_OP:
2146              assemblez_store(temp_var1, ET[below].value);
2147              assemblez_store(temp_var2, ET[ET[below].right].value);
2148              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2149              if (!void_flag) write_result_z(Result, temp_var3);
2150              assemblez_inc(temp_var3);
2151              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2152              break;
2153
2154         case ARROW_POST_DEC_OP:
2155              assemblez_store(temp_var1, ET[below].value);
2156              assemblez_store(temp_var2, ET[ET[below].right].value);
2157              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2158              if (!void_flag) write_result_z(Result, temp_var3);
2159              assemblez_dec(temp_var3);
2160              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2161              break;
2162
2163         case DARROW_INC_OP:
2164              assemblez_store(temp_var1, ET[below].value);
2165              assemblez_store(temp_var2, ET[ET[below].right].value);
2166              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2167              assemblez_inc(temp_var3);
2168              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2169              if (!void_flag) write_result_z(Result, temp_var3);
2170              break;
2171
2172         case DARROW_DEC_OP:
2173              assemblez_store(temp_var1, ET[below].value);
2174              assemblez_store(temp_var2, ET[ET[below].right].value);
2175              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2176              assemblez_dec(temp_var3);
2177              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2178              if (!void_flag) write_result_z(Result, temp_var3);
2179              break;
2180
2181         case DARROW_POST_INC_OP:
2182              assemblez_store(temp_var1, ET[below].value);
2183              assemblez_store(temp_var2, ET[ET[below].right].value);
2184              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2185              if (!void_flag) write_result_z(Result, temp_var3);
2186              assemblez_inc(temp_var3);
2187              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2188              break;
2189
2190         case DARROW_POST_DEC_OP:
2191              assemblez_store(temp_var1, ET[below].value);
2192              assemblez_store(temp_var2, ET[ET[below].right].value);
2193              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2194              if (!void_flag) write_result_z(Result, temp_var3);
2195              assemblez_dec(temp_var3);
2196              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2197              break;
2198
2199         case PROPERTY_INC_OP:
2200              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2201              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2202              assemblez_store(temp_var1, ET[below].value);
2203              assemblez_store(temp_var2, ET[ET[below].right].value);
2204              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2205              assemblez_inc(temp_var3);
2206              if (runtime_error_checking_switch && (!veneer_mode))
2207                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2208                          temp_var1, temp_var2, temp_var3);
2209              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2210              if (!void_flag) write_result_z(Result, temp_var3);
2211              break;
2212
2213         case PROPERTY_DEC_OP:
2214              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2215              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2216              assemblez_store(temp_var1, ET[below].value);
2217              assemblez_store(temp_var2, ET[ET[below].right].value);
2218              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2219              assemblez_dec(temp_var3);
2220              if (runtime_error_checking_switch && (!veneer_mode))
2221                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2222                          temp_var1, temp_var2, temp_var3);
2223              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2224              if (!void_flag) write_result_z(Result, temp_var3);
2225              break;
2226
2227         case PROPERTY_POST_INC_OP:
2228              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2229              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2230              assemblez_store(temp_var1, ET[below].value);
2231              assemblez_store(temp_var2, ET[ET[below].right].value);
2232              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2233              if (!void_flag) write_result_z(Result, temp_var3);
2234              assemblez_inc(temp_var3);
2235              if (runtime_error_checking_switch && (!veneer_mode))
2236                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2237                          temp_var1, temp_var2, temp_var3);
2238              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2239              break;
2240
2241         case PROPERTY_POST_DEC_OP:
2242              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2243              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2244              assemblez_store(temp_var1, ET[below].value);
2245              assemblez_store(temp_var2, ET[ET[below].right].value);
2246              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2247              if (!void_flag) write_result_z(Result, temp_var3);
2248              assemblez_dec(temp_var3);
2249              if (runtime_error_checking_switch && (!veneer_mode))
2250                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2251                          temp_var1, temp_var2, temp_var3);
2252              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2253              break;
2254
2255         default:
2256             printf("** Trouble op = %d i.e. '%s' **\n",
2257                 opnum, operators[opnum].description);
2258             compiler_error("Expr code gen: Can't generate yet");
2259     }
2260   }
2261   else { /* Glulx */
2262     assembly_operand AO, AO2;
2263     if (operators[opnum].opcode_number_g != -1)
2264     {
2265         /*  Operators directly translatable into opcodes: infix ops
2266             take two operands whereas pre/postfix operators take only one */
2267
2268         if (operators[opnum].usage == IN_U)
2269         {   int o_n = operators[opnum].opcode_number_g;
2270             if (runtime_error_checking_switch && (!veneer_mode)
2271                 && ((o_n == div_gc) || (o_n == mod_gc)))
2272             {   assembly_operand by_ao, error_ao; int ln;
2273                 by_ao = ET[ET[below].right].value;
2274                 if ((by_ao.value != 0) && (by_ao.marker == 0)
2275                     && is_constant_ot(by_ao.type))
2276                     assembleg_3(o_n, ET[below].value,
2277                         by_ao, Result);
2278                 else
2279                 {   assembleg_store(temp_var1, ET[below].value);
2280                     assembleg_store(temp_var2, by_ao);
2281                     ln = next_label++;
2282                     assembleg_1_branch(jnz_gc, temp_var2, ln);
2283                     INITAO(&error_ao);
2284                     error_ao.value = DBYZERO_RTE;
2285                     set_constant_ot(&error_ao);
2286                     assembleg_call_1(veneer_routine(RT__Err_VR),
2287                       error_ao, zero_operand);
2288                     assembleg_store(temp_var2, one_operand);
2289                     assemble_label_no(ln);
2290                     assembleg_3(o_n, temp_var1, temp_var2, Result);
2291                 }
2292             }
2293             else
2294             assembleg_3(o_n, ET[below].value,
2295                 ET[ET[below].right].value, Result);
2296         }
2297         else
2298             assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
2299                 Result);
2300     }
2301     else
2302     switch(opnum)
2303     {
2304
2305         case PUSH_OP:
2306              if (ET[below].value.type == Result.type
2307                && ET[below].value.value == Result.value
2308                && ET[below].value.marker == Result.marker)
2309                break;
2310              assembleg_2(copy_gc, ET[below].value, Result);
2311              break;
2312
2313         case UNARY_MINUS_OP:
2314              assembleg_2(neg_gc, ET[below].value, Result);
2315              break;
2316         case ARTNOT_OP:
2317              assembleg_2(bitnot_gc, ET[below].value, Result);
2318              break;
2319
2320         case ARROW_OP:
2321              access_memory_g(aloadb_gc, ET[below].value,
2322                                       ET[ET[below].right].value, Result);
2323              break;
2324         case DARROW_OP:
2325              access_memory_g(aload_gc, ET[below].value,
2326                                      ET[ET[below].right].value, Result);
2327              break;
2328
2329         case SETEQUALS_OP:
2330              assembleg_store(ET[below].value,
2331                  ET[ET[below].right].value);
2332              if (!void_flag) write_result_g(Result, ET[below].value);
2333              break;
2334
2335         case ARROW_SETEQUALS_OP:
2336              if (!void_flag)
2337              {   assembleg_store(temp_var1,
2338                      ET[ET[ET[below].right].right].value);
2339                  access_memory_g(astoreb_gc, ET[below].value,
2340                      ET[ET[below].right].value,
2341                      temp_var1);
2342                  write_result_g(Result, temp_var1);
2343              }
2344              else access_memory_g(astoreb_gc, ET[below].value,
2345                      ET[ET[below].right].value,
2346                      ET[ET[ET[below].right].right].value);
2347              break;
2348
2349         case DARROW_SETEQUALS_OP:
2350              if (!void_flag)
2351              {   assembleg_store(temp_var1,
2352                      ET[ET[ET[below].right].right].value);
2353                  access_memory_g(astore_gc, ET[below].value,
2354                      ET[ET[below].right].value,
2355                      temp_var1);
2356                  write_result_g(Result, temp_var1);
2357              }
2358              else
2359                  access_memory_g(astore_gc, ET[below].value,
2360                      ET[ET[below].right].value,
2361                      ET[ET[ET[below].right].right].value);
2362              break;
2363
2364         case INC_OP:
2365              assembleg_inc(ET[below].value);
2366              if (!void_flag) write_result_g(Result, ET[below].value);
2367              break;
2368         case DEC_OP:
2369              assembleg_dec(ET[below].value);
2370              if (!void_flag) write_result_g(Result, ET[below].value);
2371              break;
2372         case POST_INC_OP:
2373              if (!void_flag) write_result_g(Result, ET[below].value);
2374              assembleg_inc(ET[below].value);
2375              break;
2376         case POST_DEC_OP:
2377              if (!void_flag) write_result_g(Result, ET[below].value);
2378              assembleg_dec(ET[below].value);
2379              break;
2380
2381         case ARROW_INC_OP:
2382              assembleg_store(temp_var1, ET[below].value);
2383              assembleg_store(temp_var2, ET[ET[below].right].value);
2384              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2385              assembleg_inc(temp_var3);
2386              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2387              if (!void_flag) write_result_g(Result, temp_var3);
2388              break;
2389
2390         case ARROW_DEC_OP:
2391              assembleg_store(temp_var1, ET[below].value);
2392              assembleg_store(temp_var2, ET[ET[below].right].value);
2393              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2394              assembleg_dec(temp_var3);
2395              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2396              if (!void_flag) write_result_g(Result, temp_var3);
2397              break;
2398
2399         case ARROW_POST_INC_OP:
2400              assembleg_store(temp_var1, ET[below].value);
2401              assembleg_store(temp_var2, ET[ET[below].right].value);
2402              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2403              if (!void_flag) write_result_g(Result, temp_var3);
2404              assembleg_inc(temp_var3);
2405              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2406              break;
2407
2408         case ARROW_POST_DEC_OP:
2409              assembleg_store(temp_var1, ET[below].value);
2410              assembleg_store(temp_var2, ET[ET[below].right].value);
2411              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2412              if (!void_flag) write_result_g(Result, temp_var3);
2413              assembleg_dec(temp_var3);
2414              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2415              break;
2416
2417         case DARROW_INC_OP:
2418              assembleg_store(temp_var1, ET[below].value);
2419              assembleg_store(temp_var2, ET[ET[below].right].value);
2420              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2421              assembleg_inc(temp_var3);
2422              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2423              if (!void_flag) write_result_g(Result, temp_var3);
2424              break;
2425
2426         case DARROW_DEC_OP:
2427              assembleg_store(temp_var1, ET[below].value);
2428              assembleg_store(temp_var2, ET[ET[below].right].value);
2429              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2430              assembleg_dec(temp_var3);
2431              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2432              if (!void_flag) write_result_g(Result, temp_var3);
2433              break;
2434
2435         case DARROW_POST_INC_OP:
2436              assembleg_store(temp_var1, ET[below].value);
2437              assembleg_store(temp_var2, ET[ET[below].right].value);
2438              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2439              if (!void_flag) write_result_g(Result, temp_var3);
2440              assembleg_inc(temp_var3);
2441              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2442              break;
2443
2444         case DARROW_POST_DEC_OP:
2445              assembleg_store(temp_var1, ET[below].value);
2446              assembleg_store(temp_var2, ET[ET[below].right].value);
2447              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2448              if (!void_flag) write_result_g(Result, temp_var3);
2449              assembleg_dec(temp_var3);
2450              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2451              break;
2452
2453         case PROPERTY_OP:
2454         case MESSAGE_OP:
2455              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2456              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2457              AO = veneer_routine(RV__Pr_VR);
2458              goto TwoArgFunctionCall;
2459         case MPROP_ADD_OP:
2460         case PROP_ADD_OP:
2461              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
2462              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
2463              AO = veneer_routine(RA__Pr_VR);
2464              goto TwoArgFunctionCall;
2465         case MPROP_NUM_OP:
2466         case PROP_NUM_OP:
2467              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
2468              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
2469              AO = veneer_routine(RL__Pr_VR);
2470              goto TwoArgFunctionCall;
2471
2472         case PROP_CALL_OP:
2473         case MESSAGE_CALL_OP:
2474              check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
2475              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
2476              AO2 = veneer_routine(CA__Pr_VR);
2477              i = below;
2478              goto DoFunctionCall;
2479
2480         case MESSAGE_INC_OP:
2481         case PROPERTY_INC_OP:
2482              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2483              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2484              AO = veneer_routine(IB__Pr_VR);
2485              goto TwoArgFunctionCall;
2486         case MESSAGE_DEC_OP:
2487         case PROPERTY_DEC_OP:
2488              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2489              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2490              AO = veneer_routine(DB__Pr_VR);
2491              goto TwoArgFunctionCall;
2492         case MESSAGE_POST_INC_OP:
2493         case PROPERTY_POST_INC_OP:
2494              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2495              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2496              AO = veneer_routine(IA__Pr_VR);
2497              goto TwoArgFunctionCall;
2498         case MESSAGE_POST_DEC_OP:
2499         case PROPERTY_POST_DEC_OP:
2500              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2501              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2502              AO = veneer_routine(DA__Pr_VR);
2503              goto TwoArgFunctionCall;
2504         case SUPERCLASS_OP:
2505              AO = veneer_routine(RA__Sc_VR);
2506              goto TwoArgFunctionCall;
2507
2508              TwoArgFunctionCall:
2509              {
2510                assembly_operand AO2 = ET[below].value;
2511                assembly_operand AO3 = ET[ET[below].right].value;
2512                if (void_flag)
2513                  assembleg_call_2(AO, AO2, AO3, zero_operand);
2514                else
2515                  assembleg_call_2(AO, AO2, AO3, Result);
2516              }
2517              break;
2518
2519         case PROPERTY_SETEQUALS_OP:
2520         case MESSAGE_SETEQUALS_OP:
2521              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2522              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2523              if (runtime_error_checking_switch && (!veneer_mode))
2524                  AO = veneer_routine(RT__ChPS_VR);
2525                else
2526                  AO = veneer_routine(WV__Pr_VR);
2527
2528              {
2529                assembly_operand AO2 = ET[below].value;
2530                assembly_operand AO3 = ET[ET[below].right].value;
2531                assembly_operand AO4 = ET[ET[ET[below].right].right].value;
2532                if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
2533                  /* Rightmost is on the stack; reduce to previous case. */
2534                  if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2535                    if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2536                      /* both already on stack. */
2537                    }
2538                    else {
2539                      assembleg_store(stack_pointer, AO3);
2540                      assembleg_0(stkswap_gc);
2541                    }
2542                  }
2543                  else {
2544                    if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2545                      assembleg_store(stack_pointer, AO2);
2546                    }
2547                    else {
2548                      assembleg_store(stack_pointer, AO3);
2549                      assembleg_store(stack_pointer, AO2);
2550                    }
2551                  }
2552                }
2553                else {
2554                  /* We have to get the rightmost on the stack, below the
2555                     others. */
2556                  if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2557                    if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2558                      assembleg_store(stack_pointer, AO4);
2559                      assembleg_2(stkroll_gc, three_operand, one_operand);
2560                    }
2561                    else {
2562                      assembleg_store(stack_pointer, AO4);
2563                      assembleg_0(stkswap_gc);
2564                      assembleg_store(stack_pointer, AO2);
2565                    }
2566                  }
2567                  else {
2568                    if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2569                      assembleg_store(stack_pointer, AO4);
2570                      assembleg_store(stack_pointer, AO3);
2571                      assembleg_2(stkroll_gc, three_operand, two_operand);
2572                    }
2573                    else {
2574                      assembleg_store(stack_pointer, AO4);
2575                      assembleg_store(stack_pointer, AO3);
2576                      assembleg_store(stack_pointer, AO2);
2577                    }
2578                  }
2579                }
2580                if (void_flag)
2581                  assembleg_3(call_gc, AO, three_operand, zero_operand);
2582                else
2583                  assembleg_3(call_gc, AO, three_operand, Result);
2584              }
2585              break;
2586
2587         case FCALL_OP:
2588              j = 0;
2589
2590              if (ET[below].value.type == SYSFUN_OT)
2591              {   int sf_number = ET[below].value.value;
2592
2593                  i = ET[below].right;
2594                  if (i == -1)
2595                  {   error("Argument to system function missing");
2596                      AI.operand[0] = one_operand;
2597                      AI.operand_count = 1;
2598                  }
2599                  else
2600                  {   j=0;
2601                      while (i != -1) { j++; i = ET[i].right; }
2602
2603                      if (((sf_number != INDIRECT_SYSF) &&
2604                          (sf_number != GLK_SYSF) &&
2605                          (sf_number != RANDOM_SYSF) && (j > 1)))
2606                      {   j=1;
2607                          error("System function given with too many arguments");
2608                      }
2609                      if (sf_number != RANDOM_SYSF)
2610                      {   int jcount;
2611                          i = ET[below].right;
2612                          for (jcount = 0; jcount < j; jcount++)
2613                          {   AI.operand[jcount] = ET[i].value;
2614                              i = ET[i].right;
2615                          }
2616                          AI.operand_count = j;
2617                      }
2618                  }
2619
2620                  switch(sf_number)
2621                  {
2622                      case RANDOM_SYSF:
2623                          if (j>1)
2624                          {  assembly_operand AO, AO2;
2625                             int arg_c, arg_et;
2626                             INITAO(&AO);
2627                             AO.value = j;
2628                             set_constant_ot(&AO);
2629                             INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
2630                             AO2.marker = ARRAY_MV;
2631
2632                             for (arg_c=0, arg_et = ET[below].right;arg_c<j;
2633                                  arg_c++, arg_et = ET[arg_et].right)
2634                             {   if (ET[arg_et].value.type == LOCALVAR_OT
2635                                     || ET[arg_et].value.type == GLOBALVAR_OT)
2636               error("Only constants can be used as possible 'random' results");
2637                                 array_entry(arg_c, FALSE, ET[arg_et].value);
2638                             }
2639                             finish_array(arg_c, FALSE);
2640
2641                             assembleg_2(random_gc, AO, stack_pointer);
2642                             assembleg_3(aload_gc, AO2, stack_pointer, Result);
2643                          }
2644                          else {
2645                            assembleg_2(random_gc,
2646                              ET[ET[below].right].value, stack_pointer);
2647                            assembleg_3(add_gc, stack_pointer, one_operand,
2648                              Result);
2649                          }
2650                          break;
2651
2652                      case PARENT_SYSF:
2653                          {  assembly_operand AO;
2654                             AO = ET[ET[below].right].value;
2655                             if (runtime_error_checking_switch)
2656                                 AO = check_nonzero_at_runtime(AO, -1,
2657                                     PARENT_RTE);
2658                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2659                             assembleg_3(aload_gc, AO, AO2, Result);
2660                          }
2661                          break;
2662
2663                      case ELDEST_SYSF:
2664                      case CHILD_SYSF:
2665                          {  assembly_operand AO;
2666                             AO = ET[ET[below].right].value;
2667                             if (runtime_error_checking_switch)
2668                                AO = check_nonzero_at_runtime(AO, -1,
2669                                (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
2670                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2671                             assembleg_3(aload_gc, AO, AO2, Result);
2672                          }
2673                          break;
2674
2675                      case YOUNGER_SYSF:
2676                      case SIBLING_SYSF:
2677                          {  assembly_operand AO;
2678                             AO = ET[ET[below].right].value;
2679                             if (runtime_error_checking_switch)
2680                                AO = check_nonzero_at_runtime(AO, -1,
2681                                (sf_number==SIBLING_SYSF)
2682                                    ?SIBLING_RTE:YOUNGER_RTE);
2683                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
2684                             assembleg_3(aload_gc, AO, AO2, Result);
2685                          }
2686                          break;
2687
2688                      case CHILDREN_SYSF:
2689                          {  assembly_operand AO;
2690                             AO = ET[ET[below].right].value;
2691                             if (runtime_error_checking_switch)
2692                                 AO = check_nonzero_at_runtime(AO, -1,
2693                                     CHILDREN_RTE);
2694                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2695                             assembleg_store(temp_var1, zero_operand);
2696                             assembleg_3(aload_gc, AO, AO2, temp_var2);
2697                             AO2.value = GOBJFIELD_SIBLING();
2698                             assemble_label_no(next_label);
2699                             assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2700                             assembleg_3(add_gc, temp_var1, one_operand,
2701                               temp_var1);
2702                             assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
2703                             assembleg_0_branch(jump_gc, next_label);
2704                             assemble_label_no(next_label+1);
2705                             next_label += 2;
2706                             if (!void_flag)
2707                               write_result_g(Result, temp_var1);
2708                          }
2709                          break;
2710
2711                      case INDIRECT_SYSF:
2712                          i = ET[below].right;
2713                          check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
2714                          goto IndirectFunctionCallG;
2715
2716                      case GLK_SYSF:
2717                          AO2 = veneer_routine(Glk__Wrap_VR);
2718                          i = ET[below].right;
2719                          goto DoFunctionCall;
2720
2721                      case METACLASS_SYSF:
2722                          assembleg_call_1(veneer_routine(Metaclass_VR),
2723                              ET[ET[below].right].value, Result);
2724                          break;
2725
2726                      case YOUNGEST_SYSF:
2727                          AO = ET[ET[below].right].value;
2728                          if (runtime_error_checking_switch)
2729                            AO = check_nonzero_at_runtime(AO, -1,
2730                              YOUNGEST_RTE);
2731                          INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2732                          assembleg_3(aload_gc, AO, AO2, temp_var1);
2733                          AO2.value = GOBJFIELD_SIBLING();
2734                          assembleg_1_branch(jz_gc, temp_var1, next_label+1);
2735                          assemble_label_no(next_label);
2736                          assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2737                          assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2738                          assembleg_store(temp_var1, temp_var2);
2739                          assembleg_0_branch(jump_gc, next_label);
2740                          assemble_label_no(next_label+1);
2741                          if (!void_flag)
2742                            write_result_g(Result, temp_var1);
2743                          next_label += 2;
2744                          break;
2745
2746                      case ELDER_SYSF:
2747                          AO = ET[ET[below].right].value;
2748                          if (runtime_error_checking_switch)
2749                            AO = check_nonzero_at_runtime(AO, -1,
2750                              YOUNGEST_RTE);
2751                          assembleg_store(temp_var3, AO);
2752                          INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2753                          assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
2754                          assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2755                          AO2.value = GOBJFIELD_CHILD();
2756                          assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
2757                          assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2758                          assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
2759                            next_label+1);
2760                          assemble_label_no(next_label);
2761                          AO2.value = GOBJFIELD_SIBLING();
2762                          assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2763                          assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
2764                            next_label+2);
2765                          assembleg_store(temp_var1, temp_var2);
2766                          assembleg_0_branch(jump_gc, next_label);
2767                          assemble_label_no(next_label+1);
2768                          assembleg_store(temp_var1, zero_operand);
2769                          assemble_label_no(next_label+2);
2770                          if (!void_flag)
2771                            write_result_g(Result, temp_var1);
2772                          next_label += 3;
2773                          break;
2774
2775                      default:
2776                          error("*** system function not implemented ***");
2777                          break;
2778
2779                  }
2780                  break;
2781              }
2782
2783              check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2784              i = below;
2785
2786              IndirectFunctionCallG:
2787
2788              /* Get the function address. */
2789              AO2 = ET[i].value;
2790              i = ET[i].right;
2791
2792              DoFunctionCall:
2793
2794              {
2795                /* If all the function arguments are in local/global
2796                   variables, we have to push them all on the stack.
2797                   If all of them are on the stack, we have to do nothing.
2798                   If some are and some aren't, we have a hopeless mess,
2799                   and we should throw a compiler error.
2800                */
2801
2802                int onstack = 0;
2803                int offstack = 0;
2804
2805                /* begin part of patch G03701 */
2806                int nargs = 0;
2807                j = i;
2808                while (j != -1) {
2809                  nargs++;
2810                  j = ET[j].right;
2811                }
2812
2813                if (nargs==0) {
2814                  assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
2815                } else if (nargs==1) {
2816                  assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
2817                } else if (nargs==2) {
2818                  assembly_operand o1 = ET[i].value;
2819                  assembly_operand o2 = ET[ET[i].right].value;
2820                  assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
2821                } else if (nargs==3) {
2822                  assembly_operand o1 = ET[i].value;
2823                  assembly_operand o2 = ET[ET[i].right].value;
2824                  assembly_operand o3 = ET[ET[ET[i].right].right].value;
2825                  assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
2826                } else {
2827
2828                  j = 0;
2829                  while (i != -1) {
2830                      if (ET[i].value.type == LOCALVAR_OT
2831                        && ET[i].value.value == 0) {
2832                        onstack++;
2833                      }
2834                      else {
2835                        assembleg_store(stack_pointer, ET[i].value);
2836                        offstack++;
2837                      }
2838                      i = ET[i].right;
2839                      j++;
2840                  }
2841
2842                  if (onstack && offstack)
2843                      error("*** Function call cannot be generated with mixed arguments ***");
2844                  if (offstack > 1)
2845                      error("*** Function call cannot be generated with more than one nonstack argument ***");
2846
2847                  INITAO(&AO);
2848                  AO.value = j;
2849                  set_constant_ot(&AO);
2850
2851                  if (void_flag)
2852                    assembleg_3(call_gc, AO2, AO, zero_operand);
2853                  else
2854                    assembleg_3(call_gc, AO2, AO, Result);
2855
2856                } /* else nargs>=4 */
2857              } /* DoFunctionCall: */
2858
2859              break;
2860
2861         default:
2862             printf("** Trouble op = %d i.e. '%s' **\n",
2863                 opnum, operators[opnum].description);
2864             compiler_error("Expr code gen: Can't generate yet");
2865     }
2866   }
2867
2868     ET[n].value = Result;
2869
2870     OperatorGenerated:
2871
2872     if (!glulx_mode) {
2873
2874         if (ET[n].to_expression)
2875         {
2876             int32 donelabel;
2877             if (void_flag) {
2878                 warning("Logical expression has no side-effects");
2879                 if (ET[n].true_label != -1)
2880                     assemble_label_no(ET[n].true_label);
2881                 else
2882                     assemble_label_no(ET[n].false_label);
2883             }
2884             else if (ET[n].true_label != -1)
2885             {
2886                 donelabel = next_label++;
2887                 if (!execution_never_reaches_here) {
2888                     assemblez_1(push_zc, zero_operand);
2889                     assemblez_jump(donelabel);
2890                 }
2891                 assemble_label_no(ET[n].true_label);
2892                 assemblez_1(push_zc, one_operand);
2893                 assemble_forward_label_no(donelabel);
2894             }
2895             else
2896             {
2897                 donelabel = next_label++;
2898                 if (!execution_never_reaches_here) {
2899                     assemblez_1(push_zc, one_operand);
2900                     assemblez_jump(donelabel);
2901                 }
2902                 assemble_label_no(ET[n].false_label);
2903                 assemblez_1(push_zc, zero_operand);
2904                 assemble_forward_label_no(donelabel);
2905             }
2906             ET[n].value = stack_pointer;
2907         }
2908         else
2909             if (ET[n].label_after != -1)
2910                 assemble_label_no(ET[n].label_after);
2911
2912     }
2913     else {
2914
2915         if (ET[n].to_expression)
2916         {
2917             int32 donelabel;
2918             if (void_flag) {
2919                 warning("Logical expression has no side-effects");
2920                 if (ET[n].true_label != -1)
2921                     assemble_label_no(ET[n].true_label);
2922                 else
2923                     assemble_label_no(ET[n].false_label);
2924             }
2925             else if (ET[n].true_label != -1)
2926             {
2927                 donelabel = next_label++;
2928                 if (!execution_never_reaches_here) {
2929                     assembleg_store(stack_pointer, zero_operand);
2930                     assembleg_jump(donelabel);
2931                 }
2932                 assemble_label_no(ET[n].true_label);
2933                 assembleg_store(stack_pointer, one_operand);
2934                 assemble_forward_label_no(donelabel);
2935             }
2936             else
2937             {
2938                 donelabel = next_label++;
2939                 if (!execution_never_reaches_here) {
2940                     assembleg_store(stack_pointer, one_operand);
2941                     assembleg_jump(donelabel);
2942                 }
2943                 assemble_label_no(ET[n].false_label);
2944                 assembleg_store(stack_pointer, zero_operand);
2945                 assemble_forward_label_no(donelabel);
2946             }
2947             ET[n].value = stack_pointer;
2948         }
2949         else
2950             if (ET[n].label_after != -1)
2951                 assemble_label_no(ET[n].label_after);
2952
2953     }
2954
2955     ET[n].down = -1;
2956 }
2957
2958 assembly_operand code_generate(assembly_operand AO, int context, int label)
2959 {
2960     /*  Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
2961             QUANTITY_CONTEXT.
2962
2963         If CONDITION_CONTEXT, then compile code branching to label number
2964             "label" if the condition is false: there's no return value.
2965         (Except that if label is -3 or -4 (internal codes for rfalse and
2966         rtrue rather than branch) then this is for branching when the
2967         condition is true.  This is used for optimising code generation
2968         for "if" statements.)
2969
2970         Otherwise return the assembly operand containing the result
2971         (probably the stack pointer variable but not necessarily:
2972          e.g. is would be short constant 2 from the expression "j++, 2")     */
2973
2974     vivc_flag = FALSE;
2975
2976     if (AO.type != EXPRESSION_OT)
2977     {   switch(context)
2978         {   case VOID_CONTEXT:
2979                 value_in_void_context(AO);
2980                 AO.type = OMITTED_OT;
2981                 AO.value = 0;
2982                 break;
2983             case CONDITION_CONTEXT:
2984                 if (!glulx_mode) {
2985                   if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
2986                   else assemblez_1_branch(jz_zc, AO, label, TRUE);
2987                 }
2988                 else {
2989                   if (label < -2)
2990                     assembleg_1_branch(jnz_gc, AO, label);
2991                   else
2992                     assembleg_1_branch(jz_gc, AO, label);
2993                 }
2994                 AO.type = OMITTED_OT;
2995                 AO.value = 0;
2996                 break;
2997         }
2998         return AO;
2999     }
3000
3001     if (expr_trace_level >= 2)
3002     {   printf("Raw parse tree:\n"); show_tree(AO, FALSE);
3003     }
3004
3005     if (context == CONDITION_CONTEXT)
3006     {   if (label < -2) annotate_for_conditions(AO.value, label, -1);
3007         else annotate_for_conditions(AO.value, -1, label);
3008     }
3009     else annotate_for_conditions(AO.value, -1, -1);
3010
3011     if (expr_trace_level >= 1)
3012     {   printf("Code generation for expression in ");
3013         switch(context)
3014         {   case VOID_CONTEXT: printf("void"); break;
3015             case CONDITION_CONTEXT: printf("condition"); break;
3016             case QUANTITY_CONTEXT: printf("quantity"); break;
3017             case ASSEMBLY_CONTEXT: printf("assembly"); break;
3018             case ARRAY_CONTEXT: printf("array initialisation"); break;
3019             default: printf("* ILLEGAL *"); break;
3020         }
3021         printf(" context with annotated tree:\n");
3022         show_tree(AO, TRUE);
3023     }
3024
3025     generate_code_from(AO.value, (context==VOID_CONTEXT));
3026     return ET[AO.value].value;
3027 }
3028
3029 /* ========================================================================= */
3030 /*   Data structure management routines                                      */
3031 /* ------------------------------------------------------------------------- */
3032
3033 extern void init_expressc_vars(void)
3034 {   make_operands();
3035 }
3036
3037 extern void expressc_begin_pass(void)
3038 {
3039 }
3040
3041 extern void expressc_allocate_arrays(void)
3042 {
3043 }
3044
3045 extern void expressc_free_arrays(void)
3046 {
3047 }
3048
3049 /* ========================================================================= */