src/expressc.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "expressc" :  The expression code generator                             */
   3 /*                                                                           */
   4 /*   Part of Inform 6.42                                                     */
   5 /*   copyright (c) Graham Nelson 1993 - 2024                                 */
   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 = get_symbol_index("Class");
1088     if (ln < 0) {
1089         error("No 'Class' object found");
1090         AO3 = zero_operand;
1091     }
1092     else {
1093         AO3.value = symbols[ln].value;
1094         AO3.marker = OBJECT_MV;
1095         AO3.type = CONSTANT_OT;
1096     }
1097     assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
1098   }
1099
1100   assemble_label_no(failed_label);
1101   INITAO(&AO2);
1102   AO2.value = rte_number;
1103   set_constant_ot(&AO2);
1104   assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
1105
1106   if (error_label != -1) {
1107     /* Jump to the error label */
1108     if (error_label == -3) assembleg_1(return_gc, zero_operand);
1109     else if (error_label == -4) assembleg_1(return_gc, one_operand);
1110     else assembleg_jump(error_label);
1111   }
1112   else {
1113     /* Build the symbol for "Object" */
1114     ln = get_symbol_index("Object");
1115     if (ln < 0) {
1116         error("No 'Object' object found");
1117         AO2 = zero_operand;
1118     }
1119     else {
1120         AO2.value = symbols[ln].value;
1121         AO2.marker = OBJECT_MV;
1122         AO2.type = CONSTANT_OT;
1123     }
1124     if (check_sp) {
1125       /* Push "Object" */
1126       assembleg_store(AO1, AO2);
1127     }
1128     else {
1129       /* Store either "Object" or the operand's value in the temporary
1130          variable. */
1131       assembleg_store(temp_var2, AO2);
1132       last_label = next_label++;
1133       assembleg_jump(last_label);
1134       assemble_label_no(passed_label);
1135       assembleg_store(temp_var2, AO1);
1136       assemble_label_no(last_label);
1137       return temp_var2;
1138     }
1139   }
1140
1141   assemble_label_no(passed_label);
1142   return AO1;
1143 }
1144
1145 static void compile_conditional_g(condclass *cc,
1146     assembly_operand AO1, assembly_operand AO2, int label, int flag)
1147 {   assembly_operand AO4;
1148     int the_zc, error_label = label,
1149     va_flag = FALSE, va_label = 0;
1150
1151     ASSERT_GLULX();
1152
1153     the_zc = (flag ? cc->posform : cc->negform);
1154
1155     if (the_zc == -1) {
1156       switch ((cc-condclasses)*2 + 500) {
1157
1158       case HAS_CC:
1159         check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"has/hasnt\" expression");
1160         check_warn_symbol_type(&AO2, ATTRIBUTE_T, 0, "\"has/hasnt\" expression");
1161         if (runtime_error_checking_switch) {
1162           if (flag)
1163             error_label = next_label++;
1164           AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
1165           if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1166             if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
1167               error("'has'/'hasnt' applied to illegal attribute number");
1168             }
1169           }
1170           else {
1171             int pa_label = next_label++, fa_label = next_label++;
1172             assembly_operand en_ao, max_ao;
1173
1174             if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1175               if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1176                 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1177                 assembleg_2(stkpeek_gc, one_operand, temp_var2);
1178               }
1179               else {
1180                 assembleg_2(stkpeek_gc, zero_operand, temp_var1);
1181                 assembleg_store(temp_var2, AO2);
1182               }
1183             }
1184             else {
1185               assembleg_store(temp_var1, AO1);
1186               if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
1187                 assembleg_2(stkpeek_gc, zero_operand, temp_var2);
1188               }
1189               else {
1190                 assembleg_store(temp_var2, AO2);
1191               }
1192             }
1193
1194             INITAO(&max_ao);
1195             max_ao.value = NUM_ATTR_BYTES*8;
1196             set_constant_ot(&max_ao);
1197             assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
1198             assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
1199             assemble_label_no(fa_label);
1200             INITAO(&en_ao);
1201             en_ao.value = 19; /* INVALIDATTR_RTE */
1202             set_constant_ot(&en_ao);
1203             assembleg_store(stack_pointer, temp_var2);
1204             assembleg_store(stack_pointer, temp_var1);
1205             assembleg_store(stack_pointer, en_ao);
1206             assembleg_3(call_gc, veneer_routine(RT__Err_VR),
1207               three_operand, zero_operand);
1208             va_flag = TRUE;
1209             va_label = next_label++;
1210             assembleg_jump(va_label);
1211             assemble_label_no(pa_label);
1212           }
1213         }
1214         if (is_constant_ot(AO2.type) && AO2.marker == 0) {
1215           AO2.value += 8;
1216           set_constant_ot(&AO2);
1217         }
1218         else {
1219           INITAO(&AO4);
1220           AO4.value = 8;
1221           AO4.type = BYTECONSTANT_OT;
1222           if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
1223             if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
1224               assembleg_0(stkswap_gc);
1225             assembleg_3(add_gc, AO2, AO4, stack_pointer);
1226             assembleg_0(stkswap_gc);
1227           }
1228           else {
1229             assembleg_3(add_gc, AO2, AO4, stack_pointer);
1230           }
1231           AO2 = stack_pointer;
1232         }
1233         assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
1234         the_zc = (flag ? jnz_gc : jz_gc);
1235         AO1 = stack_pointer;
1236         break;
1237
1238       case IN_CC:
1239         check_warn_symbol_type(&AO1, OBJECT_T, 0, "\"in/notin\" expression");
1240         check_warn_symbol_type(&AO2, OBJECT_T, CLASS_T, "\"in/notin\" expression");
1241         if (runtime_error_checking_switch) {
1242           if (flag)
1243             error_label = next_label++;
1244           AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
1245         }
1246         INITAO(&AO4);
1247         AO4.value = GOBJFIELD_PARENT();
1248         AO4.type = BYTECONSTANT_OT;
1249         assembleg_3(aload_gc, AO1, AO4, stack_pointer);
1250         AO1 = stack_pointer;
1251         the_zc = (flag ? jeq_gc : jne_gc);
1252         break;
1253
1254       case OFCLASS_CC:
1255         /* first argument can be anything */
1256         check_warn_symbol_type(&AO2, CLASS_T, 0, "\"ofclass\" expression");
1257         assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
1258         the_zc = (flag ? jnz_gc : jz_gc);
1259         AO1 = stack_pointer;
1260         break;
1261
1262       case PROVIDES_CC:
1263         /* first argument can be anything */
1264         check_warn_symbol_type(&AO2, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"provides\" expression");
1265         assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
1266         the_zc = (flag ? jnz_gc : jz_gc);
1267         AO1 = stack_pointer;
1268         break;
1269
1270       default:
1271         error("condition not yet supported in Glulx");
1272         return;
1273       }
1274     }
1275
1276     if (the_zc == jnz_gc || the_zc == jz_gc)
1277       assembleg_1_branch(the_zc, AO1, label);
1278     else
1279       assembleg_2_branch(the_zc, AO1, AO2, label);
1280     if (error_label != label) assemble_label_no(error_label);
1281     if (va_flag) assemble_label_no(va_label);
1282 }
1283
1284 static void value_in_void_context(assembly_operand AO)
1285 {
1286   if (!glulx_mode)
1287     value_in_void_context_z(AO);
1288   else
1289     value_in_void_context_g(AO);
1290 }
1291
1292
1293 extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
1294   int error_label, int rte_number)
1295 {
1296   if (!glulx_mode)
1297     return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
1298   else
1299     return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
1300 }
1301
1302 static void generate_code_from(int n, int void_flag)
1303 {
1304     /*  When void, this must not leave anything on the stack. */
1305
1306     int i, j, below, above, opnum, arity; assembly_operand Result;
1307
1308     below = ET[n].down; above = ET[n].up;
1309     if (below == -1)
1310     {   if ((void_flag) && (ET[n].value.type != OMITTED_OT))
1311             value_in_void_context(ET[n].value);
1312         return;
1313     }
1314
1315     opnum = ET[n].operator_number;
1316
1317     if (opnum == COMMA_OP)
1318     {   generate_code_from(below, TRUE);
1319         generate_code_from(ET[below].right, void_flag);
1320         ET[n].value = ET[ET[below].right].value;
1321         goto OperatorGenerated;
1322     }
1323
1324     if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
1325     {   generate_code_from(below, FALSE);
1326         if (execution_never_reaches_here) {
1327             /* If the condition never falls through to here, then it
1328                was an "... && 0 && ..." test. Our convention is to skip
1329                the "not reached" warnings for this case. */
1330             execution_never_reaches_here |= EXECSTATE_NOWARN;
1331         }
1332         generate_code_from(ET[below].right, FALSE);
1333         goto OperatorGenerated;
1334     }
1335
1336     if (opnum == -1)
1337     {
1338         /*  Signifies a SETEQUALS_OP which has already been done */
1339
1340         ET[n].down = -1; return;
1341     }
1342
1343     /*  Note that (except in the cases of comma and logical and/or) it
1344         is essential to code generate the operands right to left, because
1345         of the peculiar way the Z-machine's stack works:
1346
1347             @sub sp sp -> a;
1348
1349         (for instance) pulls to the first operand, then the second.  So
1350
1351             @mul a 2 -> sp;
1352             @add b 7 -> sp;
1353             @sub sp sp -> a;
1354
1355         calculates (b+7)-(a*2), not the other way around (as would be more
1356         usual in stack machines evaluating expressions written in reverse
1357         Polish notation).  (Basically this is because the Z-machine was
1358         designed to implement a LISP-like language naturally expressed
1359         in forward Polish notation: (PLUS 3 4), for instance.)               */
1360
1361     /*  And the Glulx machine follows the Z-machine in this respect. */
1362
1363     i=below; arity = 0;
1364     while (i != -1)
1365     {   i = ET[i].right; arity++;
1366     }
1367     for (j=arity;j>0;j--)
1368     {   int k = 1;
1369         i = below;
1370         while (k<j)
1371         {   k++; i = ET[i].right;
1372         }
1373         generate_code_from(i, FALSE);
1374     }
1375
1376
1377     /*  Check this again, because code generation lower down may have
1378         stubbed it into -1  */
1379
1380     if (ET[n].operator_number == -1)
1381     {   ET[n].down = -1; return;
1382     }
1383
1384   if (!glulx_mode) {
1385
1386     if (operators[opnum].opcode_number_z >= 400)
1387     {
1388         /*  Conditional terms such as '==': */
1389
1390         int a = ET[n].true_label, b = ET[n].false_label,
1391             branch_away, branch_other,
1392             make_jump_away = FALSE, make_branch_label = FALSE;
1393         int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
1394
1395         if (oc >= 400) { oc = oc - 400; flag = FALSE; }
1396
1397         if ((oc == je_zc) && (arity == 2))
1398         {   i = ET[ET[n].down].right;
1399             if ((ET[i].value.value == zero_operand.value)
1400                 && (ET[i].value.type == zero_operand.type))
1401                 oc = jz_zc;
1402         }
1403
1404         /*  If the condition has truth state flag, branch to
1405             label a, and if not, to label b.  Possibly one of a, b
1406             equals -1, meaning "continue from this instruction".
1407
1408             branch_away is the label which is a branch away (the one
1409             which isn't immediately after) and flag is the truth
1410             state to branch there.
1411
1412             Note that when multiple instructions are needed (because
1413             of the use of the 'or' operator) the branch_other label
1414             is created if need be.
1415         */
1416
1417         /*  Reduce to the case where the branch_away label does exist:  */
1418
1419         if (a == -1) { a = b; b = -1; flag = !flag; }
1420
1421         branch_away = a; branch_other = b;
1422         if (branch_other != -1) make_jump_away = TRUE;
1423
1424         if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
1425         {
1426             /*  In this case, we have an 'or' situation where multiple
1427                 instructions are needed and where the overall condition
1428                 is negated.  That is, we have, e.g.
1429
1430                    if not (A cond B or C or D) then branch_away
1431
1432                 which we transform into
1433
1434                    if (A cond B) then branch_other
1435                    if (A cond C) then branch_other
1436                    if not (A cond D) then branch_away
1437                   .branch_other                                          */
1438
1439             if (branch_other == -1)
1440             {   branch_other = next_label++; make_branch_label = TRUE;
1441             }
1442         }
1443
1444         if (oc == jz_zc)
1445             assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
1446         else
1447         {   assembly_operand left_operand;
1448
1449             if (arity == 2)
1450                 compile_conditional_z(oc, ET[below].value,
1451                     ET[ET[below].right].value, branch_away, flag);
1452             else
1453             {   /*  The case of a condition using "or".
1454                     First: if the condition tests the stack pointer,
1455                     and it can't always be done in a single test, move
1456                     the value off the stack and into temporary variable
1457                     storage.  */
1458
1459                 if (((ET[below].value.type == VARIABLE_OT)
1460                      && (ET[below].value.value == 0))
1461                     && ((oc != je_zc) || (arity>4)) )
1462                 {   INITAOTV(&left_operand, VARIABLE_OT, 255);
1463                     assemblez_store(left_operand, ET[below].value);
1464                 }
1465                 else left_operand = ET[below].value;
1466                 i = ET[below].right; arity--;
1467
1468                 /*  "left_operand" now holds the quantity to be tested;
1469                     "i" holds the right operand reached so far;
1470                     "arity" the number of right operands.  */
1471
1472                 while (i != -1)
1473                 {   if ((oc == je_zc) && (arity>1))
1474                     {
1475                         /*  je_zc is an especially good case since the
1476                             Z-machine implements "or" for up to three
1477                             right operands automatically, though it's an
1478                             especially bad case to generate code for!  */
1479
1480                         if (arity == 2)
1481                         {   assemblez_3_branch(je_zc,
1482                               left_operand, ET[i].value,
1483                               ET[ET[i].right].value, branch_away, flag);
1484                             i = ET[i].right; arity--;
1485                         }
1486                         else
1487                         {   if ((arity == 3) || flag)
1488                               assemblez_4_branch(je_zc, left_operand,
1489                                 ET[i].value,
1490                                 ET[ET[i].right].value,
1491                                 ET[ET[ET[i].right].right].value,
1492                                 branch_away, flag);
1493                             else
1494                               assemblez_4_branch(je_zc, left_operand,
1495                                 ET[i].value,
1496                                 ET[ET[i].right].value,
1497                                 ET[ET[ET[i].right].right].value,
1498                                 branch_other, !flag);
1499                             i = ET[ET[i].right].right; arity -= 2;
1500                         }
1501                     }
1502                     else
1503                     {   /*  Otherwise we can compare the left_operand with
1504                             only one right operand at the time.  There are
1505                             two cases: it's the last right operand, or it
1506                             isn't.  */
1507
1508                         if ((arity == 1) || flag)
1509                             compile_conditional_z(oc, left_operand,
1510                                 ET[i].value, branch_away, flag);
1511                         else
1512                             compile_conditional_z(oc, left_operand,
1513                                 ET[i].value, branch_other, !flag);
1514                     }
1515                     i = ET[i].right; arity--;
1516                 }
1517
1518             }
1519         }
1520
1521         /*  NB: These two conditions cannot both occur, fortunately!  */
1522
1523         if (make_branch_label) assemble_label_no(branch_other);
1524         if (make_jump_away) assemblez_jump(branch_other);
1525
1526         goto OperatorGenerated;
1527     }
1528
1529   }
1530   else {
1531     if (operators[opnum].opcode_number_g >= FIRST_CC
1532       && operators[opnum].opcode_number_g <= LAST_CC) {
1533       /*  Conditional terms such as '==': */
1534
1535       int a = ET[n].true_label, b = ET[n].false_label;
1536       int branch_away, branch_other, flag,
1537         make_jump_away = FALSE, make_branch_label = FALSE;
1538       int ccode = operators[opnum].opcode_number_g;
1539       condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
1540       flag = (ccode & 1) ? 0 : 1;
1541
1542       /*  If the comparison is "equal to (constant) 0", change it
1543           to the simple "zero" test. Unfortunately, this doesn't
1544           work for the commutative form "(constant) 0 is equal to".
1545           At least I don't think it does. */
1546
1547       if ((cc == &condclasses[1]) && (arity == 2)) {
1548         i = ET[ET[n].down].right;
1549         if ((ET[i].value.value == 0)
1550           && (ET[i].value.marker == 0)
1551           && is_constant_ot(ET[i].value.type)) {
1552           cc = &condclasses[0];
1553         }
1554       }
1555
1556       /*  If the condition has truth state flag, branch to
1557           label a, and if not, to label b.  Possibly one of a, b
1558           equals -1, meaning "continue from this instruction".
1559
1560           branch_away is the label which is a branch away (the one
1561           which isn't immediately after) and flag is the truth
1562           state to branch there.
1563
1564           Note that when multiple instructions are needed (because
1565           of the use of the 'or' operator) the branch_other label
1566           is created if need be.
1567       */
1568
1569       /*  Reduce to the case where the branch_away label does exist:  */
1570
1571       if (a == -1) { a = b; b = -1; flag = !flag; }
1572
1573       branch_away = a; branch_other = b;
1574       if (branch_other != -1) make_jump_away = TRUE;
1575
1576       if ((arity > 2) && (flag == FALSE)) {
1577         /*  In this case, we have an 'or' situation where multiple
1578             instructions are needed and where the overall condition
1579             is negated.  That is, we have, e.g.
1580
1581             if not (A cond B or C or D) then branch_away
1582
1583             which we transform into
1584
1585             if (A cond B) then branch_other
1586             if (A cond C) then branch_other
1587             if not (A cond D) then branch_away
1588             .branch_other                                          */
1589
1590         if (branch_other == -1) {
1591           branch_other = next_label++; make_branch_label = TRUE;
1592         }
1593       }
1594
1595       if (cc == &condclasses[0]) {
1596         assembleg_1_branch((flag ? cc->posform : cc->negform),
1597           ET[below].value, branch_away);
1598       }
1599       else {
1600         if (arity == 2) {
1601           compile_conditional_g(cc, ET[below].value,
1602             ET[ET[below].right].value, branch_away, flag);
1603         }
1604         else {
1605           /*  The case of a condition using "or".
1606               First: if the condition tests the stack pointer,
1607               and it can't always be done in a single test, move
1608               the value off the stack and into temporary variable
1609               storage.  */
1610
1611           assembly_operand left_operand;
1612           if (((ET[below].value.type == LOCALVAR_OT)
1613             && (ET[below].value.value == 0))) {
1614             assembleg_store(temp_var1, ET[below].value);
1615             left_operand = temp_var1;
1616           }
1617           else {
1618             left_operand = ET[below].value;
1619           }
1620           i = ET[below].right;
1621           arity--;
1622
1623           /*  "left_operand" now holds the quantity to be tested;
1624               "i" holds the right operand reached so far;
1625               "arity" the number of right operands.  */
1626
1627           while (i != -1) {
1628             /*  We can compare the left_operand with
1629             only one right operand at the time.  There are
1630             two cases: it's the last right operand, or it
1631             isn't.  */
1632
1633             if ((arity == 1) || flag)
1634               compile_conditional_g(cc, left_operand,
1635             ET[i].value, branch_away, flag);
1636             else
1637               compile_conditional_g(cc, left_operand,
1638             ET[i].value, branch_other, !flag);
1639
1640             i = ET[i].right;
1641             arity--;
1642           }
1643         }
1644       }
1645
1646       /*  NB: These two conditions cannot both occur, fortunately!  */
1647
1648       if (make_branch_label) assemble_label_no(branch_other);
1649       if (make_jump_away) assembleg_jump(branch_other);
1650
1651       goto OperatorGenerated;
1652     }
1653
1654   }
1655
1656     /*  The operator is now definitely one which produces a value  */
1657
1658     if (void_flag && (!(operators[opnum].side_effect)))
1659         error_named("Evaluating this has no effect:",
1660             operators[opnum].description);
1661
1662     /*  Where shall we put the resulting value? (In Glulx, this could
1663         be smarter, and peg the result into ZEROCONSTANT.) */
1664
1665     if (void_flag) Result = temp_var1;  /*  Throw it away  */
1666     else
1667     {   if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
1668         {
1669             /*  If the node above is "set variable equal to", then
1670                 make that variable the place to put the result, and
1671                 delete the SETEQUALS_OP node since its effect has already
1672                 been accomplished.  */
1673
1674             ET[above].operator_number = -1;
1675             Result = ET[ET[above].down].value;
1676             ET[above].value = Result;
1677         }
1678         else Result = stack_pointer;  /*  Otherwise, put it on the stack  */
1679     }
1680
1681   if (!glulx_mode) {
1682
1683     if (operators[opnum].opcode_number_z != -1)
1684     {
1685         /*  Operators directly translatable into Z-code opcodes: infix ops
1686             take two operands whereas pre/postfix operators take only one */
1687
1688         if (operators[opnum].usage == IN_U)
1689         {   int o_n = operators[opnum].opcode_number_z;
1690             if (runtime_error_checking_switch && (!veneer_mode)
1691                 && ((o_n == div_zc) || (o_n == mod_zc)))
1692             {   assembly_operand by_ao, error_ao; int ln;
1693                 by_ao = ET[ET[below].right].value;
1694                 if ((by_ao.value != 0) && (by_ao.marker == 0)
1695                     && ((by_ao.type == SHORT_CONSTANT_OT)
1696                         || (by_ao.type == LONG_CONSTANT_OT)))
1697                     assemblez_2_to(o_n, ET[below].value,
1698                         by_ao, Result);
1699                 else
1700                 {
1701                     assemblez_store(temp_var1, ET[below].value);
1702                     assemblez_store(temp_var2, by_ao);
1703                     ln = next_label++;
1704                     assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
1705                     INITAOT(&error_ao, SHORT_CONSTANT_OT);
1706                     error_ao.value = DBYZERO_RTE;
1707                     assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
1708                         error_ao);
1709                     assemblez_inc(temp_var2);
1710                     assemble_label_no(ln);
1711                     assemblez_2_to(o_n, temp_var1, temp_var2, Result);
1712                 }
1713             }
1714             else {
1715             assemblez_2_to(o_n, ET[below].value,
1716                 ET[ET[below].right].value, Result);
1717             }
1718         }
1719         else
1720             assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
1721                 Result);
1722     }
1723     else
1724     switch(opnum)
1725     {   case ARROW_OP:
1726              access_memory_z(loadb_zc, ET[below].value,
1727                                      ET[ET[below].right].value, Result);
1728              break;
1729         case DARROW_OP:
1730              access_memory_z(loadw_zc, ET[below].value,
1731                                      ET[ET[below].right].value, Result);
1732              break;
1733         case UNARY_MINUS_OP:
1734              assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
1735              break;
1736         case ARTNOT_OP:
1737              assemblez_1_to(not_zc, ET[below].value, Result);
1738              break;
1739
1740         case PROP_ADD_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_ADD_RTE);
1746                  assemblez_2_to(get_prop_addr_zc, AO,
1747                      ET[ET[below].right].value, temp_var1);
1748                  if (!void_flag) write_result_z(Result, temp_var1);
1749              }
1750              break;
1751
1752         case PROP_NUM_OP:
1753              {   assembly_operand AO = ET[below].value;
1754                  check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1755                  check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1756                  if (runtime_error_checking_switch && (!veneer_mode))
1757                      AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
1758                  assemblez_2_to(get_prop_addr_zc, AO,
1759                      ET[ET[below].right].value, temp_var1);
1760                  assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
1761                  assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
1762                  assemble_label_no(next_label-1);
1763                  if (!void_flag) write_result_z(Result, temp_var1);
1764              }
1765              break;
1766
1767         case PROPERTY_OP:
1768              {
1769                  check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1770                  check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1771                  if (runtime_error_checking_switch && (!veneer_mode))
1772                        assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
1773                          ET[below].value, ET[ET[below].right].value, temp_var1);
1774                  else
1775                  assemblez_2_to(get_prop_zc, ET[below].value,
1776                      ET[ET[below].right].value, temp_var1);
1777                  if (!void_flag) write_result_z(Result, temp_var1);
1778              }
1779              break;
1780
1781         case MESSAGE_OP:
1782              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1783              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1784              j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
1785              goto GenFunctionCallZ;
1786         case MPROP_ADD_OP:
1787              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
1788              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
1789              j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
1790              goto GenFunctionCallZ;
1791         case MPROP_NUM_OP:
1792              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
1793              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
1794              j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
1795              goto GenFunctionCallZ;
1796         case MESSAGE_SETEQUALS_OP:
1797              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
1798              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
1799              j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
1800              goto GenFunctionCallZ;
1801         case MESSAGE_INC_OP:
1802              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
1803              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
1804              j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
1805              goto GenFunctionCallZ;
1806         case MESSAGE_DEC_OP:
1807              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
1808              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
1809              j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
1810              goto GenFunctionCallZ;
1811         case MESSAGE_POST_INC_OP:
1812              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
1813              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
1814              j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
1815              goto GenFunctionCallZ;
1816         case MESSAGE_POST_DEC_OP:
1817              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
1818              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
1819              j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
1820              goto GenFunctionCallZ;
1821         case SUPERCLASS_OP:
1822              j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
1823              goto GenFunctionCallZ;
1824         case PROP_CALL_OP:
1825              check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1826              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1827              j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1828              goto GenFunctionCallZ;
1829         case MESSAGE_CALL_OP:
1830              check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
1831              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
1832              j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
1833              goto GenFunctionCallZ;
1834
1835
1836         case FCALL_OP:
1837              j = 0;
1838
1839              if ((ET[below].value.type == VARIABLE_OT)
1840                  && (ET[below].value.value >= 256))
1841              {   int sf_number = ET[below].value.value - 256;
1842
1843                  i = ET[below].right;
1844                  if (i == -1)
1845                  {   error("Argument to system function missing");
1846                      AI.operand[0] = one_operand;
1847                      AI.operand_count = 1;
1848                  }
1849                  else
1850                  {   j=0;
1851                      while (i != -1) { j++; i = ET[i].right; }
1852
1853                      if (((sf_number != INDIRECT_SYSF) &&
1854                          (sf_number != RANDOM_SYSF) && (j > 1))
1855                          || ((sf_number == INDIRECT_SYSF) && (j>7)))
1856                      {   j=1;
1857                          error("System function given with too many arguments");
1858                      }
1859                      if (sf_number != RANDOM_SYSF)
1860                      {   int jcount;
1861                          i = ET[below].right;
1862                          for (jcount = 0; jcount < j; jcount++)
1863                          {   AI.operand[jcount] = ET[i].value;
1864                              i = ET[i].right;
1865                          }
1866                          AI.operand_count = j;
1867                      }
1868                  }
1869                  AI.store_variable_number = Result.value;
1870                  AI.branch_label_number = -1;
1871
1872                  switch(sf_number)
1873                  {   case RANDOM_SYSF:
1874                          if (j>1)
1875                          {  assembly_operand AO, AO2; int arg_c, arg_et;
1876                             INITAOTV(&AO, SHORT_CONSTANT_OT, j);
1877                             INITAOT(&AO2, LONG_CONSTANT_OT);
1878                             AO2.value = begin_word_array();
1879                             AO2.marker = ARRAY_MV;
1880
1881                             for (arg_c=0, arg_et = ET[below].right;arg_c<j;
1882                                  arg_c++, arg_et = ET[arg_et].right)
1883                             {   if (ET[arg_et].value.type == VARIABLE_OT)
1884               error("Only constants can be used as possible 'random' results");
1885                                 array_entry(arg_c, FALSE, ET[arg_et].value);
1886                             }
1887                             finish_array(arg_c, FALSE);
1888
1889                             assemblez_1_to(random_zc, AO, temp_var1);
1890                             assemblez_dec(temp_var1);
1891                             assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
1892                          }
1893                          else
1894                          assemblez_1_to(random_zc,
1895                              ET[ET[below].right].value, Result);
1896                          break;
1897
1898                      case PARENT_SYSF:
1899                          {  assembly_operand AO;
1900                             AO = ET[ET[below].right].value;
1901                             if (runtime_error_checking_switch)
1902                                 AO = check_nonzero_at_runtime(AO, -1,
1903                                     PARENT_RTE);
1904                             assemblez_1_to(get_parent_zc, AO, Result);
1905                          }
1906                          break;
1907
1908                      case ELDEST_SYSF:
1909                      case CHILD_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==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
1915                             assemblez_objcode(get_child_zc,
1916                                AO, Result, -2, TRUE);
1917                          }
1918                          break;
1919
1920                      case YOUNGER_SYSF:
1921                      case SIBLING_SYSF:
1922                          {  assembly_operand AO;
1923                             AO = ET[ET[below].right].value;
1924                             if (runtime_error_checking_switch)
1925                                AO = check_nonzero_at_runtime(AO, -1,
1926                                (sf_number==SIBLING_SYSF)
1927                                    ?SIBLING_RTE:YOUNGER_RTE);
1928                             assemblez_objcode(get_sibling_zc,
1929                                AO, Result, -2, TRUE);
1930                          }
1931                          break;
1932
1933                      case INDIRECT_SYSF:
1934                          j=0; i = ET[below].right;
1935                          check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
1936                          goto IndirectFunctionCallZ;
1937
1938                      case CHILDREN_SYSF:
1939                          {  assembly_operand AO;
1940                              AO = ET[ET[below].right].value;
1941                              if (runtime_error_checking_switch)
1942                                  AO = check_nonzero_at_runtime(AO, -1,
1943                                      CHILDREN_RTE);
1944                              assemblez_store(temp_var1, zero_operand);
1945                              assemblez_objcode(get_child_zc,
1946                                  AO, stack_pointer, next_label+1, FALSE);
1947                              assemble_label_no(next_label);
1948                              assemblez_inc(temp_var1);
1949                              assemblez_objcode(get_sibling_zc,
1950                                  stack_pointer, stack_pointer,
1951                                  next_label, TRUE);
1952                              assemble_label_no(next_label+1);
1953                              assemblez_store(temp_var2, stack_pointer);
1954                              if (!void_flag) write_result_z(Result, temp_var1);
1955                              next_label += 2;
1956                          }
1957                          break;
1958
1959                      case YOUNGEST_SYSF:
1960                          {  assembly_operand AO;
1961                              AO = ET[ET[below].right].value;
1962                              if (runtime_error_checking_switch)
1963                                  AO = check_nonzero_at_runtime(AO, -1,
1964                                      YOUNGEST_RTE);
1965                              assemblez_objcode(get_child_zc,
1966                                  AO, temp_var1, next_label+1, FALSE);
1967                              assemblez_1(push_zc, temp_var1);
1968                              assemble_label_no(next_label);
1969                              assemblez_store(temp_var1, stack_pointer);
1970                              assemblez_objcode(get_sibling_zc,
1971                                  temp_var1, stack_pointer, next_label, TRUE);
1972                              assemble_label_no(next_label+1);
1973                              if (!void_flag) write_result_z(Result, temp_var1);
1974                              next_label += 2;
1975                          }
1976                          break;
1977
1978                      case ELDER_SYSF:
1979                          assemblez_store(temp_var1, ET[ET[below].right].value);
1980                          if (runtime_error_checking_switch)
1981                              check_nonzero_at_runtime(temp_var1, -1,
1982                                  ELDER_RTE);
1983                          assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
1984                          assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
1985                          assemblez_store(temp_var2, temp_var3);
1986                          assemblez_store(temp_var3, zero_operand);
1987                          assemblez_objcode(get_child_zc,
1988                              temp_var2, temp_var2, next_label, TRUE);
1989                          assemble_label_no(next_label++);
1990                          assemblez_2_branch(je_zc, temp_var1, temp_var2,
1991                              next_label, TRUE);
1992                          assemblez_store(temp_var3, temp_var2);
1993                          assemblez_objcode(get_sibling_zc,
1994                              temp_var2, temp_var2, next_label - 1, TRUE);
1995                          assemble_label_no(next_label++);
1996                          if (!void_flag) write_result_z(Result, temp_var3);
1997                          break;
1998
1999                      case METACLASS_SYSF:
2000                          assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
2001                              veneer_routine(Metaclass_VR),
2002                              ET[ET[below].right].value, Result);
2003                          break;
2004
2005                      case GLK_SYSF:
2006                          error("The glk() system function does not exist in Z-code");
2007                          break;
2008                  }
2009                  break;
2010              }
2011              check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2012
2013              GenFunctionCallZ:
2014
2015              i = below;
2016
2017              IndirectFunctionCallZ:
2018
2019              while ((i != -1) && (j<8))
2020              {   AI.operand[j++] = ET[i].value;
2021                  i = ET[i].right;
2022              }
2023
2024              if ((j > 4) && (version_number == 3))
2025              {   error("A function may be called with at most 3 arguments");
2026                  j = 4;
2027              }
2028              if ((j==8) && (i != -1))
2029              {   error("A function may be called with at most 7 arguments");
2030              }
2031
2032              AI.operand_count = j;
2033
2034              if ((void_flag) && (version_number >= 5))
2035              {   AI.store_variable_number = -1;
2036                  switch(j)
2037                  {   case 1: AI.internal_number = call_1n_zc; break;
2038                      case 2: AI.internal_number = call_2n_zc; break;
2039                      case 3: case 4: AI.internal_number = call_vn_zc; break;
2040                      case 5: case 6: case 7: case 8:
2041                          AI.internal_number = call_vn2_zc; break;
2042                  }
2043              }
2044              else
2045              {   AI.store_variable_number = Result.value;
2046                  if (version_number == 3)
2047                      AI.internal_number = call_zc;
2048                  else
2049                  switch(j)
2050                  {   case 1: AI.internal_number = call_1s_zc; break;
2051                      case 2: AI.internal_number = call_2s_zc; break;
2052                      case 3: case 4: AI.internal_number = call_vs_zc; break;
2053                      case 5: case 6: case 7: case 8:
2054                          AI.internal_number = call_vs2_zc; break;
2055                  }
2056              }
2057
2058              AI.branch_label_number = -1;
2059              assemblez_instruction(&AI);
2060              break;
2061
2062         case SETEQUALS_OP:
2063              assemblez_store(ET[below].value,
2064                  ET[ET[below].right].value);
2065              if (!void_flag) write_result_z(Result, ET[below].value);
2066              break;
2067
2068         case PROPERTY_SETEQUALS_OP:
2069              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2070              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2071              if (!void_flag)
2072              {   if (runtime_error_checking_switch)
2073                      assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
2074                          ET[below].value, ET[ET[below].right].value,
2075                          ET[ET[ET[below].right].right].value, Result);
2076                  else
2077                  {   assemblez_store(temp_var1,
2078                          ET[ET[ET[below].right].right].value);
2079                      assemblez_3(put_prop_zc, ET[below].value,
2080                          ET[ET[below].right].value,
2081                          temp_var1);
2082                      write_result_z(Result, temp_var1);
2083                  }
2084              }
2085              else
2086              {   if (runtime_error_checking_switch && (!veneer_mode))
2087                      assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2088                          ET[below].value, ET[ET[below].right].value,
2089                          ET[ET[ET[below].right].right].value);
2090                  else assemblez_3(put_prop_zc, ET[below].value,
2091                      ET[ET[below].right].value,
2092                      ET[ET[ET[below].right].right].value);
2093              }
2094              break;
2095         case ARROW_SETEQUALS_OP:
2096              if (!void_flag)
2097              {   assemblez_store(temp_var1,
2098                      ET[ET[ET[below].right].right].value);
2099                  access_memory_z(storeb_zc, ET[below].value,
2100                      ET[ET[below].right].value,
2101                      temp_var1);
2102                  write_result_z(Result, temp_var1);
2103              }
2104              else access_memory_z(storeb_zc, ET[below].value,
2105                      ET[ET[below].right].value,
2106                      ET[ET[ET[below].right].right].value);
2107              break;
2108
2109         case DARROW_SETEQUALS_OP:
2110              if (!void_flag)
2111              {   assemblez_store(temp_var1,
2112                      ET[ET[ET[below].right].right].value);
2113                  access_memory_z(storew_zc, ET[below].value,
2114                      ET[ET[below].right].value,
2115                      temp_var1);
2116                  write_result_z(Result, temp_var1);
2117              }
2118              else
2119                  access_memory_z(storew_zc, ET[below].value,
2120                      ET[ET[below].right].value,
2121                      ET[ET[ET[below].right].right].value);
2122              break;
2123
2124         case INC_OP:
2125              assemblez_inc(ET[below].value);
2126              if (!void_flag) write_result_z(Result, ET[below].value);
2127              break;
2128         case DEC_OP:
2129              assemblez_dec(ET[below].value);
2130              if (!void_flag) write_result_z(Result, ET[below].value);
2131              break;
2132         case POST_INC_OP:
2133              if (!void_flag) write_result_z(Result, ET[below].value);
2134              assemblez_inc(ET[below].value);
2135              break;
2136         case POST_DEC_OP:
2137              if (!void_flag) write_result_z(Result, ET[below].value);
2138              assemblez_dec(ET[below].value);
2139              break;
2140
2141         case ARROW_INC_OP:
2142              assemblez_store(temp_var1, ET[below].value);
2143              assemblez_store(temp_var2, ET[ET[below].right].value);
2144              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2145              assemblez_inc(temp_var3);
2146              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2147              if (!void_flag) write_result_z(Result, temp_var3);
2148              break;
2149
2150         case ARROW_DEC_OP:
2151              assemblez_store(temp_var1, ET[below].value);
2152              assemblez_store(temp_var2, ET[ET[below].right].value);
2153              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2154              assemblez_dec(temp_var3);
2155              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2156              if (!void_flag) write_result_z(Result, temp_var3);
2157              break;
2158
2159         case ARROW_POST_INC_OP:
2160              assemblez_store(temp_var1, ET[below].value);
2161              assemblez_store(temp_var2, ET[ET[below].right].value);
2162              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2163              if (!void_flag) write_result_z(Result, temp_var3);
2164              assemblez_inc(temp_var3);
2165              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2166              break;
2167
2168         case ARROW_POST_DEC_OP:
2169              assemblez_store(temp_var1, ET[below].value);
2170              assemblez_store(temp_var2, ET[ET[below].right].value);
2171              access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
2172              if (!void_flag) write_result_z(Result, temp_var3);
2173              assemblez_dec(temp_var3);
2174              access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
2175              break;
2176
2177         case DARROW_INC_OP:
2178              assemblez_store(temp_var1, ET[below].value);
2179              assemblez_store(temp_var2, ET[ET[below].right].value);
2180              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2181              assemblez_inc(temp_var3);
2182              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2183              if (!void_flag) write_result_z(Result, temp_var3);
2184              break;
2185
2186         case DARROW_DEC_OP:
2187              assemblez_store(temp_var1, ET[below].value);
2188              assemblez_store(temp_var2, ET[ET[below].right].value);
2189              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2190              assemblez_dec(temp_var3);
2191              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2192              if (!void_flag) write_result_z(Result, temp_var3);
2193              break;
2194
2195         case DARROW_POST_INC_OP:
2196              assemblez_store(temp_var1, ET[below].value);
2197              assemblez_store(temp_var2, ET[ET[below].right].value);
2198              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2199              if (!void_flag) write_result_z(Result, temp_var3);
2200              assemblez_inc(temp_var3);
2201              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2202              break;
2203
2204         case DARROW_POST_DEC_OP:
2205              assemblez_store(temp_var1, ET[below].value);
2206              assemblez_store(temp_var2, ET[ET[below].right].value);
2207              access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
2208              if (!void_flag) write_result_z(Result, temp_var3);
2209              assemblez_dec(temp_var3);
2210              access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
2211              break;
2212
2213         case PROPERTY_INC_OP:
2214              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"++.\" expression");
2215              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"++.\" expression");
2216              assemblez_store(temp_var1, ET[below].value);
2217              assemblez_store(temp_var2, ET[ET[below].right].value);
2218              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2219              assemblez_inc(temp_var3);
2220              if (runtime_error_checking_switch && (!veneer_mode))
2221                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2222                          temp_var1, temp_var2, temp_var3);
2223              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2224              if (!void_flag) write_result_z(Result, temp_var3);
2225              break;
2226
2227         case PROPERTY_DEC_OP:
2228              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\"--.\" expression");
2229              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\"--.\" expression");
2230              assemblez_store(temp_var1, ET[below].value);
2231              assemblez_store(temp_var2, ET[ET[below].right].value);
2232              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2233              assemblez_dec(temp_var3);
2234              if (runtime_error_checking_switch && (!veneer_mode))
2235                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2236                          temp_var1, temp_var2, temp_var3);
2237              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2238              if (!void_flag) write_result_z(Result, temp_var3);
2239              break;
2240
2241         case PROPERTY_POST_INC_OP:
2242              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2243              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2244              assemblez_store(temp_var1, ET[below].value);
2245              assemblez_store(temp_var2, ET[ET[below].right].value);
2246              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2247              if (!void_flag) write_result_z(Result, temp_var3);
2248              assemblez_inc(temp_var3);
2249              if (runtime_error_checking_switch && (!veneer_mode))
2250                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2251                          temp_var1, temp_var2, temp_var3);
2252              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2253              break;
2254
2255         case PROPERTY_POST_DEC_OP:
2256              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2257              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2258              assemblez_store(temp_var1, ET[below].value);
2259              assemblez_store(temp_var2, ET[ET[below].right].value);
2260              assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
2261              if (!void_flag) write_result_z(Result, temp_var3);
2262              assemblez_dec(temp_var3);
2263              if (runtime_error_checking_switch && (!veneer_mode))
2264                   assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
2265                          temp_var1, temp_var2, temp_var3);
2266              else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
2267              break;
2268
2269         default:
2270             printf("** Trouble op = %d i.e. '%s' **\n",
2271                 opnum, operators[opnum].description);
2272             compiler_error("Expr code gen: Can't generate yet");
2273     }
2274   }
2275   else { /* Glulx */
2276     assembly_operand AO, AO2;
2277     if (operators[opnum].opcode_number_g != -1)
2278     {
2279         /*  Operators directly translatable into opcodes: infix ops
2280             take two operands whereas pre/postfix operators take only one */
2281
2282         if (operators[opnum].usage == IN_U)
2283         {   int o_n = operators[opnum].opcode_number_g;
2284             if (runtime_error_checking_switch && (!veneer_mode)
2285                 && ((o_n == div_gc) || (o_n == mod_gc)))
2286             {   assembly_operand by_ao, error_ao; int ln;
2287                 by_ao = ET[ET[below].right].value;
2288                 if ((by_ao.value != 0) && (by_ao.marker == 0)
2289                     && is_constant_ot(by_ao.type))
2290                     assembleg_3(o_n, ET[below].value,
2291                         by_ao, Result);
2292                 else
2293                 {   assembleg_store(temp_var1, ET[below].value);
2294                     assembleg_store(temp_var2, by_ao);
2295                     ln = next_label++;
2296                     assembleg_1_branch(jnz_gc, temp_var2, ln);
2297                     INITAO(&error_ao);
2298                     error_ao.value = DBYZERO_RTE;
2299                     set_constant_ot(&error_ao);
2300                     assembleg_call_1(veneer_routine(RT__Err_VR),
2301                       error_ao, zero_operand);
2302                     assembleg_store(temp_var2, one_operand);
2303                     assemble_label_no(ln);
2304                     assembleg_3(o_n, temp_var1, temp_var2, Result);
2305                 }
2306             }
2307             else
2308             assembleg_3(o_n, ET[below].value,
2309                 ET[ET[below].right].value, Result);
2310         }
2311         else
2312             assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
2313                 Result);
2314     }
2315     else
2316     switch(opnum)
2317     {
2318
2319         case PUSH_OP:
2320              if (ET[below].value.type == Result.type
2321                && ET[below].value.value == Result.value
2322                && ET[below].value.marker == Result.marker)
2323                break;
2324              assembleg_2(copy_gc, ET[below].value, Result);
2325              break;
2326
2327         case UNARY_MINUS_OP:
2328              assembleg_2(neg_gc, ET[below].value, Result);
2329              break;
2330         case ARTNOT_OP:
2331              assembleg_2(bitnot_gc, ET[below].value, Result);
2332              break;
2333
2334         case ARROW_OP:
2335              access_memory_g(aloadb_gc, ET[below].value,
2336                                       ET[ET[below].right].value, Result);
2337              break;
2338         case DARROW_OP:
2339              access_memory_g(aload_gc, ET[below].value,
2340                                      ET[ET[below].right].value, Result);
2341              break;
2342
2343         case SETEQUALS_OP:
2344              assembleg_store(ET[below].value,
2345                  ET[ET[below].right].value);
2346              if (!void_flag) write_result_g(Result, ET[below].value);
2347              break;
2348
2349         case ARROW_SETEQUALS_OP:
2350              if (!void_flag)
2351              {   assembleg_store(temp_var1,
2352                      ET[ET[ET[below].right].right].value);
2353                  access_memory_g(astoreb_gc, ET[below].value,
2354                      ET[ET[below].right].value,
2355                      temp_var1);
2356                  write_result_g(Result, temp_var1);
2357              }
2358              else access_memory_g(astoreb_gc, ET[below].value,
2359                      ET[ET[below].right].value,
2360                      ET[ET[ET[below].right].right].value);
2361              break;
2362
2363         case DARROW_SETEQUALS_OP:
2364              if (!void_flag)
2365              {   assembleg_store(temp_var1,
2366                      ET[ET[ET[below].right].right].value);
2367                  access_memory_g(astore_gc, ET[below].value,
2368                      ET[ET[below].right].value,
2369                      temp_var1);
2370                  write_result_g(Result, temp_var1);
2371              }
2372              else
2373                  access_memory_g(astore_gc, ET[below].value,
2374                      ET[ET[below].right].value,
2375                      ET[ET[ET[below].right].right].value);
2376              break;
2377
2378         case INC_OP:
2379              assembleg_inc(ET[below].value);
2380              if (!void_flag) write_result_g(Result, ET[below].value);
2381              break;
2382         case DEC_OP:
2383              assembleg_dec(ET[below].value);
2384              if (!void_flag) write_result_g(Result, ET[below].value);
2385              break;
2386         case POST_INC_OP:
2387              if (!void_flag) write_result_g(Result, ET[below].value);
2388              assembleg_inc(ET[below].value);
2389              break;
2390         case POST_DEC_OP:
2391              if (!void_flag) write_result_g(Result, ET[below].value);
2392              assembleg_dec(ET[below].value);
2393              break;
2394
2395         case ARROW_INC_OP:
2396              assembleg_store(temp_var1, ET[below].value);
2397              assembleg_store(temp_var2, ET[ET[below].right].value);
2398              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2399              assembleg_inc(temp_var3);
2400              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2401              if (!void_flag) write_result_g(Result, temp_var3);
2402              break;
2403
2404         case ARROW_DEC_OP:
2405              assembleg_store(temp_var1, ET[below].value);
2406              assembleg_store(temp_var2, ET[ET[below].right].value);
2407              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2408              assembleg_dec(temp_var3);
2409              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2410              if (!void_flag) write_result_g(Result, temp_var3);
2411              break;
2412
2413         case ARROW_POST_INC_OP:
2414              assembleg_store(temp_var1, ET[below].value);
2415              assembleg_store(temp_var2, ET[ET[below].right].value);
2416              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2417              if (!void_flag) write_result_g(Result, temp_var3);
2418              assembleg_inc(temp_var3);
2419              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2420              break;
2421
2422         case ARROW_POST_DEC_OP:
2423              assembleg_store(temp_var1, ET[below].value);
2424              assembleg_store(temp_var2, ET[ET[below].right].value);
2425              access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
2426              if (!void_flag) write_result_g(Result, temp_var3);
2427              assembleg_dec(temp_var3);
2428              access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
2429              break;
2430
2431         case DARROW_INC_OP:
2432              assembleg_store(temp_var1, ET[below].value);
2433              assembleg_store(temp_var2, ET[ET[below].right].value);
2434              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2435              assembleg_inc(temp_var3);
2436              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2437              if (!void_flag) write_result_g(Result, temp_var3);
2438              break;
2439
2440         case DARROW_DEC_OP:
2441              assembleg_store(temp_var1, ET[below].value);
2442              assembleg_store(temp_var2, ET[ET[below].right].value);
2443              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2444              assembleg_dec(temp_var3);
2445              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2446              if (!void_flag) write_result_g(Result, temp_var3);
2447              break;
2448
2449         case DARROW_POST_INC_OP:
2450              assembleg_store(temp_var1, ET[below].value);
2451              assembleg_store(temp_var2, ET[ET[below].right].value);
2452              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2453              if (!void_flag) write_result_g(Result, temp_var3);
2454              assembleg_inc(temp_var3);
2455              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2456              break;
2457
2458         case DARROW_POST_DEC_OP:
2459              assembleg_store(temp_var1, ET[below].value);
2460              assembleg_store(temp_var2, ET[ET[below].right].value);
2461              access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
2462              if (!void_flag) write_result_g(Result, temp_var3);
2463              assembleg_dec(temp_var3);
2464              access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
2465              break;
2466
2467         case PROPERTY_OP:
2468         case MESSAGE_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(RV__Pr_VR);
2472              goto TwoArgFunctionCall;
2473         case MPROP_ADD_OP:
2474         case PROP_ADD_OP:
2475              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".&\" expression");
2476              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".&\" expression");
2477              AO = veneer_routine(RA__Pr_VR);
2478              goto TwoArgFunctionCall;
2479         case MPROP_NUM_OP:
2480         case PROP_NUM_OP:
2481              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".#\" expression");
2482              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".#\" expression");
2483              AO = veneer_routine(RL__Pr_VR);
2484              goto TwoArgFunctionCall;
2485
2486         case PROP_CALL_OP:
2487         case MESSAGE_CALL_OP:
2488              check_warn_symbol_has_metaclass(&ET[below].value, "\".()\" expression");
2489              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".()\" expression");
2490              AO2 = veneer_routine(CA__Pr_VR);
2491              i = below;
2492              goto DoFunctionCall;
2493
2494         case MESSAGE_INC_OP:
2495         case PROPERTY_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(IB__Pr_VR);
2499              goto TwoArgFunctionCall;
2500         case MESSAGE_DEC_OP:
2501         case PROPERTY_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(DB__Pr_VR);
2505              goto TwoArgFunctionCall;
2506         case MESSAGE_POST_INC_OP:
2507         case PROPERTY_POST_INC_OP:
2508              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".++\" expression");
2509              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".++\" expression");
2510              AO = veneer_routine(IA__Pr_VR);
2511              goto TwoArgFunctionCall;
2512         case MESSAGE_POST_DEC_OP:
2513         case PROPERTY_POST_DEC_OP:
2514              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".--\" expression");
2515              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".--\" expression");
2516              AO = veneer_routine(DA__Pr_VR);
2517              goto TwoArgFunctionCall;
2518         case SUPERCLASS_OP:
2519              AO = veneer_routine(RA__Sc_VR);
2520              goto TwoArgFunctionCall;
2521
2522              TwoArgFunctionCall:
2523              {
2524                assembly_operand AO2 = ET[below].value;
2525                assembly_operand AO3 = ET[ET[below].right].value;
2526                if (void_flag)
2527                  assembleg_call_2(AO, AO2, AO3, zero_operand);
2528                else
2529                  assembleg_call_2(AO, AO2, AO3, Result);
2530              }
2531              break;
2532
2533         case PROPERTY_SETEQUALS_OP:
2534         case MESSAGE_SETEQUALS_OP:
2535              check_warn_symbol_type(&ET[below].value, OBJECT_T, CLASS_T, "\".\" expression");
2536              check_warn_symbol_type(&ET[ET[below].right].value, PROPERTY_T, INDIVIDUAL_PROPERTY_T, "\".\" expression");
2537              if (runtime_error_checking_switch && (!veneer_mode))
2538                  AO = veneer_routine(RT__ChPS_VR);
2539                else
2540                  AO = veneer_routine(WV__Pr_VR);
2541
2542              {
2543                assembly_operand AO2 = ET[below].value;
2544                assembly_operand AO3 = ET[ET[below].right].value;
2545                assembly_operand AO4 = ET[ET[ET[below].right].right].value;
2546                if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
2547                  /* Rightmost is on the stack; reduce to previous case. */
2548                  if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2549                    if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2550                      /* both already on stack. */
2551                    }
2552                    else {
2553                      assembleg_store(stack_pointer, AO3);
2554                      assembleg_0(stkswap_gc);
2555                    }
2556                  }
2557                  else {
2558                    if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2559                      assembleg_store(stack_pointer, AO2);
2560                    }
2561                    else {
2562                      assembleg_store(stack_pointer, AO3);
2563                      assembleg_store(stack_pointer, AO2);
2564                    }
2565                  }
2566                }
2567                else {
2568                  /* We have to get the rightmost on the stack, below the
2569                     others. */
2570                  if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
2571                    if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2572                      assembleg_store(stack_pointer, AO4);
2573                      assembleg_2(stkroll_gc, three_operand, one_operand);
2574                    }
2575                    else {
2576                      assembleg_store(stack_pointer, AO4);
2577                      assembleg_0(stkswap_gc);
2578                      assembleg_store(stack_pointer, AO2);
2579                    }
2580                  }
2581                  else {
2582                    if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
2583                      assembleg_store(stack_pointer, AO4);
2584                      assembleg_store(stack_pointer, AO3);
2585                      assembleg_2(stkroll_gc, three_operand, two_operand);
2586                    }
2587                    else {
2588                      assembleg_store(stack_pointer, AO4);
2589                      assembleg_store(stack_pointer, AO3);
2590                      assembleg_store(stack_pointer, AO2);
2591                    }
2592                  }
2593                }
2594                if (void_flag)
2595                  assembleg_3(call_gc, AO, three_operand, zero_operand);
2596                else
2597                  assembleg_3(call_gc, AO, three_operand, Result);
2598              }
2599              break;
2600
2601         case FCALL_OP:
2602              j = 0;
2603
2604              if (ET[below].value.type == SYSFUN_OT)
2605              {   int sf_number = ET[below].value.value;
2606
2607                  i = ET[below].right;
2608                  if (i == -1)
2609                  {   error("Argument to system function missing");
2610                      AI.operand[0] = one_operand;
2611                      AI.operand_count = 1;
2612                  }
2613                  else
2614                  {   j=0;
2615                      while (i != -1) { j++; i = ET[i].right; }
2616
2617                      if (((sf_number != INDIRECT_SYSF) &&
2618                          (sf_number != GLK_SYSF) &&
2619                          (sf_number != RANDOM_SYSF) && (j > 1)))
2620                      {   j=1;
2621                          error("System function given with too many arguments");
2622                      }
2623                      if (sf_number != RANDOM_SYSF)
2624                      {   int jcount;
2625                          i = ET[below].right;
2626                          for (jcount = 0; jcount < j; jcount++)
2627                          {   AI.operand[jcount] = ET[i].value;
2628                              i = ET[i].right;
2629                          }
2630                          AI.operand_count = j;
2631                      }
2632                  }
2633
2634                  switch(sf_number)
2635                  {
2636                      case RANDOM_SYSF:
2637                          if (j>1)
2638                          {  assembly_operand AO, AO2;
2639                             int arg_c, arg_et;
2640                             INITAO(&AO);
2641                             AO.value = j;
2642                             set_constant_ot(&AO);
2643                             INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
2644                             AO2.marker = ARRAY_MV;
2645
2646                             for (arg_c=0, arg_et = ET[below].right;arg_c<j;
2647                                  arg_c++, arg_et = ET[arg_et].right)
2648                             {   if (ET[arg_et].value.type == LOCALVAR_OT
2649                                     || ET[arg_et].value.type == GLOBALVAR_OT)
2650               error("Only constants can be used as possible 'random' results");
2651                                 array_entry(arg_c, FALSE, ET[arg_et].value);
2652                             }
2653                             finish_array(arg_c, FALSE);
2654
2655                             assembleg_2(random_gc, AO, stack_pointer);
2656                             assembleg_3(aload_gc, AO2, stack_pointer, Result);
2657                          }
2658                          else if (is_constant_ot(ET[ET[below].right].value.type) && ET[ET[below].right].value.marker == 0) {
2659                            /* One argument, value known at compile time */
2660                            int32 arg = ET[ET[below].right].value.value; /* signed */
2661                            if (arg > 0) {
2662                              assembly_operand AO;
2663                              INITAO(&AO);
2664                              AO.value = arg;
2665                              set_constant_ot(&AO);
2666                              assembleg_2(random_gc,
2667                                AO, stack_pointer);
2668                              assembleg_3(add_gc, stack_pointer, one_operand,
2669                                Result);
2670                            }
2671                            else {
2672                              /* This handles zero or negative */
2673                              assembly_operand AO;
2674                              INITAO(&AO);
2675                              AO.value = -arg;
2676                              set_constant_ot(&AO);
2677                              assembleg_1(setrandom_gc,
2678                                AO);
2679                              assembleg_store(Result, zero_operand);
2680                            }
2681                          }
2682                          else {
2683                            /* One argument, not known at compile time */
2684                            int ln, ln2;
2685                            assembleg_store(temp_var1, ET[ET[below].right].value);
2686                            ln = next_label++;
2687                            ln2 = next_label++;
2688                            assembleg_2_branch(jle_gc, temp_var1, zero_operand, ln);
2689                            assembleg_2(random_gc,
2690                              temp_var1, stack_pointer);
2691                            assembleg_3(add_gc, stack_pointer, one_operand,
2692                              Result);
2693                            assembleg_0_branch(jump_gc, ln2);
2694                            assemble_label_no(ln);
2695                            assembleg_2(neg_gc, temp_var1, stack_pointer);
2696                            assembleg_1(setrandom_gc,
2697                              stack_pointer);
2698                            assembleg_store(Result, zero_operand);
2699                            assemble_label_no(ln2);
2700                          }
2701                          break;
2702
2703                      case PARENT_SYSF:
2704                          {  assembly_operand AO;
2705                             AO = ET[ET[below].right].value;
2706                             if (runtime_error_checking_switch)
2707                                 AO = check_nonzero_at_runtime(AO, -1,
2708                                     PARENT_RTE);
2709                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2710                             assembleg_3(aload_gc, AO, AO2, Result);
2711                          }
2712                          break;
2713
2714                      case ELDEST_SYSF:
2715                      case CHILD_SYSF:
2716                          {  assembly_operand AO;
2717                             AO = ET[ET[below].right].value;
2718                             if (runtime_error_checking_switch)
2719                                AO = check_nonzero_at_runtime(AO, -1,
2720                                (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
2721                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2722                             assembleg_3(aload_gc, AO, AO2, Result);
2723                          }
2724                          break;
2725
2726                      case YOUNGER_SYSF:
2727                      case SIBLING_SYSF:
2728                          {  assembly_operand AO;
2729                             AO = ET[ET[below].right].value;
2730                             if (runtime_error_checking_switch)
2731                                AO = check_nonzero_at_runtime(AO, -1,
2732                                (sf_number==SIBLING_SYSF)
2733                                    ?SIBLING_RTE:YOUNGER_RTE);
2734                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
2735                             assembleg_3(aload_gc, AO, AO2, Result);
2736                          }
2737                          break;
2738
2739                      case CHILDREN_SYSF:
2740                          {  assembly_operand AO;
2741                             AO = ET[ET[below].right].value;
2742                             if (runtime_error_checking_switch)
2743                                 AO = check_nonzero_at_runtime(AO, -1,
2744                                     CHILDREN_RTE);
2745                             INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2746                             assembleg_store(temp_var1, zero_operand);
2747                             assembleg_3(aload_gc, AO, AO2, temp_var2);
2748                             AO2.value = GOBJFIELD_SIBLING();
2749                             assemble_label_no(next_label);
2750                             assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2751                             assembleg_3(add_gc, temp_var1, one_operand,
2752                               temp_var1);
2753                             assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
2754                             assembleg_0_branch(jump_gc, next_label);
2755                             assemble_label_no(next_label+1);
2756                             next_label += 2;
2757                             if (!void_flag)
2758                               write_result_g(Result, temp_var1);
2759                          }
2760                          break;
2761
2762                      case INDIRECT_SYSF:
2763                          i = ET[below].right;
2764                          check_warn_symbol_type(&ET[i].value, ROUTINE_T, 0, "indirect function call");
2765                          goto IndirectFunctionCallG;
2766
2767                      case GLK_SYSF:
2768                          AO2 = veneer_routine(Glk__Wrap_VR);
2769                          i = ET[below].right;
2770                          goto DoFunctionCall;
2771
2772                      case METACLASS_SYSF:
2773                          assembleg_call_1(veneer_routine(Metaclass_VR),
2774                              ET[ET[below].right].value, Result);
2775                          break;
2776
2777                      case YOUNGEST_SYSF:
2778                          AO = ET[ET[below].right].value;
2779                          if (runtime_error_checking_switch)
2780                            AO = check_nonzero_at_runtime(AO, -1,
2781                              YOUNGEST_RTE);
2782                          INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
2783                          assembleg_3(aload_gc, AO, AO2, temp_var1);
2784                          AO2.value = GOBJFIELD_SIBLING();
2785                          assembleg_1_branch(jz_gc, temp_var1, next_label+1);
2786                          assemble_label_no(next_label);
2787                          assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2788                          assembleg_1_branch(jz_gc, temp_var2, next_label+1);
2789                          assembleg_store(temp_var1, temp_var2);
2790                          assembleg_0_branch(jump_gc, next_label);
2791                          assemble_label_no(next_label+1);
2792                          if (!void_flag)
2793                            write_result_g(Result, temp_var1);
2794                          next_label += 2;
2795                          break;
2796
2797                      case ELDER_SYSF:
2798                          AO = ET[ET[below].right].value;
2799                          if (runtime_error_checking_switch)
2800                            AO = check_nonzero_at_runtime(AO, -1,
2801                              YOUNGEST_RTE);
2802                          assembleg_store(temp_var3, AO);
2803                          INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
2804                          assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
2805                          assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2806                          AO2.value = GOBJFIELD_CHILD();
2807                          assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
2808                          assembleg_1_branch(jz_gc, temp_var1, next_label+2);
2809                          assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
2810                            next_label+1);
2811                          assemble_label_no(next_label);
2812                          AO2.value = GOBJFIELD_SIBLING();
2813                          assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
2814                          assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
2815                            next_label+2);
2816                          assembleg_store(temp_var1, temp_var2);
2817                          assembleg_0_branch(jump_gc, next_label);
2818                          assemble_label_no(next_label+1);
2819                          assembleg_store(temp_var1, zero_operand);
2820                          assemble_label_no(next_label+2);
2821                          if (!void_flag)
2822                            write_result_g(Result, temp_var1);
2823                          next_label += 3;
2824                          break;
2825
2826                      default:
2827                          error("*** system function not implemented ***");
2828                          break;
2829
2830                  }
2831                  break;
2832              }
2833
2834              check_warn_symbol_type(&ET[below].value, ROUTINE_T, 0, "function call");
2835              i = below;
2836
2837              IndirectFunctionCallG:
2838
2839              /* Get the function address. */
2840              AO2 = ET[i].value;
2841              i = ET[i].right;
2842
2843              DoFunctionCall:
2844
2845              {
2846                /* If all the function arguments are in local/global
2847                   variables, we have to push them all on the stack.
2848                   If all of them are on the stack, we have to do nothing.
2849                   If some are and some aren't, we have a hopeless mess,
2850                   and we should throw a compiler error.
2851                */
2852
2853                int onstack = 0;
2854                int offstack = 0;
2855
2856                /* begin part of patch G03701 */
2857                int nargs = 0;
2858                j = i;
2859                while (j != -1) {
2860                  nargs++;
2861                  j = ET[j].right;
2862                }
2863
2864                if (nargs==0) {
2865                  assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
2866                } else if (nargs==1) {
2867                  assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
2868                } else if (nargs==2) {
2869                  assembly_operand o1 = ET[i].value;
2870                  assembly_operand o2 = ET[ET[i].right].value;
2871                  assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
2872                } else if (nargs==3) {
2873                  assembly_operand o1 = ET[i].value;
2874                  assembly_operand o2 = ET[ET[i].right].value;
2875                  assembly_operand o3 = ET[ET[ET[i].right].right].value;
2876                  assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
2877                } else {
2878
2879                  j = 0;
2880                  while (i != -1) {
2881                      if (ET[i].value.type == LOCALVAR_OT
2882                        && ET[i].value.value == 0) {
2883                        onstack++;
2884                      }
2885                      else {
2886                        assembleg_store(stack_pointer, ET[i].value);
2887                        offstack++;
2888                      }
2889                      i = ET[i].right;
2890                      j++;
2891                  }
2892
2893                  if (onstack && offstack)
2894                      error("*** Function call cannot be generated with mixed arguments ***");
2895                  if (offstack > 1)
2896                      error("*** Function call cannot be generated with more than one nonstack argument ***");
2897
2898                  INITAO(&AO);
2899                  AO.value = j;
2900                  set_constant_ot(&AO);
2901
2902                  if (void_flag)
2903                    assembleg_3(call_gc, AO2, AO, zero_operand);
2904                  else
2905                    assembleg_3(call_gc, AO2, AO, Result);
2906
2907                } /* else nargs>=4 */
2908              } /* DoFunctionCall: */
2909
2910              break;
2911
2912         default:
2913             printf("** Trouble op = %d i.e. '%s' **\n",
2914                 opnum, operators[opnum].description);
2915             compiler_error("Expr code gen: Can't generate yet");
2916     }
2917   }
2918
2919     ET[n].value = Result;
2920
2921     OperatorGenerated:
2922
2923     if (!glulx_mode) {
2924
2925         if (ET[n].to_expression)
2926         {
2927             int32 donelabel;
2928             if (void_flag) {
2929                 warning("Logical expression has no side-effects");
2930                 if (ET[n].true_label != -1)
2931                     assemble_label_no(ET[n].true_label);
2932                 else
2933                     assemble_label_no(ET[n].false_label);
2934             }
2935             else if (ET[n].true_label != -1)
2936             {
2937                 donelabel = next_label++;
2938                 if (!execution_never_reaches_here) {
2939                     assemblez_1(push_zc, zero_operand);
2940                     assemblez_jump(donelabel);
2941                 }
2942                 assemble_label_no(ET[n].true_label);
2943                 assemblez_1(push_zc, one_operand);
2944                 assemble_forward_label_no(donelabel);
2945             }
2946             else
2947             {
2948                 donelabel = next_label++;
2949                 if (!execution_never_reaches_here) {
2950                     assemblez_1(push_zc, one_operand);
2951                     assemblez_jump(donelabel);
2952                 }
2953                 assemble_label_no(ET[n].false_label);
2954                 assemblez_1(push_zc, zero_operand);
2955                 assemble_forward_label_no(donelabel);
2956             }
2957             ET[n].value = stack_pointer;
2958         }
2959         else
2960             if (ET[n].label_after != -1)
2961                 assemble_label_no(ET[n].label_after);
2962
2963     }
2964     else {
2965
2966         if (ET[n].to_expression)
2967         {
2968             int32 donelabel;
2969             if (void_flag) {
2970                 warning("Logical expression has no side-effects");
2971                 if (ET[n].true_label != -1)
2972                     assemble_label_no(ET[n].true_label);
2973                 else
2974                     assemble_label_no(ET[n].false_label);
2975             }
2976             else if (ET[n].true_label != -1)
2977             {
2978                 donelabel = next_label++;
2979                 if (!execution_never_reaches_here) {
2980                     assembleg_store(stack_pointer, zero_operand);
2981                     assembleg_jump(donelabel);
2982                 }
2983                 assemble_label_no(ET[n].true_label);
2984                 assembleg_store(stack_pointer, one_operand);
2985                 assemble_forward_label_no(donelabel);
2986             }
2987             else
2988             {
2989                 donelabel = next_label++;
2990                 if (!execution_never_reaches_here) {
2991                     assembleg_store(stack_pointer, one_operand);
2992                     assembleg_jump(donelabel);
2993                 }
2994                 assemble_label_no(ET[n].false_label);
2995                 assembleg_store(stack_pointer, zero_operand);
2996                 assemble_forward_label_no(donelabel);
2997             }
2998             ET[n].value = stack_pointer;
2999         }
3000         else
3001             if (ET[n].label_after != -1)
3002                 assemble_label_no(ET[n].label_after);
3003
3004     }
3005
3006     ET[n].down = -1;
3007 }
3008
3009 assembly_operand code_generate(assembly_operand AO, int context, int label)
3010 {
3011     /*  Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
3012             QUANTITY_CONTEXT.
3013
3014         If CONDITION_CONTEXT, then compile code branching to label number
3015             "label" if the condition is false: there's no return value.
3016         (Except that if label is -3 or -4 (internal codes for rfalse and
3017         rtrue rather than branch) then this is for branching when the
3018         condition is true.  This is used for optimising code generation
3019         for "if" statements.)
3020
3021         Otherwise return the assembly operand containing the result
3022         (probably the stack pointer variable but not necessarily:
3023          e.g. is would be short constant 2 from the expression "j++, 2")     */
3024
3025     vivc_flag = FALSE;
3026
3027     if (AO.type != EXPRESSION_OT)
3028     {   switch(context)
3029         {   case VOID_CONTEXT:
3030                 value_in_void_context(AO);
3031                 AO.type = OMITTED_OT;
3032                 AO.value = 0;
3033                 break;
3034             case CONDITION_CONTEXT:
3035                 if (!glulx_mode) {
3036                   if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
3037                   else assemblez_1_branch(jz_zc, AO, label, TRUE);
3038                 }
3039                 else {
3040                   if (label < -2)
3041                     assembleg_1_branch(jnz_gc, AO, label);
3042                   else
3043                     assembleg_1_branch(jz_gc, AO, label);
3044                 }
3045                 AO.type = OMITTED_OT;
3046                 AO.value = 0;
3047                 break;
3048         }
3049         return AO;
3050     }
3051
3052     if (expr_trace_level >= 2)
3053     {   printf("Raw parse tree:\n"); show_tree(&AO, FALSE);
3054     }
3055
3056     if (context == CONDITION_CONTEXT)
3057     {   if (label < -2) annotate_for_conditions(AO.value, label, -1);
3058         else annotate_for_conditions(AO.value, -1, label);
3059     }
3060     else annotate_for_conditions(AO.value, -1, -1);
3061
3062     if (expr_trace_level >= 1)
3063     {   printf("Code generation for expression in ");
3064         switch(context)
3065         {   case VOID_CONTEXT: printf("void"); break;
3066             case CONDITION_CONTEXT: printf("condition"); break;
3067             case QUANTITY_CONTEXT: printf("quantity"); break;
3068             case ASSEMBLY_CONTEXT: printf("assembly"); break;
3069             case ARRAY_CONTEXT: printf("array initialisation"); break;
3070             default: printf("* ILLEGAL *"); break;
3071         }
3072         printf(" context with annotated tree:\n");
3073         show_tree(&AO, TRUE);
3074     }
3075
3076     generate_code_from(AO.value, (context==VOID_CONTEXT));
3077     return ET[AO.value].value;
3078 }
3079
3080 /* ========================================================================= */
3081 /*   Data structure management routines                                      */
3082 /* ------------------------------------------------------------------------- */
3083
3084 extern void init_expressc_vars(void)
3085 {   make_operands();
3086 }
3087
3088 extern void expressc_begin_pass(void)
3089 {
3090 }
3091
3092 extern void expressc_allocate_arrays(void)
3093 {
3094 }
3095
3096 extern void expressc_free_arrays(void)
3097 {
3098 }
3099
3100 /* ========================================================================= */