src/expressp.c

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