src/expressp.c

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