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