1 /* ------------------------------------------------------------------------- */
2 /* "expressp" : The expression parser */
4 /* Part of Inform 6.42 */
5 /* copyright (c) Graham Nelson 1993 - 2024 */
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 void check_system_constant_available(int);
72 static int get_next_etoken(void)
73 { int v, symbol = 0, mark_symbol_as_used = FALSE,
74 initial_bracket_level = bracket_level;
79 { current_token = heldback_token;
80 inserting_token = FALSE;
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.symindex = -1;
89 current_token.symtype = 0;
90 current_token.symflags = -1;
93 switch(current_token.type)
94 { case LOCAL_VARIABLE_TT:
95 current_token.type = VARIABLE_TT;
96 variables[current_token.value].usage = TRUE;
100 current_token.marker = STRING_MV;
104 { int32 unicode = text_to_unicode(token_text);
105 if (token_text[textual_form_length] == 0)
108 current_token.value = unicode_to_zscii(unicode);
109 if (current_token.value == 5)
110 { unicode_char_error("Character can be printed \
111 but not used as a value:", unicode);
112 current_token.value = '?';
114 if (current_token.value >= 0x100)
115 current_token.type = LARGE_NUMBER_TT;
116 else current_token.type = SMALL_NUMBER_TT;
119 current_token.value = unicode;
120 if (current_token.value >= 0x8000
121 || current_token.value < -0x8000)
122 current_token.type = LARGE_NUMBER_TT;
123 else current_token.type = SMALL_NUMBER_TT;
127 { current_token.type = DICTWORD_TT;
128 current_token.marker = DWORD_MV;
135 symbol = current_token.value;
137 mark_symbol_as_used = TRUE;
139 v = symbols[symbol].value;
141 current_token.symindex = symbol;
142 current_token.symtype = symbols[symbol].type;
143 current_token.symflags = symbols[symbol].flags;
144 switch(symbols[symbol].type)
146 /* Replaced functions must always be backpatched
147 because there could be another definition coming. */
148 if (symbols[symbol].flags & REPLACE_SFLAG)
149 { current_token.marker = SYMBOL_MV;
153 current_token.marker = IROUTINE_MV;
155 case GLOBAL_VARIABLE_T:
156 current_token.marker = VARIABLE_MV;
160 /* All objects must be backpatched in Glulx. */
162 current_token.marker = OBJECT_MV;
165 current_token.marker = ARRAY_MV;
168 current_token.marker = STATIC_ARRAY_MV;
170 case INDIVIDUAL_PROPERTY_T:
173 if (symbols[symbol].flags & (UNKNOWN_SFLAG + CHANGE_SFLAG))
174 { current_token.marker = SYMBOL_MV;
177 else current_token.marker = 0;
180 error_named("Label name used as value:", token_text);
183 current_token.marker = 0;
186 if (symbols[symbol].flags & SYSTEM_SFLAG)
187 current_token.marker = 0;
189 current_token.value = v;
192 if (((current_token.marker != 0)
193 && (current_token.marker != VARIABLE_MV))
194 || (v < 0) || (v > 255))
195 current_token.type = LARGE_NUMBER_TT;
196 else current_token.type = SMALL_NUMBER_TT;
199 if (((current_token.marker != 0)
200 && (current_token.marker != VARIABLE_MV))
201 || (v < -0x8000) || (v >= 0x8000))
202 current_token.type = LARGE_NUMBER_TT;
203 else current_token.type = SMALL_NUMBER_TT;
206 if (symbols[symbol].type == GLOBAL_VARIABLE_T)
207 { current_token.type = VARIABLE_TT;
208 variables[current_token.value].usage = TRUE;
214 if (current_token.value >= 256)
215 current_token.type = LARGE_NUMBER_TT;
217 current_token.type = SMALL_NUMBER_TT;
220 if (current_token.value < -0x8000
221 || current_token.value >= 0x8000)
222 current_token.type = LARGE_NUMBER_TT;
224 current_token.type = SMALL_NUMBER_TT;
229 switch(current_token.value)
232 current_token.type = ENDEXP_TT;
236 if ((bracket_level==0) && (!comma_allowed))
237 current_token.type = ENDEXP_TT;
241 if ((bracket_level==0) && (!superclass_allowed))
242 current_token.type = ENDEXP_TT;
247 if ((token_type == SEP_TT)
248 &&((token_value == SEMICOLON_SEP)
249 || (token_value == GREATER_SEP)))
250 current_token.type = ENDEXP_TT;
256 if (expr_trace_level>=3)
257 { printf("Previous token type = %d\n",previous_token.type);
258 printf("Previous token val = %d\n",previous_token.value);
260 if ((previous_token.type == OP_TT)
261 || (previous_token.type == SUBOPEN_TT)
262 || (previous_token.type == ENDEXP_TT)
263 || (array_init_ambiguity)
264 || ((bracket_level == 1) && (action_ambiguity)))
265 current_token.type = SUBOPEN_TT;
267 { inserting_token = TRUE;
268 heldback_token = current_token;
269 current_token.text = "<call>";
276 if (bracket_level < 0)
277 current_token.type = ENDEXP_TT;
278 else current_token.type = SUBCLOSE_TT;
282 current_token.type = ENDEXP_TT; break;
285 if ((previous_token.type == OP_TT)
286 || (previous_token.type == SUBOPEN_TT)
287 || (previous_token.type == ENDEXP_TT))
288 current_token.value = UNARY_MINUS_SEP; break;
291 if ((previous_token.type == VARIABLE_TT)
292 || (previous_token.type == SUBCLOSE_TT)
293 || (previous_token.type == LARGE_NUMBER_TT)
294 || (previous_token.type == SMALL_NUMBER_TT))
295 current_token.value = POST_INC_SEP; break;
298 if ((previous_token.type == VARIABLE_TT)
299 || (previous_token.type == SUBCLOSE_TT)
300 || (previous_token.type == LARGE_NUMBER_TT)
301 || (previous_token.type == SMALL_NUMBER_TT))
302 current_token.value = POST_DEC_SEP; break;
305 token_text = current_token.text + 2;
307 ActionUsedAsConstant:
309 current_token.type = ACTION_TT;
310 current_token.text = token_text;
311 current_token.value = 0;
312 current_token.marker = ACTION_MV;
316 case HASHADOLLAR_SEP:
317 obsolete_warning("'#a$Act' is now superseded by '##Act'");
318 token_text = current_token.text + 3;
319 goto ActionUsedAsConstant;
321 case HASHGDOLLAR_SEP:
323 /* This form generates the position of a global variable
324 in the global variables array. So Glob is the same as
325 #globals_array --> #g$Glob */
327 current_token.text += 3;
328 current_token.type = SYMBOL_TT;
329 symbol = get_symbol_index(current_token.text);
330 if (symbol < 0 || symbols[symbol].type != GLOBAL_VARIABLE_T) {
332 "global variable name after '#g$'",
334 current_token.value = 0;
335 current_token.type = SMALL_NUMBER_TT;
336 current_token.marker = 0;
339 mark_symbol_as_used = TRUE;
340 current_token.value = symbols[symbol].value - MAX_LOCAL_VARIABLES;
341 current_token.marker = 0;
343 if (current_token.value >= 0x100)
344 current_token.type = LARGE_NUMBER_TT;
345 else current_token.type = SMALL_NUMBER_TT;
348 if (current_token.value >= 0x8000
349 || current_token.value < -0x8000)
350 current_token.type = LARGE_NUMBER_TT;
351 else current_token.type = SMALL_NUMBER_TT;
355 case HASHNDOLLAR_SEP:
357 /* This form is still needed for constants like #n$a (the
358 dictionary address of the word "a"), since 'a' means
359 the ASCII value of 'a' */
361 if (strlen(token_text) > 4)
363 "'#n$word' is now superseded by ''word''");
364 current_token.type = DICTWORD_TT;
365 current_token.value = 0;
366 current_token.text = token_text + 3;
367 current_token.marker = DWORD_MV;
370 case HASHRDOLLAR_SEP:
372 /* This form -- #r$Routinename, to return the routine's */
373 /* packed address -- is needed far less often in Inform 6, */
374 /* where just giving the name Routine returns the packed */
375 /* address. But it's used in a lot of Inform 5 code. */
378 "'#r$Routine' can now be written just 'Routine'");
379 current_token.text += 3;
380 current_token.type = SYMBOL_TT;
381 current_token.value = symbol_index(current_token.text, -1, NULL);
384 case HASHWDOLLAR_SEP:
385 error("The obsolete '#w$word' construct has been removed");
389 system_constants.enabled = TRUE;
391 system_constants.enabled = FALSE;
392 if (token_type != SYSTEM_CONSTANT_TT)
393 { ebf_curtoken_error(
394 "'r$', 'n$', 'g$' or internal Inform constant name after '#'");
399 check_system_constant_available(token_value);
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 and error values-------------------------------- */
482 #define GREATER_P 103
484 #define BYPREC -1 /* Compare the precedence of two operators */
486 #define NOVAL_E 1 /* Missing operand error */
487 #define CLOSEB_E 2 /* Unexpected close bracket */
488 #define NOOP_E 3 /* Missing operator error */
489 #define OPENB_E 4 /* Expression ends with an open bracket */
490 #define ASSOC_E 5 /* Associativity illegal error */
492 const int prec_table[49] = {
494 /* a ....... ( ) end op:pre op:bin op:post term */
496 /* b ( */ LOWER_P, NOOP_E, LOWER_P, LOWER_P, LOWER_P, NOOP_E, NOOP_E,
497 /* . ) */ EQUAL_P, GREATER_P, CLOSEB_E, GREATER_P, GREATER_P, GREATER_P, GREATER_P,
498 /* . end */ OPENB_E, GREATER_P, NOVAL_E, GREATER_P, GREATER_P, GREATER_P, GREATER_P,
499 /* . op:pre */ LOWER_P, NOOP_E, LOWER_P, BYPREC, BYPREC, NOOP_E, NOOP_E,
500 /* . op:bin */ LOWER_P, GREATER_P, LOWER_P, BYPREC, BYPREC, BYPREC, GREATER_P,
501 /* . op:post */ LOWER_P, GREATER_P, LOWER_P, BYPREC, BYPREC, BYPREC, GREATER_P,
502 /* . term */ LOWER_P, NOOP_E, LOWER_P, LOWER_P, LOWER_P, NOOP_E, NOOP_E
506 static int find_prec(const token_data *a, const token_data *b)
508 /* We are comparing the precedence of tokens a and b
509 (where a occurs to the left of b). If the expression is correct,
510 the only possible values are GREATER_P, LOWER_P or EQUAL_P;
511 if it is malformed then one of the *_E results.
513 Note that this routine is not symmetrical and that the relation
516 If a and b are equal (and aren't brackets), then
518 a LOWER_P a if a right-associative
519 a GREATER_P a if a left-associative
522 int ai, bi, j, l1, l2;
524 /* Select a column and row in prec_table, based on the type of
525 a and b. If a/b is an operator, we have to distinguish three
526 columns/rows depending on whether the operator is prefix,
531 { case SUBOPEN_TT: ai=0; break;
532 case SUBCLOSE_TT: ai=1; break;
533 case ENDEXP_TT: ai=2; break;
535 if (operators[a->value].usage == PRE_U)
537 else if (operators[a->value].usage == POST_U)
542 default: ai=6; break;
545 { case SUBOPEN_TT: bi=0; break;
546 case SUBCLOSE_TT: bi=1; break;
547 case ENDEXP_TT: bi=2; break;
549 if (operators[b->value].usage == PRE_U)
551 else if (operators[b->value].usage == POST_U)
556 default: bi=6; break;
559 j = prec_table[ai+7*bi];
560 if (j != BYPREC) return j;
562 /* BYPREC is the (a=OP, b=OP) cases. We must compare the precedence of the
564 (We've already eliminated invalid cases like (a++ --b).)
566 l1 = operators[a->value].precedence;
567 l2 = operators[b->value].precedence;
568 if (operators[b->value].usage == PRE_U) return LOWER_P;
569 if (operators[a->value].usage == POST_U) return GREATER_P;
571 /* Anomalous rule to resolve the function call precedence, which is
572 different on the right from on the left, e.g., in:
578 if ((l1 == 11) && (l2 > 11)) return GREATER_P;
580 if (l1 < l2) return LOWER_P;
581 if (l1 > l2) return GREATER_P;
582 switch(operators[a->value].associativity)
583 { case L_A: return GREATER_P;
584 case R_A: return LOWER_P;
585 case 0: return ASSOC_E;
590 /* --- Converting token to operand ----------------------------------------- */
592 /* List used to generate gameinfo.dbg.
593 Must match the switch statement below. */
594 int z_system_constant_list[] =
595 { adjectives_table_SC,
598 identifiers_table_SC,
603 actual_largest_object_SC,
604 static_memory_offset_SC,
605 array_names_offset_SC,
606 readable_memory_offset_SC,
613 highest_attribute_number_SC,
614 attribute_names_array_SC,
615 highest_property_number_SC,
616 property_names_array_SC,
617 highest_action_number_SC,
618 action_names_array_SC,
619 highest_fake_action_number_SC,
620 fake_action_names_array_SC,
621 highest_routine_number_SC,
622 routine_names_array_SC,
624 routine_flags_array_SC,
625 highest_global_number_SC,
626 global_names_array_SC,
628 global_flags_array_SC,
629 highest_array_number_SC,
630 array_names_array_SC,
631 array_flags_array_SC,
632 highest_constant_number_SC,
633 constant_names_array_SC,
634 highest_class_number_SC,
635 class_objects_array_SC,
636 highest_object_number_SC,
641 static void check_system_constant_available(int t)
643 if (OMIT_SYMBOL_TABLE) {
644 /* Certain system constants refer to the symbol table, which
645 is meaningless if OMIT_SYMBOL_TABLE is set. */
648 case identifiers_table_SC:
649 case attribute_names_array_SC:
650 case property_names_array_SC:
651 case action_names_array_SC:
652 case fake_action_names_array_SC:
653 case array_names_offset_SC:
654 case global_names_array_SC:
655 case routine_names_array_SC:
656 case constant_names_array_SC:
657 error_named("OMIT_SYMBOL_TABLE omits system constant", system_constants.keywords[t]);
664 static int32 value_of_system_constant_z(int t)
667 { case adjectives_table_SC:
668 return adjectives_offset;
669 case actions_table_SC:
670 return actions_offset;
671 case classes_table_SC:
672 return class_numbers_offset;
673 case identifiers_table_SC:
674 return identifier_names_offset;
675 case preactions_table_SC:
676 return preactions_offset;
677 case largest_object_SC:
678 return 256 + no_objects - 1;
679 case strings_offset_SC:
680 return strings_offset/scale_factor;
682 return code_offset/scale_factor;
683 case actual_largest_object_SC:
685 case static_memory_offset_SC:
686 return static_memory_offset;
687 case array_names_offset_SC:
688 return array_names_offset;
689 case readable_memory_offset_SC:
690 return Write_Code_At;
692 return prop_values_offset;
694 return class_numbers_offset;
696 return individuals_offset;
698 return variables_offset;
699 case array__start_SC:
700 return variables_offset + (MAX_ZCODE_GLOBAL_VARS*WORDSIZE);
702 return static_memory_offset;
703 case dictionary_table_SC:
704 return dictionary_offset;
705 case grammar_table_SC:
706 return static_memory_offset;
708 case highest_attribute_number_SC:
709 return no_attributes-1;
710 case attribute_names_array_SC:
711 return attribute_names_offset;
713 case highest_property_number_SC:
714 return no_individual_properties-1;
715 case property_names_array_SC:
716 return identifier_names_offset + 2;
718 case highest_action_number_SC:
720 case action_names_array_SC:
721 return action_names_offset;
723 case highest_fake_action_number_SC:
724 return ((grammar_version_number==1)?256:4096) + no_fake_actions-1;
725 case fake_action_names_array_SC:
726 return fake_action_names_offset;
728 case highest_routine_number_SC:
729 return no_named_routines-1;
730 case routine_names_array_SC:
731 return routine_names_offset;
732 case routines_array_SC:
733 return routines_array_offset;
734 case routine_flags_array_SC:
735 return routine_flags_array_offset;
736 case highest_global_number_SC:
737 return 16 + no_globals-1;
738 case global_names_array_SC:
739 return global_names_offset;
740 case globals_array_SC:
741 return variables_offset;
742 case global_flags_array_SC:
743 return global_flags_array_offset;
744 case highest_array_number_SC:
746 case array_names_array_SC:
747 return array_names_offset;
748 case array_flags_array_SC:
749 return array_flags_array_offset;
750 case highest_constant_number_SC:
751 return no_named_constants-1;
752 case constant_names_array_SC:
753 return constant_names_offset;
754 case highest_class_number_SC:
756 case class_objects_array_SC:
757 return class_numbers_offset;
758 case highest_object_number_SC:
762 error_named("System constant not implemented in Z-code",
763 system_constants.keywords[t]);
768 /* List used to generate gameinfo.dbg.
769 Must match the switch statement below. */
770 int glulx_system_constant_list[] =
772 identifiers_table_SC,
773 array_names_offset_SC,
777 dynam_string_table_SC,
781 highest_class_number_SC,
782 highest_object_number_SC,
785 static int32 value_of_system_constant_g(int t)
788 case classes_table_SC:
789 return Write_RAM_At + class_numbers_offset;
790 case identifiers_table_SC:
791 return Write_RAM_At + identifier_names_offset;
792 case array_names_offset_SC:
793 return Write_RAM_At + array_names_offset;
795 return prop_defaults_offset;
797 return Write_RAM_At + class_numbers_offset;
798 case dictionary_table_SC:
799 return dictionary_offset;
800 case dynam_string_table_SC:
801 return abbreviations_offset;
802 case grammar_table_SC:
803 return grammar_table_offset;
804 case actions_table_SC:
805 return actions_offset;
806 case globals_array_SC:
807 return variables_offset;
808 case highest_class_number_SC:
810 case highest_object_number_SC:
814 error_named("System constant not implemented in Glulx",
815 system_constants.keywords[t]);
820 extern int32 value_of_system_constant(int t)
823 return value_of_system_constant_z(t);
825 return value_of_system_constant_g(t);
828 extern char *name_of_system_constant(int t)
830 if (t < 0 || t >= NO_SYSTEM_CONSTANTS) {
833 return system_constants.keywords[t];
836 static int evaluate_term(const token_data *t, assembly_operand *o)
838 /* If the given token is a constant, evaluate it into the operand.
839 For now, the identifiers are considered variables.
841 Returns FALSE if it fails to understand type. */
845 o->marker = t->marker;
846 o->symindex = t->symindex;
849 { case LARGE_NUMBER_TT:
852 if (v < 0) v = v + 0x10000;
853 o->type = LONG_CONSTANT_OT;
858 o->type = CONSTANT_OT;
861 case SMALL_NUMBER_TT:
864 if (v < 0) v = v + 0x10000;
865 o->type = SHORT_CONSTANT_OT;
874 /* Find the dictionary address, adding to dictionary if absent */
876 o->type = LONG_CONSTANT_OT;
878 o->type = CONSTANT_OT;
879 o->value = dictionary_add(t->text, 0x80, 0, 0);
882 /* Create as a static string */
884 o->type = LONG_CONSTANT_OT;
886 o->type = CONSTANT_OT;
887 o->value = compile_string(t->text, STRCTX_GAME);
891 o->type = VARIABLE_OT;
894 if (t->value >= MAX_LOCAL_VARIABLES) {
895 o->type = GLOBALVAR_OT;
898 /* This includes "local variable zero", which is really
899 the stack-pointer magic variable. */
900 o->type = LOCALVAR_OT;
907 o->type = VARIABLE_OT;
908 o->value = t->value + 256;
914 system_function_usage[t->value] = 1;
917 *o = action_of_name(t->text);
919 case SYSTEM_CONSTANT_TT:
920 /* Certain system constants depend only on the
921 version number and need no backpatching, as they
922 are known in advance. We can therefore evaluate
925 o->type = LONG_CONSTANT_OT;
928 case version_number_SC:
929 o->type = SHORT_CONSTANT_OT;
931 v = version_number; break;
933 o->type = SHORT_CONSTANT_OT;
935 v = (version_number==3)?4:6; break;
937 o->type = SHORT_CONSTANT_OT;
939 v = (version_number==3)?5:7; break;
941 o->type = SHORT_CONSTANT_OT;
943 if (ZCODE_LESS_DICT_DATA)
944 error("#dict_par3 is unavailable when ZCODE_LESS_DICT_DATA is set");
945 v = (version_number==3)?6:8; break;
946 case lowest_attribute_number_SC:
947 case lowest_action_number_SC:
948 case lowest_routine_number_SC:
949 case lowest_array_number_SC:
950 case lowest_constant_number_SC:
951 case lowest_class_number_SC:
952 o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 0; break;
953 case lowest_object_number_SC:
954 case lowest_property_number_SC:
955 o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 1; break;
956 case lowest_global_number_SC:
957 o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 16; break;
958 case lowest_fake_action_number_SC:
959 o->type = LONG_CONSTANT_OT; o->marker = 0;
960 v = ((grammar_version_number==1)?256:4096); break;
961 case oddeven_packing_SC:
962 o->type = SHORT_CONSTANT_OT; o->marker = 0;
963 v = oddeven_packing_switch; break;
966 o->marker = INCON_MV;
972 o->type = CONSTANT_OT;
975 /* The three dict_par flags point at the lower byte
976 of the flag field, because the library is written
977 to expect one-byte fields, even though the compiler
978 generates a dictionary with room for two. */
980 o->type = BYTECONSTANT_OT;
982 v = DICT_ENTRY_FLAG_POS+1;
985 o->type = BYTECONSTANT_OT;
987 v = DICT_ENTRY_FLAG_POS+3;
990 o->type = BYTECONSTANT_OT;
992 v = DICT_ENTRY_FLAG_POS+5;
995 case lowest_attribute_number_SC:
996 case lowest_action_number_SC:
997 case lowest_routine_number_SC:
998 case lowest_array_number_SC:
999 case lowest_constant_number_SC:
1000 case lowest_class_number_SC:
1001 o->type = BYTECONSTANT_OT;
1005 case lowest_object_number_SC:
1006 case lowest_property_number_SC:
1007 o->type = BYTECONSTANT_OT;
1012 /* ###fix: need to fill more of these in! */
1016 o->marker = INCON_MV;
1027 /* --- Emitter ------------------------------------------------------------- */
1029 expression_tree_node *ET; /* Allocated to ET_used */
1030 static memory_list ET_memlist;
1033 extern void clear_expression_space(void)
1037 typedef struct emitterstackinfo_s {
1038 assembly_operand op;
1043 #define FUNCTION_VALUE_MARKER 1
1044 #define ARGUMENT_VALUE_MARKER 2
1045 #define OR_VALUE_MARKER 3
1047 static emitterstackinfo *emitter_stack; /* Allocated to emitter_sp */
1048 static memory_list emitter_stack_memlist;
1049 static int emitter_sp;
1051 static int is_property_t(int symbol_type)
1052 { return ((symbol_type == PROPERTY_T) || (symbol_type == INDIVIDUAL_PROPERTY_T));
1055 static void mark_top_of_emitter_stack(int marker, const token_data *t)
1056 { if (emitter_sp < 1)
1057 { compiler_error("SR error: Attempt to add a marker to the top of an empty emitter stack");
1060 if (expr_trace_level >= 2)
1061 { printf("Marking top of emitter stack (which is ");
1062 print_operand(&emitter_stack[emitter_sp-1].op, FALSE);
1066 case FUNCTION_VALUE_MARKER:
1069 case ARGUMENT_VALUE_MARKER:
1072 case OR_VALUE_MARKER:
1081 if (emitter_stack[emitter_sp-1].marker)
1082 { if (marker == ARGUMENT_VALUE_MARKER)
1084 warning("Ignoring spurious leading comma");
1087 error_named("Missing operand for", t->text);
1088 ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1089 emitter_stack[emitter_sp].marker = 0;
1090 emitter_stack[emitter_sp].bracket_count = 0;
1091 emitter_stack[emitter_sp].op = zero_operand;
1094 emitter_stack[emitter_sp-1].marker = marker;
1097 static void add_bracket_layer_to_emitter_stack(int depth)
1098 { /* There's no point in tracking bracket layers that don't fence off any values. */
1099 if (emitter_sp < depth + 1) return;
1100 if (expr_trace_level >= 2)
1101 printf("Adding bracket layer (depth %d)\n", depth);
1102 ++emitter_stack[emitter_sp-depth-1].bracket_count;
1105 static void remove_bracket_layer_from_emitter_stack()
1106 { /* Bracket layers that don't fence off any values will not have been tracked. */
1107 if (emitter_sp < 2) return;
1108 if (expr_trace_level >= 2)
1109 printf("Removing bracket layer\n");
1110 if (emitter_stack[emitter_sp-2].bracket_count <= 0)
1111 { compiler_error("SR error: Attempt to remove a nonexistent bracket layer from the emitter stack");
1114 --emitter_stack[emitter_sp-2].bracket_count;
1117 static void emit_token(const token_data *t)
1118 { assembly_operand o1, o2; int arity, stack_size, i;
1119 int op_node_number, operand_node_number, previous_node_number;
1122 if (expr_trace_level >= 2)
1123 { printf("Output: %-19s%21s ", t->text, "");
1124 for (i=0; i<emitter_sp; i++)
1125 { print_operand(&emitter_stack[i].op, FALSE); printf(" ");
1126 if (emitter_stack[i].marker == FUNCTION_VALUE_MARKER) printf(":FUNCTION ");
1127 if (emitter_stack[i].marker == ARGUMENT_VALUE_MARKER) printf(":ARGUMENT ");
1128 if (emitter_stack[i].marker == OR_VALUE_MARKER) printf(":OR ");
1129 if (emitter_stack[i].bracket_count) printf(":BRACKETS(%d) ", emitter_stack[i].bracket_count);
1134 if (t->type == SUBOPEN_TT) return;
1137 while ((stack_size < emitter_sp) &&
1138 !emitter_stack[emitter_sp-stack_size-1].marker &&
1139 !emitter_stack[emitter_sp-stack_size-1].bracket_count)
1142 if (t->type == SUBCLOSE_TT)
1143 { if (stack_size < emitter_sp && emitter_stack[emitter_sp-stack_size-1].bracket_count)
1144 { if (stack_size == 0)
1145 { error("No expression between brackets '(' and ')'");
1146 ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1147 emitter_stack[emitter_sp].op = zero_operand;
1148 emitter_stack[emitter_sp].marker = 0;
1149 emitter_stack[emitter_sp].bracket_count = 0;
1152 else if (stack_size < 1)
1153 compiler_error("SR error: emitter stack empty in subexpression");
1154 else if (stack_size > 1)
1155 compiler_error("SR error: emitter stack overfull in subexpression");
1156 remove_bracket_layer_from_emitter_stack();
1161 if (t->type != OP_TT)
1163 ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1164 emitter_stack[emitter_sp].marker = 0;
1165 emitter_stack[emitter_sp].bracket_count = 0;
1167 if (!evaluate_term(t, &(emitter_stack[emitter_sp++].op)))
1168 compiler_error_named("Emit token error:", t->text);
1172 /* A comma is argument-separating if it follows an argument (or a function
1173 call, since we ignore spurious leading commas in function argument lists)
1174 with no intervening brackets. Function calls are variadic, so we don't
1175 apply argument-separating commas. */
1176 if (t->value == COMMA_OP &&
1177 stack_size < emitter_sp &&
1178 (emitter_stack[emitter_sp-stack_size-1].marker == ARGUMENT_VALUE_MARKER ||
1179 emitter_stack[emitter_sp-stack_size-1].marker == FUNCTION_VALUE_MARKER) &&
1180 !emitter_stack[emitter_sp-stack_size-1].bracket_count)
1181 { if (expr_trace_level >= 2)
1182 printf("Treating comma as argument-separating\n");
1186 if (t->value == OR_OP)
1190 if (t->value == FCALL_OP)
1191 { if (expr_trace_level >= 3)
1192 { printf("FCALL_OP finds marker stack: ");
1193 for (x=0; x<emitter_sp; x++) printf("%d ", emitter_stack[x].marker);
1196 if (emitter_stack[emitter_sp-1].marker == ARGUMENT_VALUE_MARKER)
1197 warning("Ignoring spurious trailing comma");
1198 while (emitter_stack[emitter_sp-arity].marker != FUNCTION_VALUE_MARKER)
1201 emitter_stack[emitter_sp-arity].op.type == SYSFUN_OT) ||
1203 emitter_stack[emitter_sp-arity].op.type == VARIABLE_OT &&
1204 emitter_stack[emitter_sp-arity].op.value >= 256 &&
1205 emitter_stack[emitter_sp-arity].op.value < 288))
1206 { int index = emitter_stack[emitter_sp-arity].op.value;
1209 if(index >= 0 && index < NUMBER_SYSTEM_FUNCTIONS)
1210 error_named("System function name used as a value:", system_functions.keywords[index]);
1212 compiler_error("Found unnamed system function used as a value");
1213 emitter_stack[emitter_sp-arity].op = zero_operand;
1220 if (operators[t->value].usage == IN_U) arity = 2;
1222 if (operators[t->value].precedence == 3)
1225 if(!emitter_stack[x].marker && !emitter_stack[x].bracket_count)
1226 { for (--x; emitter_stack[x].marker == OR_VALUE_MARKER && !emitter_stack[x].bracket_count; --x)
1230 for (;x >= 0 && !emitter_stack[x].marker && !emitter_stack[x].bracket_count; --x)
1235 if (arity > stack_size)
1236 { error_named("Missing operand for", t->text);
1237 while (arity > stack_size)
1238 { ensure_memory_list_available(&emitter_stack_memlist, emitter_sp+1);
1239 emitter_stack[emitter_sp].marker = 0;
1240 emitter_stack[emitter_sp].bracket_count = 0;
1241 emitter_stack[emitter_sp].op = zero_operand;
1248 /* pseudo-typecheck in 6.30: catch an unqualified property name */
1249 for (i = 1; i <= arity; i++)
1251 o1 = emitter_stack[emitter_sp - i].op;
1252 if ((o1.symindex >= 0)
1253 && is_property_t(symbols[o1.symindex].type)) {
1257 case SETEQUALS_OP: case NOTEQUAL_OP:
1259 case PROVIDES_OP: case NOTPROVIDES_OP:
1260 case PROP_ADD_OP: case PROP_NUM_OP:
1262 case MPROP_ADD_OP: case MESSAGE_OP:
1264 if (i < arity) break;
1265 case GE_OP: case LE_OP:
1266 /* Direction properties "n_to", etc *are* compared
1267 in some libraries. They have STAR_SFLAG to tell us
1268 to skip the warning. */
1270 && (symbols[o1.symindex].flags & STAR_SFLAG)) break;
1272 warning("Property name in expression is not qualified by object");
1279 o1 = emitter_stack[emitter_sp - 1].op;
1280 if ((o1.marker == 0) && is_constant_ot(o1.type))
1282 { case UNARY_MINUS_OP:
1283 if ((uint32)o1.value == 0x80000000)
1290 x = (~o1.value) & 0xffff;
1292 x = (~o1.value) & 0xffffffff;
1295 if (o1.value != 0) x=0; else x=1;
1302 o1 = emitter_stack[emitter_sp - 2].op;
1303 o2 = emitter_stack[emitter_sp - 1].op;
1305 if ((o1.marker == 0) && (o2.marker == 0)
1306 && is_constant_ot(o1.type) && is_constant_ot(o2.type))
1314 { ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
1315 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
1320 case PLUS_OP: x = ov1 + ov2; goto FoldConstantC;
1321 case MINUS_OP: x = ov1 - ov2; goto FoldConstantC;
1322 case TIMES_OP: x = ov1 * ov2; goto FoldConstantC;
1326 error("Division of constant by zero");
1328 if (t->value == DIVIDE_OP) {
1336 x = -((-ov1) / ov2);
1345 x = -((-ov1) % ov2);
1348 case ARTAND_OP: x = o1.value & o2.value; goto FoldConstant;
1349 case ARTOR_OP: x = o1.value | o2.value; goto FoldConstant;
1351 if (o1.value == o2.value) x = 1; else x = 0;
1354 if (o1.value != o2.value) x = 1; else x = 0;
1357 if (o1.value >= o2.value) x = 1; else x = 0;
1360 if (o1.value > o2.value) x = 1; else x = 0;
1363 if (o1.value <= o2.value) x = 1; else x = 0;
1366 if (o1.value < o2.value) x = 1; else x = 0;
1369 if ((o1.value != 0) && (o2.value != 0)) x=1; else x=0;
1372 if ((o1.value != 0) || (o2.value != 0)) x=1; else x=0;
1378 /* We can also fold logical operations if they are certain
1379 to short-circuit. The right-hand argument is skipped even
1380 if it's non-constant or has side effects. */
1382 if ((o1.marker == 0)
1383 && is_constant_ot(o1.type)) {
1385 if (t->value == LOGAND_OP && o1.value == 0)
1391 if (t->value == LOGOR_OP && o1.value != 0)
1399 ensure_memory_list_available(&ET_memlist, ET_used+1);
1400 op_node_number = ET_used++;
1402 ET[op_node_number].operator_number = t->value;
1403 ET[op_node_number].up = -1;
1404 ET[op_node_number].down = -1;
1405 ET[op_node_number].right = -1;
1407 /* This statement is redundant, but prevents compilers from wrongly
1408 issuing a "used before it was assigned a value" error: */
1409 previous_node_number = 0;
1411 for (i = emitter_sp-arity; i != emitter_sp; i++)
1413 if (expr_trace_level >= 3)
1414 printf("i=%d, emitter_sp=%d, arity=%d, ETU=%d\n",
1415 i, emitter_sp, arity, ET_used);
1416 if (emitter_stack[i].op.type == EXPRESSION_OT)
1417 operand_node_number = emitter_stack[i].op.value;
1420 ensure_memory_list_available(&ET_memlist, ET_used+1);
1421 operand_node_number = ET_used++;
1422 ET[operand_node_number].down = -1;
1423 ET[operand_node_number].value = emitter_stack[i].op;
1425 ET[operand_node_number].up = op_node_number;
1426 ET[operand_node_number].right = -1;
1427 if (i == emitter_sp - arity)
1428 { ET[op_node_number].down = operand_node_number;
1431 { ET[previous_node_number].right = operand_node_number;
1433 previous_node_number = operand_node_number;
1436 emitter_sp = emitter_sp - arity + 1;
1438 emitter_stack[emitter_sp - 1].op.type = EXPRESSION_OT;
1439 emitter_stack[emitter_sp - 1].op.value = op_node_number;
1440 emitter_stack[emitter_sp - 1].op.marker = 0;
1441 emitter_stack[emitter_sp - 1].marker = 0;
1442 emitter_stack[emitter_sp - 1].bracket_count = 0;
1443 /* Remove the marker for the brackets implied by operator precedence */
1444 remove_bracket_layer_from_emitter_stack();
1450 /* In Glulx, skip this test; we can't check out-of-range errors
1451 for 32-bit arithmetic. */
1453 if (!glulx_mode && ((x<-32768) || (x > 32767)))
1455 int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
1456 int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
1470 error_fmt("Signed arithmetic on compile-time constants overflowed \
1471 the range -32768 to +32767 (%d %c %d = %d)", ov1, op, ov2, x);
1477 while (x < 0) x = x + 0x10000;
1484 emitter_sp = emitter_sp - arity + 1;
1488 emitter_stack[emitter_sp - 1].op.type = SHORT_CONSTANT_OT;
1489 else emitter_stack[emitter_sp - 1].op.type = LONG_CONSTANT_OT;
1493 emitter_stack[emitter_sp - 1].op.type = ZEROCONSTANT_OT;
1494 else if (x >= -128 && x <= 127)
1495 emitter_stack[emitter_sp - 1].op.type = BYTECONSTANT_OT;
1496 else if (x >= -32768 && x <= 32767)
1497 emitter_stack[emitter_sp - 1].op.type = HALFCONSTANT_OT;
1499 emitter_stack[emitter_sp - 1].op.type = CONSTANT_OT;
1502 emitter_stack[emitter_sp - 1].op.value = x;
1503 emitter_stack[emitter_sp - 1].op.marker = 0;
1504 emitter_stack[emitter_sp - 1].marker = 0;
1505 emitter_stack[emitter_sp - 1].bracket_count = 0;
1507 if (expr_trace_level >= 2)
1508 { printf("Folding constant to: ");
1509 print_operand(&emitter_stack[emitter_sp - 1].op, FALSE);
1513 /* Remove the marker for the brackets implied by operator precedence */
1514 remove_bracket_layer_from_emitter_stack();
1518 /* --- Pretty printing ----------------------------------------------------- */
1520 static void show_node(int n, int depth, int annotate)
1522 for (j=0; j<2*depth+2; j++) printf(" ");
1524 if (ET[n].down == -1)
1525 { print_operand(&ET[n].value, annotate);
1529 { printf("%s ", operators[ET[n].operator_number].description);
1530 j = operators[ET[n].operator_number].precedence;
1531 if ((annotate) && ((j==2) || (j==3)))
1532 { printf(" %d|%d ", ET[n].true_label, ET[n].false_label);
1533 if (ET[n].label_after != -1) printf(" def %d after ",
1535 if (ET[n].to_expression) printf(" con to expr ");
1538 show_node(ET[n].down, depth+1, annotate);
1541 if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
1544 extern void show_tree(const assembly_operand *AO, int annotate)
1545 { if (AO->type == EXPRESSION_OT) show_node(AO->value, 0, annotate);
1547 { printf("Constant: "); print_operand(AO, annotate);
1552 /* --- Lvalue transformations ---------------------------------------------- */
1554 /* This only gets called in Z-code, since Glulx doesn't distinguish
1555 individual property operators from general ones. */
1556 static void check_property_operator(int from_node)
1557 { int below = ET[from_node].down;
1558 int opnum = ET[from_node].operator_number;
1562 if (veneer_mode) return;
1564 if ((below != -1) && (ET[below].right != -1))
1565 { int n = ET[below].right, flag = FALSE;
1567 /* Can we handle this dot operator as a native @get_prop (etc)
1568 opcode? Only if we recognize the property value as a declared
1569 common property constant. */
1570 if ((ET[n].down == -1)
1571 && ((ET[n].value.type == LONG_CONSTANT_OT)
1572 || (ET[n].value.type == SHORT_CONSTANT_OT))
1573 && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
1574 && (ET[n].value.marker == 0))
1579 { case PROPERTY_OP: opnum = MESSAGE_OP; break;
1580 case PROP_ADD_OP: opnum = MPROP_ADD_OP; break;
1581 case PROP_NUM_OP: opnum = MPROP_NUM_OP; break;
1585 ET[from_node].operator_number = opnum;
1589 check_property_operator(below);
1590 if (ET[from_node].right != -1)
1591 check_property_operator(ET[from_node].right);
1594 static void check_lvalues(int from_node)
1595 { int below = ET[from_node].down;
1596 int opnum = ET[from_node].operator_number, opnum_below;
1597 int lvalue_form, i, j = 0;
1601 if ((opnum == FCALL_OP) && (ET[below].down != -1))
1602 { opnum_below = ET[below].operator_number;
1603 if ((opnum_below == PROPERTY_OP) || (opnum_below == MESSAGE_OP))
1604 { i = ET[ET[from_node].down].right;
1605 ET[from_node].down = ET[below].down;
1606 ET[ET[below].down].up = from_node;
1607 ET[ET[ET[below].down].right].up = from_node;
1608 ET[ET[ET[below].down].right].right = i;
1609 opnum = PROP_CALL_OP;
1610 ET[from_node].operator_number = opnum;
1614 if (operators[opnum].requires_lvalue)
1615 { opnum_below = ET[below].operator_number;
1617 if (ET[below].down == -1)
1618 { if (!is_variable_ot(ET[below].value.type))
1619 { error("'=' applied to undeclared variable");
1626 { case SETEQUALS_OP:
1628 { case ARROW_OP: lvalue_form = ARROW_SETEQUALS_OP; break;
1629 case DARROW_OP: lvalue_form = DARROW_SETEQUALS_OP; break;
1630 case MESSAGE_OP: lvalue_form = MESSAGE_SETEQUALS_OP; break;
1631 case PROPERTY_OP: lvalue_form = PROPERTY_SETEQUALS_OP; break;
1636 { case ARROW_OP: lvalue_form = ARROW_INC_OP; break;
1637 case DARROW_OP: lvalue_form = DARROW_INC_OP; break;
1638 case MESSAGE_OP: lvalue_form = MESSAGE_INC_OP; break;
1639 case PROPERTY_OP: lvalue_form = PROPERTY_INC_OP; break;
1644 { case ARROW_OP: lvalue_form = ARROW_POST_INC_OP; break;
1645 case DARROW_OP: lvalue_form = DARROW_POST_INC_OP; break;
1646 case MESSAGE_OP: lvalue_form = MESSAGE_POST_INC_OP; break;
1647 case PROPERTY_OP: lvalue_form = PROPERTY_POST_INC_OP; break;
1652 { case ARROW_OP: lvalue_form = ARROW_DEC_OP; break;
1653 case DARROW_OP: lvalue_form = DARROW_DEC_OP; break;
1654 case MESSAGE_OP: lvalue_form = MESSAGE_DEC_OP; break;
1655 case PROPERTY_OP: lvalue_form = PROPERTY_DEC_OP; break;
1660 { case ARROW_OP: lvalue_form = ARROW_POST_DEC_OP; break;
1661 case DARROW_OP: lvalue_form = DARROW_POST_DEC_OP; break;
1662 case MESSAGE_OP: lvalue_form = MESSAGE_POST_DEC_OP; break;
1663 case PROPERTY_OP: lvalue_form = PROPERTY_POST_DEC_OP; break;
1667 if (lvalue_form == 0)
1668 { error_named("'=' applied to",
1669 (char *) operators[opnum_below].description);
1673 /* Transform from_node from_node
1675 below value to value
1679 ET[from_node].operator_number = lvalue_form;
1681 ET[from_node].down = i;
1683 { ET[i].up = from_node;
1687 ET[j].right = ET[below].right;
1690 check_lvalues(below);
1692 if (ET[from_node].right != -1)
1693 check_lvalues(ET[from_node].right);
1697 ET[from_node].down = -1;
1698 ET[from_node].value = zero_operand;
1699 if (ET[from_node].right != -1)
1700 check_lvalues(ET[from_node].right);
1703 /* --- Tree surgery for conditionals --------------------------------------- */
1705 static void negate_condition(int n)
1708 if (ET[n].right != -1) negate_condition(ET[n].right);
1709 if (ET[n].down == -1) return;
1710 i = operators[ET[n].operator_number].negation;
1711 if (i!=0) ET[n].operator_number = i;
1712 if (operators[i].precedence==2) negate_condition(ET[n].down);
1715 static void delete_negations(int n, int context)
1717 /* Recursively apply
1719 ~~(x && y) = ~~x || ~~y
1720 ~~(x || y) = ~~x && ~~y
1723 (etc) to delete the ~~ operator from the tree. Since this is
1724 depth first, the ~~ being deleted has no ~~s beneath it, which
1725 is important to make "negate_condition" work.
1727 We also do the check for (x <= y or z) here. This must be done
1728 before negate_condition.
1733 if (ET[n].operator_number == LE_OP || ET[n].operator_number == GE_OP) {
1734 if (ET[n].down != -1
1735 && ET[ET[n].down].right != -1
1736 && ET[ET[ET[n].down].right].right != -1) {
1737 if (ET[n].operator_number == LE_OP)
1738 warning("The behavior of (<= or) may be unexpected.");
1740 warning("The behavior of (>= or) may be unexpected.");
1744 if (ET[n].right != -1) delete_negations(ET[n].right, context);
1745 if (ET[n].down == -1) return;
1746 delete_negations(ET[n].down, context);
1748 if (ET[n].operator_number == LOGNOT_OP)
1749 { negate_condition(ET[n].down);
1750 ET[n].operator_number
1751 = ET[ET[n].down].operator_number;
1752 ET[n].down = ET[ET[n].down].down;
1754 while(i != -1) { ET[i].up = n; i = ET[i].right; }
1758 static void insert_exp_to_cond(int n, int context)
1760 /* Insert a ~= test when an expression is used as a condition.
1762 Check for possible confusion over = and ==, e.g. "if (a = 1) ..." */
1766 if (ET[n].right != -1) insert_exp_to_cond(ET[n].right, context);
1768 if (ET[n].down == -1)
1769 { if (context==CONDITION_CONTEXT)
1771 ensure_memory_list_available(&ET_memlist, ET_used+1);
1774 ET[n].down = new; ET[n].operator_number = NONZERO_OP;
1775 ET[new].up = n; ET[new].right = -1;
1780 switch(operators[ET[n].operator_number].precedence)
1781 { case 3: /* Conditionals have level 3 */
1782 context = QUANTITY_CONTEXT;
1784 case 2: /* Logical operators level 2 */
1785 context = CONDITION_CONTEXT;
1787 case 1: /* Forms of '=' have level 1 */
1788 if (context == CONDITION_CONTEXT)
1789 warning("'=' used as condition: '==' intended?");
1791 if (context != CONDITION_CONTEXT) break;
1793 ensure_memory_list_available(&ET_memlist, ET_used+1);
1796 ET[n].down = new; ET[n].operator_number = NONZERO_OP;
1797 ET[new].up = n; ET[new].right = -1;
1800 while (i!= -1) { ET[i].up = new; i = ET[i].right; }
1801 context = QUANTITY_CONTEXT; n = new;
1804 insert_exp_to_cond(ET[n].down, context);
1807 static unsigned int etoken_num_children(int n)
1812 if (i == -1) { return 0; }
1820 static void func_args_on_stack(int n, int context)
1822 /* Make sure that the arguments of every function-call expression
1823 are stored to the stack. If any aren't (ie, if any arguments are
1824 constants or variables), cover them with push operators.
1825 (The very first argument does not need to be so treated, because
1826 it's the function address, not a function argument. We also
1827 skip the treatment for most system functions.) */
1829 int new, pn, fnaddr, opnum;
1833 if (ET[n].right != -1)
1834 func_args_on_stack(ET[n].right, context);
1835 if (ET[n].down == -1) {
1838 opnum = ET[pn].operator_number;
1839 if (opnum == FCALL_OP
1840 || opnum == MESSAGE_CALL_OP
1841 || opnum == PROP_CALL_OP) {
1842 /* If it's an FCALL, get the operand which contains the function
1843 address (or system-function number) */
1844 if (opnum == MESSAGE_CALL_OP
1845 || opnum == PROP_CALL_OP
1846 || ((fnaddr=ET[pn].down) != n
1847 && (ET[fnaddr].value.type != SYSFUN_OT
1848 || ET[fnaddr].value.value == INDIRECT_SYSF
1849 || ET[fnaddr].value.value == GLK_SYSF))) {
1850 if (etoken_num_children(pn) > (unsigned int)(opnum == FCALL_OP ? 4:3)) {
1851 ensure_memory_list_available(&ET_memlist, ET_used+1);
1855 ET[n].operator_number = PUSH_OP;
1865 func_args_on_stack(ET[n].down, context);
1868 static assembly_operand check_conditions(assembly_operand AO, int context)
1871 if (AO.type != EXPRESSION_OT)
1872 { if (context != CONDITION_CONTEXT) return AO;
1873 ensure_memory_list_available(&ET_memlist, ET_used+1);
1879 INITAOT(&AO, EXPRESSION_OT);
1883 insert_exp_to_cond(AO.value, context);
1884 delete_negations(AO.value, context);
1887 func_args_on_stack(AO.value, context);
1892 /* --- Shift-reduce parser ------------------------------------------------- */
1895 static token_data *sr_stack; /* Allocated to sr_sp */
1896 static memory_list sr_stack_memlist;
1898 extern assembly_operand parse_expression(int context)
1900 /* Parses an expression, evaluating it as a constant if possible.
1902 Possible contexts are:
1904 VOID_CONTEXT the expression is used as a statement, so that
1905 its value will be thrown away and it only
1906 needs to exist for any resulting side-effects
1907 (function calls and assignments)
1909 CONDITION_CONTEXT the result must be a condition
1911 CONSTANT_CONTEXT there is required to be a constant result
1912 (so that, for instance, comma becomes illegal)
1914 QUANTITY_CONTEXT the default: a quantity is to be specified
1916 ACTION_Q_CONTEXT like QUANTITY_CONTEXT, but postfixed brackets
1917 at the top level do not indicate function call:
1919 <Insert button (random(pocket1, pocket2))>
1921 RETURN_Q_CONTEXT like QUANTITY_CONTEXT, but a single property
1922 name does not generate a warning
1924 ASSEMBLY_CONTEXT a quantity which cannot use the '->' operator
1925 (needed for assembly language to indicate
1928 FORINIT_CONTEXT a quantity which cannot use an (unbracketed)
1931 ARRAY_CONTEXT like CONSTANT_CONTEXT, but where an unbracketed
1932 minus sign is ambiguous, and brackets always
1933 indicate subexpressions, not function calls
1935 Return value: an assembly operand.
1937 If the type is OMITTED_OT, then the expression has no resulting value.
1939 If the type is EXPRESSION_OT, then the value will need to be
1940 calculated at run-time by code compiled from the expression tree
1941 whose root node-number is the operand value.
1943 Otherwise the assembly operand is the value of the expression, which
1944 is constant and thus known at compile time.
1946 If an error has occurred in the expression, which recovery from was
1947 not possible, then the return is (short constant) 0 with marker
1948 value ERROR_MV. The caller may check for this marker value to
1949 decide whether to (e.g.) stop reading array values. Otherwise, it
1950 will just be treated as a zero, which should minimise the chance
1951 of a cascade of further error messages.
1954 token_data a, b, pop; int i;
1955 assembly_operand AO;
1957 superclass_allowed = (context != FORINIT_CONTEXT);
1958 if (context == FORINIT_CONTEXT) context = VOID_CONTEXT;
1960 comma_allowed = (context == VOID_CONTEXT);
1961 arrow_allowed = (context != ASSEMBLY_CONTEXT);
1962 bare_prop_allowed = (context == RETURN_Q_CONTEXT);
1963 array_init_ambiguity = ((context == ARRAY_CONTEXT) ||
1964 (context == ASSEMBLY_CONTEXT));
1966 action_ambiguity = (context == ACTION_Q_CONTEXT);
1968 if (context == ASSEMBLY_CONTEXT) context = QUANTITY_CONTEXT;
1969 if (context == ACTION_Q_CONTEXT) context = QUANTITY_CONTEXT;
1970 if (context == RETURN_Q_CONTEXT) context = QUANTITY_CONTEXT;
1971 if (context == ARRAY_CONTEXT) context = CONSTANT_CONTEXT;
1974 inserting_token = FALSE;
1979 previous_token.text = "$";
1980 previous_token.type = ENDEXP_TT;
1981 previous_token.value = 0;
1983 ensure_memory_list_available(&sr_stack_memlist, 1);
1985 sr_stack[0] = previous_token;
1989 statements.enabled = FALSE;
1990 directives.enabled = FALSE;
1992 if (get_next_etoken() == FALSE)
1993 { ebf_curtoken_error("expression");
1994 AO.marker = ERROR_MV;
1999 { if (expr_trace_level >= 2)
2000 { printf("Input: %-20s", current_token.text);
2001 for (i=0; i<sr_sp; i++) printf("%s ", sr_stack[i].text);
2004 if (expr_trace_level >= 3) printf("ET_used = %d\n", ET_used);
2007 { compiler_error("SR error: stack empty");
2008 AO.marker = ERROR_MV;
2012 a = sr_stack[sr_sp-1]; b = current_token;
2014 if ((a.type == ENDEXP_TT) && (b.type == ENDEXP_TT))
2015 { if (emitter_sp == 0)
2016 { error("No expression between brackets '(' and ')'");
2018 AO.marker = ERROR_MV;
2022 { compiler_error("SR error: emitter stack overfull");
2023 AO.marker = ERROR_MV;
2027 AO = emitter_stack[0].op;
2028 if (AO.type == EXPRESSION_OT)
2029 { if (expr_trace_level >= 3)
2030 { printf("Tree before lvalue checking:\n");
2031 show_tree(&AO, FALSE);
2034 check_property_operator(AO.value);
2035 check_lvalues(AO.value);
2036 ET[AO.value].up = -1;
2039 if ((context != CONSTANT_CONTEXT)
2040 && (AO.symindex >= 0)
2041 && is_property_t(symbols[AO.symindex].type)
2042 && (arrow_allowed) && (!bare_prop_allowed))
2043 warning("Bare property name found. \"self.prop\" intended?");
2046 check_conditions(AO, context);
2048 if (context == CONSTANT_CONTEXT)
2049 if (!is_constant_ot(AO.type))
2050 { AO = zero_operand;
2051 AO.marker = ERROR_MV;
2052 ebf_error("constant", "<expression>");
2059 switch(find_prec(&a,&b))
2061 case ASSOC_E: /* Associativity error */
2062 error_named("Brackets mandatory to clarify order of:",
2067 ensure_memory_list_available(&sr_stack_memlist, sr_sp+1);
2068 sr_stack[sr_sp++] = b;
2072 if (sr_sp >= 2 && sr_stack[sr_sp-2].type == OP_TT && sr_stack[sr_sp-2].value == FCALL_OP)
2073 mark_top_of_emitter_stack(FUNCTION_VALUE_MARKER, &b);
2075 add_bracket_layer_to_emitter_stack(0);
2080 if (sr_stack[sr_sp-2].type == OP_TT &&
2081 operators[sr_stack[sr_sp-2].value].precedence == 3)
2082 mark_top_of_emitter_stack(OR_VALUE_MARKER, &b);
2084 { error("'or' not between values to the right of a condition");
2085 /* Convert to + for error recovery purposes */
2086 sr_stack[sr_sp-1].value = PLUS_OP;
2091 /* A comma separates arguments only if the shallowest open bracket belongs to a function call. */
2092 int shallowest_open_bracket_index = sr_sp - 2;
2093 while (shallowest_open_bracket_index > 0 && sr_stack[shallowest_open_bracket_index].type != SUBOPEN_TT)
2094 --shallowest_open_bracket_index;
2095 if (shallowest_open_bracket_index > 0 &&
2096 sr_stack[shallowest_open_bracket_index-1].type == OP_TT &&
2097 sr_stack[shallowest_open_bracket_index-1].value == FCALL_OP)
2098 { mark_top_of_emitter_stack(ARGUMENT_VALUE_MARKER, &b);
2101 /* Non-argument-separating commas get treated like any other operator; we fall through to the default case. */
2105 /* Add a marker for the brackets implied by operator precedence */
2106 int operands_on_left = (operators[b.value].usage == PRE_U) ? 0 : 1;
2107 add_bracket_layer_to_emitter_stack(operands_on_left);
2115 { pop = sr_stack[sr_sp - 1];
2118 } while (find_prec(&sr_stack[sr_sp-1], &pop) != LOWER_P);
2121 case NOVAL_E: /* Missing operand error */
2122 error_named("Missing operand after", a.text);
2123 /* We insert a "0" token so that the rest of the expression
2126 current_token.type = NUMBER_TT;
2127 current_token.value = 0;
2128 current_token.marker = 0;
2129 current_token.text = "0";
2132 case CLOSEB_E: /* Unexpected close bracket */
2133 error("Found '(' without matching ')'");
2137 case NOOP_E: /* Missing operator error */
2138 error_named("Missing operator after", a.text);
2139 /* We insert a "+" token so that the rest of the expression
2142 current_token.type = OP_TT;
2143 current_token.value = PLUS_OP;
2144 current_token.marker = 0;
2145 current_token.text = "+";
2148 case OPENB_E: /* Expression ends with an open bracket */
2149 error("Found '(' without matching ')'");
2158 /* --- Test for simple ++ or -- usage: used to optimise "for" loop code ---- */
2160 extern int test_for_incdec(assembly_operand AO)
2162 if (AO.type != EXPRESSION_OT) return 0;
2163 if (ET[AO.value].down == -1) return 0;
2164 switch(ET[AO.value].operator_number)
2165 { case INC_OP: s = 1; break;
2166 case POST_INC_OP: s = 1; break;
2167 case DEC_OP: s = -1; break;
2168 case POST_DEC_OP: s = -1; break;
2171 if (ET[ET[AO.value].down].down != -1) return 0;
2172 if (!is_variable_ot(ET[ET[AO.value].down].value.type)) return 0;
2173 return s*(ET[ET[AO.value].down].value.value);
2177 /* Determine if the operand (a parsed expression) is a constant (as
2178 per is_constant_ot()) or a comma-separated list of such constants.
2180 "(1)" and "(1,2,3)" both count, and even "((1,2),3)", but
2181 not "(1,(2,3))"; the list must be left-associated.
2183 Backpatched constants (function names, etc) are acceptable, as are
2184 folded constant expressions. Variables are right out.
2186 The constants are stored in the ops_found array, up to a maximum of
2187 max_ops_found. For Inform parsing reasons, the array list is backwards
2188 from the order found.
2190 Returns the number of constants found. If the expression is not a list of
2191 constants, returns zero.
2193 (The return value may be more than max_ops_found, in which case we weren't
2194 able to return them all in the array.)
2196 extern int test_constant_op_list(const assembly_operand *AO, assembly_operand *ops_found, int max_ops_found)
2201 if (AO->type != EXPRESSION_OT) {
2202 if (!is_constant_ot(AO->type))
2205 if (ops_found && max_ops_found > 0)
2212 /* For some reason the top node is always a COMMA with no .right,
2213 just a .down. Should we rely on this? For now yes. */
2215 if (operators[ET[n].operator_number].token_value != COMMA_SEP)
2217 if (ET[n].right != -1)
2222 if (ET[n].right != -1) {
2223 if (ET[ET[n].right].down != -1)
2225 if (!is_constant_ot(ET[ET[n].right].value.type))
2228 if (ops_found && max_ops_found > count)
2229 ops_found[count] = ET[ET[n].right].value;
2233 if (ET[n].down == -1) {
2234 if (!is_constant_ot(ET[n].value.type))
2237 if (ops_found && max_ops_found > count)
2238 ops_found[count] = ET[n].value;
2243 if (operators[ET[n].operator_number].token_value != COMMA_SEP)
2250 /* ========================================================================= */
2251 /* Data structure management routines */
2252 /* ------------------------------------------------------------------------- */
2254 extern void init_expressp_vars(void)
2256 /* make_operands(); */
2257 make_lexical_interface_tables();
2258 for (i=0; i<NUMBER_SYSTEM_FUNCTIONS; i++)
2259 system_function_usage[i] = 0;
2262 emitter_stack = NULL;
2266 extern void expressp_begin_pass(void)
2270 extern void expressp_allocate_arrays(void)
2272 initialise_memory_list(&ET_memlist,
2273 sizeof(expression_tree_node), 100, (void**)&ET,
2274 "expression parse trees");
2276 initialise_memory_list(&emitter_stack_memlist,
2277 sizeof(emitterstackinfo), 100, (void**)&emitter_stack,
2278 "expression stack");
2280 initialise_memory_list(&sr_stack_memlist,
2281 sizeof(token_data), 100, (void**)&sr_stack,
2282 "shift-reduce parser stack");
2285 extern void expressp_free_arrays(void)
2287 deallocate_memory_list(&ET_memlist);
2289 deallocate_memory_list(&emitter_stack_memlist);
2291 deallocate_memory_list(&sr_stack_memlist);
2294 /* ========================================================================= */