expressp.c

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