+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "directs" : Directives (# commands) */
-/* */
-/* 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"
-
-int no_routines, /* Number of routines compiled so far */
- no_named_routines, /* Number not embedded in objects */
- no_locals, /* Number of locals in current routine */
- no_termcs; /* Number of terminating characters */
-int terminating_characters[32];
-
-brief_location routine_starts_line; /* Source code location where the current
- routine starts. (Useful for reporting
- "unused variable" warnings on the start
- line rather than the end line.) */
-
-static int constant_made_yet; /* Have any constants been defined yet? */
-
-static int ifdef_stack[32], ifdef_sp;
-
-/* ------------------------------------------------------------------------- */
-
-static int ebf_error_recover(char *s1, char *s2)
-{
- /* Display an "expected... but found..." error, then skim forward
- to the next semicolon and return FALSE. This is such a common
- case in parse_given_directive() that it's worth a utility
- function. You will see many error paths that look like:
- return ebf_error_recover(...);
- */
- ebf_error(s1, s2);
- panic_mode_error_recovery();
- return FALSE;
-}
-
-/* ------------------------------------------------------------------------- */
-
-extern int parse_given_directive(int internal_flag)
-{ /* Internal_flag is FALSE if the directive is encountered normally,
- TRUE if encountered with a # prefix inside a routine or object
- definition.
-
- Returns: FALSE if program continues, TRUE if end of file reached. */
-
- int *trace_level = NULL; int32 i, j, k, n, flag;
- const char *constant_name;
- debug_location_beginning beginning_debug_location;
-
- switch(token_value)
- {
-
- /* --------------------------------------------------------------------- */
- /* Abbreviate "string1" ["string2" ...] */
- /* --------------------------------------------------------------------- */
-
- case ABBREVIATE_CODE:
-
- do
- { get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- return FALSE;
-
- /* Z-code has a 64-abbrev limit; Glulx doesn't. */
- if (!glulx_mode && no_abbreviations==64)
- { error("All 64 abbreviations already declared");
- panic_mode_error_recovery(); return FALSE;
- }
- if (no_abbreviations==MAX_ABBREVS)
- memoryerror("MAX_ABBREVS", MAX_ABBREVS);
-
- if (abbrevs_lookup_table_made)
- { error("All abbreviations must be declared together");
- panic_mode_error_recovery(); return FALSE;
- }
- if (token_type != DQ_TT)
- return ebf_error_recover("abbreviation string", token_text);
- if (strlen(token_text)<2)
- { error_named("It's not worth abbreviating", token_text);
- continue;
- }
- /* Abbreviation string with null must fit in a MAX_ABBREV_LENGTH
- array. */
- if (strlen(token_text)>=MAX_ABBREV_LENGTH)
- { error_named("Abbreviation too long", token_text);
- continue;
- }
- make_abbreviation(token_text);
- } while (TRUE);
-
- /* --------------------------------------------------------------------- */
- /* Array arrayname array... */
- /* --------------------------------------------------------------------- */
-
- case ARRAY_CODE: make_global(TRUE, FALSE); break; /* See "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* Attribute newname [alias oldname] */
- /* --------------------------------------------------------------------- */
-
- case ATTRIBUTE_CODE:
- make_attribute(); break; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Class classname ... */
- /* --------------------------------------------------------------------- */
-
- case CLASS_CODE:
- if (internal_flag)
- { error("Cannot nest #Class inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
- make_class(NULL); /* See "objects.c" */
- return FALSE;
-
- /* --------------------------------------------------------------------- */
- /* Constant newname [[=] value] [, ...] */
- /* --------------------------------------------------------------------- */
-
- case CONSTANT_CODE:
- constant_made_yet=TRUE;
-
- ParseConstantSpec:
- get_next_token(); i = token_value;
- beginning_debug_location = get_token_location_beginning();
-
- if ((token_type != SYMBOL_TT)
- || (!(sflags[i] & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))))
- { discard_token_location(beginning_debug_location);
- return ebf_error_recover("new constant name", token_text);
- }
-
- assign_symbol(i, 0, CONSTANT_T);
- constant_name = token_text;
-
- get_next_token();
-
- if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
- { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
- { debug_file_printf("<constant>");
- debug_file_printf("<identifier>%s</identifier>", constant_name);
- write_debug_symbol_optional_backpatch(i);
- write_debug_locations(get_token_location_end(beginning_debug_location));
- debug_file_printf("</constant>");
- }
- goto ParseConstantSpec;
- }
-
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
- { debug_file_printf("<constant>");
- debug_file_printf("<identifier>%s</identifier>", constant_name);
- write_debug_symbol_optional_backpatch(i);
- write_debug_locations(get_token_location_end(beginning_debug_location));
- debug_file_printf("</constant>");
- }
- return FALSE;
- }
-
- if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
- put_token_back();
-
- { assembly_operand AO = parse_expression(CONSTANT_CONTEXT);
- if (AO.marker != 0)
- { assign_marked_symbol(i, AO.marker, AO.value,
- CONSTANT_T);
- sflags[i] |= CHANGE_SFLAG;
- if (i == grammar_version_symbol)
- error(
- "Grammar__Version must be given an explicit constant value");
- }
- else
- { assign_symbol(i, AO.value, CONSTANT_T);
- if (i == grammar_version_symbol)
- { if ((grammar_version_number != AO.value)
- && (no_fake_actions > 0))
- error(
- "Once a fake action has been defined it is too late to \
-change the grammar version. (If you are using the library, move any \
-Fake_Action directives to a point after the inclusion of \"Parser\".)");
- grammar_version_number = AO.value;
- }
- }
- }
-
- if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
- { debug_file_printf("<constant>");
- debug_file_printf("<identifier>%s</identifier>", constant_name);
- write_debug_symbol_optional_backpatch(i);
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</constant>");
- }
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
- goto ParseConstantSpec;
- put_token_back();
- break;
-
- /* --------------------------------------------------------------------- */
- /* Default constantname integer */
- /* --------------------------------------------------------------------- */
-
- case DEFAULT_CODE:
- if (module_switch)
- { error("'Default' cannot be used in -M (Module) mode");
- panic_mode_error_recovery(); return FALSE;
- }
-
- get_next_token();
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("name", token_text);
-
- i = -1;
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { i = token_value;
- sflags[i] |= DEFCON_SFLAG;
- }
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
- put_token_back();
-
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (i != -1)
- { if (AO.marker != 0)
- { assign_marked_symbol(i, AO.marker, AO.value,
- CONSTANT_T);
- sflags[i] |= CHANGE_SFLAG;
- }
- else assign_symbol(i, AO.value, CONSTANT_T);
- }
- }
-
- break;
-
- /* --------------------------------------------------------------------- */
- /* Dictionary 'word' */
- /* Dictionary 'word' val1 */
- /* Dictionary 'word' val1 val3 */
- /* --------------------------------------------------------------------- */
-
- case DICTIONARY_CODE:
- /* In Inform 5, this directive had the form
- Dictionary SYMBOL "word";
- This was deprecated as of I6 (if not earlier), and is no longer
- supported at all. The current form just creates a dictionary word,
- with the given values for dict_par1 and dict_par3. If the word
- already exists, the values are bit-or'd in with the existing
- values.
- (We don't offer a way to set dict_par2, because that is entirely
- reserved for the verb number. Or'ing values into it would create
- garbage.)
- */
- get_next_token();
- if (token_type != SQ_TT && token_type != DQ_TT)
- return ebf_error_recover("dictionary word", token_text);
-
- {
- char *wd = token_text;
- int val1 = 0;
- int val3 = 0;
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
- put_token_back();
- }
- else {
- assembly_operand AO;
- put_token_back();
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as a Dictionary flag");
- else
- val1 = AO.value;
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
- put_token_back();
- }
- else {
- assembly_operand AO;
- put_token_back();
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as a Dictionary flag");
- else
- val3 = AO.value;
- }
- }
-
- if (!glulx_mode) {
- if ((val1 & ~0xFF) || (val3 & ~0xFF)) {
- warning("Dictionary flag values cannot exceed $FF in Z-code");
- }
- }
- else {
- if ((val1 & ~0xFFFF) || (val3 & ~0xFFFF)) {
- warning("Dictionary flag values cannot exceed $FFFF in Glulx");
- }
- }
-
- dictionary_add(wd, val1, 0, val3);
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* End */
- /* --------------------------------------------------------------------- */
-
- case END_CODE: return(TRUE);
-
- case ENDIF_CODE:
- if (ifdef_sp == 0) error("'Endif' without matching 'If...'");
- else ifdef_sp--;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Extend ... */
- /* --------------------------------------------------------------------- */
-
- case EXTEND_CODE: extend_verb(); return FALSE; /* see "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* Fake_Action name */
- /* --------------------------------------------------------------------- */
-
- case FAKE_ACTION_CODE:
- make_fake_action(); break; /* see "verbs.c" */
-
- /* --------------------------------------------------------------------- */
- /* Global variable [= value / array...] */
- /* --------------------------------------------------------------------- */
-
- case GLOBAL_CODE: make_global(FALSE, FALSE); break; /* See "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* If... */
- /* */
- /* Note that each time Inform tests an If... condition, it stacks the */
- /* result (TRUE or FALSE) on ifdef_stack: thus, the top of this stack */
- /* reveals what clause of the current If... is being compiled: */
- /* */
- /* If...; ... Ifnot; ... Endif; */
- /* top of stack: TRUE FALSE */
- /* */
- /* This is used to detect "two Ifnots in same If" errors. */
- /* --------------------------------------------------------------------- */
-
- case IFDEF_CODE:
- flag = TRUE;
- goto DefCondition;
- case IFNDEF_CODE:
- flag = FALSE;
-
- DefCondition:
- get_next_token();
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("symbol name", token_text);
-
- if ((token_text[0] == 'V')
- && (token_text[1] == 'N')
- && (token_text[2] == '_')
- && (strlen(token_text)==7))
- { i = atoi(token_text+3);
- if (VNUMBER < i) flag = (flag)?FALSE:TRUE;
- goto HashIfCondition;
- }
-
- if (sflags[token_value] & UNKNOWN_SFLAG) flag = (flag)?FALSE:TRUE;
- else sflags[token_value] |= USED_SFLAG;
- goto HashIfCondition;
-
- case IFNOT_CODE:
- if (ifdef_sp == 0)
- error("'Ifnot' without matching 'If...'");
- else
- if (!(ifdef_stack[ifdef_sp-1]))
- error("Second 'Ifnot' for the same 'If...' condition");
- else
- { dont_enter_into_symbol_table = -2; n = 1;
- directives.enabled = TRUE;
- do
- { get_next_token();
- if (token_type == EOF_TT)
- { error("End of file reached in code 'If...'d out");
- directives.enabled = FALSE;
- return TRUE;
- }
- if (token_type == DIRECTIVE_TT)
- { switch(token_value)
- { case ENDIF_CODE:
- n--; break;
- case IFV3_CODE:
- case IFV5_CODE:
- case IFDEF_CODE:
- case IFNDEF_CODE:
- case IFTRUE_CODE:
- case IFFALSE_CODE:
- n++; break;
- case IFNOT_CODE:
- if (n == 1)
- { error(
- "Second 'Ifnot' for the same 'If...' condition");
- break;
- }
- }
- }
- } while (n > 0);
- ifdef_sp--;
- dont_enter_into_symbol_table = FALSE;
- directives.enabled = FALSE;
- }
- break;
-
- case IFV3_CODE:
- flag = FALSE; if (version_number == 3) flag = TRUE;
- goto HashIfCondition;
-
- case IFV5_CODE:
- flag = TRUE; if (version_number == 3) flag = FALSE;
- goto HashIfCondition;
-
- case IFTRUE_CODE:
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- { error("This condition can't be determined");
- flag = 0;
- }
- else flag = (AO.value != 0);
- }
- goto HashIfCondition;
-
- case IFFALSE_CODE:
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- { error("This condition can't be determined");
- flag = 1;
- }
- else flag = (AO.value == 0);
- }
- goto HashIfCondition;
-
- HashIfCondition:
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- return ebf_error_recover("semicolon after 'If...' condition", token_text);
-
- if (flag)
- { ifdef_stack[ifdef_sp++] = TRUE; return FALSE; }
- else
- { dont_enter_into_symbol_table = -2; n = 1;
- directives.enabled = TRUE;
- do
- { get_next_token();
- if (token_type == EOF_TT)
- { error("End of file reached in code 'If...'d out");
- directives.enabled = FALSE;
- return TRUE;
- }
- if (token_type == DIRECTIVE_TT)
- {
- switch(token_value)
- { case ENDIF_CODE:
- n--; break;
- case IFV3_CODE:
- case IFV5_CODE:
- case IFDEF_CODE:
- case IFNDEF_CODE:
- case IFTRUE_CODE:
- case IFFALSE_CODE:
- n++; break;
- case IFNOT_CODE:
- if (n == 1)
- { ifdef_stack[ifdef_sp++] = FALSE;
- n--; break;
- }
- }
- }
- } while (n > 0);
- directives.enabled = FALSE;
- dont_enter_into_symbol_table = FALSE;
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Import global <varname> [, ...] */
- /* */
- /* (Further imported goods may be allowed later.) */
- /* --------------------------------------------------------------------- */
-
- case IMPORT_CODE:
- if (!module_switch)
- { error("'Import' can only be used in -M (Module) mode");
- panic_mode_error_recovery(); return FALSE;
- }
- directives.enabled = TRUE;
- do
- { get_next_token();
- if ((token_type == DIRECTIVE_TT) && (token_value == GLOBAL_CODE))
- make_global(FALSE, TRUE);
- else error_named("'Import' cannot import things of this type:",
- token_text);
- get_next_token();
- } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
- put_token_back();
- directives.enabled = FALSE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Include "[>]filename" */
- /* */
- /* The ">" character means to load the file from the same directory as */
- /* the current file, instead of relying on the include path. */
- /* --------------------------------------------------------------------- */
-
- case INCLUDE_CODE:
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("filename in double-quotes", token_text);
-
- { char *name = token_text;
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- ebf_error("semicolon ';' after Include filename", token_text);
-
- if (strcmp(name, "language__") == 0)
- load_sourcefile(Language_Name, 0);
- else if (name[0] == '>')
- load_sourcefile(name+1, 1);
- else load_sourcefile(name, 0);
- return FALSE;
- }
-
- /* --------------------------------------------------------------------- */
- /* Link "filename" */
- /* --------------------------------------------------------------------- */
-
- case LINK_CODE:
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("filename in double-quotes", token_text);
- link_module(token_text); /* See "linker.c" */
- break;
-
- /* --------------------------------------------------------------------- */
- /* Lowstring constantname "text of string" */
- /* --------------------------------------------------------------------- */
- /* Unlike most constant creations, these do not require backpatching: */
- /* the low strings always occupy a table at a fixed offset in the */
- /* Z-machine (after the abbreviations table has finished, at 0x100). */
- /* --------------------------------------------------------------------- */
-
- case LOWSTRING_CODE:
- if (module_switch)
- { error("'LowString' cannot be used in -M (Module) mode");
- panic_mode_error_recovery(); return FALSE;
- }
- get_next_token(); i = token_value;
- if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
- return ebf_error_recover("new low string name", token_text);
-
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("literal string in double-quotes", token_text);
-
- assign_symbol(i, compile_string(token_text, TRUE, TRUE), CONSTANT_T);
- break;
-
- /* --------------------------------------------------------------------- */
- /* Message | "information" */
- /* | error "error message" */
- /* | fatalerror "fatal error message" */
- /* | warning "warning message" */
- /* --------------------------------------------------------------------- */
-
- case MESSAGE_CODE:
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
- if (token_type == DQ_TT)
- { int i;
- if (hash_printed_since_newline) printf("\n");
- for (i=0; token_text[i]!=0; i++)
- { if (token_text[i] == '^') printf("\n");
- else
- if (token_text[i] == '~') printf("\"");
- else printf("%c", token_text[i]);
- }
- printf("\n");
- break;
- }
- if ((token_type == DIR_KEYWORD_TT) && (token_value == ERROR_DK))
- { get_next_token();
- if (token_type != DQ_TT)
- { return ebf_error_recover("error message in double-quotes", token_text);
- }
- error(token_text); break;
- }
- if ((token_type == DIR_KEYWORD_TT) && (token_value == FATALERROR_DK))
- { get_next_token();
- if (token_type != DQ_TT)
- { return ebf_error_recover("fatal error message in double-quotes", token_text);
- }
- fatalerror(token_text); break;
- }
- if ((token_type == DIR_KEYWORD_TT) && (token_value == WARNING_DK))
- { get_next_token();
- if (token_type != DQ_TT)
- { return ebf_error_recover("warning message in double-quotes", token_text);
- }
- warning(token_text); break;
- }
- return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'",
- token_text);
- break;
-
- /* --------------------------------------------------------------------- */
- /* Nearby objname "short name" ... */
- /* --------------------------------------------------------------------- */
-
- case NEARBY_CODE:
- if (internal_flag)
- { error("Cannot nest #Nearby inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
- make_object(TRUE, NULL, -1, -1, -1);
- return FALSE; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Object objname "short name" ... */
- /* --------------------------------------------------------------------- */
-
- case OBJECT_CODE:
- if (internal_flag)
- { error("Cannot nest #Object inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
- make_object(FALSE, NULL, -1, -1, -1);
- return FALSE; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Origsource <file> */
- /* Origsource <file> <line> */
- /* Origsource <file> <line> <char> */
- /* Origsource */
- /* */
- /* The first three forms declare that all following lines are derived */
- /* from the named Inform 7 source file (with an optional line number */
- /* and character number). This will be reported in error messages and */
- /* in debug output. The declaration holds through the next Origsource */
- /* directive (but does not apply to included files). */
- /* */
- /* The fourth form, with no arguments, clears the declaration. */
- /* */
- /* Unlike the Include directive, Origsource does not open the named */
- /* file or even verify that it exists. The filename is treated as an */
- /* opaque string. */
- /* --------------------------------------------------------------------- */
-
- case ORIGSOURCE_CODE:
- {
- char *origsource_file = NULL;
- int32 origsource_line = 0;
- int32 origsource_char = 0;
-
- /* Parse some optional tokens followed by a mandatory semicolon. */
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
- if (token_type != DQ_TT) {
- return ebf_error_recover("a file name in double-quotes",
- token_text);
- }
- origsource_file = token_text;
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
- if (token_type != NUMBER_TT) {
- return ebf_error_recover("a file line number",
- token_text);
- }
- origsource_line = token_value;
- if (origsource_line < 0)
- origsource_line = 0;
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
- if (token_type != NUMBER_TT) {
- return ebf_error_recover("a file line number",
- token_text);
- }
- origsource_char = token_value;
- if (origsource_char < 0)
- origsource_char = 0;
-
- get_next_token();
- }
- }
- }
-
- put_token_back();
-
- set_origsource_location(origsource_file, origsource_line, origsource_char);
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Property [long] [additive] name [alias oldname] */
- /* --------------------------------------------------------------------- */
-
- case PROPERTY_CODE: make_property(); break; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Release <number> */
- /* --------------------------------------------------------------------- */
-
- case RELEASE_CODE:
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as release number");
- else
- release_number = AO.value;
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Replace routine [routinename] */
- /* --------------------------------------------------------------------- */
-
- case REPLACE_CODE:
- /* You can also replace system functions normally implemented in */
- /* the "hardware" of the Z-machine, like "random()": */
-
- system_functions.enabled = TRUE;
- directives.enabled = FALSE;
- directive_keywords.enabled = FALSE;
-
- /* Don't count the upcoming symbol as a top-level reference
- *to* the function. */
- df_dont_note_global_symbols = TRUE;
- get_next_token();
- df_dont_note_global_symbols = FALSE;
- if (token_type == SYSFUN_TT)
- { if (system_function_usage[token_value] == 1)
- error("You can't 'Replace' a system function already used");
- else system_function_usage[token_value] = 2;
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- {
- error("You can't give a 'Replace'd system function a new name");
- panic_mode_error_recovery(); return FALSE;
- }
- return FALSE;
- }
-
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("name of routine to replace", token_text);
- if (!(sflags[token_value] & UNKNOWN_SFLAG))
- return ebf_error_recover("name of routine not yet defined", token_text);
-
- sflags[token_value] |= REPLACE_SFLAG;
-
- /* If a second symbol is provided, it will refer to the
- original (replaced) definition of the routine. */
- i = token_value;
-
- system_functions.enabled = FALSE;
- df_dont_note_global_symbols = TRUE;
- get_next_token();
- df_dont_note_global_symbols = FALSE;
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { return FALSE;
- }
-
- if (token_type != SYMBOL_TT || !(sflags[token_value] & UNKNOWN_SFLAG))
- return ebf_error_recover("semicolon ';' or new routine name", token_text);
-
- /* Define the original-form symbol as a zero constant. Its
- value will be overwritten later, when we define the
- replacement. */
- assign_symbol(token_value, 0, CONSTANT_T);
- add_symbol_replacement_mapping(i, token_value);
-
- break;
-
- /* --------------------------------------------------------------------- */
- /* Serial "yymmdd" */
- /* --------------------------------------------------------------------- */
-
- case SERIAL_CODE:
- get_next_token();
- if ((token_type != DQ_TT) || (strlen(token_text)!=6))
- { error("The serial number must be a 6-digit date in double-quotes");
- panic_mode_error_recovery(); return FALSE;
- }
- for (i=0; i<6; i++) if (isdigit(token_text[i])==0)
- { error("The serial number must be a 6-digit date in double-quotes");
- panic_mode_error_recovery(); return FALSE;
- }
- strcpy(serial_code_buffer, token_text);
- serial_code_given_in_program = TRUE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Statusline score/time */
- /* --------------------------------------------------------------------- */
-
- case STATUSLINE_CODE:
- if (module_switch)
- warning("This does not set the final game's statusline");
-
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
- if ((token_type != DIR_KEYWORD_TT)
- || ((token_value != SCORE_DK) && (token_value != TIME_DK)))
- return ebf_error_recover("'score' or 'time' after 'statusline'", token_text);
- if (token_value == SCORE_DK) statusline_flag = SCORE_STYLE;
- else statusline_flag = TIME_STYLE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Stub routinename number-of-locals */
- /* --------------------------------------------------------------------- */
-
- case STUB_CODE:
- if (internal_flag)
- { error("Cannot nest #Stub inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
-
- /* The upcoming symbol is a definition; don't count it as a
- top-level reference *to* the stub function. */
- df_dont_note_global_symbols = TRUE;
- get_next_token();
- df_dont_note_global_symbols = FALSE;
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("routine name to stub", token_text);
-
- i = token_value; flag = FALSE;
-
- if (sflags[i] & UNKNOWN_SFLAG)
- { sflags[i] |= STUB_SFLAG;
- flag = TRUE;
- }
-
- get_next_token(); k = token_value;
- if (token_type != NUMBER_TT)
- return ebf_error_recover("number of local variables", token_text);
- if ((k>4) || (k<0))
- { error("Must specify 0 to 4 local variables for 'Stub' routine");
- k = 0;
- }
-
- if (flag)
- {
- /* Give these parameter-receiving local variables names
- for the benefit of the debugging information file,
- and for assembly tracing to look sensible. */
-
- local_variable_texts[0] = "dummy1";
- local_variable_texts[1] = "dummy2";
- local_variable_texts[2] = "dummy3";
- local_variable_texts[3] = "dummy4";
-
- assign_symbol(i,
- assemble_routine_header(k, FALSE, (char *) symbs[i], FALSE, i),
- ROUTINE_T);
-
- /* Ensure the return value of a stubbed routine is false,
- since this is necessary to make the library work properly */
-
- if (!glulx_mode)
- assemblez_0(rfalse_zc);
- else
- assembleg_1(return_gc, zero_operand);
-
- /* Inhibit "local variable unused" warnings */
-
- for (i=1; i<=k; i++) variable_usage[i] = 1;
- sequence_point_follows = FALSE;
- assemble_routine_end(FALSE, get_token_locations());
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Switches switchblock */
- /* (this directive is ignored if the -i switch was set at command line) */
- /* --------------------------------------------------------------------- */
-
- case SWITCHES_CODE:
- dont_enter_into_symbol_table = TRUE;
- get_next_token();
- dont_enter_into_symbol_table = FALSE;
- if (token_type != DQ_TT)
- return ebf_error_recover("string of switches", token_text);
- if (!ignore_switches_switch)
- { if (constant_made_yet)
- error("A 'Switches' directive must must come before \
-the first constant definition");
- switches(token_text, 0); /* see "inform.c" */
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* System_file */
- /* */
- /* Some files are declared as "system files": this information is used */
- /* by Inform only to skip the definition of a routine X if the designer */
- /* has indicated his intention to Replace X. */
- /* --------------------------------------------------------------------- */
-
- case SYSTEM_CODE:
- declare_systemfile(); break; /* see "files.c" */
-
- /* --------------------------------------------------------------------- */
- /* Trace dictionary */
- /* objects */
- /* symbols */
- /* verbs */
- /* [on/off] */
- /* assembly [on/off] */
- /* expressions [on/off] */
- /* lines [on/off] */
- /* --------------------------------------------------------------------- */
-
- case TRACE_CODE:
- directives.enabled = FALSE;
- trace_keywords.enabled = TRUE;
- get_next_token();
- trace_keywords.enabled = FALSE;
- directives.enabled = TRUE;
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { asm_trace_level = 1; return FALSE; }
-
- if (token_type != TRACE_KEYWORD_TT)
- return ebf_error_recover("debugging keyword", token_text);
-
- trace_keywords.enabled = TRUE;
-
- i = token_value; j = 0;
- switch(i)
- { case DICTIONARY_TK: break;
- case OBJECTS_TK: break;
- case VERBS_TK: break;
- default:
- switch(token_value)
- { case ASSEMBLY_TK:
- trace_level = &asm_trace_level; break;
- case EXPRESSIONS_TK:
- trace_level = &expr_trace_level; break;
- case LINES_TK:
- trace_level = &line_trace_level; break;
- case TOKENS_TK:
- trace_level = &tokens_trace_level; break;
- case LINKER_TK:
- trace_level = &linker_trace_level; break;
- case SYMBOLS_TK:
- trace_level = NULL; break;
- default:
- put_token_back();
- trace_level = &asm_trace_level; break;
- }
- j = 1;
- get_next_token();
- if ((token_type == SEP_TT) &&
- (token_value == SEMICOLON_SEP))
- { put_token_back(); break;
- }
- if (token_type == NUMBER_TT)
- { j = token_value; break; }
- if ((token_type == TRACE_KEYWORD_TT) && (token_value == ON_TK))
- { j = 1; break; }
- if ((token_type == TRACE_KEYWORD_TT) && (token_value == OFF_TK))
- { j = 0; break; }
- put_token_back(); break;
- }
-
- switch(i)
- { case DICTIONARY_TK: show_dictionary(); break;
- case OBJECTS_TK: list_object_tree(); break;
- case SYMBOLS_TK: list_symbols(j); break;
- case VERBS_TK: list_verb_table(); break;
- default:
- *trace_level = j;
- break;
- }
- trace_keywords.enabled = FALSE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Undef symbol */
- /* --------------------------------------------------------------------- */
-
- case UNDEF_CODE:
- get_next_token();
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("symbol name", token_text);
-
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { break; /* undef'ing an undefined constant is okay */
- }
-
- if (stypes[token_value] != CONSTANT_T)
- { error_named("Cannot Undef a symbol which is not a defined constant:", (char *)symbs[token_value]);
- break;
- }
-
- if (debugfile_switch)
- { write_debug_undef(token_value);
- }
- end_symbol_scope(token_value);
- sflags[token_value] |= USED_SFLAG;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Verb ... */
- /* --------------------------------------------------------------------- */
-
- case VERB_CODE: make_verb(); return FALSE; /* see "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* Version <number> */
- /* --------------------------------------------------------------------- */
-
- case VERSION_CODE:
-
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- /* If a version has already been set on the command line,
- that overrides this. */
- if (version_set_switch)
- {
- warning("The Version directive was overridden by a command-line argument.");
- break;
- }
-
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as version number");
- else
- if (glulx_mode)
- {
- warning("The Version directive does not work in Glulx. Use \
--vX.Y.Z instead, as either a command-line argument or a header comment.");
- break;
- }
- else
- { i = AO.value;
- if ((i<3) || (i>8))
- { error("The version number must be in the range 3 to 8");
- break;
- }
- select_version(i);
- }
- }
- break; /* see "inform.c" */
-
- /* --------------------------------------------------------------------- */
- /* Zcharacter table <num> ... */
- /* Zcharacter table + <num> ... */
- /* Zcharacter <string> <string> <string> */
- /* Zcharacter <char> */
- /* --------------------------------------------------------------------- */
-
- case ZCHARACTER_CODE:
-
- if (glulx_mode) {
- error("The Zcharacter directive has no meaning in Glulx.");
- panic_mode_error_recovery(); return FALSE;
- }
-
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
-
- switch(token_type)
- { case DQ_TT:
- new_alphabet(token_text, 0);
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("double-quoted alphabet string", token_text);
- new_alphabet(token_text, 1);
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("double-quoted alphabet string", token_text);
- new_alphabet(token_text, 2);
- break;
-
- case SQ_TT:
- map_new_zchar(text_to_unicode(token_text));
- if (token_text[textual_form_length] != 0)
- return ebf_error_recover("single character value", token_text);
- break;
-
- case DIR_KEYWORD_TT:
- switch(token_value)
- { case TABLE_DK:
- { int plus_flag = FALSE;
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == PLUS_SEP))
- { plus_flag = TRUE;
- get_next_token();
- }
- while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
- { switch(token_type)
- { case NUMBER_TT:
- new_zscii_character(token_value, plus_flag);
- plus_flag = TRUE; break;
- case SQ_TT:
- new_zscii_character(text_to_unicode(token_text),
- plus_flag);
- if (token_text[textual_form_length] != 0)
- return ebf_error_recover("single character value",
- token_text);
- plus_flag = TRUE;
- break;
- default:
- return ebf_error_recover("character or Unicode number",
- token_text);
- }
- get_next_token();
- }
- if (plus_flag) new_zscii_finished();
- put_token_back();
- }
- break;
- case TERMINATING_DK:
- get_next_token();
- while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
- { switch(token_type)
- { case NUMBER_TT:
- terminating_characters[no_termcs++]
- = token_value;
- break;
- default:
- return ebf_error_recover("ZSCII number",
- token_text);
- }
- get_next_token();
- }
- put_token_back();
- break;
- default:
- return ebf_error_recover("'table', 'terminating', \
-a string or a constant",
- token_text);
- }
- break;
- default:
- return ebf_error_recover("three alphabet strings, \
-a 'table' or 'terminating' command or a single character", token_text);
- }
- break;
-
- /* ===================================================================== */
-
- }
-
- /* We are now at the end of a syntactically valid directive. It
- should be terminated by a semicolon. */
-
- get_next_token();
- if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- /* Put the non-semicolon back. We will continue parsing from
- that point, in hope that it's the start of a new directive.
- (This recovers cleanly from a missing semicolon at the end
- of a directive. It's not so clean if the directive *does*
- end with a semicolon, but there's extra garbage before it.) */
- put_token_back();
- }
- return FALSE;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_directs_vars(void)
-{
-}
-
-extern void directs_begin_pass(void)
-{ no_routines = 0;
- no_named_routines = 0;
- no_locals = 0;
- no_termcs = 0;
- constant_made_yet = FALSE;
- ifdef_sp = 0;
-}
-
-extern void directs_allocate_arrays(void)
-{
-}
-
-extern void directs_free_arrays(void)
-{
-}
-
-/* ========================================================================= */
projects / inform.git / blobdiff