--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "expressp" : The expression parser */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+/* --- Interface to lexer -------------------------------------------------- */
+
+static char separators_to_operators[103];
+static char conditionals_to_operators[7];
+static char token_type_allowable[301];
+
+#define NOT_AN_OPERATOR (char) 0x7e
+
+static void make_lexical_interface_tables(void)
+{ int i;
+ for (i=0;i<103;i++)
+ separators_to_operators[i] = NOT_AN_OPERATOR;
+ for (i=0;i<NUM_OPERATORS;i++)
+ if (operators[i].token_type == SEP_TT)
+ separators_to_operators[operators[i].token_value] = i;
+
+ for (i=0;i<7;i++) /* 7 being the size of keyword_group "conditions" */
+ conditionals_to_operators[i] = NOT_AN_OPERATOR;
+ for (i=0;i<NUM_OPERATORS;i++)
+ if (operators[i].token_type == CND_TT)
+ conditionals_to_operators[operators[i].token_value] = i;
+
+ for (i=0;i<301;i++) token_type_allowable[i] = 0;
+
+ token_type_allowable[VARIABLE_TT] = 1;
+ token_type_allowable[SYSFUN_TT] = 1;
+ token_type_allowable[DQ_TT] = 1;
+ token_type_allowable[DICTWORD_TT] = 1;
+ token_type_allowable[SUBOPEN_TT] = 1;
+ token_type_allowable[SUBCLOSE_TT] = 1;
+ token_type_allowable[SMALL_NUMBER_TT] = 1;
+ token_type_allowable[LARGE_NUMBER_TT] = 1;
+ token_type_allowable[ACTION_TT] = 1;
+ token_type_allowable[SYSTEM_CONSTANT_TT] = 1;
+ token_type_allowable[OP_TT] = 1;
+}
+
+static token_data current_token, previous_token, heldback_token;
+
+static int comma_allowed, arrow_allowed, superclass_allowed,
+ bare_prop_allowed,
+ array_init_ambiguity, action_ambiguity,
+ etoken_count, inserting_token, bracket_level;
+
+extern int *variable_usage;
+
+int system_function_usage[32];
+
+static int get_next_etoken(void)
+{ int v, symbol = 0, mark_symbol_as_used = FALSE,
+ initial_bracket_level = bracket_level;
+
+ etoken_count++;
+
+ if (inserting_token)
+ { current_token = heldback_token;
+ inserting_token = FALSE;
+ }
+ else
+ { get_next_token();
+ current_token.text = token_text;
+ current_token.value = token_value;
+ current_token.type = token_type;
+ current_token.marker = 0;
+ current_token.symtype = 0;
+ current_token.symflags = -1;
+ }
+
+ switch(current_token.type)
+ { case LOCAL_VARIABLE_TT:
+ current_token.type = VARIABLE_TT;
+ variable_usage[current_token.value] = TRUE;
+ break;
+
+ case DQ_TT:
+ current_token.marker = STRING_MV;
+ break;
+
+ case SQ_TT:
+ { int32 unicode = text_to_unicode(token_text);
+ if (token_text[textual_form_length] == 0)
+ {
+ if (!glulx_mode) {
+ current_token.value = unicode_to_zscii(unicode);
+ if (current_token.value == 5)
+ { unicode_char_error("Character can be printed \
+but not used as a value:", unicode);
+ current_token.value = '?';
+ }
+ if (current_token.value >= 0x100)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ current_token.value = unicode;
+ if (current_token.value >= 0x8000
+ || current_token.value < -0x8000)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ }
+ else
+ { current_token.type = DICTWORD_TT;
+ current_token.marker = DWORD_MV;
+ }
+ }
+ break;
+
+ case SYMBOL_TT:
+ ReceiveSymbol:
+ symbol = current_token.value;
+
+ mark_symbol_as_used = TRUE;
+
+ v = svals[symbol];
+
+ current_token.symtype = stypes[symbol];
+ current_token.symflags = sflags[symbol];
+ switch(stypes[symbol])
+ { case ROUTINE_T:
+ /* Replaced functions must always be backpatched
+ because there could be another definition coming. */
+ if (sflags[symbol] & REPLACE_SFLAG)
+ { current_token.marker = SYMBOL_MV;
+ if (module_switch) import_symbol(symbol);
+ v = symbol;
+ break;
+ }
+ current_token.marker = IROUTINE_MV;
+ break;
+ case GLOBAL_VARIABLE_T:
+ current_token.marker = VARIABLE_MV;
+ break;
+ case OBJECT_T:
+ case CLASS_T:
+ /* All objects must be backpatched in Glulx. */
+ if (module_switch || glulx_mode)
+ current_token.marker = OBJECT_MV;
+ break;
+ case ARRAY_T:
+ current_token.marker = ARRAY_MV;
+ break;
+ case INDIVIDUAL_PROPERTY_T:
+ if (module_switch) current_token.marker = IDENT_MV;
+ break;
+ case CONSTANT_T:
+ if (sflags[symbol] & (UNKNOWN_SFLAG + CHANGE_SFLAG))
+ { current_token.marker = SYMBOL_MV;
+ if (module_switch) import_symbol(symbol);
+ v = symbol;
+ }
+ else current_token.marker = 0;
+ break;
+ case LABEL_T:
+ error_named("Label name used as value:", token_text);
+ break;
+ default:
+ current_token.marker = 0;
+ break;
+ }
+ if (sflags[symbol] & SYSTEM_SFLAG)
+ current_token.marker = 0;
+
+ current_token.value = v;
+
+ if (!glulx_mode) {
+ if (((current_token.marker != 0)
+ && (current_token.marker != VARIABLE_MV))
+ || (v < 0) || (v > 255))
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ if (((current_token.marker != 0)
+ && (current_token.marker != VARIABLE_MV))
+ || (v < -0x8000) || (v >= 0x8000))
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+
+ if (stypes[symbol] == GLOBAL_VARIABLE_T)
+ { current_token.type = VARIABLE_TT;
+ variable_usage[current_token.value] = TRUE;
+ }
+ break;
+
+ case NUMBER_TT:
+ if (!glulx_mode) {
+ if (current_token.value >= 256)
+ current_token.type = LARGE_NUMBER_TT;
+ else
+ current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ if (current_token.value < -0x8000
+ || current_token.value >= 0x8000)
+ current_token.type = LARGE_NUMBER_TT;
+ else
+ current_token.type = SMALL_NUMBER_TT;
+ }
+ break;
+
+ case SEP_TT:
+ switch(current_token.value)
+ { case ARROW_SEP:
+ if (!arrow_allowed)
+ current_token.type = ENDEXP_TT;
+ break;
+
+ case COMMA_SEP:
+ if ((bracket_level==0) && (!comma_allowed))
+ current_token.type = ENDEXP_TT;
+ break;
+
+ case SUPERCLASS_SEP:
+ if ((bracket_level==0) && (!superclass_allowed))
+ current_token.type = ENDEXP_TT;
+ break;
+
+ case GREATER_SEP:
+ get_next_token();
+ if ((token_type == SEP_TT)
+ &&((token_value == SEMICOLON_SEP)
+ || (token_value == GREATER_SEP)))
+ current_token.type = ENDEXP_TT;
+ put_token_back();
+ break;
+
+ case OPENB_SEP:
+ bracket_level++;
+ if (expr_trace_level>=3)
+ { printf("Previous token type = %d\n",previous_token.type);
+ printf("Previous token val = %d\n",previous_token.value);
+ }
+ if ((previous_token.type == OP_TT)
+ || (previous_token.type == SUBOPEN_TT)
+ || (previous_token.type == ENDEXP_TT)
+ || (array_init_ambiguity)
+ || ((bracket_level == 1) && (action_ambiguity)))
+ current_token.type = SUBOPEN_TT;
+ else
+ { inserting_token = TRUE;
+ heldback_token = current_token;
+ current_token.text = "<call>";
+ bracket_level--;
+ }
+ break;
+
+ case CLOSEB_SEP:
+ bracket_level--;
+ if (bracket_level < 0)
+ current_token.type = ENDEXP_TT;
+ else current_token.type = SUBCLOSE_TT;
+ break;
+
+ case SEMICOLON_SEP:
+ current_token.type = ENDEXP_TT; break;
+
+ case MINUS_SEP:
+ if ((previous_token.type == OP_TT)
+ || (previous_token.type == SUBOPEN_TT)
+ || (previous_token.type == ENDEXP_TT))
+ current_token.value = UNARY_MINUS_SEP; break;
+
+ case INC_SEP:
+ if ((previous_token.type == VARIABLE_TT)
+ || (previous_token.type == SUBCLOSE_TT)
+ || (previous_token.type == LARGE_NUMBER_TT)
+ || (previous_token.type == SMALL_NUMBER_TT))
+ current_token.value = POST_INC_SEP; break;
+
+ case DEC_SEP:
+ if ((previous_token.type == VARIABLE_TT)
+ || (previous_token.type == SUBCLOSE_TT)
+ || (previous_token.type == LARGE_NUMBER_TT)
+ || (previous_token.type == SMALL_NUMBER_TT))
+ current_token.value = POST_DEC_SEP; break;
+
+ case HASHHASH_SEP:
+ token_text = current_token.text + 2;
+
+ ActionUsedAsConstant:
+
+ current_token.type = ACTION_TT;
+ current_token.text = token_text;
+ current_token.value = 0;
+ current_token.marker = ACTION_MV;
+
+ break;
+
+ case HASHADOLLAR_SEP:
+ obsolete_warning("'#a$Act' is now superseded by '##Act'");
+ token_text = current_token.text + 3;
+ goto ActionUsedAsConstant;
+
+ case HASHGDOLLAR_SEP:
+
+ /* This form generates the position of a global variable
+ in the global variables array. So Glob is the same as
+ #globals_array --> #g$Glob */
+
+ current_token.text += 3;
+ current_token.type = SYMBOL_TT;
+ symbol = symbol_index(current_token.text, -1);
+ if (stypes[symbol] != GLOBAL_VARIABLE_T) {
+ ebf_error(
+ "global variable name after '#g$'",
+ current_token.text);
+ current_token.value = 0;
+ current_token.type = SMALL_NUMBER_TT;
+ current_token.marker = 0;
+ break;
+ }
+ mark_symbol_as_used = TRUE;
+ current_token.value = svals[symbol] - MAX_LOCAL_VARIABLES;
+ current_token.marker = 0;
+ if (!glulx_mode) {
+ if (current_token.value >= 0x100)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ if (current_token.value >= 0x8000
+ || current_token.value < -0x8000)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ break;
+
+ case HASHNDOLLAR_SEP:
+
+ /* This form is still needed for constants like #n$a (the
+ dictionary address of the word "a"), since 'a' means
+ the ASCII value of 'a' */
+
+ if (strlen(token_text) > 4)
+ obsolete_warning(
+ "'#n$word' is now superseded by ''word''");
+ current_token.type = DICTWORD_TT;
+ current_token.value = 0;
+ current_token.text = token_text + 3;
+ current_token.marker = DWORD_MV;
+ break;
+
+ case HASHRDOLLAR_SEP:
+
+ /* This form -- #r$Routinename, to return the routine's */
+ /* packed address -- is needed far less often in Inform 6, */
+ /* where just giving the name Routine returns the packed */
+ /* address. But it's used in a lot of Inform 5 code. */
+
+ obsolete_warning(
+ "'#r$Routine' can now be written just 'Routine'");
+ current_token.text += 3;
+ current_token.type = SYMBOL_TT;
+ current_token.value = symbol_index(current_token.text, -1);
+ goto ReceiveSymbol;
+
+ case HASHWDOLLAR_SEP:
+ error("The obsolete '#w$word' construct has been removed");
+ break;
+
+ case HASH_SEP:
+ system_constants.enabled = TRUE;
+ get_next_token();
+ system_constants.enabled = FALSE;
+ if (token_type != SYSTEM_CONSTANT_TT)
+ { ebf_error(
+ "'r$', 'n$', 'g$' or internal Inform constant name after '#'",
+ token_text);
+ break;
+ }
+ else
+ { current_token.type = token_type;
+ current_token.value = token_value;
+ current_token.text = token_text;
+ current_token.marker = INCON_MV;
+ }
+ break;
+ }
+ break;
+
+ case CND_TT:
+ v = conditionals_to_operators[current_token.value];
+ if (v != NOT_AN_OPERATOR)
+ { current_token.type = OP_TT; current_token.value = v;
+ }
+ break;
+ }
+
+ if (current_token.type == SEP_TT)
+ { v = separators_to_operators[current_token.value];
+ if (v != NOT_AN_OPERATOR)
+ { if ((veneer_mode)
+ || ((v!=MESSAGE_OP) && (v!=MPROP_NUM_OP) && (v!=MPROP_NUM_OP)))
+ { current_token.type = OP_TT; current_token.value = v;
+ if (array_init_ambiguity &&
+ ((v==MINUS_OP) || (v==UNARY_MINUS_OP)) &&
+ (initial_bracket_level == 0) &&
+ (etoken_count != 1))
+ warning("Without bracketing, the minus sign '-' is ambiguous");
+ }
+ }
+ }
+
+ /* A feature of Inform making it annoyingly hard to parse left-to-right
+ is that there is no clear delimiter for expressions; that is, the
+ legal syntax often includes sequences of expressions with no
+ intervening markers such as commas. We therefore need to use some
+ internal context to determine whether an end is in sight... */
+
+ if (token_type_allowable[current_token.type]==0)
+ { if (expr_trace_level >= 3)
+ { printf("Discarding as not allowable: '%s' ", current_token.text);
+ describe_token(current_token);
+ printf("\n");
+ }
+ current_token.type = ENDEXP_TT;
+ }
+ else
+ if ((!((initial_bracket_level > 0)
+ || (previous_token.type == ENDEXP_TT)
+ || ((previous_token.type == OP_TT)
+ && (operators[previous_token.value].usage != POST_U))
+ || (previous_token.type == SYSFUN_TT)))
+ && ((current_token.type != OP_TT)
+ || (operators[current_token.value].usage == PRE_U)))
+ { if (expr_trace_level >= 3)
+ { printf("Discarding as no longer part: '%s' ", current_token.text);
+ describe_token(current_token);
+ printf("\n");
+ }
+ current_token.type = ENDEXP_TT;
+ }
+ else
+ { if (mark_symbol_as_used) sflags[symbol] |= USED_SFLAG;
+ if (expr_trace_level >= 3)
+ { printf("Expr token = '%s' ", current_token.text);
+ describe_token(current_token);
+ printf("\n");
+ }
+ }
+
+ if ((previous_token.type == ENDEXP_TT)
+ && (current_token.type == ENDEXP_TT)) return FALSE;
+
+ previous_token = current_token;
+
+ return TRUE;
+}
+
+/* --- Operator precedences ------------------------------------------------ */
+
+#define LOWER_P 101
+#define EQUAL_P 102
+#define GREATER_P 103
+
+#define e1 1 /* Missing operand error */
+#define e2 2 /* Unexpected close bracket */
+#define e3 3 /* Missing operator error */
+#define e4 4 /* Expression ends with an open bracket */
+#define e5 5 /* Associativity illegal error */
+
+const int prec_table[] = {
+
+/* a .......... ( ) end op term */
+
+/* b ( */ LOWER_P, e3, LOWER_P, LOWER_P, e3,
+/* . ) */ EQUAL_P, GREATER_P, e2, GREATER_P, GREATER_P,
+/* . end */ e4, GREATER_P, e1, GREATER_P, GREATER_P,
+/* . op */ LOWER_P, GREATER_P, LOWER_P, -1, GREATER_P,
+/* . term */ LOWER_P, e3, LOWER_P, LOWER_P, e3
+
+};
+
+static int find_prec(token_data a, token_data b)
+{
+ /* We are comparing the precedence of tokens a and b
+ (where a occurs to the left of b). If the expression is correct,
+ the only possible values are GREATER_P, LOWER_P or EQUAL_P;
+ if it is malformed then one of e1 to e5 results.
+
+ Note that this routine is not symmetrical and that the relation
+ is not trichotomous.
+
+ If a and b are equal (and aren't brackets), then
+
+ a LOWER_P a if a right-associative
+ a GREATER_P a if a left-associative
+ */
+
+ int i, j, l1, l2;
+
+ switch(a.type)
+ { case SUBOPEN_TT: i=0; break;
+ case SUBCLOSE_TT: i=1; break;
+ case ENDEXP_TT: i=2; break;
+ case OP_TT: i=3; break;
+ default: i=4; break;
+ }
+ switch(b.type)
+ { case SUBOPEN_TT: i+=0; break;
+ case SUBCLOSE_TT: i+=5; break;
+ case ENDEXP_TT: i+=10; break;
+ case OP_TT: i+=15; break;
+ default: i+=20; break;
+ }
+
+ j = prec_table[i]; if (j != -1) return j;
+
+ l1 = operators[a.value].precedence;
+ l2 = operators[b.value].precedence;
+ if (operators[b.value].usage == PRE_U) return LOWER_P;
+ if (operators[a.value].usage == POST_U) return GREATER_P;
+
+ /* Anomalous rule to resolve the function call precedence, which is
+ different on the right from on the left, e.g., in:
+
+ alpha.beta(gamma)
+ beta(gamma).alpha
+ */
+
+ if ((l1 == 11) && (l2 > 11)) return GREATER_P;
+
+ if (l1 < l2) return LOWER_P;
+ if (l1 > l2) return GREATER_P;
+ switch(operators[a.value].associativity)
+ { case L_A: return GREATER_P;
+ case R_A: return LOWER_P;
+ case 0: return e5;
+ }
+ return GREATER_P;
+}
+
+/* --- Converting token to operand ----------------------------------------- */
+
+/* Must match the switch statement below */
+int z_system_constant_list[] =
+ { adjectives_table_SC,
+ actions_table_SC,
+ classes_table_SC,
+ identifiers_table_SC,
+ preactions_table_SC,
+ largest_object_SC,
+ strings_offset_SC,
+ code_offset_SC,
+ actual_largest_object_SC,
+ static_memory_offset_SC,
+ array_names_offset_SC,
+ readable_memory_offset_SC,
+ cpv__start_SC,
+ cpv__end_SC,
+ ipv__start_SC,
+ ipv__end_SC,
+ array__start_SC,
+ array__end_SC,
+ highest_attribute_number_SC,
+ attribute_names_array_SC,
+ highest_property_number_SC,
+ property_names_array_SC,
+ highest_action_number_SC,
+ action_names_array_SC,
+ highest_fake_action_number_SC,
+ fake_action_names_array_SC,
+ highest_routine_number_SC,
+ routine_names_array_SC,
+ routines_array_SC,
+ routine_flags_array_SC,
+ highest_global_number_SC,
+ global_names_array_SC,
+ globals_array_SC,
+ global_flags_array_SC,
+ highest_array_number_SC,
+ array_names_array_SC,
+ array_flags_array_SC,
+ highest_constant_number_SC,
+ constant_names_array_SC,
+ highest_class_number_SC,
+ class_objects_array_SC,
+ highest_object_number_SC,
+ -1 };
+
+static int32 value_of_system_constant_z(int t)
+{ switch(t)
+ { case adjectives_table_SC:
+ return adjectives_offset;
+ case actions_table_SC:
+ return actions_offset;
+ case classes_table_SC:
+ return class_numbers_offset;
+ case identifiers_table_SC:
+ return identifier_names_offset;
+ case preactions_table_SC:
+ return preactions_offset;
+ case largest_object_SC:
+ return 256 + no_objects - 1;
+ case strings_offset_SC:
+ return strings_offset/scale_factor;
+ case code_offset_SC:
+ return code_offset/scale_factor;
+ case actual_largest_object_SC:
+ return no_objects;
+ case static_memory_offset_SC:
+ return static_memory_offset;
+ case array_names_offset_SC:
+ return array_names_offset;
+ case readable_memory_offset_SC:
+ return Write_Code_At;
+ case cpv__start_SC:
+ return prop_values_offset;
+ case cpv__end_SC:
+ return class_numbers_offset;
+ case ipv__start_SC:
+ return individuals_offset;
+ case ipv__end_SC:
+ return variables_offset;
+ case array__start_SC:
+ return variables_offset + (MAX_GLOBAL_VARIABLES*WORDSIZE);
+ case array__end_SC:
+ return static_memory_offset;
+
+ case highest_attribute_number_SC:
+ return no_attributes-1;
+ case attribute_names_array_SC:
+ return attribute_names_offset;
+
+ case highest_property_number_SC:
+ return no_individual_properties-1;
+ case property_names_array_SC:
+ return identifier_names_offset + 2;
+
+ case highest_action_number_SC:
+ return no_actions-1;
+ case action_names_array_SC:
+ return action_names_offset;
+
+ case highest_fake_action_number_SC:
+ return ((grammar_version_number==1)?256:4096) + no_fake_actions-1;
+ case fake_action_names_array_SC:
+ return fake_action_names_offset;
+
+ case highest_routine_number_SC:
+ return no_named_routines-1;
+ case routine_names_array_SC:
+ return routine_names_offset;
+ case routines_array_SC:
+ return routines_array_offset;
+ case routine_flags_array_SC:
+ return routine_flags_array_offset;
+ case highest_global_number_SC:
+ return 16 + no_globals-1;
+ case global_names_array_SC:
+ return global_names_offset;
+ case globals_array_SC:
+ return variables_offset;
+ case global_flags_array_SC:
+ return global_flags_array_offset;
+ case highest_array_number_SC:
+ return no_arrays-1;
+ case array_names_array_SC:
+ return array_names_offset;
+ case array_flags_array_SC:
+ return array_flags_array_offset;
+ case highest_constant_number_SC:
+ return no_named_constants-1;
+ case constant_names_array_SC:
+ return constant_names_offset;
+ case highest_class_number_SC:
+ return no_classes-1;
+ case class_objects_array_SC:
+ return class_numbers_offset;
+ case highest_object_number_SC:
+ return no_objects-1;
+ }
+
+ error_named("System constant not implemented in Z-code",
+ system_constants.keywords[t]);
+
+ return(0);
+}
+
+/* Must match the switch statement below */
+int glulx_system_constant_list[] =
+ { classes_table_SC,
+ identifiers_table_SC,
+ array_names_offset_SC,
+ cpv__start_SC,
+ cpv__end_SC,
+ dictionary_table_SC,
+ dynam_string_table_SC,
+ grammar_table_SC,
+ actions_table_SC,
+ globals_array_SC,
+ highest_class_number_SC,
+ highest_object_number_SC,
+ -1 };
+
+static int32 value_of_system_constant_g(int t)
+{
+ switch (t) {
+ case classes_table_SC:
+ return Write_RAM_At + class_numbers_offset;
+ case identifiers_table_SC:
+ return Write_RAM_At + identifier_names_offset;
+ case array_names_offset_SC:
+ return Write_RAM_At + array_names_offset;
+ case cpv__start_SC:
+ return prop_defaults_offset;
+ case cpv__end_SC:
+ return Write_RAM_At + class_numbers_offset;
+ case dictionary_table_SC:
+ return dictionary_offset;
+ case dynam_string_table_SC:
+ return abbreviations_offset;
+ case grammar_table_SC:
+ return grammar_table_offset;
+ case actions_table_SC:
+ return actions_offset;
+ case globals_array_SC:
+ return variables_offset;
+ case highest_class_number_SC:
+ return no_classes-1;
+ case highest_object_number_SC:
+ return no_objects-1;
+ }
+
+ error_named("System constant not implemented in Glulx",
+ system_constants.keywords[t]);
+
+ return 0;
+}
+
+extern int32 value_of_system_constant(int t)
+{
+ if (!glulx_mode)
+ return value_of_system_constant_z(t);
+ else
+ return value_of_system_constant_g(t);
+}
+
+static int evaluate_term(token_data t, assembly_operand *o)
+{
+ /* If the given token is a constant, evaluate it into the operand.
+ For now, the identifiers are considered variables.
+
+ Returns FALSE if it fails to understand type. */
+
+ int32 v;
+
+ o->marker = t.marker;
+ o->symtype = t.symtype;
+ o->symflags = t.symflags;
+
+ switch(t.type)
+ { case LARGE_NUMBER_TT:
+ v = t.value;
+ if (!glulx_mode) {
+ if (v < 0) v = v + 0x10000;
+ o->type = LONG_CONSTANT_OT;
+ o->value = v;
+ }
+ else {
+ o->value = v;
+ o->type = CONSTANT_OT;
+ }
+ return(TRUE);
+ case SMALL_NUMBER_TT:
+ v = t.value;
+ if (!glulx_mode) {
+ if (v < 0) v = v + 0x10000;
+ o->type = SHORT_CONSTANT_OT;
+ o->value = v;
+ }
+ else {
+ o->value = v;
+ set_constant_ot(o);
+ }
+ return(TRUE);
+ case DICTWORD_TT:
+ /* Find the dictionary address, adding to dictionary if absent */
+ if (!glulx_mode)
+ o->type = LONG_CONSTANT_OT;
+ else
+ o->type = CONSTANT_OT;
+ o->value = dictionary_add(t.text, 0x80, 0, 0);
+ return(TRUE);
+ case DQ_TT:
+ /* Create as a static string */
+ if (!glulx_mode)
+ o->type = LONG_CONSTANT_OT;
+ else
+ o->type = CONSTANT_OT;
+ o->value = compile_string(t.text, FALSE, FALSE);
+ return(TRUE);
+ case VARIABLE_TT:
+ if (!glulx_mode) {
+ o->type = VARIABLE_OT;
+ }
+ else {
+ if (t.value >= MAX_LOCAL_VARIABLES) {
+ o->type = GLOBALVAR_OT;
+ }
+ else {
+ /* This includes "local variable zero", which is really
+ the stack-pointer magic variable. */
+ o->type = LOCALVAR_OT;
+ }
+ }
+ o->value = t.value;
+ return(TRUE);
+ case SYSFUN_TT:
+ if (!glulx_mode) {
+ o->type = VARIABLE_OT;
+ o->value = t.value + 256;
+ }
+ else {
+ o->type = SYSFUN_OT;
+ o->value = t.value;
+ }
+ system_function_usage[t.value] = 1;
+ return(TRUE);
+ case ACTION_TT:
+ *o = action_of_name(t.text);
+ return(TRUE);
+ case SYSTEM_CONSTANT_TT:
+ /* Certain system constants depend only on the
+ version number and need no backpatching, as they
+ are known in advance. We can therefore evaluate
+ them immediately. */
+ if (!glulx_mode) {
+ o->type = LONG_CONSTANT_OT;
+ switch(t.value)
+ {
+ case version_number_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = version_number; break;
+ case dict_par1_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = (version_number==3)?4:6; break;
+ case dict_par2_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = (version_number==3)?5:7; break;
+ case dict_par3_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = (version_number==3)?6:8; break;
+ case lowest_attribute_number_SC:
+ case lowest_action_number_SC:
+ case lowest_routine_number_SC:
+ case lowest_array_number_SC:
+ case lowest_constant_number_SC:
+ case lowest_class_number_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 0; break;
+ case lowest_object_number_SC:
+ case lowest_property_number_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 1; break;
+ case lowest_global_number_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 16; break;
+ case lowest_fake_action_number_SC:
+ o->type = LONG_CONSTANT_OT; o->marker = 0;
+ v = ((grammar_version_number==1)?256:4096); break;
+ case oddeven_packing_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0;
+ v = oddeven_packing_switch; break;
+ default:
+ v = t.value;
+ o->marker = INCON_MV;
+ break;
+ }
+ o->value = v;
+ }
+ else {
+ o->type = CONSTANT_OT;
+ switch(t.value)
+ {
+ /* The three dict_par flags point at the lower byte
+ of the flag field, because the library is written
+ to expect one-byte fields, even though the compiler
+ generates a dictionary with room for two. */
+ case dict_par1_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = DICT_ENTRY_FLAG_POS+1;
+ break;
+ case dict_par2_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = DICT_ENTRY_FLAG_POS+3;
+ break;
+ case dict_par3_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = DICT_ENTRY_FLAG_POS+5;
+ break;
+
+ case lowest_attribute_number_SC:
+ case lowest_action_number_SC:
+ case lowest_routine_number_SC:
+ case lowest_array_number_SC:
+ case lowest_constant_number_SC:
+ case lowest_class_number_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = 0;
+ break;
+ case lowest_object_number_SC:
+ case lowest_property_number_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = 1;
+ break;
+
+ /* ###fix: need to fill more of these in! */
+
+ default:
+ v = t.value;
+ o->marker = INCON_MV;
+ break;
+ }
+ o->value = v;
+ }
+ return(TRUE);
+ default:
+ return(FALSE);
+ }
+}
+
+/* --- Emitter ------------------------------------------------------------- */
+
+expression_tree_node *ET;
+static int ET_used;
+
+extern void clear_expression_space(void)
+{ ET_used = 0;
+}
+
+static assembly_operand *emitter_stack;
+static int *emitter_markers;
+static int *emitter_bracket_counts;
+
+#define FUNCTION_VALUE_MARKER 1
+#define ARGUMENT_VALUE_MARKER 2
+#define OR_VALUE_MARKER 3
+
+static int emitter_sp;
+
+static int is_property_t(int symbol_type)
+{ return ((symbol_type == PROPERTY_T) || (symbol_type == INDIVIDUAL_PROPERTY_T));
+}
+
+static void mark_top_of_emitter_stack(int marker, token_data t)
+{ if (emitter_sp < 1)
+ { compiler_error("SR error: Attempt to add a marker to the top of an empty emitter stack");
+ return;
+ }
+ if (expr_trace_level >= 2)
+ { printf("Marking top of emitter stack (which is ");
+ print_operand(emitter_stack[emitter_sp-1]);
+ printf(") as ");
+ switch(marker)
+ {
+ case FUNCTION_VALUE_MARKER:
+ printf("FUNCTION");
+ break;
+ case ARGUMENT_VALUE_MARKER:
+ printf("ARGUMENT");
+ break;
+ case OR_VALUE_MARKER:
+ printf("OR_VALUE");
+ break;
+ default:
+ printf("UNKNOWN");
+ break;
+ }
+ printf("\n");
+ }
+ if (emitter_markers[emitter_sp-1])
+ { if (marker == ARGUMENT_VALUE_MARKER)
+ {
+ warning("Ignoring spurious leading comma");
+ return;
+ }
+ error_named("Missing operand for", t.text);
+ if (emitter_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+ emitter_stack[emitter_sp] = zero_operand;
+ emitter_sp++;
+ }
+ emitter_markers[emitter_sp-1] = marker;
+}
+
+static void add_bracket_layer_to_emitter_stack(int depth)
+{ /* There's no point in tracking bracket layers that don't fence off any values. */
+ if (emitter_sp < depth + 1) return;
+ if (expr_trace_level >= 2)
+ printf("Adding bracket layer\n");
+ ++emitter_bracket_counts[emitter_sp-depth-1];
+}
+
+static void remove_bracket_layer_from_emitter_stack()
+{ /* Bracket layers that don't fence off any values will not have been tracked. */
+ if (emitter_sp < 2) return;
+ if (expr_trace_level >= 2)
+ printf("Removing bracket layer\n");
+ if (emitter_bracket_counts[emitter_sp-2] <= 0)
+ { compiler_error("SR error: Attempt to remove a nonexistent bracket layer from the emitter stack");
+ return;
+ }
+ --emitter_bracket_counts[emitter_sp-2];
+}
+
+static void emit_token(token_data t)
+{ assembly_operand o1, o2; int arity, stack_size, i;
+ int op_node_number, operand_node_number, previous_node_number;
+ int32 x = 0;
+
+ if (expr_trace_level >= 2)
+ { printf("Output: %-19s%21s ", t.text, "");
+ for (i=0; i<emitter_sp; i++)
+ { print_operand(emitter_stack[i]); printf(" ");
+ if (emitter_markers[i] == FUNCTION_VALUE_MARKER) printf(":FUNCTION ");
+ if (emitter_markers[i] == ARGUMENT_VALUE_MARKER) printf(":ARGUMENT ");
+ if (emitter_markers[i] == OR_VALUE_MARKER) printf(":OR ");
+ if (emitter_bracket_counts[i]) printf(":BRACKETS(%d) ", emitter_bracket_counts[i]);
+ }
+ printf("\n");
+ }
+
+ if (t.type == SUBOPEN_TT) return;
+
+ stack_size = 0;
+ while ((stack_size < emitter_sp) &&
+ !emitter_markers[emitter_sp-stack_size-1] &&
+ !emitter_bracket_counts[emitter_sp-stack_size-1])
+ stack_size++;
+
+ if (t.type == SUBCLOSE_TT)
+ { if (stack_size < emitter_sp && emitter_bracket_counts[emitter_sp-stack_size-1])
+ { if (stack_size == 0)
+ { error("No expression between brackets '(' and ')'");
+ emitter_stack[emitter_sp] = zero_operand;
+ emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+ ++emitter_sp;
+ }
+ else if (stack_size < 1)
+ compiler_error("SR error: emitter stack empty in subexpression");
+ else if (stack_size > 1)
+ compiler_error("SR error: emitter stack overfull in subexpression");
+ remove_bracket_layer_from_emitter_stack();
+ }
+ return;
+ }
+
+ if (t.type != OP_TT)
+ { emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+
+ if (emitter_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ if (!evaluate_term(t, &(emitter_stack[emitter_sp++])))
+ compiler_error_named("Emit token error:", t.text);
+ return;
+ }
+
+ /* A comma is argument-separating if it follows an argument (or a function
+ call, since we ignore spurious leading commas in function argument lists)
+ with no intervening brackets. Function calls are variadic, so we don't
+ apply argument-separating commas. */
+ if (t.value == COMMA_OP &&
+ stack_size < emitter_sp &&
+ (emitter_markers[emitter_sp-stack_size-1] == ARGUMENT_VALUE_MARKER ||
+ emitter_markers[emitter_sp-stack_size-1] == FUNCTION_VALUE_MARKER) &&
+ !emitter_bracket_counts[emitter_sp-stack_size-1])
+ { if (expr_trace_level >= 2)
+ printf("Treating comma as argument-separating\n");
+ return;
+ }
+
+ if (t.value == OR_OP)
+ return;
+
+ arity = 1;
+ if (t.value == FCALL_OP)
+ { if (expr_trace_level >= 3)
+ { printf("FCALL_OP finds marker stack: ");
+ for (x=0; x<emitter_sp; x++) printf("%d ", emitter_markers[x]);
+ printf("\n");
+ }
+ if (emitter_markers[emitter_sp-1] == ARGUMENT_VALUE_MARKER)
+ warning("Ignoring spurious trailing comma");
+ while (emitter_markers[emitter_sp-arity] != FUNCTION_VALUE_MARKER)
+ {
+ if ((glulx_mode &&
+ emitter_stack[emitter_sp-arity].type == SYSFUN_OT) ||
+ (!glulx_mode &&
+ emitter_stack[emitter_sp-arity].type == VARIABLE_OT &&
+ emitter_stack[emitter_sp-arity].value >= 256 &&
+ emitter_stack[emitter_sp-arity].value < 288))
+ { int index = emitter_stack[emitter_sp-arity].value;
+ if(!glulx_mode)
+ index -= 256;
+ if(index >= 0 && index < NUMBER_SYSTEM_FUNCTIONS)
+ error_named("System function name used as a value:", system_functions.keywords[index]);
+ else
+ compiler_error("Found unnamed system function used as a value");
+ emitter_stack[emitter_sp-arity] = zero_operand;
+ }
+ ++arity;
+ }
+ }
+ else
+ { arity = 1;
+ if (operators[t.value].usage == IN_U) arity = 2;
+
+ if (operators[t.value].precedence == 3)
+ { arity = 2;
+ x = emitter_sp-1;
+ if(!emitter_markers[x] && !emitter_bracket_counts[x])
+ { for (--x; emitter_markers[x] == OR_VALUE_MARKER && !emitter_bracket_counts[x]; --x)
+ { ++arity;
+ ++stack_size;
+ }
+ for (;x >= 0 && !emitter_markers[x] && !emitter_bracket_counts[x]; --x)
+ ++stack_size;
+ }
+ }
+
+ if (arity > stack_size)
+ { error_named("Missing operand for", t.text);
+ while (arity > stack_size)
+ { if (emitter_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+ emitter_stack[emitter_sp] = zero_operand;
+ emitter_sp++;
+ stack_size++;
+ }
+ }
+ }
+
+ /* pseudo-typecheck in 6.30 */
+ for (i = 1; i <= arity; i++)
+ {
+ o1 = emitter_stack[emitter_sp - i];
+ if (is_property_t(o1.symtype) ) {
+ switch(t.value)
+ {
+ case FCALL_OP:
+ case SETEQUALS_OP: case NOTEQUAL_OP:
+ case CONDEQUALS_OP:
+ case PROVIDES_OP: case NOTPROVIDES_OP:
+ case PROP_ADD_OP: case PROP_NUM_OP:
+ case SUPERCLASS_OP:
+ case MPROP_ADD_OP: case MESSAGE_OP:
+ case PROPERTY_OP:
+ if (i < arity) break;
+ case GE_OP: case LE_OP:
+ if ((i < arity) && (o1.symflags & STAR_SFLAG)) break;
+ default:
+ warning("Property name in expression is not qualified by object");
+ }
+ } /* if (is_property_t */
+ }
+
+ switch(arity)
+ { case 1:
+ o1 = emitter_stack[emitter_sp - 1];
+ if ((o1.marker == 0) && is_constant_ot(o1.type))
+ { switch(t.value)
+ { case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
+ case ARTNOT_OP:
+ if (!glulx_mode)
+ x = (~o1.value) & 0xffff;
+ else
+ x = (~o1.value) & 0xffffffff;
+ goto FoldConstant;
+ case LOGNOT_OP:
+ if (o1.value != 0) x=0; else x=1;
+ goto FoldConstant;
+ }
+ }
+ break;
+
+ case 2:
+ o1 = emitter_stack[emitter_sp - 2];
+ o2 = emitter_stack[emitter_sp - 1];
+
+ if ((o1.marker == 0) && (o2.marker == 0)
+ && is_constant_ot(o1.type) && is_constant_ot(o2.type))
+ {
+ int32 ov1, ov2;
+ if (glulx_mode)
+ { ov1 = o1.value;
+ ov2 = o2.value;
+ }
+ else
+ { ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
+ ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
+ }
+
+ switch(t.value)
+ {
+ case PLUS_OP: x = ov1 + ov2; goto FoldConstantC;
+ case MINUS_OP: x = ov1 - ov2; goto FoldConstantC;
+ case TIMES_OP: x = ov1 * ov2; goto FoldConstantC;
+ case DIVIDE_OP:
+ case REMAINDER_OP:
+ if (ov2 == 0)
+ error("Division of constant by zero");
+ else
+ if (t.value == DIVIDE_OP) {
+ if (ov2 < 0) {
+ ov1 = -ov1;
+ ov2 = -ov2;
+ }
+ if (ov1 >= 0)
+ x = ov1 / ov2;
+ else
+ x = -((-ov1) / ov2);
+ }
+ else {
+ if (ov2 < 0) {
+ ov2 = -ov2;
+ }
+ if (ov1 >= 0)
+ x = ov1 % ov2;
+ else
+ x = -((-ov1) % ov2);
+ }
+ goto FoldConstant;
+ case ARTAND_OP: x = o1.value & o2.value; goto FoldConstant;
+ case ARTOR_OP: x = o1.value | o2.value; goto FoldConstant;
+ case CONDEQUALS_OP:
+ if (o1.value == o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case NOTEQUAL_OP:
+ if (o1.value != o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case GE_OP:
+ if (o1.value >= o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case GREATER_OP:
+ if (o1.value > o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case LE_OP:
+ if (o1.value <= o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case LESS_OP:
+ if (o1.value < o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case LOGAND_OP:
+ if ((o1.value != 0) && (o2.value != 0)) x=1; else x=0;
+ goto FoldConstant;
+ case LOGOR_OP:
+ if ((o1.value != 0) || (o2.value != 0)) x=1; else x=0;
+ goto FoldConstant;
+ }
+
+ }
+ }
+
+ op_node_number = ET_used++;
+ if (op_node_number == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+
+ ET[op_node_number].operator_number = t.value;
+ ET[op_node_number].up = -1;
+ ET[op_node_number].down = -1;
+ ET[op_node_number].right = -1;
+
+ /* This statement is redundant, but prevents compilers from wrongly
+ issuing a "used before it was assigned a value" error: */
+ previous_node_number = 0;
+
+ for (i = emitter_sp-arity; i != emitter_sp; i++)
+ {
+ if (expr_trace_level >= 3)
+ printf("i=%d, emitter_sp=%d, arity=%d, ETU=%d\n",
+ i, emitter_sp, arity, ET_used);
+ if (emitter_stack[i].type == EXPRESSION_OT)
+ operand_node_number = emitter_stack[i].value;
+ else
+ { operand_node_number = ET_used++;
+ if (operand_node_number == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[operand_node_number].down = -1;
+ ET[operand_node_number].value = emitter_stack[i];
+ }
+ ET[operand_node_number].up = op_node_number;
+ ET[operand_node_number].right = -1;
+ if (i == emitter_sp - arity)
+ { ET[op_node_number].down = operand_node_number;
+ }
+ else
+ { ET[previous_node_number].right = operand_node_number;
+ }
+ previous_node_number = operand_node_number;
+ }
+
+ emitter_sp = emitter_sp - arity + 1;
+
+ emitter_stack[emitter_sp - 1].type = EXPRESSION_OT;
+ emitter_stack[emitter_sp - 1].value = op_node_number;
+ emitter_stack[emitter_sp - 1].marker = 0;
+ emitter_markers[emitter_sp - 1] = 0;
+ emitter_bracket_counts[emitter_sp - 1] = 0;
+ /* Remove the marker for the brackets implied by operator precedence */
+ remove_bracket_layer_from_emitter_stack();
+
+ return;
+
+ FoldConstantC:
+
+ /* In Glulx, skip this test; we can't check out-of-range errors
+ for 32-bit arithmetic. */
+
+ if (!glulx_mode && ((x<-32768) || (x > 32767)))
+ { char folding_error[40];
+ int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
+ int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
+ switch(t.value)
+ {
+ case PLUS_OP:
+ sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
+ break;
+ case MINUS_OP:
+ sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
+ break;
+ case TIMES_OP:
+ sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
+ break;
+ }
+ error_named("Signed arithmetic on compile-time constants overflowed \
+the range -32768 to +32767:", folding_error);
+ }
+
+ FoldConstant:
+
+ if (!glulx_mode) {
+ while (x < 0) x = x + 0x10000;
+ x = x & 0xffff;
+ }
+ else {
+ x = x & 0xffffffff;
+ }
+
+ emitter_sp = emitter_sp - arity + 1;
+
+ if (!glulx_mode) {
+ if (x<256)
+ emitter_stack[emitter_sp - 1].type = SHORT_CONSTANT_OT;
+ else emitter_stack[emitter_sp - 1].type = LONG_CONSTANT_OT;
+ }
+ else {
+ if (x == 0)
+ emitter_stack[emitter_sp - 1].type = ZEROCONSTANT_OT;
+ else if (x >= -128 && x <= 127)
+ emitter_stack[emitter_sp - 1].type = BYTECONSTANT_OT;
+ else if (x >= -32768 && x <= 32767)
+ emitter_stack[emitter_sp - 1].type = HALFCONSTANT_OT;
+ else
+ emitter_stack[emitter_sp - 1].type = CONSTANT_OT;
+ }
+
+ emitter_stack[emitter_sp - 1].value = x;
+ emitter_stack[emitter_sp - 1].marker = 0;
+ emitter_markers[emitter_sp - 1] = 0;
+ emitter_bracket_counts[emitter_sp - 1] = 0;
+
+ if (expr_trace_level >= 2)
+ { printf("Folding constant to: ");
+ print_operand(emitter_stack[emitter_sp - 1]);
+ printf("\n");
+ }
+
+ /* Remove the marker for the brackets implied by operator precedence */
+ remove_bracket_layer_from_emitter_stack();
+ return;
+}
+
+/* --- Pretty printing ----------------------------------------------------- */
+
+static void show_node(int n, int depth, int annotate)
+{ int j;
+ for (j=0; j<2*depth+2; j++) printf(" ");
+
+ if (ET[n].down == -1)
+ { print_operand(ET[n].value);
+ if (annotate && (ET[n].value.marker != 0))
+ printf(" [%s]", describe_mv(ET[n].value.marker));
+ printf("\n");
+ }
+ else
+ { printf("%s ", operators[ET[n].operator_number].description);
+ j = operators[ET[n].operator_number].precedence;
+ if ((annotate) && ((j==2) || (j==3)))
+ { printf(" %d|%d ", ET[n].true_label, ET[n].false_label);
+ if (ET[n].label_after != -1) printf(" def %d after ",
+ ET[n].label_after);
+ if (ET[n].to_expression) printf(" con to expr ");
+ }
+ printf("\n");
+ show_node(ET[n].down, depth+1, annotate);
+ }
+
+ if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
+}
+
+extern void show_tree(assembly_operand AO, int annotate)
+{ if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
+ else
+ { printf("Constant: "); print_operand(AO);
+ if (annotate && (AO.marker != 0))
+ printf(" [%s]", describe_mv(AO.marker));
+ printf("\n");
+ }
+}
+
+/* --- Lvalue transformations ---------------------------------------------- */
+
+/* This only gets called in Z-code, since Glulx doesn't distinguish
+ individual property operators from general ones. */
+static void check_property_operator(int from_node)
+{ int below = ET[from_node].down;
+ int opnum = ET[from_node].operator_number;
+
+ ASSERT_ZCODE();
+
+ if (veneer_mode) return;
+
+ if ((below != -1) && (ET[below].right != -1))
+ { int n = ET[below].right, flag = FALSE;
+
+ if ((ET[n].down == -1)
+ && ((ET[n].value.type == LONG_CONSTANT_OT)
+ || (ET[n].value.type == SHORT_CONSTANT_OT))
+ && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
+ && ((!module_switch) || (ET[n].value.marker == 0)))
+ flag = TRUE;
+
+ if (!flag)
+ { switch(opnum)
+ { case PROPERTY_OP: opnum = MESSAGE_OP; break;
+ case PROP_ADD_OP: opnum = MPROP_ADD_OP; break;
+ case PROP_NUM_OP: opnum = MPROP_NUM_OP; break;
+ }
+ }
+
+ ET[from_node].operator_number = opnum;
+ }
+
+ if (below != -1)
+ check_property_operator(below);
+ if (ET[from_node].right != -1)
+ check_property_operator(ET[from_node].right);
+}
+
+static void check_lvalues(int from_node)
+{ int below = ET[from_node].down;
+ int opnum = ET[from_node].operator_number, opnum_below;
+ int lvalue_form, i, j = 0;
+
+ if (below != -1)
+ {
+ if ((opnum == FCALL_OP) && (ET[below].down != -1))
+ { opnum_below = ET[below].operator_number;
+ if ((opnum_below == PROPERTY_OP) || (opnum_below == MESSAGE_OP))
+ { i = ET[ET[from_node].down].right;
+ ET[from_node].down = ET[below].down;
+ ET[ET[below].down].up = from_node;
+ ET[ET[ET[below].down].right].up = from_node;
+ ET[ET[ET[below].down].right].right = i;
+ opnum = PROP_CALL_OP;
+ ET[from_node].operator_number = opnum;
+ }
+ }
+
+ if (operators[opnum].requires_lvalue)
+ { opnum_below = ET[below].operator_number;
+
+ if (ET[below].down == -1)
+ { if (!is_variable_ot(ET[below].value.type))
+ { error("'=' applied to undeclared variable");
+ goto LvalueError;
+ }
+ }
+ else
+ { lvalue_form=0;
+ switch(opnum)
+ { case SETEQUALS_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_SETEQUALS_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_SETEQUALS_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_SETEQUALS_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_SETEQUALS_OP; break;
+ }
+ break;
+ case INC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_INC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_INC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_INC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_INC_OP; break;
+ }
+ break;
+ case POST_INC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_POST_INC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_POST_INC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_POST_INC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_POST_INC_OP; break;
+ }
+ break;
+ case DEC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_DEC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_DEC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_DEC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_DEC_OP; break;
+ }
+ break;
+ case POST_DEC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_POST_DEC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_POST_DEC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_POST_DEC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_POST_DEC_OP; break;
+ }
+ break;
+ }
+ if (lvalue_form == 0)
+ { error_named("'=' applied to",
+ (char *) operators[opnum_below].description);
+ goto LvalueError;
+ }
+
+ /* Transform from_node from_node
+ | \ | \\\ \
+ below value to value
+ | \\\
+ */
+
+ ET[from_node].operator_number = lvalue_form;
+ i = ET[below].down;
+ ET[from_node].down = i;
+ while (i != -1)
+ { ET[i].up = from_node;
+ j = i;
+ i = ET[i].right;
+ }
+ ET[j].right = ET[below].right;
+ }
+ }
+ check_lvalues(below);
+ }
+ if (ET[from_node].right != -1)
+ check_lvalues(ET[from_node].right);
+ return;
+
+ LvalueError:
+ ET[from_node].down = -1;
+ ET[from_node].value = zero_operand;
+ if (ET[from_node].right != -1)
+ check_lvalues(ET[from_node].right);
+}
+
+/* --- Tree surgery for conditionals --------------------------------------- */
+
+static void negate_condition(int n)
+{ int i;
+
+ if (ET[n].right != -1) negate_condition(ET[n].right);
+ if (ET[n].down == -1) return;
+ i = operators[ET[n].operator_number].negation;
+ if (i!=0) ET[n].operator_number = i;
+ if (operators[i].precedence==2) negate_condition(ET[n].down);
+}
+
+static void delete_negations(int n, int context)
+{
+ /* Recursively apply
+
+ ~~(x && y) = ~~x || ~~y
+ ~~(x || y) = ~~x && ~~y
+ ~~(x == y) = x ~= y
+
+ (etc) to delete the ~~ operator from the tree. Since this is
+ depth first, the ~~ being deleted has no ~~s beneath it, which
+ is important to make "negate_condition" work. */
+
+ int i;
+
+ if (ET[n].right != -1) delete_negations(ET[n].right, context);
+ if (ET[n].down == -1) return;
+ delete_negations(ET[n].down, context);
+
+ if (ET[n].operator_number == LOGNOT_OP)
+ { negate_condition(ET[n].down);
+ ET[n].operator_number
+ = ET[ET[n].down].operator_number;
+ ET[n].down = ET[ET[n].down].down;
+ i = ET[n].down;
+ while(i != -1) { ET[i].up = n; i = ET[i].right; }
+ }
+}
+
+static void insert_exp_to_cond(int n, int context)
+{
+ /* Insert a ~= test when an expression is used as a condition.
+
+ Check for possible confusion over = and ==, e.g. "if (a = 1) ..." */
+
+ int new, i;
+
+ if (ET[n].right != -1) insert_exp_to_cond(ET[n].right, context);
+
+ if (ET[n].down == -1)
+ { if (context==CONDITION_CONTEXT)
+ { new = ET_used++;
+ if (new == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[new] = ET[n];
+ ET[n].down = new; ET[n].operator_number = NONZERO_OP;
+ ET[new].up = n; ET[new].right = -1;
+ }
+ return;
+ }
+
+ switch(operators[ET[n].operator_number].precedence)
+ { case 3: /* Conditionals have level 3 */
+ context = QUANTITY_CONTEXT;
+ break;
+ case 2: /* Logical operators level 2 */
+ context = CONDITION_CONTEXT;
+ break;
+ case 1: /* Forms of '=' have level 1 */
+ if (context == CONDITION_CONTEXT)
+ warning("'=' used as condition: '==' intended?");
+ default:
+ if (context != CONDITION_CONTEXT) break;
+
+ new = ET_used++;
+ if (new == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[new] = ET[n];
+ ET[n].down = new; ET[n].operator_number = NONZERO_OP;
+ ET[new].up = n; ET[new].right = -1;
+
+ i = ET[new].down;
+ while (i!= -1) { ET[i].up = new; i = ET[i].right; }
+ context = QUANTITY_CONTEXT; n = new;
+ }
+
+ insert_exp_to_cond(ET[n].down, context);
+}
+
+static unsigned int etoken_num_children(int n)
+{
+ int count = 0;
+ int i;
+ i = ET[n].down;
+ if (i == -1) { return 0; }
+ do {
+ count++;
+ i = ET[i].right;
+ } while (i!=-1);
+ return count;
+}
+
+static void func_args_on_stack(int n, int context)
+{
+ /* Make sure that the arguments of every function-call expression
+ are stored to the stack. If any aren't (ie, if any arguments are
+ constants or variables), cover them with push operators.
+ (The very first argument does not need to be so treated, because
+ it's the function address, not a function argument. We also
+ skip the treatment for most system functions.) */
+
+ int new, pn, fnaddr, opnum;
+
+ ASSERT_GLULX();
+
+ if (ET[n].right != -1)
+ func_args_on_stack(ET[n].right, context);
+ if (ET[n].down == -1) {
+ pn = ET[n].up;
+ if (pn != -1) {
+ opnum = ET[pn].operator_number;
+ if (opnum == FCALL_OP
+ || opnum == MESSAGE_CALL_OP
+ || opnum == PROP_CALL_OP) {
+ /* If it's an FCALL, get the operand which contains the function
+ address (or system-function number) */
+ if (opnum == MESSAGE_CALL_OP
+ || opnum == PROP_CALL_OP
+ || ((fnaddr=ET[pn].down) != n
+ && (ET[fnaddr].value.type != SYSFUN_OT
+ || ET[fnaddr].value.value == INDIRECT_SYSF
+ || ET[fnaddr].value.value == GLK_SYSF))) {
+ if (etoken_num_children(pn) > (unsigned int)(opnum == FCALL_OP ? 4:3)) {
+ new = ET_used++;
+ if (new == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[new] = ET[n];
+ ET[n].down = new;
+ ET[n].operator_number = PUSH_OP;
+ ET[new].up = n;
+ ET[new].right = -1;
+ }
+ }
+ }
+ }
+ return;
+ }
+
+ func_args_on_stack(ET[n].down, context);
+}
+
+static assembly_operand check_conditions(assembly_operand AO, int context)
+{ int n;
+
+ if (AO.type != EXPRESSION_OT)
+ { if (context != CONDITION_CONTEXT) return AO;
+ n = ET_used++;
+ if (n == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[n].down = -1;
+ ET[n].up = -1;
+ ET[n].right = -1;
+ ET[n].value = AO;
+ INITAOT(&AO, EXPRESSION_OT);
+ AO.value = n;
+ }
+
+ insert_exp_to_cond(AO.value, context);
+ delete_negations(AO.value, context);
+
+ if (glulx_mode)
+ func_args_on_stack(AO.value, context);
+
+ return AO;
+}
+
+/* --- Shift-reduce parser ------------------------------------------------- */
+
+static int sr_sp;
+static token_data *sr_stack;
+
+extern assembly_operand parse_expression(int context)
+{
+ /* Parses an expression, evaluating it as a constant if possible.
+
+ Possible contexts are:
+
+ VOID_CONTEXT the expression is used as a statement, so that
+ its value will be thrown away and it only
+ needs to exist for any resulting side-effects
+ (function calls and assignments)
+
+ CONDITION_CONTEXT the result must be a condition
+
+ CONSTANT_CONTEXT there is required to be a constant result
+ (so that, for instance, comma becomes illegal)
+
+ QUANTITY_CONTEXT the default: a quantity is to be specified
+
+ ACTION_Q_CONTEXT like QUANTITY_CONTEXT, but postfixed brackets
+ at the top level do not indicate function call:
+ used for e.g.
+ <Insert button (random(pocket1, pocket2))>
+
+ RETURN_Q_CONTEXT like QUANTITY_CONTEXT, but a single property
+ name does not generate a warning
+
+ ASSEMBLY_CONTEXT a quantity which cannot use the '->' operator
+ (needed for assembly language to indicate
+ store destinations)
+
+ FORINIT_CONTEXT a quantity which cannot use an (unbracketed)
+ '::' operator
+
+ ARRAY_CONTEXT like CONSTANT_CONTEXT, but where an unbracketed
+ minus sign is ambiguous, and brackets always
+ indicate subexpressions, not function calls
+
+ Return value: an assembly operand.
+
+ If the type is OMITTED_OT, then the expression has no resulting value.
+
+ If the type is EXPRESSION_OT, then the value will need to be
+ calculated at run-time by code compiled from the expression tree
+ whose root node-number is the operand value.
+
+ Otherwise the assembly operand is the value of the expression, which
+ is constant and thus known at compile time.
+
+ If an error has occurred in the expression, which recovery from was
+ not possible, then the return is (short constant) 0. This should
+ minimise the chance of a cascade of further error messages.
+ */
+
+ token_data a, b, pop; int i;
+ assembly_operand AO;
+
+ superclass_allowed = (context != FORINIT_CONTEXT);
+ if (context == FORINIT_CONTEXT) context = VOID_CONTEXT;
+
+ comma_allowed = (context == VOID_CONTEXT);
+ arrow_allowed = (context != ASSEMBLY_CONTEXT);
+ bare_prop_allowed = (context == RETURN_Q_CONTEXT);
+ array_init_ambiguity = ((context == ARRAY_CONTEXT) ||
+ (context == ASSEMBLY_CONTEXT));
+
+ action_ambiguity = (context == ACTION_Q_CONTEXT);
+
+ if (context == ASSEMBLY_CONTEXT) context = QUANTITY_CONTEXT;
+ if (context == ACTION_Q_CONTEXT) context = QUANTITY_CONTEXT;
+ if (context == RETURN_Q_CONTEXT) context = QUANTITY_CONTEXT;
+ if (context == ARRAY_CONTEXT) context = CONSTANT_CONTEXT;
+
+ etoken_count = 0;
+ inserting_token = FALSE;
+
+ emitter_sp = 0;
+ bracket_level = 0;
+
+ previous_token.text = "$";
+ previous_token.type = ENDEXP_TT;
+ previous_token.value = 0;
+
+ sr_sp = 1;
+ sr_stack[0] = previous_token;
+
+ AO = zero_operand;
+
+ statements.enabled = FALSE;
+ directives.enabled = FALSE;
+
+ if (get_next_etoken() == FALSE)
+ { ebf_error("expression", token_text);
+ return AO;
+ }
+
+ do
+ { if (expr_trace_level >= 2)
+ { printf("Input: %-20s", current_token.text);
+ for (i=0; i<sr_sp; i++) printf("%s ", sr_stack[i].text);
+ printf("\n");
+ }
+ if (expr_trace_level >= 3) printf("ET_used = %d\n", ET_used);
+
+ if (sr_sp == 0)
+ { compiler_error("SR error: stack empty");
+ return(AO);
+ }
+
+ a = sr_stack[sr_sp-1]; b = current_token;
+
+ if ((a.type == ENDEXP_TT) && (b.type == ENDEXP_TT))
+ { if (emitter_sp == 0)
+ { error("No expression between brackets '(' and ')'");
+ put_token_back();
+ return AO;
+ }
+ if (emitter_sp > 1)
+ { compiler_error("SR error: emitter stack overfull");
+ return AO;
+ }
+
+ AO = emitter_stack[0];
+ if (AO.type == EXPRESSION_OT)
+ { if (expr_trace_level >= 3)
+ { printf("Tree before lvalue checking:\n");
+ show_tree(AO, FALSE);
+ }
+ if (!glulx_mode)
+ check_property_operator(AO.value);
+ check_lvalues(AO.value);
+ ET[AO.value].up = -1;
+ }
+ else {
+ if ((context != CONSTANT_CONTEXT) && is_property_t(AO.symtype)
+ && (arrow_allowed) && (!bare_prop_allowed))
+ warning("Bare property name found. \"self.prop\" intended?");
+ }
+
+ check_conditions(AO, context);
+
+ if (context == CONSTANT_CONTEXT)
+ if (!is_constant_ot(AO.type))
+ { AO = zero_operand;
+ ebf_error("constant", "<expression>");
+ }
+ put_token_back();
+
+ return(AO);
+ }
+
+ switch(find_prec(a,b))
+ {
+ case e5: /* Associativity error */
+ error_named("Brackets mandatory to clarify order of:",
+ a.text);
+
+ case LOWER_P:
+ case EQUAL_P:
+ if (sr_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ sr_stack[sr_sp++] = b;
+ switch(b.type)
+ {
+ case SUBOPEN_TT:
+ if (sr_sp >= 2 && sr_stack[sr_sp-2].type == OP_TT && sr_stack[sr_sp-2].value == FCALL_OP)
+ mark_top_of_emitter_stack(FUNCTION_VALUE_MARKER, b);
+ else
+ add_bracket_layer_to_emitter_stack(0);
+ break;
+ case OP_TT:
+ switch(b.value){
+ case OR_OP:
+ if (sr_stack[sr_sp-2].type == OP_TT &&
+ operators[sr_stack[sr_sp-2].value].precedence == 3)
+ mark_top_of_emitter_stack(OR_VALUE_MARKER, b);
+ else
+ { error("'or' not between values to the right of a condition");
+ /* Convert to + for error recovery purposes */
+ sr_stack[sr_sp-1].value = PLUS_OP;
+ }
+ break;
+ case COMMA_OP:
+ {
+ /* A comma separates arguments only if the shallowest open bracket belongs to a function call. */
+ int shallowest_open_bracket_index = sr_sp - 2;
+ while (shallowest_open_bracket_index > 0 && sr_stack[shallowest_open_bracket_index].type != SUBOPEN_TT)
+ --shallowest_open_bracket_index;
+ if (shallowest_open_bracket_index > 0 &&
+ sr_stack[shallowest_open_bracket_index-1].type == OP_TT &&
+ sr_stack[shallowest_open_bracket_index-1].value == FCALL_OP)
+ { mark_top_of_emitter_stack(ARGUMENT_VALUE_MARKER, b);
+ break;
+ }
+ /* Non-argument-separating commas get treated like any other operator; we fall through to the default case. */
+ }
+ default:
+ {
+ /* Add a marker for the brackets implied by operator precedence */
+ int operands_on_left = (operators[b.value].usage == PRE_U) ? 0 : 1;
+ add_bracket_layer_to_emitter_stack(operands_on_left);
+ }
+ }
+ }
+ get_next_etoken();
+ break;
+ case GREATER_P:
+ do
+ { pop = sr_stack[sr_sp - 1];
+ emit_token(pop);
+ sr_sp--;
+ } while (find_prec(sr_stack[sr_sp-1], pop) != LOWER_P);
+ break;
+
+ case e1: /* Missing operand error */
+ error_named("Missing operand after", a.text);
+ put_token_back();
+ current_token.type = NUMBER_TT;
+ current_token.value = 0;
+ current_token.marker = 0;
+ current_token.text = "0";
+ break;
+
+ case e2: /* Unexpected close bracket */
+ error("Found '(' without matching ')'");
+ get_next_etoken();
+ break;
+
+ case e3: /* Missing operator error */
+ error("Missing operator: inserting '+'");
+ put_token_back();
+ current_token.type = OP_TT;
+ current_token.value = PLUS_OP;
+ current_token.marker = 0;
+ current_token.text = "+";
+ break;
+
+ case e4: /* Expression ends with an open bracket */
+ error("Found '(' without matching ')'");
+ sr_sp--;
+ break;
+
+ }
+ }
+ while (TRUE);
+}
+
+/* --- Test for simple ++ or -- usage: used to optimise "for" loop code ---- */
+
+extern int test_for_incdec(assembly_operand AO)
+{ int s = 0;
+ if (AO.type != EXPRESSION_OT) return 0;
+ if (ET[AO.value].down == -1) return 0;
+ switch(ET[AO.value].operator_number)
+ { case INC_OP: s = 1; break;
+ case POST_INC_OP: s = 1; break;
+ case DEC_OP: s = -1; break;
+ case POST_DEC_OP: s = -1; break;
+ }
+ if (s==0) return 0;
+ if (ET[ET[AO.value].down].down != -1) return 0;
+ if (!is_variable_ot(ET[ET[AO.value].down].value.type)) return 0;
+ return s*(ET[ET[AO.value].down].value.value);
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_expressp_vars(void)
+{ int i;
+ /* make_operands(); */
+ make_lexical_interface_tables();
+ for (i=0;i<32;i++) system_function_usage[i] = 0;
+}
+
+extern void expressp_begin_pass(void)
+{
+}
+
+extern void expressp_allocate_arrays(void)
+{ ET = my_calloc(sizeof(expression_tree_node), MAX_EXPRESSION_NODES,
+ "expression parse trees");
+ emitter_markers = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
+ "emitter markers");
+ emitter_bracket_counts = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
+ "emitter bracket layer counts");
+ emitter_stack = my_calloc(sizeof(assembly_operand), MAX_EXPRESSION_NODES,
+ "emitter stack");
+ sr_stack = my_calloc(sizeof(token_data), MAX_EXPRESSION_NODES,
+ "shift-reduce parser stack");
+}
+
+extern void expressp_free_arrays(void)
+{ my_free(&ET, "expression parse trees");
+ my_free(&emitter_markers, "emitter markers");
+ my_free(&emitter_bracket_counts, "emitter bracket layer counts");
+ my_free(&emitter_stack, "emitter stack");
+ my_free(&sr_stack, "shift-reduce parser stack");
+}
+
+/* ========================================================================= */
projects / inform.git / blobdiff