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