src/expressc.c

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