src/expressp.c

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