src/expressp.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "expressp" :  The expression parser                                     */
   3 /*                                                                           */
   4 /*   Part of Inform 6.41                                                     */
   5 /*   copyright (c) Graham Nelson 1993 - 2022                                 */
   6 /*                                                                           */
   7 /* Inform is free software: you can redistribute it and/or modify            */
   8 /* it under the terms of the GNU General Public License as published by      */
   9 /* the Free Software Foundation, either version 3 of the License, or         */
  10 /* (at your option) any later version.                                       */
  11 /*                                                                           */
  12 /* Inform is distributed in the hope that it will be useful,                 */
  13 /* but WITHOUT ANY WARRANTY; without even the implied warranty of            */
  14 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the              */
  15 /* GNU General Public License for more details.                              */
  16 /*                                                                           */
  17 /* You should have received a copy of the GNU General Public License         */
  18 /* along with Inform. If not, see https://gnu.org/licenses/                  */
  19 /*                                                                           */
  20 /* ------------------------------------------------------------------------- */
  21
  22 #include "header.h"
  23
  24 /* --- Interface to lexer -------------------------------------------------- */
  25
  26 static char separators_to_operators[103];
  27 static char conditionals_to_operators[7];
  28 static char token_type_allowable[301];
  29
  30 #define NOT_AN_OPERATOR (char) 0x7e
  31
  32 static void make_lexical_interface_tables(void)
  33 {   int i;
  34     for (i=0;i<103;i++)
  35         separators_to_operators[i] = NOT_AN_OPERATOR;
  36     for (i=0;i<NUM_OPERATORS;i++)
  37         if (operators[i].token_type == SEP_TT)
  38             separators_to_operators[operators[i].token_value] = i;
  39
  40     for (i=0;i<7;i++)  /*  7 being the size of keyword_group "conditions"  */
  41         conditionals_to_operators[i] = NOT_AN_OPERATOR;
  42     for (i=0;i<NUM_OPERATORS;i++)
  43         if (operators[i].token_type == CND_TT)
  44             conditionals_to_operators[operators[i].token_value] = i;
  45
  46     for (i=0;i<301;i++) token_type_allowable[i] = 0;
  47
  48     token_type_allowable[VARIABLE_TT] = 1;
  49     token_type_allowable[SYSFUN_TT] = 1;
  50     token_type_allowable[DQ_TT] = 1;
  51     token_type_allowable[DICTWORD_TT] = 1;
  52     token_type_allowable[SUBOPEN_TT] = 1;
  53     token_type_allowable[SUBCLOSE_TT] = 1;
  54     token_type_allowable[SMALL_NUMBER_TT] = 1;
  55     token_type_allowable[LARGE_NUMBER_TT] = 1;
  56     token_type_allowable[ACTION_TT] = 1;
  57     token_type_allowable[SYSTEM_CONSTANT_TT] = 1;
  58     token_type_allowable[OP_TT] = 1;
  59 }
  60
  61 static token_data current_token, previous_token, heldback_token;
  62
  63 static int comma_allowed, arrow_allowed, superclass_allowed,
  64            bare_prop_allowed,
  65            array_init_ambiguity, action_ambiguity,
  66            etoken_count, inserting_token, bracket_level;
  67
  68 int system_function_usage[NUMBER_SYSTEM_FUNCTIONS];
  69
  70 static int get_next_etoken(void)
  71 {   int v, symbol = 0, mark_symbol_as_used = FALSE,
  72         initial_bracket_level = bracket_level;
  73
  74     etoken_count++;
  75
  76     if (inserting_token)
  77     {   current_token = heldback_token;
  78         inserting_token = FALSE;
  79     }
  80     else
  81     {   get_next_token();
  82         current_token.text = token_text;
  83         current_token.value = token_value;
  84         current_token.type = token_type;
  85         current_token.marker = 0;
  86         current_token.symindex = -1;
  87         current_token.symtype = 0;
  88         current_token.symflags = -1;
  89     }
  90
  91     switch(current_token.type)
  92     {   case LOCAL_VARIABLE_TT:
  93             current_token.type = VARIABLE_TT;
  94             variables[current_token.value].usage = TRUE;
  95             break;
  96
  97         case DQ_TT:
  98             current_token.marker = STRING_MV;
  99             break;
 100
 101         case SQ_TT:
 102             {   int32 unicode = text_to_unicode(token_text);
 103                 if (token_text[textual_form_length] == 0)
 104                 {
 105                     if (!glulx_mode) {
 106                         current_token.value = unicode_to_zscii(unicode);
 107                         if (current_token.value == 5)
 108                         {   unicode_char_error("Character can be printed \
 109 but not used as a value:", unicode);
 110                             current_token.value = '?';
 111                         }
 112                         if (current_token.value >= 0x100)
 113                             current_token.type = LARGE_NUMBER_TT;
 114                         else current_token.type = SMALL_NUMBER_TT;
 115                     }
 116                     else {
 117                         current_token.value = unicode;
 118                         if (current_token.value >= 0x8000
 119                           || current_token.value < -0x8000)
 120                             current_token.type = LARGE_NUMBER_TT;
 121                         else current_token.type = SMALL_NUMBER_TT;
 122                     }
 123                 }
 124                 else
 125                 {   current_token.type = DICTWORD_TT;
 126                     current_token.marker = DWORD_MV;
 127                 }
 128             }
 129             break;
 130
 131         case SYMBOL_TT:
 132         ReceiveSymbol:
 133             symbol = current_token.value;
 134
 135             mark_symbol_as_used = TRUE;
 136
 137             v = symbols[symbol].value;
 138
 139             current_token.symindex = symbol;
 140             current_token.symtype = symbols[symbol].type;
 141             current_token.symflags = symbols[symbol].flags;
 142             switch(symbols[symbol].type)
 143             {   case ROUTINE_T:
 144                     /* Replaced functions must always be backpatched
 145                        because there could be another definition coming. */
 146                     if (symbols[symbol].flags & REPLACE_SFLAG)
 147                     {   current_token.marker = SYMBOL_MV;
 148                         v = symbol;
 149                         break;
 150                     }
 151                     current_token.marker = IROUTINE_MV;
 152                     break;
 153                 case GLOBAL_VARIABLE_T:
 154                     current_token.marker = VARIABLE_MV;
 155                     break;
 156                 case OBJECT_T:
 157                 case CLASS_T:
 158                     /* All objects must be backpatched in Glulx. */
 159                     if (glulx_mode)
 160                         current_token.marker = OBJECT_MV;
 161                     break;
 162                 case ARRAY_T:
 163                     current_token.marker = ARRAY_MV;
 164                     break;
 165                 case STATIC_ARRAY_T:
 166                     current_token.marker = STATIC_ARRAY_MV;
 167                     break;
 168                 case INDIVIDUAL_PROPERTY_T:
 169                     break;
 170                 case CONSTANT_T:
 171                     if (symbols[symbol].flags & (UNKNOWN_SFLAG + CHANGE_SFLAG))
 172                     {   current_token.marker = SYMBOL_MV;
 173                         v = symbol;
 174                     }
 175                     else current_token.marker = 0;
 176                     break;
 177                 case LABEL_T:
 178                     error_named("Label name used as value:", token_text);
 179                     break;
 180                 default:
 181                     current_token.marker = 0;
 182                     break;
 183             }
 184             if (symbols[symbol].flags & SYSTEM_SFLAG)
 185                 current_token.marker = 0;
 186
 187             current_token.value = v;
 188
 189             if (!glulx_mode) {
 190                 if (((current_token.marker != 0)
 191                   && (current_token.marker != VARIABLE_MV))
 192                   || (v < 0) || (v > 255))
 193                     current_token.type = LARGE_NUMBER_TT;
 194                 else current_token.type = SMALL_NUMBER_TT;
 195             }
 196             else {
 197                 if (((current_token.marker != 0)
 198                   && (current_token.marker != VARIABLE_MV))
 199                   || (v < -0x8000) || (v >= 0x8000))
 200                     current_token.type = LARGE_NUMBER_TT;
 201                 else current_token.type = SMALL_NUMBER_TT;
 202             }
 203
 204             if (symbols[symbol].type == GLOBAL_VARIABLE_T)
 205             {   current_token.type = VARIABLE_TT;
 206                 variables[current_token.value].usage = TRUE;
 207             }
 208             break;
 209
 210         case NUMBER_TT:
 211             if (!glulx_mode) {
 212                 if (current_token.value >= 256)
 213                     current_token.type = LARGE_NUMBER_TT;
 214                 else
 215                     current_token.type = SMALL_NUMBER_TT;
 216             }
 217             else {
 218                 if (current_token.value < -0x8000
 219                   || current_token.value >= 0x8000)
 220                     current_token.type = LARGE_NUMBER_TT;
 221                 else
 222                     current_token.type = SMALL_NUMBER_TT;
 223             }
 224             break;
 225
 226         case SEP_TT:
 227             switch(current_token.value)
 228             {   case ARROW_SEP:
 229                     if (!arrow_allowed)
 230                         current_token.type = ENDEXP_TT;
 231                     break;
 232
 233                 case COMMA_SEP:
 234                     if ((bracket_level==0) && (!comma_allowed))
 235                         current_token.type = ENDEXP_TT;
 236                     break;
 237
 238                 case SUPERCLASS_SEP:
 239                     if ((bracket_level==0) && (!superclass_allowed))
 240                         current_token.type = ENDEXP_TT;
 241                     break;
 242
 243                 case GREATER_SEP:
 244                     get_next_token();
 245                     if ((token_type == SEP_TT)
 246                         &&((token_value == SEMICOLON_SEP)
 247                            || (token_value == GREATER_SEP)))
 248                         current_token.type = ENDEXP_TT;
 249                     put_token_back();
 250                     break;
 251
 252                 case OPENB_SEP:
 253                     bracket_level++;
 254                     if (expr_trace_level>=3)
 255                     { printf("Previous token type = %d\n",previous_token.type);
 256                       printf("Previous token val  = %d\n",previous_token.value);
 257                     }
 258                     if ((previous_token.type == OP_TT)
 259                         || (previous_token.type == SUBOPEN_TT)
 260                         || (previous_token.type == ENDEXP_TT)
 261                         || (array_init_ambiguity)
 262                         || ((bracket_level == 1) && (action_ambiguity)))
 263                         current_token.type = SUBOPEN_TT;
 264                     else
 265                     {   inserting_token = TRUE;
 266                         heldback_token = current_token;
 267                         current_token.text = "<call>";
 268                         bracket_level--;
 269                     }
 270                     break;
 271
 272                 case CLOSEB_SEP:
 273                     bracket_level--;
 274                     if (bracket_level < 0)
 275                         current_token.type = ENDEXP_TT;
 276                     else current_token.type = SUBCLOSE_TT;
 277                     break;
 278
 279                 case SEMICOLON_SEP:
 280                     current_token.type = ENDEXP_TT; break;
 281
 282                 case MINUS_SEP:
 283                     if ((previous_token.type == OP_TT)
 284                         || (previous_token.type == SUBOPEN_TT)
 285                         || (previous_token.type == ENDEXP_TT))
 286                     current_token.value = UNARY_MINUS_SEP; break;
 287
 288                 case INC_SEP:
 289                     if ((previous_token.type == VARIABLE_TT)
 290                         || (previous_token.type == SUBCLOSE_TT)
 291                         || (previous_token.type == LARGE_NUMBER_TT)
 292                         || (previous_token.type == SMALL_NUMBER_TT))
 293                     current_token.value = POST_INC_SEP; break;
 294
 295                 case DEC_SEP:
 296                     if ((previous_token.type == VARIABLE_TT)
 297                         || (previous_token.type == SUBCLOSE_TT)
 298                         || (previous_token.type == LARGE_NUMBER_TT)
 299                         || (previous_token.type == SMALL_NUMBER_TT))
 300                     current_token.value = POST_DEC_SEP; break;
 301
 302                 case HASHHASH_SEP:
 303                     token_text = current_token.text + 2;
 304
 305                     ActionUsedAsConstant:
 306
 307                     current_token.type = ACTION_TT;
 308                     current_token.text = token_text;
 309                     current_token.value = 0;
 310                     current_token.marker = ACTION_MV;
 311
 312                     break;
 313
 314                 case HASHADOLLAR_SEP:
 315                 obsolete_warning("'#a$Act' is now superseded by '##Act'");
 316                     token_text = current_token.text + 3;
 317                     goto ActionUsedAsConstant;
 318
 319                 case HASHGDOLLAR_SEP:
 320
 321                 /* This form generates the position of a global variable
 322                    in the global variables array. So Glob is the same as
 323                    #globals_array --> #g$Glob                                */
 324
 325                     current_token.text += 3;
 326                     current_token.type = SYMBOL_TT;
 327                     symbol = symbol_index(current_token.text, -1);
 328                     if (symbols[symbol].type != GLOBAL_VARIABLE_T) {
 329                         ebf_error(
 330                         "global variable name after '#g$'",
 331                         current_token.text);
 332                         current_token.value = 0;
 333                         current_token.type = SMALL_NUMBER_TT;
 334                         current_token.marker = 0;
 335                         break;
 336                     }
 337                     mark_symbol_as_used = TRUE;
 338                     current_token.value = symbols[symbol].value - MAX_LOCAL_VARIABLES;
 339                     current_token.marker = 0;
 340                     if (!glulx_mode) {
 341                         if (current_token.value >= 0x100)
 342                             current_token.type = LARGE_NUMBER_TT;
 343                         else current_token.type = SMALL_NUMBER_TT;
 344                     }
 345                     else {
 346                         if (current_token.value >= 0x8000
 347                           || current_token.value < -0x8000)
 348                             current_token.type = LARGE_NUMBER_TT;
 349                         else current_token.type = SMALL_NUMBER_TT;
 350                     }
 351                     break;
 352
 353                 case HASHNDOLLAR_SEP:
 354
 355                 /* This form is still needed for constants like #n$a (the
 356                    dictionary address of the word "a"), since 'a' means
 357                    the ASCII value of 'a'                                    */
 358
 359                     if (strlen(token_text) > 4)
 360                         obsolete_warning(
 361                             "'#n$word' is now superseded by ''word''");
 362                     current_token.type  = DICTWORD_TT;
 363                     current_token.value = 0;
 364                     current_token.text  = token_text + 3;
 365                     current_token.marker = DWORD_MV;
 366                     break;
 367
 368                 case HASHRDOLLAR_SEP:
 369
 370                 /*  This form -- #r$Routinename, to return the routine's     */
 371                 /*  packed address -- is needed far less often in Inform 6,  */
 372                 /*  where just giving the name Routine returns the packed    */
 373                 /*  address.  But it's used in a lot of Inform 5 code.       */
 374
 375                     obsolete_warning(
 376                         "'#r$Routine' can now be written just 'Routine'");
 377                     current_token.text += 3;
 378                     current_token.type = SYMBOL_TT;
 379                     current_token.value = symbol_index(current_token.text, -1);
 380                     goto ReceiveSymbol;
 381
 382                 case HASHWDOLLAR_SEP:
 383                     error("The obsolete '#w$word' construct has been removed");
 384                     break;
 385
 386                 case HASH_SEP:
 387                     system_constants.enabled = TRUE;
 388                     get_next_token();
 389                     system_constants.enabled = FALSE;
 390                     if (token_type != SYSTEM_CONSTANT_TT)
 391                     {   ebf_error(
 392                         "'r$', 'n$', 'g$' or internal Inform constant name after '#'",
 393                         token_text);
 394                         break;
 395                     }
 396                     else
 397                     {   current_token.type   = token_type;
 398                         current_token.value  = token_value;
 399                         current_token.text   = token_text;
 400                         current_token.marker = INCON_MV;
 401                     }
 402                     break;
 403             }
 404             break;
 405
 406         case CND_TT:
 407             v = conditionals_to_operators[current_token.value];
 408             if (v != NOT_AN_OPERATOR)
 409             {   current_token.type = OP_TT; current_token.value = v;
 410             }
 411             break;
 412     }
 413
 414     if (current_token.type == SEP_TT)
 415     {   v = separators_to_operators[current_token.value];
 416         if (v != NOT_AN_OPERATOR)
 417         {   if ((veneer_mode)
 418                 || ((v!=MESSAGE_OP) && (v!=MPROP_NUM_OP) && (v!=MPROP_NUM_OP)))
 419             {   current_token.type = OP_TT; current_token.value = v;
 420                 if (array_init_ambiguity &&
 421                     ((v==MINUS_OP) || (v==UNARY_MINUS_OP)) &&
 422                     (initial_bracket_level == 0) &&
 423                     (etoken_count != 1))
 424                 warning("Without bracketing, the minus sign '-' is ambiguous");
 425             }
 426         }
 427     }
 428
 429     /*  A feature of Inform making it annoyingly hard to parse left-to-right
 430         is that there is no clear delimiter for expressions; that is, the
 431         legal syntax often includes sequences of expressions with no
 432         intervening markers such as commas.  We therefore need to use some
 433         internal context to determine whether an end is in sight...          */
 434
 435     if (token_type_allowable[current_token.type]==0)
 436     {   if (expr_trace_level >= 3)
 437         {   printf("Discarding as not allowable: '%s' ", current_token.text);
 438             describe_token(&current_token);
 439             printf("\n");
 440         }
 441         current_token.type = ENDEXP_TT;
 442     }
 443     else
 444     if ((!((initial_bracket_level > 0)
 445            || (previous_token.type == ENDEXP_TT)
 446            || ((previous_token.type == OP_TT)
 447                && (operators[previous_token.value].usage != POST_U))
 448            || (previous_token.type == SYSFUN_TT)))
 449         && ((current_token.type != OP_TT)
 450             || (operators[current_token.value].usage == PRE_U)))
 451     {   if (expr_trace_level >= 3)
 452         {   printf("Discarding as no longer part: '%s' ", current_token.text);
 453             describe_token(&current_token);
 454             printf("\n");
 455         }
 456         current_token.type = ENDEXP_TT;
 457     }
 458     else
 459     {   if (mark_symbol_as_used) symbols[symbol].flags |= USED_SFLAG;
 460         if (expr_trace_level >= 3)
 461         {   printf("Expr token = '%s' ", current_token.text);
 462             describe_token(&current_token);
 463             printf("\n");
 464         }
 465     }
 466
 467     if ((previous_token.type == ENDEXP_TT)
 468         && (current_token.type == ENDEXP_TT)) return FALSE;
 469
 470     previous_token = current_token;
 471
 472     return TRUE;
 473 }
 474
 475 /* --- Operator precedences ------------------------------------------------ */
 476
 477 #define LOWER_P   101
 478 #define EQUAL_P   102
 479 #define GREATER_P 103
 480
 481 #define e1        1       /* Missing operand error                */
 482 #define e2        2       /* Unexpected close bracket             */
 483 #define e3        3       /* Missing operator error               */
 484 #define e4        4       /* Expression ends with an open bracket */
 485 #define e5        5       /* Associativity illegal error          */
 486
 487 const int prec_table[] = {
 488
 489 /* a .......... (         )           end       op          term             */
 490
 491 /* b  (    */   LOWER_P,  e3,         LOWER_P,  LOWER_P,    e3,
 492 /* .  )    */   EQUAL_P,  GREATER_P,  e2,       GREATER_P,  GREATER_P,
 493 /* .  end  */   e4,       GREATER_P,  e1,       GREATER_P,  GREATER_P,
 494 /* .  op   */   LOWER_P,  GREATER_P,  LOWER_P,  -1,         GREATER_P,
 495 /* .  term */   LOWER_P,  e3,         LOWER_P,  LOWER_P,    e3
 496
 497 };
 498
 499 static int find_prec(const token_data *a, const token_data *b)
 500 {
 501     /*  We are comparing the precedence of tokens  a  and  b
 502         (where a occurs to the left of b).  If the expression is correct,
 503         the only possible values are GREATER_P, LOWER_P or EQUAL_P;
 504         if it is malformed then one of e1 to e5 results.
 505
 506         Note that this routine is not symmetrical and that the relation
 507         is not trichotomous.
 508
 509         If a and b are equal (and aren't brackets), then
 510
 511             a LOWER_P a     if a right-associative
 512             a GREATER_P a   if a left-associative
 513     */
 514
 515     int i, j, l1, l2;
 516
 517     switch(a->type)
 518     {   case SUBOPEN_TT:  i=0; break;
 519         case SUBCLOSE_TT: i=1; break;
 520         case ENDEXP_TT:   i=2; break;
 521         case OP_TT:       i=3; break;
 522         default:          i=4; break;
 523     }
 524     switch(b->type)
 525     {   case SUBOPEN_TT:  i+=0; break;
 526         case SUBCLOSE_TT: i+=5; break;
 527         case ENDEXP_TT:   i+=10; break;
 528         case OP_TT:       i+=15; break;
 529         default:          i+=20; break;
 530     }
 531
 532     j = prec_table[i]; if (j != -1) return j;
 533
 534     l1 = operators[a->value].precedence;
 535     l2 = operators[b->value].precedence;
 536     if (operators[b->value].usage == PRE_U) return LOWER_P;
 537     if (operators[a->value].usage == POST_U) return GREATER_P;
 538
 539     /*  Anomalous rule to resolve the function call precedence, which is
 540         different on the right from on the left, e.g., in:
 541
 542                  alpha.beta(gamma)
 543                  beta(gamma).alpha
 544     */
 545
 546     if ((l1 == 11) && (l2 > 11)) return GREATER_P;
 547
 548     if (l1 < l2)  return LOWER_P;
 549     if (l1 > l2)  return GREATER_P;
 550     switch(operators[a->value].associativity)
 551     {   case L_A: return GREATER_P;
 552         case R_A: return LOWER_P;
 553         case 0:   return e5;
 554     }
 555     return GREATER_P;
 556 }
 557
 558 /* --- Converting token to operand ----------------------------------------- */
 559
 560 /* List used to generate gameinfo.dbg.
 561    Must match the switch statement below. */
 562 int z_system_constant_list[] =
 563     { adjectives_table_SC,
 564       actions_table_SC,
 565       classes_table_SC,
 566       identifiers_table_SC,
 567       preactions_table_SC,
 568       largest_object_SC,
 569       strings_offset_SC,
 570       code_offset_SC,
 571       actual_largest_object_SC,
 572       static_memory_offset_SC,
 573       array_names_offset_SC,
 574       readable_memory_offset_SC,
 575       cpv__start_SC,
 576       cpv__end_SC,
 577       ipv__start_SC,
 578       ipv__end_SC,
 579       array__start_SC,
 580       array__end_SC,
 581       highest_attribute_number_SC,
 582       attribute_names_array_SC,
 583       highest_property_number_SC,
 584       property_names_array_SC,
 585       highest_action_number_SC,
 586       action_names_array_SC,
 587       highest_fake_action_number_SC,
 588       fake_action_names_array_SC,
 589       highest_routine_number_SC,
 590       routine_names_array_SC,
 591       routines_array_SC,
 592       routine_flags_array_SC,
 593       highest_global_number_SC,
 594       global_names_array_SC,
 595       globals_array_SC,
 596       global_flags_array_SC,
 597       highest_array_number_SC,
 598       array_names_array_SC,
 599       array_flags_array_SC,
 600       highest_constant_number_SC,
 601       constant_names_array_SC,
 602       highest_class_number_SC,
 603       class_objects_array_SC,
 604       highest_object_number_SC,
 605       dictionary_table_SC,
 606       grammar_table_SC,
 607       -1 };
 608
 609 static int32 value_of_system_constant_z(int t)
 610 {   switch(t)
 611     {   case adjectives_table_SC:
 612             return adjectives_offset;
 613         case actions_table_SC:
 614             return actions_offset;
 615         case classes_table_SC:
 616             return class_numbers_offset;
 617         case identifiers_table_SC:
 618             return identifier_names_offset;
 619         case preactions_table_SC:
 620             return preactions_offset;
 621         case largest_object_SC:
 622             return 256 + no_objects - 1;
 623         case strings_offset_SC:
 624             return strings_offset/scale_factor;
 625         case code_offset_SC:
 626             return code_offset/scale_factor;
 627         case actual_largest_object_SC:
 628             return no_objects;
 629         case static_memory_offset_SC:
 630             return static_memory_offset;
 631         case array_names_offset_SC:
 632             return array_names_offset;
 633         case readable_memory_offset_SC:
 634             return Write_Code_At;
 635         case cpv__start_SC:
 636             return prop_values_offset;
 637         case cpv__end_SC:
 638             return class_numbers_offset;
 639         case ipv__start_SC:
 640             return individuals_offset;
 641         case ipv__end_SC:
 642             return variables_offset;
 643         case array__start_SC:
 644             return variables_offset + (MAX_ZCODE_GLOBAL_VARS*WORDSIZE);
 645         case array__end_SC:
 646             return static_memory_offset;
 647         case dictionary_table_SC:
 648             return dictionary_offset;
 649         case grammar_table_SC:
 650             return static_memory_offset;
 651
 652         case highest_attribute_number_SC:
 653             return no_attributes-1;
 654         case attribute_names_array_SC:
 655             return attribute_names_offset;
 656
 657         case highest_property_number_SC:
 658             return no_individual_properties-1;
 659         case property_names_array_SC:
 660             return identifier_names_offset + 2;
 661
 662         case highest_action_number_SC:
 663             return no_actions-1;
 664         case action_names_array_SC:
 665             return action_names_offset;
 666
 667         case highest_fake_action_number_SC:
 668             return ((grammar_version_number==1)?256:4096) + no_fake_actions-1;
 669         case fake_action_names_array_SC:
 670             return fake_action_names_offset;
 671
 672         case highest_routine_number_SC:
 673             return no_named_routines-1;
 674         case routine_names_array_SC:
 675             return routine_names_offset;
 676         case routines_array_SC:
 677             return routines_array_offset;
 678         case routine_flags_array_SC:
 679             return routine_flags_array_offset;
 680         case highest_global_number_SC:
 681             return 16 + no_globals-1;
 682         case global_names_array_SC:
 683             return global_names_offset;
 684         case globals_array_SC:
 685             return variables_offset;
 686         case global_flags_array_SC:
 687             return global_flags_array_offset;
 688         case highest_array_number_SC:
 689             return no_arrays-1;
 690         case array_names_array_SC:
 691             return array_names_offset;
 692         case array_flags_array_SC:
 693             return array_flags_array_offset;
 694         case highest_constant_number_SC:
 695             return no_named_constants-1;
 696         case constant_names_array_SC:
 697             return constant_names_offset;
 698         case highest_class_number_SC:
 699             return no_classes-1;
 700         case class_objects_array_SC:
 701             return class_numbers_offset;
 702         case highest_object_number_SC:
 703             return no_objects-1;
 704     }
 705
 706     error_named("System constant not implemented in Z-code",
 707         system_constants.keywords[t]);
 708
 709     return(0);
 710 }
 711
 712 /* List used to generate gameinfo.dbg.
 713    Must match the switch statement below. */
 714 int glulx_system_constant_list[] =
 715     { classes_table_SC,
 716       identifiers_table_SC,
 717       array_names_offset_SC,
 718       cpv__start_SC,
 719       cpv__end_SC,
 720       dictionary_table_SC,
 721       dynam_string_table_SC,
 722       grammar_table_SC,
 723       actions_table_SC,
 724       globals_array_SC,
 725       highest_class_number_SC,
 726       highest_object_number_SC,
 727       -1 };
 728
 729 static int32 value_of_system_constant_g(int t)
 730 {
 731   switch (t) {
 732   case classes_table_SC:
 733     return Write_RAM_At + class_numbers_offset;
 734   case identifiers_table_SC:
 735     return Write_RAM_At + identifier_names_offset;
 736   case array_names_offset_SC:
 737     return Write_RAM_At + array_names_offset;
 738   case cpv__start_SC:
 739     return prop_defaults_offset;
 740   case cpv__end_SC:
 741     return Write_RAM_At + class_numbers_offset;
 742   case dictionary_table_SC:
 743     return dictionary_offset;
 744   case dynam_string_table_SC:
 745     return abbreviations_offset;
 746   case grammar_table_SC:
 747     return grammar_table_offset;
 748   case actions_table_SC:
 749     return actions_offset;
 750   case globals_array_SC:
 751     return variables_offset;
 752   case highest_class_number_SC:
 753     return no_classes-1;
 754   case highest_object_number_SC:
 755     return no_objects-1;
 756   }
 757
 758   error_named("System constant not implemented in Glulx",
 759     system_constants.keywords[t]);
 760
 761   return 0;
 762 }
 763
 764 extern int32 value_of_system_constant(int t)
 765 {
 766   if (!glulx_mode)
 767     return value_of_system_constant_z(t);
 768   else
 769     return value_of_system_constant_g(t);
 770 }
 771
 772 extern char *name_of_system_constant(int t)
 773 {
 774   if (t < 0 || t >= NO_SYSTEM_CONSTANTS) {
 775     return "???";
 776   }
 777   return system_constants.keywords[t];
 778 }
 779
 780 static int evaluate_term(const token_data *t, assembly_operand *o)
 781 {
 782     /*  If the given token is a constant, evaluate it into the operand.
 783         For now, the identifiers are considered variables.
 784
 785         Returns FALSE if it fails to understand type. */
 786
 787     int32 v;
 788
 789     o->marker = t->marker;
 790     o->symindex = t->symindex;
 791
 792     switch(t->type)
 793     {   case LARGE_NUMBER_TT:
 794              v = t->value;
 795              if (!glulx_mode) {
 796                  if (v < 0) v = v + 0x10000;
 797                  o->type = LONG_CONSTANT_OT;
 798                  o->value = v;
 799              }
 800              else {
 801                  o->value = v;
 802                  o->type = CONSTANT_OT;
 803              }
 804              return(TRUE);
 805         case SMALL_NUMBER_TT:
 806              v = t->value;
 807              if (!glulx_mode) {
 808                  if (v < 0) v = v + 0x10000;
 809                  o->type = SHORT_CONSTANT_OT;
 810                  o->value = v;
 811              }
 812              else {
 813                  o->value = v;
 814                  set_constant_ot(o);
 815              }
 816              return(TRUE);
 817         case DICTWORD_TT:
 818              /*  Find the dictionary address, adding to dictionary if absent */
 819              if (!glulx_mode)
 820                  o->type = LONG_CONSTANT_OT;
 821              else
 822                  o->type = CONSTANT_OT;
 823              o->value = dictionary_add(t->text, 0x80, 0, 0);
 824              return(TRUE);
 825         case DQ_TT:
 826              /*  Create as a static string  */
 827              if (!glulx_mode)
 828                  o->type = LONG_CONSTANT_OT;
 829              else
 830                  o->type = CONSTANT_OT;
 831              o->value = compile_string(t->text, STRCTX_GAME);
 832              return(TRUE);
 833         case VARIABLE_TT:
 834              if (!glulx_mode) {
 835                  o->type = VARIABLE_OT;
 836              }
 837              else {
 838                  if (t->value >= MAX_LOCAL_VARIABLES) {
 839                      o->type = GLOBALVAR_OT;
 840                  }
 841                  else {
 842                      /* This includes "local variable zero", which is really
 843                         the stack-pointer magic variable. */
 844                      o->type = LOCALVAR_OT;
 845                  }
 846              }
 847              o->value = t->value;
 848              return(TRUE);
 849         case SYSFUN_TT:
 850              if (!glulx_mode) {
 851                  o->type = VARIABLE_OT;
 852                  o->value = t->value + 256;
 853              }
 854              else {
 855                  o->type = SYSFUN_OT;
 856                  o->value = t->value;
 857              }
 858              system_function_usage[t->value] = 1;
 859              return(TRUE);
 860         case ACTION_TT:
 861              *o = action_of_name(t->text);
 862              return(TRUE);
 863         case SYSTEM_CONSTANT_TT:
 864              /*  Certain system constants depend only on the
 865                  version number and need no backpatching, as they
 866                  are known in advance.  We can therefore evaluate
 867                  them immediately.  */
 868              if (!glulx_mode) {
 869                  o->type = LONG_CONSTANT_OT;
 870                  switch(t->value)
 871                  {
 872                  case version_number_SC:
 873                      o->type = SHORT_CONSTANT_OT;
 874                      o->marker = 0;
 875                      v = version_number; break;
 876                  case dict_par1_SC:
 877                      o->type = SHORT_CONSTANT_OT;
 878                      o->marker = 0;
 879                      v = (version_number==3)?4:6; break;
 880                  case dict_par2_SC:
 881                      o->type = SHORT_CONSTANT_OT;
 882                      o->marker = 0;
 883                      v = (version_number==3)?5:7; break;
 884                  case dict_par3_SC:
 885                      o->type = SHORT_CONSTANT_OT;
 886                      o->marker = 0;
 887                      if (ZCODE_LESS_DICT_DATA)
 888                          error("#dict_par3 is unavailable when ZCODE_LESS_DICT_DATA is set");
 889                      v = (version_number==3)?6:8; break;
 890                  case lowest_attribute_number_SC:
 891                  case lowest_action_number_SC:
 892                  case lowest_routine_number_SC:
 893                  case lowest_array_number_SC:
 894                  case lowest_constant_number_SC:
 895                  case lowest_class_number_SC:
 896                      o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 0; break;
 897                  case lowest_object_number_SC:
 898                  case lowest_property_number_SC:
 899                      o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 1; break;
 900                  case lowest_global_number_SC:
 901                      o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 16; break;
 902                  case lowest_fake_action_number_SC:
 903                      o->type = LONG_CONSTANT_OT; o->marker = 0;
 904                      v = ((grammar_version_number==1)?256:4096); break;
 905                  case oddeven_packing_SC:
 906                      o->type = SHORT_CONSTANT_OT; o->marker = 0;
 907                      v = oddeven_packing_switch; break;
 908                  default:
 909                      v = t->value;
 910                      o->marker = INCON_MV;
 911                      break;
 912                  }
 913                  o->value = v;
 914              }
 915              else {
 916                  o->type = CONSTANT_OT;
 917                  switch(t->value)
 918                  {
 919                  /* The three dict_par flags point at the lower byte
 920                     of the flag field, because the library is written
 921                     to expect one-byte fields, even though the compiler
 922                     generates a dictionary with room for two. */
 923                  case dict_par1_SC:
 924                      o->type = BYTECONSTANT_OT;
 925                      o->marker = 0;
 926                      v = DICT_ENTRY_FLAG_POS+1;
 927                      break;
 928                  case dict_par2_SC:
 929                      o->type = BYTECONSTANT_OT;
 930                      o->marker = 0;
 931                      v = DICT_ENTRY_FLAG_POS+3;
 932                      break;
 933                  case dict_par3_SC:
 934                      o->type = BYTECONSTANT_OT;
 935                      o->marker = 0;
 936                      v = DICT_ENTRY_FLAG_POS+5;
 937                      break;
 938
 939                  case lowest_attribute_number_SC:
 940                  case lowest_action_number_SC:
 941                  case lowest_routine_number_SC:
 942                  case lowest_array_number_SC:
 943                  case lowest_constant_number_SC:
 944                  case lowest_class_number_SC:
 945                      o->type = BYTECONSTANT_OT;
 946                      o->marker = 0;
 947                      v = 0;
 948                      break;
 949                  case lowest_object_number_SC:
 950                  case lowest_property_number_SC:
 951                      o->type = BYTECONSTANT_OT;
 952                      o->marker = 0;
 953                      v = 1;
 954                      break;
 955
 956                  /* ###fix: need to fill more of these in! */
 957
 958                  default:
 959                      v = t->value;
 960                      o->marker = INCON_MV;
 961                      break;
 962                  }
 963                  o->value = v;
 964              }
 965              return(TRUE);
 966         default:
 967              return(FALSE);
 968     }
 969 }
 970
 971 /* --- Emitter ------------------------------------------------------------- */
 972
 973 expression_tree_node *ET; /* Allocated to ET_used */
 974 static memory_list ET_memlist;
 975 static int ET_used;
 976
 977 extern void clear_expression_space(void)
 978 {   ET_used = 0;
 979 }
 980
 981 typedef struct emitterstackinfo_s {
 982     assembly_operand op;
 983     int marker;
 984     int bracket_count;
 985 } emitterstackinfo;
 986
 987 #define FUNCTION_VALUE_MARKER 1
 988 #define ARGUMENT_VALUE_MARKER 2
 989 #define OR_VALUE_MARKER 3
 990
 991 static emitterstackinfo *emitter_stack; /* Allocated to emitter_sp */
 992 static memory_list emitter_stack_memlist;
 993 static int emitter_sp;
 994
 995 static int is_property_t(int symbol_type)
 996 {   return ((symbol_type == PROPERTY_T) || (symbol_type == INDIVIDUAL_PROPERTY_T));
 997 }
 998
 999 static void mark_top_of_emitter_stack(int marker, const token_data *t)
