1 /* ------------------------------------------------------------------------- */
2 /* "expressp" : The expression parser */
4 /* Part of Inform 6.40 */
5 /* copyright (c) Graham Nelson 1993 - 2022 */
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. */
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. */
17 /* You should have received a copy of the GNU General Public License */
18 /* along with Inform. If not, see https://gnu.org/licenses/ */
20 /* ------------------------------------------------------------------------- */
24 /* --- Interface to lexer -------------------------------------------------- */
26 static char separators_to_operators[103];
27 static char conditionals_to_operators[7];
28 static char token_type_allowable[301];
30 #define NOT_AN_OPERATOR (char) 0x7e
32 static void make_lexical_interface_tables(void)
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;
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;
46 for (i=0;i<301;i++) token_type_allowable[i] = 0;
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;
61 static token_data current_token, previous_token, heldback_token;
63 static int comma_allowed, arrow_allowed, superclass_allowed,
65 array_init_ambiguity, action_ambiguity,
66 etoken_count, inserting_token, bracket_level;
68 int system_function_usage[NUMBER_SYSTEM_FUNCTIONS];
70 static int get_next_etoken(void)
71 { int v, symbol = 0, mark_symbol_as_used = FALSE,
72 initial_bracket_level = bracket_level;
77 { current_token = heldback_token;
78 inserting_token = FALSE;
82 current_token.text = token_text;
83 current_token.value = token_value;
84 current_token.type = token_type;
85 current_token.marker = 0;
86 current_token.symindex = -1;
87 current_token.symtype = 0;
88 current_token.symflags = -1;
91 switch(current_token.type)
92 { case LOCAL_VARIABLE_TT:
93 current_token.type = VARIABLE_TT;
94 variables[current_token.value].usage = TRUE;
98 current_token.marker = STRING_MV;
102 { int32 unicode = text_to_unicode(token_text);
103 if (token_text[textual_form_length] == 0)
106 current_token.value = unicode_to_zscii(unicode);
107 if (current_token.value == 5)
108 { unicode_char_error("Character can be printed \
109 but not used as a value:", unicode);
110 current_token.value = '?';
112 if (current_token.value >= 0x100)
113 current_token.type = LARGE_NUMBER_TT;
114 else current_token.type = SMALL_NUMBER_TT;
117 current_token.value = unicode;
118 if (current_token.value >= 0x8000
119 || current_token.value < -0x8000)
120 current_token.type = LARGE_NUMBER_TT;
121 else current_token.type = SMALL_NUMBER_TT;
125 { current_token.type = DICTWORD_TT;
126 current_token.marker = DWORD_MV;
133 symbol = current_token.value;
135 mark_symbol_as_used = TRUE;
137 v = symbols[symbol].value;
139 current_token.symindex = symbol;
140 current_token.symtype = symbols[symbol].type;
141 current_token.symflags = symbols[symbol].flags;
142 switch(symbols[symbol].type)
144 /* Replaced functions must always be backpatched
145 because there could be another definition coming. */
146 if (symbols[symbol].flags & REPLACE_SFLAG)
147 { current_token.marker = SYMBOL_MV;
148 if (module_switch) import_symbol(symbol);
152 current_token.marker = IROUTINE_MV;
154 case GLOBAL_VARIABLE_T:
155 current_token.marker = VARIABLE_MV;
159 /* All objects must be backpatched in Glulx. */
160 if (module_switch || glulx_mode)
161 current_token.marker = OBJECT_MV;
164 current_token.marker = ARRAY_MV;
167 current_token.marker = STATIC_ARRAY_MV;
169 case INDIVIDUAL_PROPERTY_T:
170 if (module_switch) current_token.marker = IDENT_MV;
173 if (symbols[symbol].flags & (UNKNOWN_SFLAG + CHANGE_SFLAG))
174 { current_token.marker = SYMBOL_MV;
175 if (module_switch) import_symbol(symbol);
178 else current_token.marker = 0;
181 error_named("Label name used as value:", token_text);
184 current_token.marker = 0;
187 if (symbols[symbol].flags & SYSTEM_SFLAG)
188 current_token.marker = 0;
190 current_token.value = v;
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;
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;
207 if (symbols[symbol].type == GLOBAL_VARIABLE_T)
208 { current_token.type = VARIABLE_TT;
209 variables[current_token.value].usage = TRUE;
215 if (current_token.value >= 256)
216 current_token.type = LARGE_NUMBER_TT;
218 current_token.type = SMALL_NUMBER_TT;
221 if (current_token.value < -0x8000
222 || current_token.value >= 0x8000)
223 current_token.type = LARGE_NUMBER_TT;
225 current_token.type = SMALL_NUMBER_TT;
230 switch(current_token.value)
233 current_token.type = ENDEXP_TT;
237 if ((bracket_level==0) && (!comma_allowed))
238 current_token.type = ENDEXP_TT;
242 if ((bracket_level==0) && (!superclass_allowed))
243 current_token.type = ENDEXP_TT;
248 if ((token_type == SEP_TT)
249 &&((token_value == SEMICOLON_SEP)
250 || (token_value == GREATER_SEP)))
251 current_token.type = ENDEXP_TT;
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);
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;
268 { inserting_token = TRUE;
269 heldback_token = current_token;
270 current_token.text = "<call>";
277 if (bracket_level < 0)
278 current_token.type = ENDEXP_TT;
279 else current_token.type = SUBCLOSE_TT;
283 current_token.type = ENDEXP_TT; break;
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;
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;
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;
306 token_text = current_token.text + 2;
308 ActionUsedAsConstant:
310 current_token.type = ACTION_TT;
311 current_token.text = token_text;
312 current_token.value = 0;
313 current_token.marker = ACTION_MV;
317 case HASHADOLLAR_SEP:
318 obsolete_warning("'#a$Act' is now superseded by '##Act'");
319 token_text = current_token.text + 3;
320 goto ActionUsedAsConstant;
322 case HASHGDOLLAR_SEP:
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 */
328 current_token.text += 3;
329 current_token.type = SYMBOL_TT;
330 symbol = symbol_index(current_token.text, -1);
331 if (symbols[symbol].type != GLOBAL_VARIABLE_T) {
333 "global variable name after '#g$'",
335 current_token.value = 0;
336 current_token.type = SMALL_NUMBER_TT;
337 current_token.marker = 0;
340 mark_symbol_as_used = TRUE;
341 current_token.value = symbols[symbol].value - MAX_LOCAL_VARIABLES;
342 current_token.marker = 0;
344 if (current_token.value >= 0x100)
345 current_token.type = LARGE_NUMBER_TT;
346 else current_token.type = SMALL_NUMBER_TT;
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;
356 case HASHNDOLLAR_SEP:
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' */
362 if (strlen(token_text) > 4)
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;
371 case HASHRDOLLAR_SEP:
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. */
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);
385 case HASHWDOLLAR_SEP:
386 error("The obsolete '#w$word' construct has been removed");
390 system_constants.enabled = TRUE;
392 system_constants.enabled = FALSE;
393 if (token_type != SYSTEM_CONSTANT_TT)
395 "'r$', 'n$', 'g$' or internal Inform constant name after '#'",
400 { current_token.type = token_type;
401 current_token.value = token_value;
402 current_token.text = token_text;
403 current_token.marker = INCON_MV;
410 v = conditionals_to_operators[current_token.value];
411 if (v != NOT_AN_OPERATOR)
412 { current_token.type = OP_TT; current_token.value = v;
417 if (current_token.type == SEP_TT)
418 { v = separators_to_operators[current_token.value];
419 if (v != NOT_AN_OPERATOR)
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) &&
427 warning("Without bracketing, the minus sign '-' is ambiguous");
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... */
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(¤t_token);
444 current_token.type = ENDEXP_TT;
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(¤t_token);
459 current_token.type = ENDEXP_TT;
462 { if (mark_symbol_as_used) symbols[symbol].flags |= USED_SFLAG;
463 if (expr_trace_level >= 3)
464 { printf("Expr token = '%s' ", current_token.text);
465 describe_token(¤t_token);
470 if ((previous_token.type == ENDEXP_TT)
471 && (current_token.type == ENDEXP_TT)) return FALSE;
473 previous_token = current_token;
478 /* --- Operator precedences ------------------------------------------------ */
482 #define GREATER_P 103
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 */
490 const int prec_table[] = {
492 /* a .......... ( ) end op term */
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
502 static int find_prec(const token_data *a, const token_data *b)
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.
509 Note that this routine is not symmetrical and that the relation
512 If a and b are equal (and aren't brackets), then
514 a LOWER_P a if a right-associative
515 a GREATER_P a if a left-associative
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;
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;
535 j = prec_table[i]; if (j != -1) return j;
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;
542 /* Anomalous rule to resolve the function call precedence, which is
543 different on the right from on the left, e.g., in:
549 if ((l1 == 11) && (l2 > 11)) return GREATER_P;
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;
561 /* --- Converting token to operand ----------------------------------------- */
563 /* List used to generate gameinfo.dbg.
564 Must match the switch statement below. */
565 int z_system_constant_list[] =
566 { adjectives_table_SC,
569 identifiers_table_SC,
574 actual_largest_object_SC,
575 static_memory_offset_SC,
576 array_names_offset_SC,
577 readable_memory_offset_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,
595 routine_flags_array_SC,
596 highest_global_number_SC,
597 global_names_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,
612 static int32 value_of_system_constant_z(int t)
614 { case adjectives_table_SC:
615 return adjectives_offset;
616 case actions_table_SC:
617 return actions_offset;
618 case classes_table_SC:
619 return class_numbers_offset;
620 case identifiers_table_SC:
621 return identifier_names_offset;
622 case preactions_table_SC:
623 return preactions_offset;
624 case largest_object_SC:
625 return 256 + no_objects - 1;
626 case strings_offset_SC:
627 return strings_offset/scale_factor;
629 return code_offset/scale_factor;
630 case actual_largest_object_SC:
632 case static_memory_offset_SC:
633 return static_memory_offset;
634 case array_names_offset_SC:
635 return array_names_offset;
636 case readable_memory_offset_SC:
637 return Write_Code_At;
639 return prop_values_offset;
641 return class_numbers_offset;
643 return individuals_offset;
645 return variables_offset;
646 case array__start_SC:
647 return variables_offset + (MAX_ZCODE_GLOBAL_VARS*WORDSIZE);
649 return static_memory_offset;
650 case dictionary_table_SC:
651 return dictionary_offset;
652 case grammar_table_SC:
653 return static_memory_offset;
655 case highest_attribute_number_SC:
656 return no_attributes-1;
657 case attribute_names_array_SC:
658 return attribute_names_offset;
660 case highest_property_number_SC:
661 return no_individual_properties-1;
662 case property_names_array_SC:
663 return identifier_names_offset + 2;
665 case highest_action_number_SC:
667 case action_names_array_SC:
668 return action_names_offset;
670 case highest_fake_action_number_SC:
671 return ((grammar_version_number==1)?256:4096) + no_fake_actions-1;
672 case fake_action_names_array_SC:
673 return fake_action_names_offset;
675 case highest_routine_number_SC:
676 return no_named_routines-1;
677 case routine_names_array_SC:
678 return routine_names_offset;
679 case routines_array_SC:
680 return routines_array_offset;
681 case routine_flags_array_SC:
682 return routine_flags_array_offset;
683 case highest_global_number_SC:
684 return 16 + no_globals-1;
685 case global_names_array_SC:
686 return global_names_offset;
687 case globals_array_SC:
688 return variables_offset;
689 case global_flags_array_SC:
690 return global_flags_array_offset;
691 case highest_array_number_SC:
693 case array_names_array_SC:
694 return array_names_offset;
695 case array_flags_array_SC:
696 return array_flags_array_offset;
697 case highest_constant_number_SC:
698 return no_named_constants-1;
699 case constant_names_array_SC:
700 return constant_names_offset;
701 case highest_class_number_SC:
703 case class_objects_array_SC:
704 return class_numbers_offset;
705 case highest_object_number_SC:
709 error_named("System constant not implemented in Z-code",
710 system_constants.keywords[t]);
715 /* List used to generate gameinfo.dbg.
716 Must match the switch statement below. */
717 int glulx_system_constant_list[] =
719 identifiers_table_SC,
720 array_names_offset_SC,
724 dynam_string_table_SC,
728 highest_class_number_SC,
729 highest_object_number_SC,
732 static int32 value_of_system_constant_g(int t)
735 case classes_table_SC:
736 return Write_RAM_At + class_numbers_offset;
737 case identifiers_table_SC:
738 return Write_RAM_At + identifier_names_offset;
739 case array_names_offset_SC:
740 return Write_RAM_At + array_names_offset;
742 return prop_defaults_offset;
744 return Write_RAM_At + class_numbers_offset;
745 case dictionary_table_SC:
746 return dictionary_offset;
747 case dynam_string_table_SC:
748 return abbreviations_offset;
749 case grammar_table_SC:
750 return grammar_table_offset;
751 case actions_table_SC:
752 return actions_offset;
753 case globals_array_SC:
754 return variables_offset;
755 case highest_class_number_SC:
757 case highest_object_number_SC:
761 error_named("System constant not implemented in Glulx",
762 system_constants.keywords[t]);
767 extern int32 value_of_system_constant(int t)
770 return value_of_system_constant_z(t);
772 return value_of_system_constant_g(t);
775 extern char *name_of_system_constant(int t)
777 if (t < 0 || t >= NO_SYSTEM_CONSTANTS) {
780 return system_constants.keywords[t];
783 static int evaluate_term(const token_data *t, assembly_operand *o)
785 /* If the given token is a constant, evaluate it into the operand.
786 For now, the identifiers are considered variables.
788 Returns FALSE if it fails to understand type. */
792 o->marker = t->marker;
793 o->symindex = t->symindex;
796 { case LARGE_NUMBER_TT:
799 if (v < 0) v = v + 0x10000;
800 o->type = LONG_CONSTANT_OT;
805 o->type = CONSTANT_OT;
808 case SMALL_NUMBER_TT:
811 if (v < 0) v = v + 0x10000;
812 o->type = SHORT_CONSTANT_OT;
821 /* Find the dictionary address, adding to dictionary if absent */
823 o->type = LONG_CONSTANT_OT;
825 o->type = CONSTANT_OT;
826 o->value = dictionary_add(t->text, 0x80, 0, 0);
829 /* Create as a static string */
831 o->type = LONG_CONSTANT_OT;
833 o->type = CONSTANT_OT;
834 o->value = compile_string(t->text, STRCTX_GAME);
838 o->type = VARIABLE_OT;
841 if (t->value >= MAX_LOCAL_VARIABLES) {
842 o->type = GLOBALVAR_OT;
845 /* This includes "local variable zero", which is really
846 the stack-pointer magic variable. */
847 o->type = LOCALVAR_OT;
854 o->type = VARIABLE_OT;
855 o->value = t->value + 256;
861 system_function_usage[t->value] = 1;
864 *o = action_of_name(t->text);
866 case SYSTEM_CONSTANT_TT:
867 /* Certain system constants depend only on the
868 version number and need no backpatching, as they
869 are known in advance. We can therefore evaluate
872 o->type = LONG_CONSTANT_OT;
875 case version_number_SC:
876 o->type = SHORT_CONSTANT_OT;
878 v = version_number; break;
880 o->type = SHORT_CONSTANT_OT;
882 v = (version_number==3)?4:6; break;
884 o->type = SHORT_CONSTANT_OT;
886 v = (version_number==3)?5:7; break;
888 o->type = SHORT_CONSTANT_OT;
890 if (ZCODE_LESS_DICT_DATA)
891 error("#dict_par3 is unavailable when ZCODE_LESS_DICT_DATA is set");
892 v = (version_number==3)?6:8; break;
893 case lowest_attribute_number_SC:
894 case lowest_action_number_SC:
895 case lowest_routine_number_SC:
896 case lowest_array_number_SC:
897 case lowest_constant_number_SC:
898 case lowest_class_number_SC:
899 o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 0; break;
900 case lowest_object_number_SC:
901 case lowest_property_number_SC:
902 o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 1; break;
903 case lowest_global_number_SC:
904 o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 16; break;
905 case lowest_fake_action_number_SC:
906 o->type = LONG_CONSTANT_OT; o->marker = 0;
907 v = ((grammar_version_number==1)?256:4096); break;
908 case oddeven_packing_SC:
909 o->type = SHORT_CONSTANT_OT; o->marker = 0;
910 v = oddeven_packing_switch; break;
913 o->marker = INCON_MV;
919 o->type = CONSTANT_OT;
922 /* The three dict_par flags point at the lower byte
923 of the flag field, because the library is written
924 to expect one-byte fields, even though the compiler
925 generates a dictionary with room for two. */
927 o->type = BYTECONSTANT_OT;
929 v = DICT_ENTRY_FLAG_POS+1;
932 o->type = BYTECONSTANT_OT;
934 v = DICT_ENTRY_FLAG_POS+3;
937 o->type = BYTECONSTANT_OT;
939 v = DICT_ENTRY_FLAG_POS+5;
942 case lowest_attribute_number_SC:
943 case lowest_action_number_SC:
944 case lowest_routine_number_SC:
945 case lowest_array_number_SC:
946 case lowest_constant_number_SC:
947 case lowest_class_number_SC:
948 o->type = BYTECONSTANT_OT;
952 case lowest_object_number_SC:
953 case lowest_property_number_SC:
954 o->type = BYTECONSTANT_OT;
959 /* ###fix: need to fill more of these in! */
963 o->marker = INCON_MV;
974 /* --- Emitter ------------------------------------------------------------- */
976 expression_tree_node *ET; /* Allocated to ET_used */
977 static memory_list ET_memlist;
980 extern void clear_expression_space(void)
984 typedef struct emitterstackinfo_s {
990 #define FUNCTION_VALUE_MARKER 1
991 #define ARGUMENT_VALUE_MARKER 2
992 #define OR_VALUE_MARKER 3
994 static emitterstackinfo *emitter_stack; /* Allocated to emitter_sp */
995 static memory_list emitter_stack_memlist;
996 static int emitter_sp;
998 static int is_property_t(int symbol_type)
999 { return ((symbol_type == PROPERTY_T) || (symbol_type == INDIVIDUAL_PROPERTY_T));
1002 static void mark_top_of_emitter_stack(int marker, const token_data *t)
1003 { if (emitter_sp < 1)
1004 { compiler_error("SR error: Attempt to add a marker to the top of an empty emitter stack");
1007 if (expr_trace_level >= 2)
1008 { printf("Marking top of emitter stack (which is ");
1009 print_operand(&emitter_stack[emitter_sp-1].op, FALSE);
1013 case FUNCTION_VALUE_MARKER:
1016 case ARGUMENT_VALUE_MARKER:
1019 case OR_VALUE_MARKER:
1028 if (emitter_stack[emitter_sp-1].marker)
1029 { if (marker == ARGUMENT_VALUE_MARKER)
1031 warning("Ignoring spurious leading comma");
1034 error_named("Missing operand for", t->text);
1035 ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1036 emitter_stack[emitter_sp].marker = 0;
1037 emitter_stack[emitter_sp].bracket_count = 0;
1038 emitter_stack[emitter_sp].op = zero_operand;
1041 emitter_stack[emitter_sp-1].marker = marker;
1044 static void add_bracket_layer_to_emitter_stack(int depth)
1045 { /* There's no point in tracking bracket layers that don't fence off any values. */
1046 if (emitter_sp < depth + 1) return;
1047 if (expr_trace_level >= 2)
1048 printf("Adding bracket layer\n");
1049 ++emitter_stack[emitter_sp-depth-1].bracket_count;
1052 static void remove_bracket_layer_from_emitter_stack()
1053 { /* Bracket layers that don't fence off any values will not have been tracked. */
1054 if (emitter_sp < 2) return;
1055 if (expr_trace_level >= 2)
1056 printf("Removing bracket layer\n");
1057 if (emitter_stack[emitter_sp-2].bracket_count <= 0)
1058 { compiler_error("SR error: Attempt to remove a nonexistent bracket layer from the emitter stack");
1061 --emitter_stack[emitter_sp-2].bracket_count;
1064 static void emit_token(const token_data *t)
1065 { assembly_operand o1, o2; int arity, stack_size, i;
1066 int op_node_number, operand_node_number, previous_node_number;
1069 if (expr_trace_level >= 2)
1070 { printf("Output: %-19s%21s ", t->text, "");
1071 for (i=0; i<emitter_sp; i++)
1072 { print_operand(&emitter_stack[i].op, FALSE); printf(" ");
1073 if (emitter_stack[i].marker == FUNCTION_VALUE_MARKER) printf(":FUNCTION ");
1074 if (emitter_stack[i].marker == ARGUMENT_VALUE_MARKER) printf(":ARGUMENT ");
1075 if (emitter_stack[i].marker == OR_VALUE_MARKER) printf(":OR ");
1076 if (emitter_stack[i].bracket_count) printf(":BRACKETS(%d) ", emitter_stack[i].bracket_count);
1081 if (t->type == SUBOPEN_TT) return;
1084 while ((stack_size < emitter_sp) &&
1085 !emitter_stack[emitter_sp-stack_size-1].marker &&
1086 !emitter_stack[emitter_sp-stack_size-1].bracket_count)
1089 if (t->type == SUBCLOSE_TT)
1090 { if (stack_size < emitter_sp && emitter_stack[emitter_sp-stack_size-1].bracket_count)
1091 { if (stack_size == 0)
1092 { error("No expression between brackets '(' and ')'");
1093 ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1094 emitter_stack[emitter_sp].op = zero_operand;
1095 emitter_stack[emitter_sp].marker = 0;
1096 emitter_stack[emitter_sp].bracket_count = 0;
1099 else if (stack_size < 1)
1100 compiler_error("SR error: emitter stack empty in subexpression");
1101 else if (stack_size > 1)
1102 compiler_error("SR error: emitter stack overfull in subexpression");
1103 remove_bracket_layer_from_emitter_stack();
1108 if (t->type != OP_TT)
1110 ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1111 emitter_stack[emitter_sp].marker = 0;
1112 emitter_stack[emitter_sp].bracket_count = 0;
1114 if (!evaluate_term(t, &(emitter_stack[emitter_sp++].op)))
1115 compiler_error_named("Emit token error:", t->text);
1119 /* A comma is argument-separating if it follows an argument (or a function
1120 call, since we ignore spurious leading commas in function argument lists)
1121 with no intervening brackets. Function calls are variadic, so we don't
1122 apply argument-separating commas. */
1123 if (t->value == COMMA_OP &&
1124 stack_size < emitter_sp &&
1125 (emitter_stack[emitter_sp-stack_size-1].marker == ARGUMENT_VALUE_MARKER ||
1126 emitter_stack[emitter_sp-stack_size-1].marker == FUNCTION_VALUE_MARKER) &&
1127 !emitter_stack[emitter_sp-stack_size-1].bracket_count)
1128 { if (expr_trace_level >= 2)
1129 printf("Treating comma as argument-separating\n");
1133 if (t->value == OR_OP)
1137 if (t->value == FCALL_OP)
1138 { if (expr_trace_level >= 3)
1139 { printf("FCALL_OP finds marker stack: ");
1140 for (x=0; x<emitter_sp; x++) printf("%d ", emitter_stack[x].marker);
1143 if (emitter_stack[emitter_sp-1].marker == ARGUMENT_VALUE_MARKER)
1144 warning("Ignoring spurious trailing comma");
1145 while (emitter_stack[emitter_sp-arity].marker != FUNCTION_VALUE_MARKER)
1148 emitter_stack[emitter_sp-arity].op.type == SYSFUN_OT) ||
1150 emitter_stack[emitter_sp-arity].op.type == VARIABLE_OT &&
1151 emitter_stack[emitter_sp-arity].op.value >= 256 &&
1152 emitter_stack[emitter_sp-arity].op.value < 288))
1153 { int index = emitter_stack[emitter_sp-arity].op.value;
1156 if(index >= 0 && index < NUMBER_SYSTEM_FUNCTIONS)
1157 error_named("System function name used as a value:", system_functions.keywords[index]);
1159 compiler_error("Found unnamed system function used as a value");
1160 emitter_stack[emitter_sp-arity].op = zero_operand;
1167 if (operators[t->value].usage == IN_U) arity = 2;
1169 if (operators[t->value].precedence == 3)
1172 if(!emitter_stack[x].marker && !emitter_stack[x].bracket_count)
1173 { for (--x; emitter_stack[x].marker == OR_VALUE_MARKER && !emitter_stack[x].bracket_count; --x)
1177 for (;x >= 0 && !emitter_stack[x].marker && !emitter_stack[x].bracket_count; --x)
1182 if (arity > stack_size)
1183 { error_named("Missing operand for", t->text);
1184 while (arity > stack_size)
1185 { ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1186 emitter_stack[emitter_sp].marker = 0;
1187 emitter_stack[emitter_sp].bracket_count = 0;
1188 emitter_stack[emitter_sp].op = zero_operand;
1195 /* pseudo-typecheck in 6.30: catch an unqualified property name */
1196 for (i = 1; i <= arity; i++)
1198 o1 = emitter_stack[emitter_sp - i].op;
1199 if ((o1.symindex >= 0)
1200 && is_property_t(symbols[o1.symindex].type)) {
1204 case SETEQUALS_OP: case NOTEQUAL_OP:
1206 case PROVIDES_OP: case NOTPROVIDES_OP:
1207 case PROP_ADD_OP: case PROP_NUM_OP:
1209 case MPROP_ADD_OP: case MESSAGE_OP:
1211 if (i < arity) break;
1212 case GE_OP: case LE_OP:
1213 /* Direction properties "n_to", etc *are* compared
1214 in some libraries. They have STAR_SFLAG to tell us
1215 to skip the warning. */
1217 && (symbols[o1.symindex].flags & STAR_SFLAG)) break;
1219 warning("Property name in expression is not qualified by object");
1221 } /* if (is_property_t */
1226 o1 = emitter_stack[emitter_sp - 1].op;
1227 if ((o1.marker == 0) && is_constant_ot(o1.type))
1229 { case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
1232 x = (~o1.value) & 0xffff;
1234 x = (~o1.value) & 0xffffffff;
1237 if (o1.value != 0) x=0; else x=1;
1244 o1 = emitter_stack[emitter_sp - 2].op;
1245 o2 = emitter_stack[emitter_sp - 1].op;
1247 if ((o1.marker == 0) && (o2.marker == 0)
1248 && is_constant_ot(o1.type) && is_constant_ot(o2.type))
1256 { ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
1257 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
1262 case PLUS_OP: x = ov1 + ov2; goto FoldConstantC;
1263 case MINUS_OP: x = ov1 - ov2; goto FoldConstantC;
1264 case TIMES_OP: x = ov1 * ov2; goto FoldConstantC;
1268 error("Division of constant by zero");
1270 if (t->value == DIVIDE_OP) {
1278 x = -((-ov1) / ov2);
1287 x = -((-ov1) % ov2);
1290 case ARTAND_OP: x = o1.value & o2.value; goto FoldConstant;
1291 case ARTOR_OP: x = o1.value | o2.value; goto FoldConstant;
1293 if (o1.value == o2.value) x = 1; else x = 0;
1296 if (o1.value != o2.value) x = 1; else x = 0;
1299 if (o1.value >= o2.value) x = 1; else x = 0;
1302 if (o1.value > o2.value) x = 1; else x = 0;
1305 if (o1.value <= o2.value) x = 1; else x = 0;
1308 if (o1.value < o2.value) x = 1; else x = 0;
1311 if ((o1.value != 0) && (o2.value != 0)) x=1; else x=0;
1314 if ((o1.value != 0) || (o2.value != 0)) x=1; else x=0;
1320 /* We can also fold logical operations if they are certain
1321 to short-circuit. The right-hand argument is skipped even
1322 if it's non-constant or has side effects. */
1324 if ((o1.marker == 0)
1325 && is_constant_ot(o1.type)) {
1327 if (t->value == LOGAND_OP && o1.value == 0)
1333 if (t->value == LOGOR_OP && o1.value != 0)
1341 ensure_memory_list_available(&ET_memlist, ET_used+1);
1342 op_node_number = ET_used++;
1344 ET[op_node_number].operator_number = t->value;
1345 ET[op_node_number].up = -1;
1346 ET[op_node_number].down = -1;
1347 ET[op_node_number].right = -1;
1349 /* This statement is redundant, but prevents compilers from wrongly
1350 issuing a "used before it was assigned a value" error: */
1351 previous_node_number = 0;
1353 for (i = emitter_sp-arity; i != emitter_sp; i++)
1355 if (expr_trace_level >= 3)
1356 printf("i=%d, emitter_sp=%d, arity=%d, ETU=%d\n",
1357 i, emitter_sp, arity, ET_used);
1358 if (emitter_stack[i].op.type == EXPRESSION_OT)
1359 operand_node_number = emitter_stack[i].op.value;
1362 ensure_memory_list_available(&ET_memlist, ET_used+1);
1363 operand_node_number = ET_used++;
1364 ET[operand_node_number].down = -1;
1365 ET[operand_node_number].value = emitter_stack[i].op;
1367 ET[operand_node_number].up = op_node_number;
1368 ET[operand_node_number].right = -1;
1369 if (i == emitter_sp - arity)
1370 { ET[op_node_number].down = operand_node_number;
1373 { ET[previous_node_number].right = operand_node_number;
1375 previous_node_number = operand_node_number;
1378 emitter_sp = emitter_sp - arity + 1;
1380 emitter_stack[emitter_sp - 1].op.type = EXPRESSION_OT;
1381 emitter_stack[emitter_sp - 1].op.value = op_node_number;
1382 emitter_stack[emitter_sp - 1].op.marker = 0;
1383 emitter_stack[emitter_sp - 1].marker = 0;
1384 emitter_stack[emitter_sp - 1].bracket_count = 0;
1385 /* Remove the marker for the brackets implied by operator precedence */
1386 remove_bracket_layer_from_emitter_stack();
1392 /* In Glulx, skip this test; we can't check out-of-range errors
1393 for 32-bit arithmetic. */
1395 if (!glulx_mode && ((x<-32768) || (x > 32767)))
1396 { char folding_error[40];
1397 int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
1398 int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
1402 sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
1405 sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
1408 sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
1411 error_named("Signed arithmetic on compile-time constants overflowed \
1412 the range -32768 to +32767:", folding_error);
1418 while (x < 0) x = x + 0x10000;
1425 emitter_sp = emitter_sp - arity + 1;
1429 emitter_stack[emitter_sp - 1].op.type = SHORT_CONSTANT_OT;
1430 else emitter_stack[emitter_sp - 1].op.type = LONG_CONSTANT_OT;
1434 emitter_stack[emitter_sp - 1].op.type = ZEROCONSTANT_OT;
1435 else if (x >= -128 && x <= 127)
1436 emitter_stack[emitter_sp - 1].op.type = BYTECONSTANT_OT;
1437 else if (x >= -32768 && x <= 32767)
1438 emitter_stack[emitter_sp - 1].op.type = HALFCONSTANT_OT;
1440 emitter_stack[emitter_sp - 1].op.type = CONSTANT_OT;
1443 emitter_stack[emitter_sp - 1].op.value = x;
1444 emitter_stack[emitter_sp - 1].op.marker = 0;
1445 emitter_stack[emitter_sp - 1].marker = 0;
1446 emitter_stack[emitter_sp - 1].bracket_count = 0;
1448 if (expr_trace_level >= 2)
1449 { printf("Folding constant to: ");
1450 print_operand(&emitter_stack[emitter_sp - 1].op, FALSE);
1454 /* Remove the marker for the brackets implied by operator precedence */
1455 remove_bracket_layer_from_emitter_stack();
1459 /* --- Pretty printing ----------------------------------------------------- */
1461 static void show_node(int n, int depth, int annotate)
1463 for (j=0; j<2*depth+2; j++) printf(" ");
1465 if (ET[n].down == -1)
1466 { print_operand(&ET[n].value, annotate);
1470 { printf("%s ", operators[ET[n].operator_number].description);
1471 j = operators[ET[n].operator_number].precedence;
1472 if ((annotate) && ((j==2) || (j==3)))
1473 { printf(" %d|%d ", ET[n].true_label, ET[n].false_label);
1474 if (ET[n].label_after != -1) printf(" def %d after ",
1476 if (ET[n].to_expression) printf(" con to expr ");
1479 show_node(ET[n].down, depth+1, annotate);
1482 if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
1485 extern void show_tree(assembly_operand AO, int annotate)
1486 { if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
1488 { printf("Constant: "); print_operand(&AO, annotate);
1493 /* --- Lvalue transformations ---------------------------------------------- */
1495 /* This only gets called in Z-code, since Glulx doesn't distinguish
1496 individual property operators from general ones. */
1497 static void check_property_operator(int from_node)
1498 { int below = ET[from_node].down;
1499 int opnum = ET[from_node].operator_number;
1503 if (veneer_mode) return;
1505 if ((below != -1) && (ET[below].right != -1))
1506 { int n = ET[below].right, flag = FALSE;
1508 /* Can we handle this dot operator as a native @get_prop (etc)
1509 opcode? Only if we recognize the property value as a declared
1510 common property constant. */
1511 if ((ET[n].down == -1)
1512 && ((ET[n].value.type == LONG_CONSTANT_OT)
1513 || (ET[n].value.type == SHORT_CONSTANT_OT))
1514 && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
1516 && (ET[n].value.marker == 0))
1521 { case PROPERTY_OP: opnum = MESSAGE_OP; break;
1522 case PROP_ADD_OP: opnum = MPROP_ADD_OP; break;
1523 case PROP_NUM_OP: opnum = MPROP_NUM_OP; break;
1527 ET[from_node].operator_number = opnum;
1531 check_property_operator(below);
1532 if (ET[from_node].right != -1)
1533 check_property_operator(ET[from_node].right);
1536 static void check_lvalues(int from_node)
1537 { int below = ET[from_node].down;
1538 int opnum = ET[from_node].operator_number, opnum_below;
1539 int lvalue_form, i, j = 0;
1543 if ((opnum == FCALL_OP) && (ET[below].down != -1))
1544 { opnum_below = ET[below].operator_number;
1545 if ((opnum_below == PROPERTY_OP) || (opnum_below == MESSAGE_OP))
1546 { i = ET[ET[from_node].down].right;
1547 ET[from_node].down = ET[below].down;
1548 ET[ET[below].down].up = from_node;
1549 ET[ET[ET[below].down].right].up = from_node;
1550 ET[ET[ET[below].down].right].right = i;
1551 opnum = PROP_CALL_OP;
1552 ET[from_node].operator_number = opnum;
1556 if (operators[opnum].requires_lvalue)
1557 { opnum_below = ET[below].operator_number;
1559 if (ET[below].down == -1)
1560 { if (!is_variable_ot(ET[below].value.type))
1561 { error("'=' applied to undeclared variable");
1568 { case SETEQUALS_OP:
1570 { case ARROW_OP: lvalue_form = ARROW_SETEQUALS_OP; break;
1571 case DARROW_OP: lvalue_form = DARROW_SETEQUALS_OP; break;
1572 case MESSAGE_OP: lvalue_form = MESSAGE_SETEQUALS_OP; break;
1573 case PROPERTY_OP: lvalue_form = PROPERTY_SETEQUALS_OP; break;
1578 { case ARROW_OP: lvalue_form = ARROW_INC_OP; break;
1579 case DARROW_OP: lvalue_form = DARROW_INC_OP; break;
1580 case MESSAGE_OP: lvalue_form = MESSAGE_INC_OP; break;
1581 case PROPERTY_OP: lvalue_form = PROPERTY_INC_OP; break;
1586 { case ARROW_OP: lvalue_form = ARROW_POST_INC_OP; break;
1587 case DARROW_OP: lvalue_form = DARROW_POST_INC_OP; break;
1588 case MESSAGE_OP: lvalue_form = MESSAGE_POST_INC_OP; break;
1589 case PROPERTY_OP: lvalue_form = PROPERTY_POST_INC_OP; break;
1594 { case ARROW_OP: lvalue_form = ARROW_DEC_OP; break;
1595 case DARROW_OP: lvalue_form = DARROW_DEC_OP; break;
1596 case MESSAGE_OP: lvalue_form = MESSAGE_DEC_OP; break;
1597 case PROPERTY_OP: lvalue_form = PROPERTY_DEC_OP; break;
1602 { case ARROW_OP: lvalue_form = ARROW_POST_DEC_OP; break;
1603 case DARROW_OP: lvalue_form = DARROW_POST_DEC_OP; break;
1604 case MESSAGE_OP: lvalue_form = MESSAGE_POST_DEC_OP; break;
1605 case PROPERTY_OP: lvalue_form = PROPERTY_POST_DEC_OP; break;
1609 if (lvalue_form == 0)
1610 { error_named("'=' applied to",
1611 (char *) operators[opnum_below].description);
1615 /* Transform from_node from_node
1617 below value to value
1621 ET[from_node].operator_number = lvalue_form;
1623 ET[from_node].down = i;
1625 { ET[i].up = from_node;
1629 ET[j].right = ET[below].right;
1632 check_lvalues(below);
1634 if (ET[from_node].right != -1)
1635 check_lvalues(ET[from_node].right);
1639 ET[from_node].down = -1;
1640 ET[from_node].value = zero_operand;
1641 if (ET[from_node].right != -1)
1642 check_lvalues(ET[from_node].right);
1645 /* --- Tree surgery for conditionals --------------------------------------- */
1647 static void negate_condition(int n)
1650 if (ET[n].right != -1) negate_condition(ET[n].right);
1651 if (ET[n].down == -1) return;
1652 i = operators[ET[n].operator_number].negation;
1653 if (i!=0) ET[n].operator_number = i;
1654 if (operators[i].precedence==2) negate_condition(ET[n].down);
1657 static void delete_negations(int n, int context)
1659 /* Recursively apply
1661 ~~(x && y) = ~~x || ~~y
1662 ~~(x || y) = ~~x && ~~y
1665 (etc) to delete the ~~ operator from the tree. Since this is
1666 depth first, the ~~ being deleted has no ~~s beneath it, which
1667 is important to make "negate_condition" work.
1669 We also do the check for (x <= y or z) here. This must be done
1670 before negate_condition.
1675 if (ET[n].operator_number == LE_OP || ET[n].operator_number == GE_OP) {
1676 if (ET[n].down != -1
1677 && ET[ET[n].down].right != -1
1678 && ET[ET[ET[n].down].right].right != -1) {
1679 if (ET[n].operator_number == LE_OP)
1680 warning("The behavior of (<= or) may be unexpected.");
1682 warning("The behavior of (>= or) may be unexpected.");
1686 if (ET[n].right != -1) delete_negations(ET[n].right, context);
1687 if (ET[n].down == -1) return;
1688 delete_negations(ET[n].down, context);
1690 if (ET[n].operator_number == LOGNOT_OP)
1691 { negate_condition(ET[n].down);
1692 ET[n].operator_number
1693 = ET[ET[n].down].operator_number;
1694 ET[n].down = ET[ET[n].down].down;
1696 while(i != -1) { ET[i].up = n; i = ET[i].right; }
1700 static void insert_exp_to_cond(int n, int context)
1702 /* Insert a ~= test when an expression is used as a condition.
1704 Check for possible confusion over = and ==, e.g. "if (a = 1) ..." */
1708 if (ET[n].right != -1) insert_exp_to_cond(ET[n].right, context);
1710 if (ET[n].down == -1)
1711 { if (context==CONDITION_CONTEXT)
1713 ensure_memory_list_available(&ET_memlist, ET_used+1);
1716 ET[n].down = new; ET[n].operator_number = NONZERO_OP;
1717 ET[new].up = n; ET[new].right = -1;
1722 switch(operators[ET[n].operator_number].precedence)
1723 { case 3: /* Conditionals have level 3 */
1724 context = QUANTITY_CONTEXT;
1726 case 2: /* Logical operators level 2 */
1727 context = CONDITION_CONTEXT;
1729 case 1: /* Forms of '=' have level 1 */
1730 if (context == CONDITION_CONTEXT)
1731 warning("'=' used as condition: '==' intended?");
1733 if (context != CONDITION_CONTEXT) break;
1735 ensure_memory_list_available(&ET_memlist, ET_used+1);
1738 ET[n].down = new; ET[n].operator_number = NONZERO_OP;
1739 ET[new].up = n; ET[new].right = -1;
1742 while (i!= -1) { ET[i].up = new; i = ET[i].right; }
1743 context = QUANTITY_CONTEXT; n = new;
1746 insert_exp_to_cond(ET[n].down, context);
1749 static unsigned int etoken_num_children(int n)
1754 if (i == -1) { return 0; }
1762 static void func_args_on_stack(int n, int context)
1764 /* Make sure that the arguments of every function-call expression
1765 are stored to the stack. If any aren't (ie, if any arguments are
1766 constants or variables), cover them with push operators.
1767 (The very first argument does not need to be so treated, because
1768 it's the function address, not a function argument. We also
1769 skip the treatment for most system functions.) */
1771 int new, pn, fnaddr, opnum;
1775 if (ET[n].right != -1)
1776 func_args_on_stack(ET[n].right, context);
1777 if (ET[n].down == -1) {
1780 opnum = ET[pn].operator_number;
1781 if (opnum == FCALL_OP
1782 || opnum == MESSAGE_CALL_OP
1783 || opnum == PROP_CALL_OP) {
1784 /* If it's an FCALL, get the operand which contains the function
1785 address (or system-function number) */
1786 if (opnum == MESSAGE_CALL_OP
1787 || opnum == PROP_CALL_OP
1788 || ((fnaddr=ET[pn].down) != n
1789 && (ET[fnaddr].value.type != SYSFUN_OT
1790 || ET[fnaddr].value.value == INDIRECT_SYSF
1791 || ET[fnaddr].value.value == GLK_SYSF))) {
1792 if (etoken_num_children(pn) > (unsigned int)(opnum == FCALL_OP ? 4:3)) {
1793 ensure_memory_list_available(&ET_memlist, ET_used+1);
1797 ET[n].operator_number = PUSH_OP;
1807 func_args_on_stack(ET[n].down, context);
1810 static assembly_operand check_conditions(assembly_operand AO, int context)
1813 if (AO.type != EXPRESSION_OT)
1814 { if (context != CONDITION_CONTEXT) return AO;
1815 ensure_memory_list_available(&ET_memlist, ET_used+1);
1821 INITAOT(&AO, EXPRESSION_OT);
1825 insert_exp_to_cond(AO.value, context);
1826 delete_negations(AO.value, context);
1829 func_args_on_stack(AO.value, context);
1834 /* --- Shift-reduce parser ------------------------------------------------- */
1837 static token_data *sr_stack; /* Allocated to sr_sp */
1838 static memory_list sr_stack_memlist;
1840 extern assembly_operand parse_expression(int context)
1842 /* Parses an expression, evaluating it as a constant if possible.
1844 Possible contexts are:
1846 VOID_CONTEXT the expression is used as a statement, so that
1847 its value will be thrown away and it only
1848 needs to exist for any resulting side-effects
1849 (function calls and assignments)
1851 CONDITION_CONTEXT the result must be a condition
1853 CONSTANT_CONTEXT there is required to be a constant result
1854 (so that, for instance, comma becomes illegal)
1856 QUANTITY_CONTEXT the default: a quantity is to be specified
1858 ACTION_Q_CONTEXT like QUANTITY_CONTEXT, but postfixed brackets
1859 at the top level do not indicate function call:
1861 <Insert button (random(pocket1, pocket2))>
1863 RETURN_Q_CONTEXT like QUANTITY_CONTEXT, but a single property
1864 name does not generate a warning
1866 ASSEMBLY_CONTEXT a quantity which cannot use the '->' operator
1867 (needed for assembly language to indicate
1870 FORINIT_CONTEXT a quantity which cannot use an (unbracketed)
1873 ARRAY_CONTEXT like CONSTANT_CONTEXT, but where an unbracketed
1874 minus sign is ambiguous, and brackets always
1875 indicate subexpressions, not function calls
1877 Return value: an assembly operand.
1879 If the type is OMITTED_OT, then the expression has no resulting value.
1881 If the type is EXPRESSION_OT, then the value will need to be
1882 calculated at run-time by code compiled from the expression tree
1883 whose root node-number is the operand value.
1885 Otherwise the assembly operand is the value of the expression, which
1886 is constant and thus known at compile time.
1888 If an error has occurred in the expression, which recovery from was
1889 not possible, then the return is (short constant) 0. This should
1890 minimise the chance of a cascade of further error messages.
1893 token_data a, b, pop; int i;
1894 assembly_operand AO;
1896 superclass_allowed = (context != FORINIT_CONTEXT);
1897 if (context == FORINIT_CONTEXT) context = VOID_CONTEXT;
1899 comma_allowed = (context == VOID_CONTEXT);
1900 arrow_allowed = (context != ASSEMBLY_CONTEXT);
1901 bare_prop_allowed = (context == RETURN_Q_CONTEXT);
1902 array_init_ambiguity = ((context == ARRAY_CONTEXT) ||
1903 (context == ASSEMBLY_CONTEXT));
1905 action_ambiguity = (context == ACTION_Q_CONTEXT);
1907 if (context == ASSEMBLY_CONTEXT) context = QUANTITY_CONTEXT;
1908 if (context == ACTION_Q_CONTEXT) context = QUANTITY_CONTEXT;
1909 if (context == RETURN_Q_CONTEXT) context = QUANTITY_CONTEXT;
1910 if (context == ARRAY_CONTEXT) context = CONSTANT_CONTEXT;
1913 inserting_token = FALSE;
1918 previous_token.text = "$";
1919 previous_token.type = ENDEXP_TT;
1920 previous_token.value = 0;
1922 ensure_memory_list_available(&sr_stack_memlist, 1);
1924 sr_stack[0] = previous_token;
1928 statements.enabled = FALSE;
1929 directives.enabled = FALSE;
1931 if (get_next_etoken() == FALSE)
1932 { ebf_error("expression", token_text);
1937 { if (expr_trace_level >= 2)
1938 { printf("Input: %-20s", current_token.text);
1939 for (i=0; i<sr_sp; i++) printf("%s ", sr_stack[i].text);
1942 if (expr_trace_level >= 3) printf("ET_used = %d\n", ET_used);
1945 { compiler_error("SR error: stack empty");
1949 a = sr_stack[sr_sp-1]; b = current_token;
1951 if ((a.type == ENDEXP_TT) && (b.type == ENDEXP_TT))
1952 { if (emitter_sp == 0)
1953 { error("No expression between brackets '(' and ')'");
1958 { compiler_error("SR error: emitter stack overfull");
1962 AO = emitter_stack[0].op;
1963 if (AO.type == EXPRESSION_OT)
1964 { if (expr_trace_level >= 3)
1965 { printf("Tree before lvalue checking:\n");
1966 show_tree(AO, FALSE);
1969 check_property_operator(AO.value);
1970 check_lvalues(AO.value);
1971 ET[AO.value].up = -1;
1974 if ((context != CONSTANT_CONTEXT)
1975 && (AO.symindex >= 0)
1976 && is_property_t(symbols[AO.symindex].type)
1977 && (arrow_allowed) && (!bare_prop_allowed))
1978 warning("Bare property name found. \"self.prop\" intended?");
1981 check_conditions(AO, context);
1983 if (context == CONSTANT_CONTEXT)
1984 if (!is_constant_ot(AO.type))
1985 { AO = zero_operand;
1986 ebf_error("constant", "<expression>");
1993 switch(find_prec(&a,&b))
1995 case e5: /* Associativity error */
1996 error_named("Brackets mandatory to clarify order of:",
2001 ensure_memory_list_available(&sr_stack_memlist, sr_sp+1);
2002 sr_stack[sr_sp++] = b;
2006 if (sr_sp >= 2 && sr_stack[sr_sp-2].type == OP_TT && sr_stack[sr_sp-2].value == FCALL_OP)
2007 mark_top_of_emitter_stack(FUNCTION_VALUE_MARKER, &b);
2009 add_bracket_layer_to_emitter_stack(0);
2014 if (sr_stack[sr_sp-2].type == OP_TT &&
2015 operators[sr_stack[sr_sp-2].value].precedence == 3)
2016 mark_top_of_emitter_stack(OR_VALUE_MARKER, &b);
2018 { error("'or' not between values to the right of a condition");
2019 /* Convert to + for error recovery purposes */
2020 sr_stack[sr_sp-1].value = PLUS_OP;
2025 /* A comma separates arguments only if the shallowest open bracket belongs to a function call. */
2026 int shallowest_open_bracket_index = sr_sp - 2;
2027 while (shallowest_open_bracket_index > 0 && sr_stack[shallowest_open_bracket_index].type != SUBOPEN_TT)
2028 --shallowest_open_bracket_index;
2029 if (shallowest_open_bracket_index > 0 &&
2030 sr_stack[shallowest_open_bracket_index-1].type == OP_TT &&
2031 sr_stack[shallowest_open_bracket_index-1].value == FCALL_OP)
2032 { mark_top_of_emitter_stack(ARGUMENT_VALUE_MARKER, &b);
2035 /* Non-argument-separating commas get treated like any other operator; we fall through to the default case. */
2039 /* Add a marker for the brackets implied by operator precedence */
2040 int operands_on_left = (operators[b.value].usage == PRE_U) ? 0 : 1;
2041 add_bracket_layer_to_emitter_stack(operands_on_left);
2049 { pop = sr_stack[sr_sp - 1];
2052 } while (find_prec(&sr_stack[sr_sp-1], &pop) != LOWER_P);
2055 case e1: /* Missing operand error */
2056 error_named("Missing operand after", a.text);
2058 current_token.type = NUMBER_TT;
2059 current_token.value = 0;
2060 current_token.marker = 0;
2061 current_token.text = "0";
2064 case e2: /* Unexpected close bracket */
2065 error("Found '(' without matching ')'");
2069 case e3: /* Missing operator error */
2070 error("Missing operator: inserting '+'");
2072 current_token.type = OP_TT;
2073 current_token.value = PLUS_OP;
2074 current_token.marker = 0;
2075 current_token.text = "+";
2078 case e4: /* Expression ends with an open bracket */
2079 error("Found '(' without matching ')'");
2088 /* --- Test for simple ++ or -- usage: used to optimise "for" loop code ---- */
2090 extern int test_for_incdec(assembly_operand AO)
2092 if (AO.type != EXPRESSION_OT) return 0;
2093 if (ET[AO.value].down == -1) return 0;
2094 switch(ET[AO.value].operator_number)
2095 { case INC_OP: s = 1; break;
2096 case POST_INC_OP: s = 1; break;
2097 case DEC_OP: s = -1; break;
2098 case POST_DEC_OP: s = -1; break;
2101 if (ET[ET[AO.value].down].down != -1) return 0;
2102 if (!is_variable_ot(ET[ET[AO.value].down].value.type)) return 0;
2103 return s*(ET[ET[AO.value].down].value.value);
2106 /* ========================================================================= */
2107 /* Data structure management routines */
2108 /* ------------------------------------------------------------------------- */
2110 extern void init_expressp_vars(void)
2112 /* make_operands(); */
2113 make_lexical_interface_tables();
2114 for (i=0; i<NUMBER_SYSTEM_FUNCTIONS; i++)
2115 system_function_usage[i] = 0;
2118 emitter_stack = NULL;
2122 extern void expressp_begin_pass(void)
2126 extern void expressp_allocate_arrays(void)
2128 initialise_memory_list(&ET_memlist,
2129 sizeof(expression_tree_node), 100, (void**)&ET,
2130 "expression parse trees");
2132 initialise_memory_list(&emitter_stack_memlist,
2133 sizeof(emitterstackinfo), 100, (void**)&emitter_stack,
2134 "expression stack");
2136 initialise_memory_list(&sr_stack_memlist,
2137 sizeof(token_data), 100, (void**)&sr_stack,
2138 "shift-reduce parser stack");
2141 extern void expressp_free_arrays(void)
2143 deallocate_memory_list(&ET_memlist);
2145 deallocate_memory_list(&emitter_stack_memlist);
2147 deallocate_memory_list(&sr_stack_memlist);
2150 /* ========================================================================= */