1000 {   if (emitter_sp < 1)
1001     {   compiler_error("SR error: Attempt to add a marker to the top of an empty emitter stack");
1002         return;
1003     }
1004     if (expr_trace_level >= 2)
1005     {   printf("Marking top of emitter stack (which is ");
1006         print_operand(&emitter_stack[emitter_sp-1].op, FALSE);
1007         printf(") as ");
1008         switch(marker)
1009         {
1010             case FUNCTION_VALUE_MARKER:
1011                 printf("FUNCTION");
1012                 break;
1013             case ARGUMENT_VALUE_MARKER:
1014                 printf("ARGUMENT");
1015                 break;
1016             case OR_VALUE_MARKER:
1017                 printf("OR_VALUE");
1018                 break;
1019             default:
1020                 printf("UNKNOWN");
1021                 break;
1022         }
1023         printf("\n");
1024     }
1025     if (emitter_stack[emitter_sp-1].marker)
1026     {   if (marker == ARGUMENT_VALUE_MARKER)
1027         {
1028             warning("Ignoring spurious leading comma");
1029             return;
1030         }
1031         error_named("Missing operand for", t->text);
1032         ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1033         emitter_stack[emitter_sp].marker = 0;
1034         emitter_stack[emitter_sp].bracket_count = 0;
1035         emitter_stack[emitter_sp].op = zero_operand;
1036         emitter_sp++;
1037     }
1038     emitter_stack[emitter_sp-1].marker = marker;
1039 }
1040
1041 static void add_bracket_layer_to_emitter_stack(int depth)
1042 {   /* There's no point in tracking bracket layers that don't fence off any values. */
1043     if (emitter_sp < depth + 1) return;
1044     if (expr_trace_level >= 2)
1045         printf("Adding bracket layer\n");
1046     ++emitter_stack[emitter_sp-depth-1].bracket_count;
1047 }
1048
1049 static void remove_bracket_layer_from_emitter_stack()
1050 {   /* Bracket layers that don't fence off any values will not have been tracked. */
1051     if (emitter_sp < 2) return;
1052     if (expr_trace_level >= 2)
1053         printf("Removing bracket layer\n");
1054     if (emitter_stack[emitter_sp-2].bracket_count <= 0)
1055     {   compiler_error("SR error: Attempt to remove a nonexistent bracket layer from the emitter stack");
1056         return;
1057     }
1058     --emitter_stack[emitter_sp-2].bracket_count;
1059 }
1060
1061 static void emit_token(const token_data *t)
1062 {   assembly_operand o1, o2; int arity, stack_size, i;
1063     int op_node_number, operand_node_number, previous_node_number;
1064     int32 x = 0;
1065
1066     if (expr_trace_level >= 2)
1067     {   printf("Output: %-19s%21s ", t->text, "");
1068         for (i=0; i<emitter_sp; i++)
1069         {   print_operand(&emitter_stack[i].op, FALSE); printf(" ");
1070             if (emitter_stack[i].marker == FUNCTION_VALUE_MARKER) printf(":FUNCTION ");
1071             if (emitter_stack[i].marker == ARGUMENT_VALUE_MARKER) printf(":ARGUMENT ");
1072             if (emitter_stack[i].marker == OR_VALUE_MARKER) printf(":OR ");
1073             if (emitter_stack[i].bracket_count) printf(":BRACKETS(%d) ", emitter_stack[i].bracket_count);
1074         }
1075         printf("\n");
1076     }
1077
1078     if (t->type == SUBOPEN_TT) return;
1079
1080     stack_size = 0;
1081     while ((stack_size < emitter_sp) &&
1082            !emitter_stack[emitter_sp-stack_size-1].marker &&
1083            !emitter_stack[emitter_sp-stack_size-1].bracket_count)
1084         stack_size++;
1085
1086     if (t->type == SUBCLOSE_TT)
1087     {   if (stack_size < emitter_sp && emitter_stack[emitter_sp-stack_size-1].bracket_count)
1088         {   if (stack_size == 0)
1089             {   error("No expression between brackets '(' and ')'");
1090                 ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1091                 emitter_stack[emitter_sp].op = zero_operand;
1092                 emitter_stack[emitter_sp].marker = 0;
1093                 emitter_stack[emitter_sp].bracket_count = 0;
1094                 emitter_sp++;
1095             }
1096             else if (stack_size < 1)
1097                 compiler_error("SR error: emitter stack empty in subexpression");
1098             else if (stack_size > 1)
1099                 compiler_error("SR error: emitter stack overfull in subexpression");
1100             remove_bracket_layer_from_emitter_stack();
1101         }
1102         return;
1103     }
1104
1105     if (t->type != OP_TT)
1106     {
1107         ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1108         emitter_stack[emitter_sp].marker = 0;
1109         emitter_stack[emitter_sp].bracket_count = 0;
1110
1111         if (!evaluate_term(t, &(emitter_stack[emitter_sp++].op)))
1112             compiler_error_named("Emit token error:", t->text);
1113         return;
1114     }
1115
1116     /* A comma is argument-separating if it follows an argument (or a function
1117        call, since we ignore spurious leading commas in function argument lists)
1118        with no intervening brackets.  Function calls are variadic, so we don't
1119        apply argument-separating commas. */
1120     if (t->value == COMMA_OP &&
1121         stack_size < emitter_sp &&
1122         (emitter_stack[emitter_sp-stack_size-1].marker == ARGUMENT_VALUE_MARKER ||
1123          emitter_stack[emitter_sp-stack_size-1].marker == FUNCTION_VALUE_MARKER) &&
1124         !emitter_stack[emitter_sp-stack_size-1].bracket_count)
1125     {   if (expr_trace_level >= 2)
1126             printf("Treating comma as argument-separating\n");
1127         return;
1128     }
1129
1130     if (t->value == OR_OP)
1131         return;
1132
1133     arity = 1;
1134     if (t->value == FCALL_OP)
1135     {   if (expr_trace_level >= 3)
1136         {   printf("FCALL_OP finds marker stack: ");
1137             for (x=0; x<emitter_sp; x++) printf("%d ", emitter_stack[x].marker);
1138             printf("\n");
1139         }
1140         if (emitter_stack[emitter_sp-1].marker == ARGUMENT_VALUE_MARKER)
1141             warning("Ignoring spurious trailing comma");
1142         while (emitter_stack[emitter_sp-arity].marker != FUNCTION_VALUE_MARKER)
1143         {
1144             if ((glulx_mode &&
1145                  emitter_stack[emitter_sp-arity].op.type == SYSFUN_OT) ||
1146                 (!glulx_mode &&
1147                  emitter_stack[emitter_sp-arity].op.type == VARIABLE_OT &&
1148                  emitter_stack[emitter_sp-arity].op.value >= 256 &&
1149                  emitter_stack[emitter_sp-arity].op.value < 288))
1150             {   int index = emitter_stack[emitter_sp-arity].op.value;
1151                 if(!glulx_mode)
1152                     index -= 256;
1153                 if(index >= 0 && index < NUMBER_SYSTEM_FUNCTIONS)
1154                     error_named("System function name used as a value:", system_functions.keywords[index]);
1155                 else
1156                     compiler_error("Found unnamed system function used as a value");
1157                 emitter_stack[emitter_sp-arity].op = zero_operand;
1158             }
1159             ++arity;
1160         }
1161     }
1162     else
1163     {   arity = 1;
1164         if (operators[t->value].usage == IN_U) arity = 2;
1165
1166         if (operators[t->value].precedence == 3)
1167         {   arity = 2;
1168             x = emitter_sp-1;
1169             if(!emitter_stack[x].marker && !emitter_stack[x].bracket_count)
1170             {   for (--x; emitter_stack[x].marker == OR_VALUE_MARKER && !emitter_stack[x].bracket_count; --x)
1171                 {   ++arity;
1172                     ++stack_size;
1173                 }
1174                 for (;x >= 0 && !emitter_stack[x].marker && !emitter_stack[x].bracket_count; --x)
1175                     ++stack_size;
1176             }
1177         }
1178
1179         if (arity > stack_size)
1180         {   error_named("Missing operand for", t->text);
1181             while (arity > stack_size)
1182             {   ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1183                 emitter_stack[emitter_sp].marker = 0;
1184                 emitter_stack[emitter_sp].bracket_count = 0;
1185                 emitter_stack[emitter_sp].op = zero_operand;
1186                 emitter_sp++;
1187                 stack_size++;
1188             }
1189         }
1190     }
1191
1192     /* pseudo-typecheck in 6.30: catch an unqualified property name */
1193     for (i = 1; i <= arity; i++)
1194     {
1195         o1 = emitter_stack[emitter_sp - i].op;
1196         if ((o1.symindex >= 0)
1197             && is_property_t(symbols[o1.symindex].type)) {
1198             switch(t->value)
1199             {
1200                 case FCALL_OP:
1201                 case SETEQUALS_OP: case NOTEQUAL_OP:
1202                 case CONDEQUALS_OP:
1203                 case PROVIDES_OP: case NOTPROVIDES_OP:
1204                 case PROP_ADD_OP: case PROP_NUM_OP:
1205                 case SUPERCLASS_OP:
1206                 case MPROP_ADD_OP: case MESSAGE_OP:
1207                 case PROPERTY_OP:
1208                     if (i < arity) break;
1209                 case GE_OP: case LE_OP:
1210                     /* Direction properties "n_to", etc *are* compared
1211                        in some libraries. They have STAR_SFLAG to tell us
1212                        to skip the warning. */
1213                     if ((i < arity)
1214                         && (symbols[o1.symindex].flags & STAR_SFLAG)) break;
1215                 default:
1216                     warning("Property name in expression is not qualified by object");
1217             }
1218         } /* if (is_property_t */
1219     }
1220
1221     switch(arity)
1222     {   case 1:
1223             o1 = emitter_stack[emitter_sp - 1].op;
1224             if ((o1.marker == 0) && is_constant_ot(o1.type))
1225             {   switch(t->value)
1226                 {   case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
1227                     case ARTNOT_OP:
1228                          if (!glulx_mode)
1229                              x = (~o1.value) & 0xffff;
1230                          else
1231                              x = (~o1.value) & 0xffffffff;
1232                          goto FoldConstant;
1233                     case LOGNOT_OP:
1234                         if (o1.value != 0) x=0; else x=1;
1235                         goto FoldConstant;
1236                 }
1237             }
1238             break;
1239
1240         case 2:
1241             o1 = emitter_stack[emitter_sp - 2].op;
1242             o2 = emitter_stack[emitter_sp - 1].op;
1243
1244             if ((o1.marker == 0) && (o2.marker == 0)
1245                 && is_constant_ot(o1.type) && is_constant_ot(o2.type))
1246             {
1247                 int32 ov1, ov2;
1248                 if (glulx_mode)
1249                 { ov1 = o1.value;
1250                   ov2 = o2.value;
1251                 }
1252                 else
1253                 { ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
1254                   ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
1255                 }
1256
1257                 switch(t->value)
1258                 {
1259                     case PLUS_OP: x = ov1 + ov2; goto FoldConstantC;
1260                     case MINUS_OP: x = ov1 - ov2; goto FoldConstantC;
1261                     case TIMES_OP: x = ov1 * ov2; goto FoldConstantC;
1262                     case DIVIDE_OP:
1263                     case REMAINDER_OP:
1264                         if (ov2 == 0)
1265                           error("Division of constant by zero");
1266                         else
1267                         if (t->value == DIVIDE_OP) {
1268                           if (ov2 < 0) {
1269                             ov1 = -ov1;
1270                             ov2 = -ov2;
1271                           }
1272                           if (ov1 >= 0)
1273                             x = ov1 / ov2;
1274                           else
1275                             x = -((-ov1) / ov2);
1276                         }
1277                         else {
1278                           if (ov2 < 0) {
1279                             ov2 = -ov2;
1280                           }
1281                           if (ov1 >= 0)
1282                             x = ov1 % ov2;
1283                           else
1284                             x = -((-ov1) % ov2);
1285                         }
1286                         goto FoldConstant;
1287                     case ARTAND_OP: x = o1.value & o2.value; goto FoldConstant;
1288                     case ARTOR_OP: x = o1.value | o2.value; goto FoldConstant;
1289                     case CONDEQUALS_OP:
1290                         if (o1.value == o2.value) x = 1; else x = 0;
1291                         goto FoldConstant;
1292                     case NOTEQUAL_OP:
1293                         if (o1.value != o2.value) x = 1; else x = 0;
1294                         goto FoldConstant;
1295                     case GE_OP:
1296                         if (o1.value >= o2.value) x = 1; else x = 0;
1297                         goto FoldConstant;
1298                     case GREATER_OP:
1299                         if (o1.value > o2.value) x = 1; else x = 0;
1300                         goto FoldConstant;
1301                     case LE_OP:
1302                         if (o1.value <= o2.value) x = 1; else x = 0;
1303                         goto FoldConstant;
1304                     case LESS_OP:
1305                         if (o1.value < o2.value) x = 1; else x = 0;
1306                         goto FoldConstant;
1307                     case LOGAND_OP:
1308                         if ((o1.value != 0) && (o2.value != 0)) x=1; else x=0;
1309                         goto FoldConstant;
1310                     case LOGOR_OP:
1311                         if ((o1.value != 0) || (o2.value != 0)) x=1; else x=0;
1312                         goto FoldConstant;
1313                 }
1314
1315             }
1316
1317             /* We can also fold logical operations if they are certain
1318                to short-circuit. The right-hand argument is skipped even
1319                if it's non-constant or has side effects. */
1320
1321             if ((o1.marker == 0)
1322                 && is_constant_ot(o1.type)) {
1323
1324                 if (t->value == LOGAND_OP && o1.value == 0)
1325                 {
1326                     x = 0;
1327                     goto FoldConstant;
1328                 }
1329
1330                 if (t->value == LOGOR_OP && o1.value != 0)
1331                 {
1332                     x = 1;
1333                     goto FoldConstant;
1334                 }
1335             }
1336     }
1337
1338     ensure_memory_list_available(&ET_memlist, ET_used+1);
1339     op_node_number = ET_used++;
1340
1341     ET[op_node_number].operator_number = t->value;
1342     ET[op_node_number].up = -1;
1343     ET[op_node_number].down = -1;
1344     ET[op_node_number].right = -1;
1345
1346     /*  This statement is redundant, but prevents compilers from wrongly
1347         issuing a "used before it was assigned a value" error:  */
1348     previous_node_number = 0;
1349
1350     for (i = emitter_sp-arity; i != emitter_sp; i++)
1351     {
1352         if (expr_trace_level >= 3)
1353             printf("i=%d, emitter_sp=%d, arity=%d, ETU=%d\n",
1354                 i, emitter_sp, arity, ET_used);
1355         if (emitter_stack[i].op.type == EXPRESSION_OT)
1356             operand_node_number = emitter_stack[i].op.value;
1357         else
1358         {
1359             ensure_memory_list_available(&ET_memlist, ET_used+1);
1360             operand_node_number = ET_used++;
1361             ET[operand_node_number].down = -1;
1362             ET[operand_node_number].value = emitter_stack[i].op;
1363         }
1364         ET[operand_node_number].up = op_node_number;
1365         ET[operand_node_number].right = -1;
1366         if (i == emitter_sp - arity)
1367         {   ET[op_node_number].down = operand_node_number;
1368         }
1369         else
1370         {   ET[previous_node_number].right = operand_node_number;
1371         }
1372         previous_node_number = operand_node_number;
1373     }
1374
1375     emitter_sp = emitter_sp - arity + 1;
1376
1377     emitter_stack[emitter_sp - 1].op.type = EXPRESSION_OT;
1378     emitter_stack[emitter_sp - 1].op.value = op_node_number;
1379     emitter_stack[emitter_sp - 1].op.marker = 0;
1380     emitter_stack[emitter_sp - 1].marker = 0;
1381     emitter_stack[emitter_sp - 1].bracket_count = 0;
1382     /* Remove the marker for the brackets implied by operator precedence */
1383     remove_bracket_layer_from_emitter_stack();
1384
1385     return;
1386
1387     FoldConstantC:
1388
1389     /* In Glulx, skip this test; we can't check out-of-range errors
1390        for 32-bit arithmetic. */
1391
1392     if (!glulx_mode && ((x<-32768) || (x > 32767)))
1393     {   char folding_error[40];
1394         int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
1395         int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
1396         switch(t->value)
1397         {
1398             case PLUS_OP:
1399                 sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
1400                 break;
1401             case MINUS_OP:
1402                 sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
1403                 break;
1404             case TIMES_OP:
1405                 sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
1406                 break;
1407         }
1408         error_named("Signed arithmetic on compile-time constants overflowed \
1409 the range -32768 to +32767:", folding_error);
1410     }
1411
1412     FoldConstant:
1413
1414     if (!glulx_mode) {
1415         while (x < 0) x = x + 0x10000;
1416         x = x & 0xffff;
1417     }
1418     else {
1419         x = x & 0xffffffff;
1420     }
1421
1422     emitter_sp = emitter_sp - arity + 1;
1423
1424     if (!glulx_mode) {
1425         if (x<256)
1426             emitter_stack[emitter_sp - 1].op.type = SHORT_CONSTANT_OT;
1427         else emitter_stack[emitter_sp - 1].op.type = LONG_CONSTANT_OT;
1428     }
1429     else {
1430         if (x == 0)
1431             emitter_stack[emitter_sp - 1].op.type = ZEROCONSTANT_OT;
1432         else if (x >= -128 && x <= 127)
1433             emitter_stack[emitter_sp - 1].op.type = BYTECONSTANT_OT;
1434         else if (x >= -32768 && x <= 32767)
1435             emitter_stack[emitter_sp - 1].op.type = HALFCONSTANT_OT;
1436         else
1437             emitter_stack[emitter_sp - 1].op.type = CONSTANT_OT;
1438     }
1439
1440     emitter_stack[emitter_sp - 1].op.value = x;
1441     emitter_stack[emitter_sp - 1].op.marker = 0;
1442     emitter_stack[emitter_sp - 1].marker = 0;
1443     emitter_stack[emitter_sp - 1].bracket_count = 0;
1444
1445     if (expr_trace_level >= 2)
1446     {   printf("Folding constant to: ");
1447         print_operand(&emitter_stack[emitter_sp - 1].op, FALSE);
1448         printf("\n");
1449     }
1450
1451     /* Remove the marker for the brackets implied by operator precedence */
1452     remove_bracket_layer_from_emitter_stack();
1453     return;
1454 }
1455
1456 /* --- Pretty printing ----------------------------------------------------- */
1457
1458 static void show_node(int n, int depth, int annotate)
1459 {   int j;
1460     for (j=0; j<2*depth+2; j++) printf(" ");
1461
1462     if (ET[n].down == -1)
1463     {   print_operand(&ET[n].value, annotate);
1464         printf("\n");
1465     }
1466     else
1467     {   printf("%s ", operators[ET[n].operator_number].description);
1468         j = operators[ET[n].operator_number].precedence;
1469         if ((annotate) && ((j==2) || (j==3)))
1470         {   printf(" %d|%d ", ET[n].true_label, ET[n].false_label);
1471             if (ET[n].label_after != -1) printf(" def %d after ",
1472                 ET[n].label_after);
1473             if (ET[n].to_expression) printf(" con to expr ");
1474         }
1475         printf("\n");
1476         show_node(ET[n].down, depth+1, annotate);
1477     }
1478
1479     if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
1480 }
1481
1482 extern void show_tree(assembly_operand AO, int annotate)
1483 {   if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
1484     else
1485     {   printf("Constant: "); print_operand(&AO, annotate);
1486         printf("\n");
1487     }
1488 }
1489
1490 /* --- Lvalue transformations ---------------------------------------------- */
1491
1492 /* This only gets called in Z-code, since Glulx doesn't distinguish
1493    individual property operators from general ones. */
1494 static void check_property_operator(int from_node)
1495 {   int below = ET[from_node].down;
1496     int opnum = ET[from_node].operator_number;
1497
1498     ASSERT_ZCODE();
1499
1500     if (veneer_mode) return;
1501
1502     if ((below != -1) && (ET[below].right != -1))
1503     {   int n = ET[below].right, flag = FALSE;
1504
1505         /* Can we handle this dot operator as a native @get_prop (etc)
1506            opcode? Only if we recognize the property value as a declared
1507            common property constant. */
1508         if ((ET[n].down == -1)
1509                 && ((ET[n].value.type == LONG_CONSTANT_OT)
1510                     || (ET[n].value.type == SHORT_CONSTANT_OT))
1511                 && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
1512                 && (ET[n].value.marker == 0))
1513             flag = TRUE;
1514
1515         if (!flag)
1516         {   switch(opnum)
1517             {   case PROPERTY_OP: opnum = MESSAGE_OP; break;
1518                 case PROP_ADD_OP: opnum = MPROP_ADD_OP; break;
1519                 case PROP_NUM_OP: opnum = MPROP_NUM_OP; break;
1520             }
1521         }
1522
1523         ET[from_node].operator_number = opnum;
1524     }
1525
1526     if (below != -1)
1527         check_property_operator(below);
1528     if (ET[from_node].right != -1)
1529         check_property_operator(ET[from_node].right);
1530 }
1531
1532 static void check_lvalues(int from_node)
1533 {   int below = ET[from_node].down;
1534     int opnum = ET[from_node].operator_number, opnum_below;
1535     int lvalue_form, i, j = 0;
1536
1537     if (below != -1)
1538     {
1539         if ((opnum == FCALL_OP) && (ET[below].down != -1))
1540         {   opnum_below = ET[below].operator_number;
1541             if ((opnum_below == PROPERTY_OP) || (opnum_below == MESSAGE_OP))
1542             {   i = ET[ET[from_node].down].right;
1543                 ET[from_node].down = ET[below].down;
1544                 ET[ET[below].down].up = from_node;
1545                 ET[ET[ET[below].down].right].up = from_node;
1546                 ET[ET[ET[below].down].right].right = i;
1547                 opnum = PROP_CALL_OP;
1548                 ET[from_node].operator_number = opnum;
1549             }
1550         }
1551
1552         if (operators[opnum].requires_lvalue)
1553         {   opnum_below = ET[below].operator_number;
1554
1555             if (ET[below].down == -1)
1556             {   if (!is_variable_ot(ET[below].value.type))
1557                 {   error("'=' applied to undeclared variable");
1558                     goto LvalueError;
1559                 }
1560             }
1561             else
1562             { lvalue_form=0;
1563               switch(opnum)
1564               { case SETEQUALS_OP:
1565                 switch(opnum_below)
1566                 { case ARROW_OP:    lvalue_form = ARROW_SETEQUALS_OP; break;
1567                   case DARROW_OP:   lvalue_form = DARROW_SETEQUALS_OP; break;
1568                   case MESSAGE_OP:  lvalue_form = MESSAGE_SETEQUALS_OP; break;
1569                   case PROPERTY_OP: lvalue_form = PROPERTY_SETEQUALS_OP; break;
1570                 }
1571                 break;
1572                 case INC_OP:
1573                 switch(opnum_below)
1574                 { case ARROW_OP:    lvalue_form = ARROW_INC_OP; break;
1575                   case DARROW_OP:   lvalue_form = DARROW_INC_OP; break;
1576                   case MESSAGE_OP:  lvalue_form = MESSAGE_INC_OP; break;
1577                   case PROPERTY_OP: lvalue_form = PROPERTY_INC_OP; break;
1578                 }
1579                 break;
1580                 case POST_INC_OP:
1581                 switch(opnum_below)
1582                 { case ARROW_OP:    lvalue_form = ARROW_POST_INC_OP; break;
1583                   case DARROW_OP:   lvalue_form = DARROW_POST_INC_OP; break;
1584                   case MESSAGE_OP:  lvalue_form = MESSAGE_POST_INC_OP; break;
1585                   case PROPERTY_OP: lvalue_form = PROPERTY_POST_INC_OP; break;
1586                 }
1587                 break;
1588                 case DEC_OP:
1589                 switch(opnum_below)
1590                 { case ARROW_OP:    lvalue_form = ARROW_DEC_OP; break;
1591                   case DARROW_OP:   lvalue_form = DARROW_DEC_OP; break;
1592                   case MESSAGE_OP:  lvalue_form = MESSAGE_DEC_OP; break;
1593                   case PROPERTY_OP: lvalue_form = PROPERTY_DEC_OP; break;
1594                 }
1595                 break;
1596                 case POST_DEC_OP:
1597                 switch(opnum_below)
1598                 { case ARROW_OP:    lvalue_form = ARROW_POST_DEC_OP; break;
1599                   case DARROW_OP:   lvalue_form = DARROW_POST_DEC_OP; break;
1600                   case MESSAGE_OP:  lvalue_form = MESSAGE_POST_DEC_OP; break;
1601                   case PROPERTY_OP: lvalue_form = PROPERTY_POST_DEC_OP; break;
1602                 }
1603                 break;
1604               }
1605               if (lvalue_form == 0)
1606               {   error_named("'=' applied to",
1607                       (char *) operators[opnum_below].description);
1608                   goto LvalueError;
1609               }
1610
1611               /*  Transform  from_node                     from_node
1612                                |      \                       | \\\  \
1613                              below    value       to                 value
1614                                | \\\
1615               */
1616
1617               ET[from_node].operator_number = lvalue_form;
1618               i = ET[below].down;
1619               ET[from_node].down = i;
1620               while (i != -1)
1621               {   ET[i].up = from_node;
1622                   j = i;
1623                   i = ET[i].right;
1624               }
1625               ET[j].right = ET[below].right;
1626             }
1627         }
1628         check_lvalues(below);
1629     }
1630     if (ET[from_node].right != -1)
1631         check_lvalues(ET[from_node].right);
1632     return;
1633
1634     LvalueError:
1635     ET[from_node].down = -1;
1636     ET[from_node].value = zero_operand;
1637     if (ET[from_node].right != -1)
1638         check_lvalues(ET[from_node].right);
1639 }
1640
1641 /* --- Tree surgery for conditionals --------------------------------------- */
1642
1643 static void negate_condition(int n)
1644 {   int i;
1645
1646     if (ET[n].right != -1) negate_condition(ET[n].right);
1647     if (ET[n].down == -1) return;
1648     i = operators[ET[n].operator_number].negation;
1649     if (i!=0) ET[n].operator_number = i;
1650     if (operators[i].precedence==2) negate_condition(ET[n].down);
1651 }
1652
1653 static void delete_negations(int n, int context)
1654 {
1655     /*  Recursively apply
1656
1657             ~~(x && y)   =   ~~x || ~~y
1658             ~~(x || y)   =   ~~x && ~~y
1659             ~~(x == y)   =   x ~= y
1660
1661         (etc) to delete the ~~ operator from the tree.  Since this is
1662         depth first, the ~~ being deleted has no ~~s beneath it, which
1663         is important to make "negate_condition" work.
1664
1665         We also do the check for (x <= y or z) here. This must be done
1666         before negate_condition.
1667     */
1668
1669     int i;
1670
1671     if (ET[n].operator_number == LE_OP || ET[n].operator_number == GE_OP) {
1672         if (ET[n].down != -1
1673             && ET[ET[n].down].right != -1
1674             && ET[ET[ET[n].down].right].right != -1) {
1675             if (ET[n].operator_number == LE_OP)
1676                 warning("The behavior of (<= or) may be unexpected.");
1677             else
1678                 warning("The behavior of (>= or) may be unexpected.");
1679         }
1680     }
1681
1682     if (ET[n].right != -1) delete_negations(ET[n].right, context);
1683     if (ET[n].down == -1) return;
1684     delete_negations(ET[n].down, context);
1685
1686     if (ET[n].operator_number == LOGNOT_OP)
1687     {   negate_condition(ET[n].down);
1688         ET[n].operator_number
1689             = ET[ET[n].down].operator_number;
1690         ET[n].down = ET[ET[n].down].down;
1691         i = ET[n].down;
1692         while(i != -1) { ET[i].up = n; i = ET[i].right; }
1693     }
1694 }
1695
1696 static void insert_exp_to_cond(int n, int context)
1697 {
1698     /*  Insert a ~= test when an expression is used as a condition.
1699
1700         Check for possible confusion over = and ==, e.g. "if (a = 1) ..."    */
1701
1702     int new, i;
1703
1704     if (ET[n].right != -1) insert_exp_to_cond(ET[n].right, context);
1705
1706     if (ET[n].down == -1)
1707     {   if (context==CONDITION_CONTEXT)
1708         {
1709             ensure_memory_list_available(&ET_memlist, ET_used+1);
1710             new = ET_used++;
1711             ET[new] = ET[n];
1712             ET[n].down = new; ET[n].operator_number = NONZERO_OP;
1713             ET[new].up = n; ET[new].right = -1;
1714         }
1715         return;
1716     }
1717
1718     switch(operators[ET[n].operator_number].precedence)
1719     {   case 3:                                 /* Conditionals have level 3 */
1720             context = QUANTITY_CONTEXT;
1721             break;
1722         case 2:                                 /* Logical operators level 2 */
1723             context = CONDITION_CONTEXT;
1724             break;
1725         case 1:                                 /* Forms of '=' have level 1 */
1726             if (context == CONDITION_CONTEXT)
1727                 warning("'=' used as condition: '==' intended?");
1728         default:
1729             if (context != CONDITION_CONTEXT) break;
1730
1731             ensure_memory_list_available(&ET_memlist, ET_used+1);
1732             new = ET_used++;
1733             ET[new] = ET[n];
1734             ET[n].down = new; ET[n].operator_number = NONZERO_OP;
1735             ET[new].up = n; ET[new].right = -1;
1736
1737             i = ET[new].down;
1738             while (i!= -1) { ET[i].up = new; i = ET[i].right; }
1739             context = QUANTITY_CONTEXT; n = new;
1740     }
1741
1742     insert_exp_to_cond(ET[n].down, context);
1743 }
1744
1745 static unsigned int etoken_num_children(int n)
1746 {
1747     int count = 0;
1748     int i;
1749     i = ET[n].down;
1750     if (i == -1) { return 0; }
1751     do {
1752         count++;
1753         i = ET[i].right;
1754     } while (i!=-1);
1755     return count;
1756 }
1757
1758 static void func_args_on_stack(int n, int context)
1759 {
1760   /* Make sure that the arguments of every function-call expression
1761      are stored to the stack. If any aren't (ie, if any arguments are
1762      constants or variables), cover them with push operators.
1763      (The very first argument does not need to be so treated, because
1764      it's the function address, not a function argument. We also
1765      skip the treatment for most system functions.) */
1766
1767   int new, pn, fnaddr, opnum;
1768
1769   ASSERT_GLULX();
1770
1771   if (ET[n].right != -1)
1772     func_args_on_stack(ET[n].right, context);
1773   if (ET[n].down == -1) {
1774     pn = ET[n].up;
1775     if (pn != -1) {
1776       opnum = ET[pn].operator_number;
1777       if (opnum == FCALL_OP
1778         || opnum == MESSAGE_CALL_OP
1779         || opnum == PROP_CALL_OP) {
1780         /* If it's an FCALL, get the operand which contains the function
1781            address (or system-function number) */
1782         if (opnum == MESSAGE_CALL_OP
1783           || opnum == PROP_CALL_OP
1784           || ((fnaddr=ET[pn].down) != n
1785             && (ET[fnaddr].value.type != SYSFUN_OT
1786               || ET[fnaddr].value.value == INDIRECT_SYSF
1787               || ET[fnaddr].value.value == GLK_SYSF))) {
1788         if (etoken_num_children(pn) > (unsigned int)(opnum == FCALL_OP ? 4:3)) {
1789           ensure_memory_list_available(&ET_memlist, ET_used+1);
1790           new = ET_used++;
1791           ET[new] = ET[n];
1792           ET[n].down = new;
1793           ET[n].operator_number = PUSH_OP;
1794           ET[new].up = n;
1795           ET[new].right = -1;
1796         }
1797         }
1798       }
1799     }
1800     return;
1801   }
1802
1803   func_args_on_stack(ET[n].down, context);
1804 }
1805
1806 static assembly_operand check_conditions(assembly_operand AO, int context)
1807 {   int n;
1808
1809     if (AO.type != EXPRESSION_OT)
1810     {   if (context != CONDITION_CONTEXT) return AO;
1811         ensure_memory_list_available(&ET_memlist, ET_used+1);
1812         n = ET_used++;
1813         ET[n].down = -1;
1814         ET[n].up = -1;
1815         ET[n].right = -1;
1816         ET[n].value = AO;
1817         INITAOT(&AO, EXPRESSION_OT);
1818         AO.value = n;
1819     }
1820
1821     insert_exp_to_cond(AO.value, context);
1822     delete_negations(AO.value, context);
1823
1824     if (glulx_mode)
1825         func_args_on_stack(AO.value, context);
1826
1827     return AO;
1828 }
1829
1830 /* --- Shift-reduce parser ------------------------------------------------- */
1831
1832 static int sr_sp;
1833 static token_data *sr_stack; /* Allocated to sr_sp */
1834 static memory_list sr_stack_memlist;
1835
1836 extern assembly_operand parse_expression(int context)
1837 {
1838     /*  Parses an expression, evaluating it as a constant if possible.
1839
1840         Possible contexts are:
1841
1842             VOID_CONTEXT        the expression is used as a statement, so that
1843                                 its value will be thrown away and it only
1844                                 needs to exist for any resulting side-effects
1845                                 (function calls and assignments)
1846
1847             CONDITION_CONTEXT   the result must be a condition
1848
1849             CONSTANT_CONTEXT    there is required to be a constant result
1850                                 (so that, for instance, comma becomes illegal)
1851
1852             QUANTITY_CONTEXT    the default: a quantity is to be specified
1853
1854             ACTION_Q_CONTEXT    like QUANTITY_CONTEXT, but postfixed brackets
1855                                 at the top level do not indicate function call:
1856                                 used for e.g.
1857                                    <Insert button (random(pocket1, pocket2))>
1858
1859             RETURN_Q_CONTEXT    like QUANTITY_CONTEXT, but a single property
1860                                 name does not generate a warning
1861
1862             ASSEMBLY_CONTEXT    a quantity which cannot use the '->' operator
1863                                 (needed for assembly language to indicate
1864                                 store destinations)
1865
1866             FORINIT_CONTEXT     a quantity which cannot use an (unbracketed)
1867                                 '::' operator
1868
1869             ARRAY_CONTEXT       like CONSTANT_CONTEXT, but where an unbracketed
1870                                 minus sign is ambiguous, and brackets always
1871                                 indicate subexpressions, not function calls
1872
1873         Return value: an assembly operand.
1874
1875         If the type is OMITTED_OT, then the expression has no resulting value.
1876
1877         If the type is EXPRESSION_OT, then the value will need to be
1878         calculated at run-time by code compiled from the expression tree
1879         whose root node-number is the operand value.
1880
1881         Otherwise the assembly operand is the value of the expression, which
1882         is constant and thus known at compile time.
1883
1884         If an error has occurred in the expression, which recovery from was
1885         not possible, then the return is (short constant) 0.  This should
1886         minimise the chance of a cascade of further error messages.
1887     */
1888
1889     token_data a, b, pop; int i;
1890     assembly_operand AO;
1891
1892     superclass_allowed = (context != FORINIT_CONTEXT);
1893     if (context == FORINIT_CONTEXT) context = VOID_CONTEXT;
1894
1895     comma_allowed = (context == VOID_CONTEXT);
1896     arrow_allowed = (context != ASSEMBLY_CONTEXT);
1897     bare_prop_allowed = (context == RETURN_Q_CONTEXT);
1898     array_init_ambiguity = ((context == ARRAY_CONTEXT) ||
1899         (context == ASSEMBLY_CONTEXT));
1900
1901     action_ambiguity = (context == ACTION_Q_CONTEXT);
1902
1903     if (context == ASSEMBLY_CONTEXT) context = QUANTITY_CONTEXT;
1904     if (context == ACTION_Q_CONTEXT) context = QUANTITY_CONTEXT;
1905     if (context == RETURN_Q_CONTEXT) context = QUANTITY_CONTEXT;
1906     if (context == ARRAY_CONTEXT) context = CONSTANT_CONTEXT;
1907
1908     etoken_count = 0;
1909     inserting_token = FALSE;
1910
1911     emitter_sp = 0;
1912     bracket_level = 0;
1913
1914     previous_token.text = "$";
1915     previous_token.type = ENDEXP_TT;
1916     previous_token.value = 0;
1917
1918     ensure_memory_list_available(&sr_stack_memlist, 1);
1919     sr_sp = 1;
1920     sr_stack[0] = previous_token;
1921
1922     AO = zero_operand;
1923
1924     statements.enabled = FALSE;
1925     directives.enabled = FALSE;
1926
1927     if (get_next_etoken() == FALSE)
1928     {   ebf_error("expression", token_text);
1929         return AO;
1930     }
1931
1932     do
1933     {   if (expr_trace_level >= 2)
1934         {   printf("Input: %-20s", current_token.text);
1935             for (i=0; i<sr_sp; i++) printf("%s ", sr_stack[i].text);
1936             printf("\n");
1937         }
1938         if (expr_trace_level >= 3) printf("ET_used = %d\n", ET_used);
1939
1940         if (sr_sp == 0)
1941         {   compiler_error("SR error: stack empty");
1942             return(AO);
1943         }
1944
1945         a = sr_stack[sr_sp-1]; b = current_token;
1946
1947         if ((a.type == ENDEXP_TT) && (b.type == ENDEXP_TT))
1948         {   if (emitter_sp == 0)
1949             {   error("No expression between brackets '(' and ')'");
1950                 put_token_back();
1951                 return AO;
1952             }
1953             if (emitter_sp > 1)
1954             {   compiler_error("SR error: emitter stack overfull");
1955                 return AO;
1956             }
1957
1958             AO = emitter_stack[0].op;
1959             if (AO.type == EXPRESSION_OT)
1960             {   if (expr_trace_level >= 3)
1961                 {   printf("Tree before lvalue checking:\n");
1962                     show_tree(AO, FALSE);
1963                 }
1964                 if (!glulx_mode)
1965                     check_property_operator(AO.value);
1966                 check_lvalues(AO.value);
1967                 ET[AO.value].up = -1;
1968             }
1969             else {
1970                 if ((context != CONSTANT_CONTEXT)
1971                     && (AO.symindex >= 0)
1972                     && is_property_t(symbols[AO.symindex].type)
1973                     && (arrow_allowed) && (!bare_prop_allowed))
1974                     warning("Bare property name found. \"self.prop\" intended?");
1975             }
1976
1977             check_conditions(AO, context);
1978
1979             if (context == CONSTANT_CONTEXT)
1980                 if (!is_constant_ot(AO.type))
1981                 {   AO = zero_operand;
1982                     ebf_error("constant", "<expression>");
1983                 }
1984             put_token_back();
1985
1986             return(AO);
1987         }
1988
1989         switch(find_prec(&a,&b))
1990         {
1991             case e5:                 /* Associativity error                  */
1992                 error_named("Brackets mandatory to clarify order of:",
1993                     a.text);
1994
1995             case LOWER_P:
1996             case EQUAL_P:
1997                 ensure_memory_list_available(&sr_stack_memlist, sr_sp+1);
1998                 sr_stack[sr_sp++] = b;
1999                 switch(b.type)
2000                 {
2001                     case SUBOPEN_TT:
2002                         if (sr_sp >= 2 && sr_stack[sr_sp-2].type == OP_TT && sr_stack[sr_sp-2].value == FCALL_OP)
2003                             mark_top_of_emitter_stack(FUNCTION_VALUE_MARKER, &b);
2004                         else
2005                             add_bracket_layer_to_emitter_stack(0);
2006                         break;
2007                     case OP_TT:
2008                         switch(b.value){
2009                             case OR_OP:
2010                                 if (sr_stack[sr_sp-2].type == OP_TT &&
2011                                     operators[sr_stack[sr_sp-2].value].precedence == 3)
2012                                     mark_top_of_emitter_stack(OR_VALUE_MARKER, &b);
2013                                 else
2014                                 {   error("'or' not between values to the right of a condition");
2015                                     /* Convert to + for error recovery purposes */
2016                                     sr_stack[sr_sp-1].value = PLUS_OP;
2017                                 }
2018                                 break;
2019                             case COMMA_OP:
2020                                 {
2021                                     /* A comma separates arguments only if the shallowest open bracket belongs to a function call. */
2022                                     int shallowest_open_bracket_index = sr_sp - 2;
2023                                     while (shallowest_open_bracket_index > 0 && sr_stack[shallowest_open_bracket_index].type != SUBOPEN_TT)
2024                                         --shallowest_open_bracket_index;
2025                                     if (shallowest_open_bracket_index > 0 &&
2026                                         sr_stack[shallowest_open_bracket_index-1].type == OP_TT &&
2027                                         sr_stack[shallowest_open_bracket_index-1].value == FCALL_OP)
2028                                     {   mark_top_of_emitter_stack(ARGUMENT_VALUE_MARKER, &b);
2029                                         break;
2030                                     }
2031                                     /* Non-argument-separating commas get treated like any other operator; we fall through to the default case. */
2032                                 }
2033                             default:
2034                                 {
2035                                     /* Add a marker for the brackets implied by operator precedence */
2036                                     int operands_on_left = (operators[b.value].usage == PRE_U) ? 0 : 1;
2037                                     add_bracket_layer_to_emitter_stack(operands_on_left);
2038                                 }
2039                         }
2040                 }
2041                 get_next_etoken();
2042                 break;
2043             case GREATER_P:
2044                 do
2045                 {   pop = sr_stack[sr_sp - 1];
2046                     emit_token(&pop);
2047                     sr_sp--;
2048                 } while (find_prec(&sr_stack[sr_sp-1], &pop) != LOWER_P);
2049                 break;
2050
2051             case e1:                 /* Missing operand error                */
2052                 error_named("Missing operand after", a.text);
2053                 put_token_back();
2054                 current_token.type = NUMBER_TT;
2055                 current_token.value = 0;
2056                 current_token.marker = 0;
2057                 current_token.text = "0";
2058                 break;
2059
2060             case e2:                 /* Unexpected close bracket             */
2061                 error("Found '(' without matching ')'");
2062                 get_next_etoken();
2063                 break;
2064
2065             case e3:                 /* Missing operator error               */
2066                 error("Missing operator: inserting '+'");
2067                 put_token_back();
2068                 current_token.type = OP_TT;
2069                 current_token.value = PLUS_OP;
2070                 current_token.marker = 0;
2071                 current_token.text = "+";
2072                 break;
2073
2074             case e4:                 /* Expression ends with an open bracket */
2075                 error("Found '(' without matching ')'");
2076                 sr_sp--;
2077                 break;
2078
2079         }
2080     }
2081     while (TRUE);
2082 }
2083
2084 /* --- Test for simple ++ or -- usage: used to optimise "for" loop code ---- */
2085
2086 extern int test_for_incdec(assembly_operand AO)
2087 {   int s = 0;
2088     if (AO.type != EXPRESSION_OT) return 0;
2089     if (ET[AO.value].down == -1) return 0;
2090     switch(ET[AO.value].operator_number)
2091     {   case INC_OP:      s = 1; break;
2092         case POST_INC_OP: s = 1; break;
2093         case DEC_OP:      s = -1; break;
2094         case POST_DEC_OP: s = -1; break;
2095     }
2096     if (s==0) return 0;
2097     if (ET[ET[AO.value].down].down != -1) return 0;
2098     if (!is_variable_ot(ET[ET[AO.value].down].value.type)) return 0;
2099     return s*(ET[ET[AO.value].down].value.value);
2100 }
2101
2102 /* ========================================================================= */
2103 /*   Data structure management routines                                      */
2104 /* ------------------------------------------------------------------------- */
2105
2106 extern void init_expressp_vars(void)
2107 {   int i;
2108     /* make_operands(); */
2109     make_lexical_interface_tables();
2110     for (i=0; i<NUMBER_SYSTEM_FUNCTIONS; i++)
2111         system_function_usage[i] = 0;
2112
2113     ET = NULL;
2114     emitter_stack = NULL;
2115     sr_stack = NULL;
2116 }
2117
2118 extern void expressp_begin_pass(void)
2119 {
2120 }
2121
2122 extern void expressp_allocate_arrays(void)
2123 {
2124     initialise_memory_list(&ET_memlist,
2125         sizeof(expression_tree_node), 100, (void**)&ET,
2126         "expression parse trees");
2127
2128     initialise_memory_list(&emitter_stack_memlist,
2129         sizeof(emitterstackinfo), 100, (void**)&emitter_stack,
2130         "expression stack");
2131
2132     initialise_memory_list(&sr_stack_memlist,
2133         sizeof(token_data), 100, (void**)&sr_stack,
2134         "shift-reduce parser stack");
2135 }
2136
2137 extern void expressp_free_arrays(void)
2138 {
2139     deallocate_memory_list(&ET_memlist);
2140
2141     deallocate_memory_list(&emitter_stack_memlist);
2142
2143     deallocate_memory_list(&sr_stack_memlist);
2144 }
2145
2146 /* ========================================================================= */