# You should have received a copy of the GNU General Public License
# along with Inform. If not, see https://gnu.org/licenses/
-AC_INIT([inform], [6.41], [j@jxself.org])
+AC_INIT([inform], [6.42], [j@jxself.org])
AM_INIT_AUTOMAKE([foreign])
AC_OUTPUT(Makefile src/Makefile)
/* likewise global variables, which are in some ways a */
/* simpler form of the same thing. */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
int name_length;
assembly_operand AO;
- int32 globalnum;
+ uint32 globalnum;
int32 global_symbol;
debug_location_beginning beginning_debug_location =
get_token_location_beginning();
if (token_type != SYMBOL_TT)
{ discard_token_location(beginning_debug_location);
- ebf_error("new global variable name", token_text);
+ ebf_curtoken_error("new global variable name");
panic_mode_error_recovery(); return;
}
4*globalnum);
}
- if (globalnum < 0 || globalnum >= global_initial_value_memlist.count)
+ if (globalnum >= global_initial_value_memlist.count)
compiler_error("Globalnum out of range");
global_initial_value[globalnum] = AO.value;
if (token_type != SYMBOL_TT)
{ discard_token_location(beginning_debug_location);
- ebf_error("new array name", token_text);
+ ebf_curtoken_error("new array name");
panic_mode_error_recovery(); return;
}
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
{
discard_token_location(beginning_debug_location);
- ebf_error("array definition", token_text);
+ ebf_curtoken_error("array definition");
put_token_back();
return;
}
array_type = BUFFER_ARRAY;
else
{ discard_token_location(beginning_debug_location);
- ebf_error
- ("'->', '-->', 'string', 'table' or 'buffer'", token_text);
+ ebf_curtoken_error("'->', '-->', 'string', 'table' or 'buffer'");
panic_mode_error_recovery();
return;
}
put_token_back();
AO = parse_expression(ARRAY_CONTEXT);
+ if (AO.marker == ERROR_MV)
+ break;
if (i == 0)
{ get_next_token();
get_next_token();
if (token_type != DQ_TT)
- { ebf_error("literal text in double-quotes", token_text);
+ { ebf_curtoken_error("literal text in double-quotes");
token_text = "error";
}
i = 0;
while (TRUE)
{
+ assembly_operand AO;
/* This isn't the start of a statement, but it's safe to
release token texts anyway. Expressions in an array
list are independent of each other. */
been missed, and the programmer is now starting
a new routine */
- ebf_error("']'", token_text);
+ ebf_curtoken_error("']'");
put_token_back(); break;
}
put_token_back();
- array_entry(i, is_static, parse_expression(ARRAY_CONTEXT));
+ AO = parse_expression(ARRAY_CONTEXT);
+ if (AO.marker == ERROR_MV)
+ break;
+ array_entry(i, is_static, AO);
i++;
}
}
"global variable values");
initialise_memory_list(¤t_array_name,
- sizeof(char), MAX_IDENTIFIER_LENGTH+1, NULL,
+ sizeof(char), 32, NULL,
"array name currently being defined");
}
/* ------------------------------------------------------------------------- */
/* "asm" : The Inform assembler */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
static int routine_symbol; /* The symbol index of the routine currently
being compiled */
static memory_list current_routine_name; /* The name of the routine currently
- being compiled. (This may be longer
- than MAX_IDENTIFIER_LENGTH, e.g. for
- an "obj.prop" property routine.) */
-static int routine_locals; /* The number of local variables used by
- the routine currently being compiled */
+ being compiled. (This may not be a
+ simple symbol, e.g. for an "obj.prop"
+ property routine.) */
static int32 routine_start_pc;
extern char *variable_name(int32 i)
{
if (i==0) return("sp");
- if (i<MAX_LOCAL_VARIABLES) return local_variable_names[i-1].text;
+ if (i<MAX_LOCAL_VARIABLES) return get_local_variable_name(i-1);
if (!glulx_mode) {
if (i==255) return("TEMP1");
/* Opcodes introduced in Z-Machine Specification Standard 1.0 */
/* 116 */ { (uchar *) "print_unicode", 5, 0, -1, 0x0b, 0, 0, 0, EXT },
-/* 117 */ { (uchar *) "check_unicode", 5, 0, -1, 0x0c, St, 0, 0, EXT }
+/* 117 */ { (uchar *) "check_unicode", 5, 0, -1, 0x0c, St, 0, 0, EXT },
+
+ /* Opcodes introduced in Z-Machine Specification Standard 1.1 */
+
+/* 118 */ { (uchar *) "set_true_colour", 5, 0, -1, 0x0d, 0, 0, 0, EXT },
+/* 119 */ { (uchar *) "buffer_screen", 6, 6, -1, 0x1d, St, 0, 0, EXT }
};
/* Subsequent forms for opcodes whose meaning changes with version */
static void make_opcode_syntax_z(opcodez opco)
{ char *p = "", *q = opcode_syntax_string;
+ /* TODO: opcode_syntax_string[128] is unsafe */
sprintf(q, "%s", opco.name);
switch(opco.no)
{ case ONE: p=" <operand>"; break;
int ix;
char *cx;
char *q = opcode_syntax_string;
+ /* TODO: opcode_syntax_string[128] is unsafe */
sprintf(q, "%s", opco.name);
sprintf(q+strlen(q), " <%d operand%s", opco.no,
{ for (j=0;start_pc<zcode_ha_size;
j++, start_pc++)
{ if (j%16==0) printf("\n ");
+ if (zcode_markers[start_pc] & 0x7f)
+ printf("{%s}", describe_mv_short(zcode_markers[start_pc] & 0x7f));
printf("%02x ", zcode_holding_area[start_pc]);
}
}
AMO_1 = AI->operand[1];
AMO_2 = AI->operand[2];
if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 0)) {
- // addr is on the stack
+ /* addr is on the stack */
assembleg_store(temp_var3, stack_pointer);
assembleg_3(aload_gc, temp_var3, one_operand, AMO_1);
assembleg_3(aload_gc, temp_var3, zero_operand, AMO_2);
AMO_1 = AI->operand[1];
AMO_2 = AI->operand[2];
if ((AMO_0.type == LOCALVAR_OT) && (AMO_0.value == 0)) {
- // addr is on the stack
+ /* addr is on the stack */
assembleg_store(temp_var3, stack_pointer);
assembleg_3(astore_gc, temp_var3, zero_operand, AMO_1);
assembleg_3(astore_gc, temp_var3, one_operand, AMO_2);
printf("%02x ", zcode_holding_area[start_pc]);
}
else {
- printf("%02x", zcode_holding_area[start_pc]);
if (zcode_markers[start_pc])
- printf("{%02x}", zcode_markers[start_pc]);
+ printf("{%s}", describe_mv_short(zcode_markers[start_pc]));
+ printf("%02x", zcode_holding_area[start_pc]);
printf(" ");
}
}
labels[label].symbol = symbol;
}
-extern int32 assemble_routine_header(int no_locals,
- int routine_asterisked, char *name, int embedded_flag, int the_symbol)
+/* The local variables must already be set up; no_locals indicates
+ how many exist. */
+extern int32 assemble_routine_header(int routine_asterisked, char *name,
+ int embedded_flag, int the_symbol)
{ int i, rv;
int stackargs = FALSE;
int name_length;
execution_never_reaches_here = EXECSTATE_REACHABLE;
- routine_locals = no_locals;
-
ensure_memory_list_available(&variables_memlist, MAX_LOCAL_VARIABLES);
for (i=0; i<MAX_LOCAL_VARIABLES; i++) variables[i].usage = FALSE;
if (no_locals >= 1
- && strcmpcis(local_variable_names[0].text, "_vararg_count")==0) {
- stackargs = TRUE;
+ && strcmpcis(get_local_variable_name(0), "_vararg_count")==0) {
+ stackargs = TRUE;
}
if (veneer_mode) routine_starts_line = blank_brief_location;
if ((routine_asterisked) || (define_INFIX_switch))
{ char fnt[256]; assembly_operand PV, RFA, CON, STP, SLF; int ln, ln2;
-
+ /* TODO: fnt[256] is unsafe */
+
ln = next_label++;
ln2 = next_label++;
debug_file_printf
("<byte-count>%d</byte-count>", zmachine_pc - routine_start_pc);
write_debug_locations(locations);
- for (i = 1; i <= routine_locals; ++i)
+ for (i = 1; i <= no_locals; ++i)
{ debug_file_printf("<local-variable>");
debug_file_printf("<identifier>%s</identifier>", variable_name(i));
if (glulx_mode)
/* Issue warnings about any local variables not used in the routine. */
- for (i=1; i<=routine_locals; i++)
+ for (i=1; i<=no_locals; i++)
if (!(variables[i].usage))
dbnu_warning("Local variable", variable_name(i),
routine_starts_line);
addr = labels[j].offset - offset_of_next + 2;
}
if (addr<-0x2000 || addr>0x1fff)
- fatalerror("Branch out of range: divide the routine up?");
+ error_fmt("Branch out of range: routine \"%s\" is too large", current_routine_name.data);
if (addr<0) addr+=(int32) 0x10000L;
addr=addr&0x3fff;
addr = labels[j].offset - new_pc;
}
if (addr<-0x8000 || addr>0x7fff)
- fatalerror("Jump out of range: divide the routine up?");
+ error_fmt("Jump out of range: routine \"%s\" is too large", current_routine_name.data);
if (addr<0) addr += (int32) 0x10000L;
zcode_holding_area[i] = addr/256;
zcode_holding_area[i+1] = addr%256;
default:
switch(zcode_markers[i] & 0x7f)
{ case NULL_MV: break;
+ case ERROR_MV: break;
case VARIABLE_MV:
case OBJECT_MV:
case ACTION_MV:
switch(zcode_markers[i] & 0x7f) {
case NULL_MV:
break;
+ case ERROR_MV:
+ break;
case ACTION_MV:
case IDENT_MV:
break;
}
static void parse_assembly_z(void)
-{ int n, min, max, indirect_addressed, error_flag = FALSE;
+{ int n, min, max;
+ int indirect_addressed, jumplabel_args;
+ int error_flag = FALSE;
opcodez O;
AI.operand_count = 0;
if (i>0) token_text[i-1] = ':';
if (n==-1)
- { ebf_error("Expected 0OP, 1OP, 2OP, VAR, EXT, VAR_LONG or EXT_LONG",
- token_text);
+ { ebf_curtoken_error("Expected 0OP, 1OP, 2OP, VAR, EXT, VAR_LONG or EXT_LONG");
n = EXT;
}
custom_opcode_z.no = n;
case TWO: max = 32; break;
}
if ((custom_opcode_z.code < min) || (custom_opcode_z.code >= max))
- { char range[32];
- sprintf(range, "%d to %d", min, max-1);
- error_named("For this operand type, opcode number must be in range",
- range);
+ {
+ error_fmt("For this operand type, opcode number must be in range %d to %d",
+ min, max-1);
custom_opcode_z.code = min;
}
}
}
O = custom_opcode_z;
}
+ else if ((token_type == SEP_TT) && (token_value == ARROW_SEP || token_value == DARROW_SEP))
+ {
+ int32 start_pc = zcode_ha_size;
+ int bytecount = 0;
+ int isword = (token_value == DARROW_SEP);
+ while (1) {
+ assembly_operand AO;
+ /* This isn't the start of a statement, but it's safe to
+ release token texts anyway. */
+ release_token_texts();
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
+ put_token_back();
+ AO = parse_expression(ARRAY_CONTEXT);
+ if (AO.marker == ERROR_MV) {
+ break;
+ }
+ if (!isword) {
+ if (AO.marker != 0)
+ error("Entries in code byte arrays must be known constants");
+ if (AO.value >= 256)
+ warning("Entry in code byte array not in range 0 to 255");
+ }
+ if (execution_never_reaches_here) {
+ continue;
+ }
+ if (bytecount == 0 && asm_trace_level > 0) {
+ printf("%5d +%05lx %3s %-12s", ErrorReport.line_number,
+ ((long int) zmachine_pc), " ",
+ isword?"<words>":"<bytes>");
+ }
+ if (!isword) {
+ byteout((AO.value & 0xFF), 0);
+ bytecount++;
+ if (asm_trace_level > 0) {
+ printf(" %02x", (AO.value & 0xFF));
+ }
+ }
+ else {
+ byteout(((AO.value >> 8) & 0xFF), AO.marker);
+ byteout((AO.value & 0xFF), 0);
+ bytecount += 2;
+ if (asm_trace_level > 0) {
+ printf(" ");
+ print_operand(&AO, TRUE);
+ }
+ }
+ }
+ if (bytecount > 0 && asm_trace_level > 0) {
+ printf("\n");
+ }
+ if (asm_trace_level>=2)
+ {
+ int j;
+ for (j=0;start_pc<zcode_ha_size;
+ j++, start_pc++)
+ { if (j%16==0) printf(" ");
+ if (zcode_markers[start_pc] & 0x7f)
+ printf("{%s}", describe_mv_short(zcode_markers[start_pc] & 0x7f));
+ printf("%02x ", zcode_holding_area[start_pc]);
+ }
+ if (j) printf("\n");
+ }
+ return;
+ }
else
{ if (token_type != OPCODE_NAME_TT)
- { ebf_error("an opcode name", token_text);
+ { ebf_curtoken_error("an opcode name");
panic_mode_error_recovery();
return;
}
}
indirect_addressed = (O.op_rules == VARIAB);
+ jumplabel_args = (O.op_rules == LABEL); /* only @jump */
if (O.op_rules == TEXT)
{ get_next_token();
if (token_type != DQ_TT)
- ebf_error("literal text in double-quotes", token_text);
+ ebf_curtoken_error("literal text in double-quotes");
AI.text = token_text;
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
get_next_token();
AI.text = NULL;
return;
}
- ebf_error("semicolon ';' after print string", token_text);
+ ebf_curtoken_error("semicolon ';' after print string");
AI.text = NULL;
put_token_back();
return;
get_next_token();
if ((token_type != SYMBOL_TT)
&& (token_type != LOCAL_VARIABLE_TT))
- ebf_error("variable name or 'sp'", token_text);
+ ebf_curtoken_error("variable name or 'sp'");
n = 255;
if (token_type == LOCAL_VARIABLE_TT) n = token_value;
else
n = parse_label();
}
else
- ebf_error("label name after '?' or '?~'", token_text);
+ ebf_curtoken_error("label name after '?' or '?~'");
}
AI.branch_label_number = n;
continue;
AI.operand[AI.operand_count++] = parse_operand_z();
get_next_token();
if (!((token_type == SEP_TT) && (token_value == CLOSE_SQUARE_SEP)))
- { ebf_error("']'", token_text);
+ { ebf_curtoken_error("']'");
put_token_back();
}
}
+ else if (jumplabel_args)
+ { assembly_operand AO;
+ put_token_back();
+ INITAOTV(&AO, LONG_CONSTANT_OT, parse_label());
+ AI.operand[AI.operand_count++] = AO;
+ }
else
{ put_token_back();
AI.operand[AI.operand_count++] = parse_operand_z();
static void parse_assembly_g(void)
{
- opcodeg O;
- assembly_operand AO;
- int error_flag = FALSE, is_macro = FALSE;
+ opcodeg O;
+ assembly_operand AO;
+ int error_flag = FALSE, is_macro = FALSE;
- AI.operand_count = 0;
- AI.text = NULL;
+ AI.operand_count = 0;
+ AI.text = NULL;
- opcode_names.enabled = TRUE;
- opcode_macros.enabled = TRUE;
- get_next_token();
- opcode_names.enabled = FALSE;
- opcode_macros.enabled = FALSE;
+ opcode_names.enabled = TRUE;
+ opcode_macros.enabled = TRUE;
+ get_next_token();
+ opcode_names.enabled = FALSE;
+ opcode_macros.enabled = FALSE;
- if (token_type == DQ_TT) {
- char *cx;
- int badflags;
+ if (token_type == DQ_TT) {
+ char *cx;
+ int badflags;
- AI.internal_number = -1;
+ AI.internal_number = -1;
- /* The format is @"FlagsCount:Code". Flags (which are optional)
- can include "S" for store, "SS" for two stores, "B" for branch
- format, "R" if execution never continues after the opcode. The
- Count is the number of arguments (currently limited to 0-9),
- and the Code is a decimal integer representing the opcode
- number.
+ /* The format is @"FlagsCount:Code". Flags (which are optional)
+ can include "S" for store, "SS" for two stores, "B" for branch
+ format, "R" if execution never continues after the opcode. The
+ Count is the number of arguments (currently limited to 0-9),
+ and the Code is a decimal integer representing the opcode
+ number.
- So: @"S3:123" for a three-argument opcode (load, load, store)
- whose opcode number is (decimal) 123. Or: @"2:234" for a
- two-argument opcode (load, load) whose number is 234. */
+ So: @"S3:123" for a three-argument opcode (load, load, store)
+ whose opcode number is (decimal) 123. Or: @"2:234" for a
+ two-argument opcode (load, load) whose number is 234. */
- custom_opcode_g.name = (uchar *) token_text;
- custom_opcode_g.flags = 0;
- custom_opcode_g.op_rules = 0;
- custom_opcode_g.no = 0;
+ custom_opcode_g.name = (uchar *) token_text;
+ custom_opcode_g.flags = 0;
+ custom_opcode_g.op_rules = 0;
+ custom_opcode_g.no = 0;
- badflags = FALSE;
+ badflags = FALSE;
- for (cx = token_text; *cx && *cx != ':'; cx++) {
- if (badflags)
- continue;
+ for (cx = token_text; *cx && *cx != ':'; cx++) {
+ if (badflags)
+ continue;
- switch (*cx) {
- case 'S':
- if (custom_opcode_g.flags & St)
- custom_opcode_g.flags |= St2;
- else
- custom_opcode_g.flags |= St;
- break;
- case 'B':
- custom_opcode_g.flags |= Br;
- break;
- case 'R':
- custom_opcode_g.flags |= Rf;
- break;
- default:
- if (isdigit(*cx)) {
- custom_opcode_g.no = (*cx) - '0';
- break;
- }
- badflags = TRUE;
- error("Unknown custom opcode flag: options are B (branch), \
+ switch (*cx) {
+ case 'S':
+ if (custom_opcode_g.flags & St)
+ custom_opcode_g.flags |= St2;
+ else
+ custom_opcode_g.flags |= St;
+ break;
+ case 'B':
+ custom_opcode_g.flags |= Br;
+ break;
+ case 'R':
+ custom_opcode_g.flags |= Rf;
+ break;
+ default:
+ if (isdigit(*cx)) {
+ custom_opcode_g.no = (*cx) - '0';
+ break;
+ }
+ badflags = TRUE;
+ error("Unknown custom opcode flag: options are B (branch), \
S (store), SS (two stores), R (execution never continues)");
- break;
- }
- }
+ break;
+ }
+ }
- if (*cx != ':') {
- error("Custom opcode must have colon");
- }
- else {
- cx++;
- if (!(*cx))
- error("Custom opcode must have colon followed by opcode number");
- else
- custom_opcode_g.code = atoi(cx);
- }
+ if (*cx != ':') {
+ error("Custom opcode must have colon");
+ }
+ else {
+ cx++;
+ if (!(*cx))
+ error("Custom opcode must have colon followed by opcode number");
+ else
+ custom_opcode_g.code = atoi(cx);
+ }
- O = custom_opcode_g;
- }
- else {
- if (token_type != OPCODE_NAME_TT && token_type != OPCODE_MACRO_TT) {
- ebf_error("an opcode name", token_text);
- panic_mode_error_recovery();
- return;
+ O = custom_opcode_g;
}
- AI.internal_number = token_value;
- if (token_type == OPCODE_MACRO_TT) {
- O = internal_number_to_opmacro_g(AI.internal_number);
- is_macro = TRUE;
+ else if ((token_type == SEP_TT) && (token_value == ARROW_SEP || token_value == DARROW_SEP))
+ {
+ int32 start_pc = zcode_ha_size;
+ int bytecount = 0;
+ int isword = (token_value == DARROW_SEP);
+ while (1) {
+ assembly_operand AO;
+ /* This isn't the start of a statement, but it's safe to
+ release token texts anyway. */
+ release_token_texts();
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
+ put_token_back();
+ AO = parse_expression(ARRAY_CONTEXT);
+ if (AO.marker == ERROR_MV) {
+ break;
+ }
+ if (!isword) {
+ if (AO.marker != 0)
+ error("Entries in code byte arrays must be known constants");
+ if (AO.value >= 256)
+ warning("Entry in code byte array not in range 0 to 255");
+ }
+ if (execution_never_reaches_here) {
+ continue;
+ }
+ if (bytecount == 0 && asm_trace_level > 0) {
+ printf("%5d +%05lx %3s %-12s", ErrorReport.line_number,
+ ((long int) zmachine_pc), " ",
+ isword?"<words>":"<bytes>");
+ }
+ if (!isword) {
+ byteout((AO.value & 0xFF), 0);
+ bytecount++;
+ if (asm_trace_level > 0) {
+ printf(" %02x", (AO.value & 0xFF));
+ }
+ }
+ else {
+ byteout(((AO.value >> 24) & 0xFF), AO.marker);
+ byteout(((AO.value >> 16) & 0xFF), 0);
+ byteout(((AO.value >> 8) & 0xFF), 0);
+ byteout((AO.value & 0xFF), 0);
+ bytecount += 4;
+ if (asm_trace_level > 0) {
+ printf(" ");
+ print_operand(&AO, TRUE);
+ }
+ }
+ }
+ if (bytecount > 0 && asm_trace_level > 0) {
+ printf("\n");
+ }
+ if (asm_trace_level>=2)
+ {
+ int j;
+ for (j=0;start_pc<zcode_ha_size;
+ j++, start_pc++)
+ { if (j%16==0) printf(" ");
+ if (zcode_markers[start_pc])
+ printf("{%s}", describe_mv_short(zcode_markers[start_pc]));
+ printf("%02x ", zcode_holding_area[start_pc]);
+ }
+ if (j) printf("\n");
+ }
+ return;
+ }
+ else {
+ if (token_type != OPCODE_NAME_TT && token_type != OPCODE_MACRO_TT) {
+ ebf_curtoken_error("an opcode name");
+ panic_mode_error_recovery();
+ return;
+ }
+ AI.internal_number = token_value;
+ if (token_type == OPCODE_MACRO_TT) {
+ O = internal_number_to_opmacro_g(AI.internal_number);
+ is_macro = TRUE;
+ }
+ else
+ O = internal_number_to_opcode_g(AI.internal_number);
}
- else
- O = internal_number_to_opcode_g(AI.internal_number);
- }
- return_sp_as_variable = TRUE;
+ return_sp_as_variable = TRUE;
- while (1) {
- get_next_token();
+ while (1) {
+ get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- break;
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ break;
- if (AI.operand_count == 8) {
- error("No assembly instruction may have more than 8 operands");
- panic_mode_error_recovery();
- break;
- }
+ if (AI.operand_count == 8) {
+ error("No assembly instruction may have more than 8 operands");
+ panic_mode_error_recovery();
+ break;
+ }
- if ((O.flags & Br) && (AI.operand_count == O.no-1)) {
- if (!((token_type == SEP_TT) && (token_value == BRANCH_SEP))) {
- error_flag = TRUE;
- error("Branch opcode must have '?' label");
- put_token_back();
- }
- AO.type = CONSTANT_OT;
- AO.value = parse_label();
- AO.marker = BRANCH_MV;
- }
- else {
- put_token_back();
- AO = parse_operand_g();
- }
+ if ((O.flags & Br) && (AI.operand_count == O.no-1)) {
+ if (!((token_type == SEP_TT) && (token_value == BRANCH_SEP))) {
+ error_flag = TRUE;
+ error("Branch opcode must have '?' label");
+ put_token_back();
+ }
+ AO.type = CONSTANT_OT;
+ AO.value = parse_label();
+ AO.marker = BRANCH_MV;
+ }
+ else {
+ put_token_back();
+ AO = parse_operand_g();
+ }
- AI.operand[AI.operand_count] = AO;
- AI.operand_count++;
- }
+ AI.operand[AI.operand_count] = AO;
+ AI.operand_count++;
+ }
- return_sp_as_variable = FALSE;
+ return_sp_as_variable = FALSE;
- if (O.no != AI.operand_count) {
- error_flag = TRUE;
- }
+ if (O.no != AI.operand_count) {
+ error_flag = TRUE;
+ }
- if (!error_flag) {
- if (is_macro)
- assembleg_macro(&AI);
- else
- assembleg_instruction(&AI);
- }
+ if (!error_flag) {
+ if (is_macro)
+ assembleg_macro(&AI);
+ else
+ assembleg_instruction(&AI);
+ }
- if (error_flag) {
- make_opcode_syntax_g(O);
- error_named("Assembly mistake: syntax is",
- opcode_syntax_string);
- }
+ if (error_flag) {
+ make_opcode_syntax_g(O);
+ error_named("Assembly mistake: syntax is",
+ opcode_syntax_string);
+ }
}
extern void parse_assembly(void)
"code area");
initialise_memory_list(¤t_routine_name,
- sizeof(char), 3*MAX_IDENTIFIER_LENGTH, NULL,
+ sizeof(char), 64, NULL,
"routine name currently being defined");
}
/* "bpatch" : Keeps track of, and finally acts on, backpatch markers, */
/* correcting symbol values not known at compilation time */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
case IROUTINE_MV: return("routine");
case VROUTINE_MV: return("veneer routine");
case ARRAY_MV: return("internal array");
+ case STATIC_ARRAY_MV: return("internal static array");
case NO_OBJS_MV: return("the number of objects");
case INHERIT_MV: return("inherited common p value");
case INDIVPT_MV: return("indiv prop table address");
case ACTION_MV: return("action");
case OBJECT_MV: return("internal object");
+ /* Only occurs secondary to another reported error */
+ case ERROR_MV: return("error");
+
}
return("** No such MV **");
}
+extern char *describe_mv_short(int mval)
+{ switch(mval)
+ { case NULL_MV: return("");
+
+ /* Marker values used in ordinary story file backpatching */
+
+ case DWORD_MV: return("dict");
+ case STRING_MV: return("str");
+ case INCON_MV: return("syscon");
+ case IROUTINE_MV: return("rtn");
+ case VROUTINE_MV: return("vrtn");
+ case ARRAY_MV: return("arr");
+ case STATIC_ARRAY_MV: return("stat-arr");
+ case NO_OBJS_MV: return("obj-count");
+ case INHERIT_MV: return("inh-com");
+ case INDIVPT_MV: return("indiv-ptab");
+ case INHERIT_INDIV_MV: return("inh-indiv");
+ case MAIN_MV: return("main");
+ case SYMBOL_MV: return("sym");
+
+ /* Additional marker values used in Glulx backpatching
+ (IDENT_MV is not really used at all any more) */
+
+ case VARIABLE_MV: return("glob");
+ case IDENT_MV: return("prop");
+ case ACTION_MV: return("action");
+ case OBJECT_MV: return("obj");
+
+ case LABEL_MV: return("lbl");
+ case DELETED_MV: return("del");
+
+ /* Only occurs secondary to another reported error */
+ case ERROR_MV: return("err");
+
+ }
+ if (mval >= BRANCH_MV && mval < BRANCHMAX_MV) return "br";
+
+ return("???");
+}
+
/* ------------------------------------------------------------------------- */
/* The mending operation */
/* ------------------------------------------------------------------------- */
value += individuals_offset;
break;
case MAIN_MV:
- value = symbol_index("Main", -1);
- if (symbols[value].type != ROUTINE_T)
+ value = get_symbol_index("Main");
+ if (value < 0 || (symbols[value].flags & UNKNOWN_SFLAG)) {
error("No 'Main' routine has been defined");
+ value = 0;
+ break;
+ }
+ if (symbols[value].type != ROUTINE_T) {
+ ebf_symbol_error("'Main' routine", symbols[value].name, typename(symbols[value].type), symbols[value].line);
+ value = 0;
+ break;
+ }
symbols[value].flags |= USED_SFLAG;
value = symbols[value].value;
if (OMIT_UNUSED_ROUTINES)
value += individuals_offset;
break;
case MAIN_MV:
- value = symbol_index("Main", -1);
- if (symbols[value].type != ROUTINE_T)
+ value = get_symbol_index("Main");
+ if (value < 0 || (symbols[value].flags & UNKNOWN_SFLAG)) {
error("No 'Main' routine has been defined");
+ value = 0;
+ break;
+ }
+ if (symbols[value].type != ROUTINE_T) {
+ ebf_symbol_error("'Main' routine", symbols[value].name, typename(symbols[value].type), symbols[value].line);
+ value = 0;
+ break;
+ }
symbols[value].flags |= USED_SFLAG;
value = symbols[value].value;
if (OMIT_UNUSED_ROUTINES)
/* ------------------------------------------------------------------------- */
/* "chars" : Character set mappings and the Z-machine alphabet table */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* */
/* 00 remains 0 (meaning "end of file") */
/* TAB becomes SPACE */
+/* 0a remains '\n' */
/* 0c ("form feed") becomes '\n' */
-/* 0d becomes '\n' */
+/* 0d remains '\r' */
/* other control characters become '?' */
/* 7f becomes '?' */
/* 80 to 9f become '?' */
for (n=1; n<32; n++) source_to_iso_grid[n] = '?';
source_to_iso_grid[10] = '\n';
source_to_iso_grid[12] = '\n';
- source_to_iso_grid[13] = '\n';
+ source_to_iso_grid[13] = '\r';
source_to_iso_grid[127] = '?';
source_to_iso_grid[TAB_CHARACTER] = ' ';
/* ------------------------------------------------------------------------- */
/* "directs" : Directives (# commands) */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
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];
/* ------------------------------------------------------------------------- */
-static int ebf_error_recover(char *s1, char *s2)
+static int ebf_error_recover(char *s1)
{
- /* 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:
+ /* Display an "expected... but found (current token)" 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);
+ ebf_curtoken_error(s1);
panic_mode_error_recovery();
return FALSE;
}
-static int ebf_symbol_error_recover(char *s1, char *name, char *type, brief_location report_line)
+static int ebf_symbol_error_recover(char *s1, char *type, brief_location report_line)
{
/* Same for ebf_symbol_error(). */
- ebf_symbol_error(s1, name, type, report_line);
+ ebf_symbol_error(s1, token_text, type, report_line);
panic_mode_error_recovery();
return FALSE;
}
panic_mode_error_recovery(); return FALSE;
}
if (token_type != DQ_TT)
- { return ebf_error_recover("abbreviation string", token_text);
- }
- /* 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;
+ { return ebf_error_recover("abbreviation string");
}
make_abbreviation(token_text);
} while (TRUE);
if (token_type != SYMBOL_TT)
{ discard_token_location(beginning_debug_location);
- return ebf_error_recover("new constant name", token_text);
+ return ebf_error_recover("new constant name");
}
if (!(symbols[i].flags & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG)))
{ discard_token_location(beginning_debug_location);
- return ebf_symbol_error_recover("new constant name", token_text, typename(symbols[i].type), symbols[i].line);
+ return ebf_symbol_error_recover("new constant name", typename(symbols[i].type), symbols[i].line);
}
assign_symbol(i, 0, CONSTANT_T);
case DEFAULT_CODE:
get_next_token();
if (token_type != SYMBOL_TT)
- return ebf_error_recover("name", token_text);
+ return ebf_error_recover("name");
i = -1;
if (symbols[token_value].flags & UNKNOWN_SFLAG)
*/
get_next_token();
if (token_type != SQ_TT && token_type != DQ_TT)
- return ebf_error_recover("dictionary word", token_text);
+ return ebf_error_recover("dictionary word");
{
char *wd = token_text;
DefCondition:
get_next_token();
if (token_type != SYMBOL_TT)
- return ebf_error_recover("symbol name", token_text);
+ return ebf_error_recover("symbol name");
/* Special case: a symbol of the form "VN_nnnn" is considered
defined if the compiler version number is at least nnnn.
HashIfCondition:
get_next_token();
if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- return ebf_error_recover("semicolon after 'If...' condition", token_text);
+ return ebf_error_recover("semicolon after 'If...' condition");
if (ifdef_sp >= MAX_IFDEF_STACK) {
error("'If' directives nested too deeply");
case INCLUDE_CODE:
get_next_token();
if (token_type != DQ_TT)
- return ebf_error_recover("filename in double-quotes", token_text);
+ return ebf_error_recover("filename in double-quotes");
{ char *name = token_text;
get_next_token();
if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- ebf_error("semicolon ';' after Include filename", token_text);
+ ebf_curtoken_error("semicolon ';' after Include filename");
if (strcmp(name, "language__") == 0)
load_sourcefile(Language_Name, 0);
}
get_next_token(); i = token_value;
if (token_type != SYMBOL_TT)
- return ebf_error_recover("new low string name", token_text);
+ return ebf_error_recover("new low string name");
if (!(symbols[i].flags & UNKNOWN_SFLAG))
- return ebf_symbol_error_recover("new low string name", token_text, typename(symbols[i].type), symbols[i].line);
+ return ebf_symbol_error_recover("new low string name", typename(symbols[i].type), symbols[i].line);
get_next_token();
if (token_type != DQ_TT)
- return ebf_error_recover("literal string in double-quotes", token_text);
+ return ebf_error_recover("literal string in double-quotes");
assign_symbol(i, compile_string(token_text, STRCTX_LOWSTRING), CONSTANT_T);
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);
+ { return ebf_error_recover("error message in double-quotes");
}
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);
+ { return ebf_error_recover("fatal error message in double-quotes");
}
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);
+ { return ebf_error_recover("warning message in double-quotes");
}
warning(token_text); break;
}
- return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'",
- token_text);
+ return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'");
break;
/* --------------------------------------------------------------------- */
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);
+ return ebf_error_recover("a file name in double-quotes");
}
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);
+ return ebf_error_recover("a file line number");
}
origsource_line = token_value;
if (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);
+ return ebf_error_recover("a file line number");
}
origsource_char = token_value;
if (origsource_char < 0)
}
if (token_type != SYMBOL_TT)
- return ebf_error_recover("name of routine to replace", token_text);
+ return ebf_error_recover("name of routine to replace");
if (!(symbols[token_value].flags & UNKNOWN_SFLAG))
- return ebf_error_recover("name of routine not yet defined", token_text);
+ return ebf_error_recover("name of routine not yet defined");
symbols[token_value].flags |= REPLACE_SFLAG;
}
if (token_type != SYMBOL_TT || !(symbols[token_value].flags & UNKNOWN_SFLAG))
- return ebf_error_recover("semicolon ';' or new routine name", token_text);
+ return ebf_error_recover("semicolon ';' or new routine name");
/* Define the original-form symbol as a zero constant. Its
value will be overwritten later, when we define the
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);
+ return ebf_error_recover("'score' or 'time' after 'statusline'");
if (token_value == SCORE_DK) statusline_flag = SCORE_STYLE;
else statusline_flag = TIME_STYLE;
break;
get_next_token();
df_dont_note_global_symbols = FALSE;
if (token_type != SYMBOL_TT)
- return ebf_error_recover("routine name to stub", token_text);
+ return ebf_error_recover("routine name to stub");
i = token_value; flag = FALSE;
get_next_token(); k = token_value;
if (token_type != NUMBER_TT)
- return ebf_error_recover("number of local variables", token_text);
+ return ebf_error_recover("number of local variables");
if ((k>4) || (k<0))
{ error("Must specify 0 to 4 local variables for 'Stub' routine");
k = 0;
(We don't set local_variable.keywords because we're not
going to be parsing any code.) */
- strcpy(local_variable_names[0].text, "dummy1");
- strcpy(local_variable_names[1].text, "dummy2");
- strcpy(local_variable_names[2].text, "dummy3");
- strcpy(local_variable_names[3].text, "dummy4");
+ clear_local_variables();
+ if (k >= 1) add_local_variable("dummy1");
+ if (k >= 2) add_local_variable("dummy2");
+ if (k >= 3) add_local_variable("dummy3");
+ if (k >= 4) add_local_variable("dummy4");
assign_symbol(i,
- assemble_routine_header(k, FALSE, symbols[i].name, FALSE, i),
+ assemble_routine_header(FALSE, symbols[i].name, FALSE, i),
ROUTINE_T);
/* Ensure the return value of a stubbed routine is false,
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 (token_type != UQ_TT)
+ return ebf_error_recover("string of switches");
if (!ignore_switches_switch)
{
if (constant_made_yet) {
'on' and 'off' are trace keywords. */
if (token_type != TRACE_KEYWORD_TT)
- return ebf_error_recover("debugging keyword", token_text);
+ return ebf_error_recover("debugging keyword");
trace_keywords.enabled = TRUE;
case UNDEF_CODE:
get_next_token();
if (token_type != SYMBOL_TT)
- return ebf_error_recover("symbol name", token_text);
+ return ebf_error_recover("symbol name");
if (symbols[token_value].flags & UNKNOWN_SFLAG)
{ break; /* undef'ing an undefined constant is okay */
if (debugfile_switch)
{ write_debug_undef(token_value);
}
- end_symbol_scope(token_value);
+ /* We remove it from the symbol table. But previous uses of the symbol
+ were valid, so we don't set neverused true. We also mark it
+ USED so that it can't trigger "symbol not used" warnings. */
+ end_symbol_scope(token_value, FALSE);
symbols[token_value].flags |= USED_SFLAG;
break;
version.
The calculation here is repeated from select_target(). */
DICT_ENTRY_BYTE_LENGTH = ((version_number==3)?7:9) - (ZCODE_LESS_DICT_DATA?1:0);
- debtok = symbol_index("DICT_ENTRY_BYTES", -1);
- if (!(symbols[debtok].flags & UNKNOWN_SFLAG))
+ debtok = get_symbol_index("DICT_ENTRY_BYTES");
+ if (debtok >= 0 && !(symbols[debtok].flags & UNKNOWN_SFLAG))
{
if (!(symbols[debtok].flags & REDEFINABLE_SFLAG))
{
new_alphabet(token_text, 0);
get_next_token();
if (token_type != DQ_TT)
- return ebf_error_recover("double-quoted alphabet string", token_text);
+ return ebf_error_recover("double-quoted alphabet string");
new_alphabet(token_text, 1);
get_next_token();
if (token_type != DQ_TT)
- return ebf_error_recover("double-quoted alphabet string", token_text);
+ return ebf_error_recover("double-quoted alphabet string");
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);
+ return ebf_error_recover("single character value");
break;
case DIR_KEYWORD_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);
+ return ebf_error_recover("single character value");
plus_flag = TRUE;
break;
default:
- return ebf_error_recover("character or Unicode number",
- token_text);
+ return ebf_error_recover("character or Unicode number");
}
get_next_token();
}
= token_value;
break;
default:
- return ebf_error_recover("ZSCII number",
- token_text);
+ return ebf_error_recover("ZSCII number");
}
get_next_token();
}
break;
default:
return ebf_error_recover("'table', 'terminating', \
-a string or a constant",
- token_text);
+a string or a constant");
}
break;
default:
return ebf_error_recover("three alphabet strings, \
-a 'table' or 'terminating' command or a single character", token_text);
+a 'table' or 'terminating' command or a single character");
}
break;
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
+ { ebf_curtoken_error("';'");
/* 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
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;
/* "errors" : Warnings, errors and fatal errors */
/* (with error throwback code for RISC OS machines) */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
return other_pos_buff;
}
+char *current_location_text(void)
+{
+ /* Convert the current lexer location to a brief string.
+ (Called by some trace messages.)
+ This uses the static buffer other_pos_buff. */
+ return location_text(get_brief_location(&ErrorReport));
+}
+
static void ellipsize_error_message_buff(void)
{
/* If the error buffer was actually filled up by a message, it was
exit(1);
}
+extern void fatalerror_fmt(const char *format, ...)
+{
+ va_list argument_pointer;
+ va_start(argument_pointer, format);
+ vsnprintf(error_message_buff, ERROR_BUFLEN, format, argument_pointer);
+ va_end(argument_pointer);
+ ellipsize_error_message_buff();
+ fatalerror(error_message_buff);
+}
+
extern void fatalerror_named(char *m, char *fn)
{ snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\"", m, fn);
ellipsize_error_message_buff();
fatalerror(error_message_buff);
}
-extern void memory_out_error(int32 size, int32 howmany, char *name)
+extern void fatalerror_memory_out(int32 size, int32 howmany, char *name)
{ if (howmany == 1)
snprintf(error_message_buff, ERROR_BUFLEN,
"Run out of memory allocating %d bytes for %s", size, name);
message(1,s);
}
-extern void error_named(char *s1, char *s2)
-{ snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
+extern void error_fmt(const char *format, ...)
+{
+ va_list argument_pointer;
+ va_start(argument_pointer, format);
+ vsnprintf(error_message_buff, ERROR_BUFLEN, format, argument_pointer);
+ va_end(argument_pointer);
ellipsize_error_message_buff();
error(error_message_buff);
}
-extern void error_numbered(char *s1, int val)
-{
- snprintf(error_message_buff, ERROR_BUFLEN,"%s %d.",s1,val);
+extern void error_named(char *s1, char *s2)
+{ snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
ellipsize_error_message_buff();
error(error_message_buff);
}
ErrorReport = E; concise_switch = i;
}
-extern void no_such_label(char *lname)
-{ error_named("No such label as",lname);
-}
-
extern void ebf_error(char *s1, char *s2)
{ snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found %s", s1, s2);
ellipsize_error_message_buff();
error(error_message_buff);
}
+extern void ebf_curtoken_error(char *s)
+{
+ /* This is "Expected (s) but found (the current token_text)". We use
+ token_type as a hint for how to display token_text. */
+
+ if (token_type == DQ_TT) {
+ snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found string \"%s\"", s, token_text);
+ }
+ else if (token_type == SQ_TT && strlen(token_text)==1) {
+ snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found char '%s'", s, token_text);
+ }
+ else if (token_type == SQ_TT) {
+ snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found dict word '%s'", s, token_text);
+ }
+ else {
+ /* Symbols, unquoted strings, and numbers can be printed directly. EOF will have "<end of file>" in token_text. */
+ snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found %s", s, token_text);
+ }
+
+ ellipsize_error_message_buff();
+ error(error_message_buff);
+}
+
extern void ebf_symbol_error(char *s1, char *name, char *type, brief_location report_line)
{ snprintf(error_message_buff, ERROR_BUFLEN, "\"%s\" is a name already in use and may not be used as a %s (%s \"%s\" was defined at %s)", name, s1, type, name, location_text(report_line));
ellipsize_error_message_buff();
message(2,s1);
}
-extern void warning_numbered(char *s1, int val)
-{ if (nowarnings_switch) { no_suppressed_warnings++; return; }
- snprintf(error_message_buff, ERROR_BUFLEN,"%s %d.", s1, val);
+extern void warning_fmt(const char *format, ...)
+{
+ va_list argument_pointer;
+ if (nowarnings_switch) { no_suppressed_warnings++; return; }
+ va_start(argument_pointer, format);
+ vsnprintf(error_message_buff, ERROR_BUFLEN, format, argument_pointer);
+ va_end(argument_pointer);
ellipsize_error_message_buff();
message(2,error_message_buff);
}
message(2,error_message_buff);
}
+extern void warning_at(char *name, brief_location report_line)
+{ int i;
+ ErrorPosition E = ErrorReport;
+ if (nowarnings_switch) { no_suppressed_warnings++; return; }
+ export_brief_location(report_line, &ErrorReport);
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s", name);
+ ellipsize_error_message_buff();
+ i = concise_switch; concise_switch = TRUE;
+ message(2,error_message_buff);
+ concise_switch = i;
+ ErrorReport = E;
+}
+
extern void symtype_warning(char *context, char *name, char *type, char *wanttype)
{
if (nowarnings_switch) { no_suppressed_warnings++; return; }
/* ------------------------------------------------------------------------- */
/* "expressc" : The expression code generator */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* Test if inside the "Class" object... */
INITAOTV(&AO3, BYTECONSTANT_OT, GOBJFIELD_PARENT());
assembleg_3(aload_gc, AO, AO3, stack_pointer);
- ln = symbol_index("Class", -1);
- AO3.value = symbols[ln].value;
- AO3.marker = OBJECT_MV;
- AO3.type = CONSTANT_OT;
+ ln = get_symbol_index("Class");
+ if (ln < 0) {
+ error("No 'Class' object found");
+ AO3 = zero_operand;
+ }
+ else {
+ AO3.value = symbols[ln].value;
+ AO3.marker = OBJECT_MV;
+ AO3.type = CONSTANT_OT;
+ }
assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
}
}
else {
/* Build the symbol for "Object" */
- ln = symbol_index("Object", -1);
- AO2.value = symbols[ln].value;
- AO2.marker = OBJECT_MV;
- AO2.type = CONSTANT_OT;
+ ln = get_symbol_index("Object");
+ if (ln < 0) {
+ error("No 'Object' object found");
+ AO2 = zero_operand;
+ }
+ else {
+ AO2.value = symbols[ln].value;
+ AO2.marker = OBJECT_MV;
+ AO2.type = CONSTANT_OT;
+ }
if (check_sp) {
/* Push "Object" */
assembleg_store(AO1, AO2);
assembleg_2(random_gc, AO, stack_pointer);
assembleg_3(aload_gc, AO2, stack_pointer, Result);
}
+ else if (is_constant_ot(ET[ET[below].right].value.type) && ET[ET[below].right].value.marker == 0) {
+ /* One argument, value known at compile time */
+ int32 arg = ET[ET[below].right].value.value; /* signed */
+ if (arg > 0) {
+ assembly_operand AO;
+ INITAO(&AO);
+ AO.value = arg;
+ set_constant_ot(&AO);
+ assembleg_2(random_gc,
+ AO, stack_pointer);
+ assembleg_3(add_gc, stack_pointer, one_operand,
+ Result);
+ }
+ else {
+ /* This handles zero or negative */
+ assembly_operand AO;
+ INITAO(&AO);
+ AO.value = -arg;
+ set_constant_ot(&AO);
+ assembleg_1(setrandom_gc,
+ AO);
+ assembleg_store(Result, zero_operand);
+ }
+ }
else {
+ /* One argument, not known at compile time */
+ int ln, ln2;
+ assembleg_store(temp_var1, ET[ET[below].right].value);
+ ln = next_label++;
+ ln2 = next_label++;
+ assembleg_2_branch(jle_gc, temp_var1, zero_operand, ln);
assembleg_2(random_gc,
- ET[ET[below].right].value, stack_pointer);
+ temp_var1, stack_pointer);
assembleg_3(add_gc, stack_pointer, one_operand,
Result);
+ assembleg_0_branch(jump_gc, ln2);
+ assemble_label_no(ln);
+ assembleg_2(neg_gc, temp_var1, stack_pointer);
+ assembleg_1(setrandom_gc,
+ stack_pointer);
+ assembleg_store(Result, zero_operand);
+ assemble_label_no(ln2);
}
break;
}
if (expr_trace_level >= 2)
- { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
+ { printf("Raw parse tree:\n"); show_tree(&AO, FALSE);
}
if (context == CONDITION_CONTEXT)
default: printf("* ILLEGAL *"); break;
}
printf(" context with annotated tree:\n");
- show_tree(AO, TRUE);
+ show_tree(&AO, TRUE);
}
generate_code_from(AO.value, (context==VOID_CONTEXT));
/* ------------------------------------------------------------------------- */
/* "expressp" : The expression parser */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
int system_function_usage[NUMBER_SYSTEM_FUNCTIONS];
+static void check_system_constant_available(int);
+
static int get_next_etoken(void)
{ int v, symbol = 0, mark_symbol_as_used = FALSE,
initial_bracket_level = bracket_level;
current_token.text += 3;
current_token.type = SYMBOL_TT;
- symbol = symbol_index(current_token.text, -1);
- if (symbols[symbol].type != GLOBAL_VARIABLE_T) {
+ symbol = get_symbol_index(current_token.text);
+ if (symbol < 0 || symbols[symbol].type != GLOBAL_VARIABLE_T) {
ebf_error(
"global variable name after '#g$'",
current_token.text);
"'#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);
+ current_token.value = symbol_index(current_token.text, -1, NULL);
goto ReceiveSymbol;
case HASHWDOLLAR_SEP:
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);
+ { ebf_curtoken_error(
+ "'r$', 'n$', 'g$' or internal Inform constant name after '#'");
break;
}
else
- { current_token.type = token_type;
+ {
+ check_system_constant_available(token_value);
+ current_token.type = token_type;
current_token.value = token_value;
current_token.text = token_text;
current_token.marker = INCON_MV;
return TRUE;
}
-/* --- Operator precedences ------------------------------------------------ */
+/* --- Operator precedences and error values-------------------------------- */
#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 */
+#define BYPREC -1 /* Compare the precedence of two operators */
+
+#define NOVAL_E 1 /* Missing operand error */
+#define CLOSEB_E 2 /* Unexpected close bracket */
+#define NOOP_E 3 /* Missing operator error */
+#define OPENB_E 4 /* Expression ends with an open bracket */
+#define ASSOC_E 5 /* Associativity illegal error */
-const int prec_table[] = {
+const int prec_table[49] = {
-/* a .......... ( ) end op term */
+/* a ....... ( ) end op:pre op:bin op:post 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
+/* b ( */ LOWER_P, NOOP_E, LOWER_P, LOWER_P, LOWER_P, NOOP_E, NOOP_E,
+/* . ) */ EQUAL_P, GREATER_P, CLOSEB_E, GREATER_P, GREATER_P, GREATER_P, GREATER_P,
+/* . end */ OPENB_E, GREATER_P, NOVAL_E, GREATER_P, GREATER_P, GREATER_P, GREATER_P,
+/* . op:pre */ LOWER_P, NOOP_E, LOWER_P, BYPREC, BYPREC, NOOP_E, NOOP_E,
+/* . op:bin */ LOWER_P, GREATER_P, LOWER_P, BYPREC, BYPREC, BYPREC, GREATER_P,
+/* . op:post */ LOWER_P, GREATER_P, LOWER_P, BYPREC, BYPREC, BYPREC, GREATER_P,
+/* . term */ LOWER_P, NOOP_E, LOWER_P, LOWER_P, LOWER_P, NOOP_E, NOOP_E
};
/* 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.
+ if it is malformed then one of the *_E results.
Note that this routine is not symmetrical and that the relation
is not trichotomous.
a GREATER_P a if a left-associative
*/
- int i, j, l1, l2;
+ int ai, bi, j, l1, l2;
+ /* Select a column and row in prec_table, based on the type of
+ a and b. If a/b is an operator, we have to distinguish three
+ columns/rows depending on whether the operator is prefix,
+ postfix, or neither.
+ */
+
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;
+ { case SUBOPEN_TT: ai=0; break;
+ case SUBCLOSE_TT: ai=1; break;
+ case ENDEXP_TT: ai=2; break;
+ case OP_TT:
+ if (operators[a->value].usage == PRE_U)
+ ai=3;
+ else if (operators[a->value].usage == POST_U)
+ ai=5;
+ else
+ ai=4;
+ break;
+ default: ai=6; 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;
+ { case SUBOPEN_TT: bi=0; break;
+ case SUBCLOSE_TT: bi=1; break;
+ case ENDEXP_TT: bi=2; break;
+ case OP_TT:
+ if (operators[b->value].usage == PRE_U)
+ bi=3;
+ else if (operators[b->value].usage == POST_U)
+ bi=5;
+ else
+ bi=4;
+ break;
+ default: bi=6; break;
}
+
+ j = prec_table[ai+7*bi];
+ if (j != BYPREC) return j;
- j = prec_table[i]; if (j != -1) return j;
-
+ /* BYPREC is the (a=OP, b=OP) cases. We must compare the precedence of the
+ two operators.
+ (We've already eliminated invalid cases like (a++ --b).)
+ */
l1 = operators[a->value].precedence;
l2 = operators[b->value].precedence;
if (operators[b->value].usage == PRE_U) return LOWER_P;
switch(operators[a->value].associativity)
{ case L_A: return GREATER_P;
case R_A: return LOWER_P;
- case 0: return e5;
+ case 0: return ASSOC_E;
}
return GREATER_P;
}
grammar_table_SC,
-1 };
+static void check_system_constant_available(int t)
+{
+ if (OMIT_SYMBOL_TABLE) {
+ /* Certain system constants refer to the symbol table, which
+ is meaningless if OMIT_SYMBOL_TABLE is set. */
+ switch(t)
+ {
+ case identifiers_table_SC:
+ case attribute_names_array_SC:
+ case property_names_array_SC:
+ case action_names_array_SC:
+ case fake_action_names_array_SC:
+ case array_names_offset_SC:
+ case global_names_array_SC:
+ case routine_names_array_SC:
+ case constant_names_array_SC:
+ error_named("OMIT_SYMBOL_TABLE omits system constant", system_constants.keywords[t]);
+ default:
+ break;
+ }
+ }
+}
+
static int32 value_of_system_constant_z(int t)
-{ switch(t)
+{
+ switch(t)
{ case adjectives_table_SC:
return adjectives_offset;
case actions_table_SC:
{ /* 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");
+ printf("Adding bracket layer (depth %d)\n", depth);
++emitter_stack[emitter_sp-depth-1].bracket_count;
}
default:
warning("Property name in expression is not qualified by object");
}
- } /* if (is_property_t */
+ }
}
switch(arity)
o1 = emitter_stack[emitter_sp - 1].op;
if ((o1.marker == 0) && is_constant_ot(o1.type))
{ switch(t->value)
- { case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
+ { case UNARY_MINUS_OP:
+ if ((uint32)o1.value == 0x80000000)
+ x = 0x80000000;
+ else
+ x = -o1.value;
+ goto FoldConstant;
case ARTNOT_OP:
if (!glulx_mode)
x = (~o1.value) & 0xffff;
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;
+ char op = '?';
switch(t->value)
{
case PLUS_OP:
- sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
+ op = '+';
break;
case MINUS_OP:
- sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
+ op = '-';
break;
case TIMES_OP:
- sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
+ op = '*';
break;
}
- error_named("Signed arithmetic on compile-time constants overflowed \
-the range -32768 to +32767:", folding_error);
+ error_fmt("Signed arithmetic on compile-time constants overflowed \
+the range -32768 to +32767 (%d %c %d = %d)", ov1, op, ov2, x);
}
FoldConstant:
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);
+extern void show_tree(const assembly_operand *AO, int annotate)
+{ if (AO->type == EXPRESSION_OT) show_node(AO->value, 0, annotate);
else
- { printf("Constant: "); print_operand(&AO, annotate);
+ { printf("Constant: "); print_operand(AO, annotate);
printf("\n");
}
}
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.
+ not possible, then the return is (short constant) 0 with marker
+ value ERROR_MV. The caller may check for this marker value to
+ decide whether to (e.g.) stop reading array values. Otherwise, it
+ will just be treated as a zero, which should minimise the chance
+ of a cascade of further error messages.
*/
token_data a, b, pop; int i;
directives.enabled = FALSE;
if (get_next_etoken() == FALSE)
- { ebf_error("expression", token_text);
+ { ebf_curtoken_error("expression");
+ AO.marker = ERROR_MV;
return AO;
}
if (sr_sp == 0)
{ compiler_error("SR error: stack empty");
+ AO.marker = ERROR_MV;
return(AO);
}
{ if (emitter_sp == 0)
{ error("No expression between brackets '(' and ')'");
put_token_back();
+ AO.marker = ERROR_MV;
return AO;
}
if (emitter_sp > 1)
{ compiler_error("SR error: emitter stack overfull");
+ AO.marker = ERROR_MV;
return AO;
}
if (AO.type == EXPRESSION_OT)
{ if (expr_trace_level >= 3)
{ printf("Tree before lvalue checking:\n");
- show_tree(AO, FALSE);
+ show_tree(&AO, FALSE);
}
if (!glulx_mode)
check_property_operator(AO.value);
if (context == CONSTANT_CONTEXT)
if (!is_constant_ot(AO.type))
{ AO = zero_operand;
+ AO.marker = ERROR_MV;
ebf_error("constant", "<expression>");
}
put_token_back();
switch(find_prec(&a,&b))
{
- case e5: /* Associativity error */
+ case ASSOC_E: /* Associativity error */
error_named("Brackets mandatory to clarify order of:",
a.text);
} while (find_prec(&sr_stack[sr_sp-1], &pop) != LOWER_P);
break;
- case e1: /* Missing operand error */
+ case NOVAL_E: /* Missing operand error */
error_named("Missing operand after", a.text);
+ /* We insert a "0" token so that the rest of the expression
+ can be compiled. */
put_token_back();
current_token.type = NUMBER_TT;
current_token.value = 0;
current_token.text = "0";
break;
- case e2: /* Unexpected close bracket */
+ case CLOSEB_E: /* Unexpected close bracket */
error("Found '(' without matching ')'");
get_next_etoken();
break;
- case e3: /* Missing operator error */
- error("Missing operator: inserting '+'");
+ case NOOP_E: /* Missing operator error */
+ error_named("Missing operator after", a.text);
+ /* We insert a "+" token so that the rest of the expression
+ can be compiled. */
put_token_back();
current_token.type = OP_TT;
current_token.value = PLUS_OP;
current_token.text = "+";
break;
- case e4: /* Expression ends with an open bracket */
+ case OPENB_E: /* Expression ends with an open bracket */
error("Found '(' without matching ')'");
sr_sp--;
break;
return s*(ET[ET[AO.value].down].value.value);
}
+
+/* Determine if the operand (a parsed expression) is a constant (as
+ per is_constant_ot()) or a comma-separated list of such constants.
+
+ "(1)" and "(1,2,3)" both count, and even "((1,2),3)", but
+ not "(1,(2,3))"; the list must be left-associated.
+
+ Backpatched constants (function names, etc) are acceptable, as are
+ folded constant expressions. Variables are right out.
+
+ The constants are stored in the ops_found array, up to a maximum of
+ max_ops_found. For Inform parsing reasons, the array list is backwards
+ from the order found.
+
+ Returns the number of constants found. If the expression is not a list of
+ constants, returns zero.
+
+ (The return value may be more than max_ops_found, in which case we weren't
+ able to return them all in the array.)
+*/
+extern int test_constant_op_list(const assembly_operand *AO, assembly_operand *ops_found, int max_ops_found)
+{
+ int count = 0;
+ int n;
+
+ if (AO->type != EXPRESSION_OT) {
+ if (!is_constant_ot(AO->type))
+ return 0;
+
+ if (ops_found && max_ops_found > 0)
+ ops_found[0] = *AO;
+ return 1;
+ }
+
+ n = AO->value;
+
+ /* For some reason the top node is always a COMMA with no .right,
+ just a .down. Should we rely on this? For now yes. */
+
+ if (operators[ET[n].operator_number].token_value != COMMA_SEP)
+ return 0;
+ if (ET[n].right != -1)
+ return 0;
+ n = ET[n].down;
+
+ while (TRUE) {
+ if (ET[n].right != -1) {
+ if (ET[ET[n].right].down != -1)
+ return 0;
+ if (!is_constant_ot(ET[ET[n].right].value.type))
+ return 0;
+
+ if (ops_found && max_ops_found > count)
+ ops_found[count] = ET[ET[n].right].value;
+ count++;
+ }
+
+ if (ET[n].down == -1) {
+ if (!is_constant_ot(ET[n].value.type))
+ return 0;
+
+ if (ops_found && max_ops_found > count)
+ ops_found[count] = ET[n].value;
+ count++;
+ return count;
+ }
+
+ if (operators[ET[n].operator_number].token_value != COMMA_SEP)
+ return 0;
+
+ n = ET[n].down;
+ }
+}
+
/* ========================================================================= */
/* Data structure management routines */
/* ------------------------------------------------------------------------- */
/* routines in "inform.c", since they are tied up with ICL */
/* settings and are very host OS-dependent. */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
static int checksum_low_byte, /* For calculating the Z-machine's */
checksum_high_byte; /* "verify" checksum */
-static int32 checksum_long; /* For the Glulx checksum, */
+static uint32 checksum_long; /* For the Glulx checksum, */
static int checksum_count; /* similarly */
/* ------------------------------------------------------------------------- */
do
{ x = translate_in_filename(x, name, filename_given, same_directory_flag,
(total_files==0)?1:0);
- handle = fopen(name,"r");
+ handle = fopen(name,"rb");
} while ((handle == NULL) && (x != 0));
InputFiles[total_files].filename = my_malloc(strlen(name)+1, "filename storage");
switch (checksum_count) {
case 0:
- checksum_long += (((int32)(c & 0xFF)) << 24);
+ checksum_long += (((uint32)(c & 0xFF)) << 24);
break;
case 1:
- checksum_long += (((int32)(c & 0xFF)) << 16);
+ checksum_long += (((uint32)(c & 0xFF)) << 16);
break;
case 2:
- checksum_long += (((int32)(c & 0xFF)) << 8);
+ checksum_long += (((uint32)(c & 0xFF)) << 8);
break;
case 3:
- checksum_long += ((int32)(c & 0xFF));
+ checksum_long += ((uint32)(c & 0xFF));
break;
}
(*size) += 1;
break;
case 3:
- cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
+ cx = abbreviation_text(ent->u.val);
while (*cx) {
sf_put(*cx);
cx++;
static void output_file_g(void)
{ char new_name[PATHLEN];
int32 size, i, j, offset;
- int32 VersionNum;
uint32 code_length, size_before_code, next_cons_check;
int use_function;
int first_byte_of_triple, second_byte_of_triple, third_byte_of_triple;
/* Determine the version number. */
- VersionNum = 0x00020000;
+ final_glulx_version = 0x00020000;
/* Increase for various features the game may have used. */
if (no_unicode_chars != 0 || (uses_unicode_features)) {
- VersionNum = 0x00030000;
+ final_glulx_version = 0x00030000;
}
if (uses_memheap_features) {
- VersionNum = 0x00030100;
+ final_glulx_version = 0x00030100;
}
if (uses_acceleration_features) {
- VersionNum = 0x00030101;
+ final_glulx_version = 0x00030101;
}
if (uses_float_features) {
- VersionNum = 0x00030102;
+ final_glulx_version = 0x00030102;
}
if (uses_double_features || uses_extundo_features) {
- VersionNum = 0x00030103;
+ final_glulx_version = 0x00030103;
}
/* And check if the user has requested a specific version. */
if (requested_glulx_version) {
- if (requested_glulx_version < VersionNum) {
- static char error_message_buff[256];
- sprintf(error_message_buff, "Version 0x%08lx requested, but \
-game features require version 0x%08lx", (long)requested_glulx_version, (long)VersionNum);
- warning(error_message_buff);
+ if (requested_glulx_version < final_glulx_version) {
+ warning_fmt("Version 0x%08lx requested, but game features require version 0x%08lx",
+ (long)requested_glulx_version, (long)final_glulx_version);
}
else {
- VersionNum = requested_glulx_version;
+ final_glulx_version = requested_glulx_version;
}
}
sf_put('u');
sf_put('l');
/* Version number. */
- sf_put((VersionNum >> 24));
- sf_put((VersionNum >> 16));
- sf_put((VersionNum >> 8));
- sf_put((VersionNum));
+ sf_put((final_glulx_version >> 24));
+ sf_put((final_glulx_version >> 16));
+ sf_put((final_glulx_version >> 8));
+ sf_put((final_glulx_version));
/* RAMSTART */
sf_put((Write_RAM_At >> 24));
sf_put((Write_RAM_At >> 16));
transcript_open = TRUE;
- sprintf(topline_buffer, "Transcript of the text of \"%s\"", what_of);
+ snprintf(topline_buffer, 256, "Transcript of the text of \"%s\"", what_of);
write_to_transcript_file(topline_buffer, STRCTX_INFO);
- sprintf(topline_buffer, "[From %s]", banner_line);
+ snprintf(topline_buffer, 256, "[From %s]", banner_line);
write_to_transcript_file(topline_buffer, STRCTX_INFO);
if (TRANSCRIPT_FORMAT == 1) {
write_to_transcript_file("[I:info, G:game text, V:veneer text, L:lowmem string, A:abbreviation, D:dict word, O:object name, S:symbol, X:infix]", STRCTX_INFO);
{ char botline_buffer[256];
char sn_buffer[7];
+ write_to_transcript_file("", STRCTX_INFO);
+
+ if (!glulx_mode) {
+ snprintf(botline_buffer, 256, "[Compiled Z-machine version %d]", version_number);
+ }
+ else {
+ int32 major = (final_glulx_version >> 16) & 0xFFFF;
+ int32 minor = (final_glulx_version >> 8) & 0xFF;
+ int32 patch = final_glulx_version & 0xFF;
+ snprintf(botline_buffer, 256, "[Compiled Glulx version %d.%d.%d]", major, minor, patch);
+ }
+ write_to_transcript_file(botline_buffer, STRCTX_INFO);
+
write_serial_number(sn_buffer);
- sprintf(botline_buffer, "[End of transcript: release %d, serial %s]",
+ snprintf(botline_buffer, 256, "[End of transcript: release %d, serial %s]",
release_number, sn_buffer);
- write_to_transcript_file("", STRCTX_INFO);
write_to_transcript_file(botline_buffer, STRCTX_INFO);
write_to_transcript_file("", STRCTX_INFO);
/* ------------------------------------------------------------------------- */
/* Header file for Inform: Z-machine ("Infocom" format) compiler */
/* */
-/* Inform 6.41 */
+/* Inform 6.42 */
/* */
/* This header file and the others making up the Inform source code are */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* ------------------------------------------------------------------------- */
/* For releases, set to the release date in the form "1st January 2000" */
-#define RELEASE_DATE "22nd July 2022"
-#define RELEASE_NUMBER 1641
+#define RELEASE_DATE "10th February 2024"
+#define RELEASE_NUMBER 1642
#define GLULX_RELEASE_NUMBER 38
#define VNUMBER RELEASE_NUMBER
#define ReadInt32(ptr) \
- ( (((int32)(((uchar *)(ptr))[0])) << 24) \
- | (((int32)(((uchar *)(ptr))[1])) << 16) \
- | (((int32)(((uchar *)(ptr))[2])) << 8) \
- | (((int32)(((uchar *)(ptr))[3])) ) )
+ ( (((uint32)(((uchar *)(ptr))[0])) << 24) \
+ | (((uint32)(((uchar *)(ptr))[1])) << 16) \
+ | (((uint32)(((uchar *)(ptr))[2])) << 8) \
+ | (((uint32)(((uchar *)(ptr))[3])) ) )
#define ReadInt16(ptr) \
- ( (((int32)(((uchar *)(ptr))[0])) << 8) \
- | (((int32)(((uchar *)(ptr))[1])) ) )
+ ( (((uint32)(((uchar *)(ptr))[0])) << 8) \
+ | (((uint32)(((uchar *)(ptr))[1])) ) )
#define WriteInt32(ptr, val) \
((ptr)[0] = (uchar)(((int32)(val)) >> 24), \
/* ------------------------------------------------------------------------- */
#define MAX_ERRORS 100
-#define MAX_IDENTIFIER_LENGTH 32
-#define MAX_ABBREV_LENGTH 64
-#define MAX_DICT_WORD_SIZE 40
-#define MAX_DICT_WORD_BYTES (40*4)
#define MAX_NUM_ATTR_BYTES 39
#define MAX_VERB_WORD_SIZE 120
size_t count; /* number of items allocated */
} memory_list;
-typedef struct identstruct_s
-{
- char text[MAX_IDENTIFIER_LENGTH+1];
-} identstruct;
+typedef struct brief_location_s
+{ int32 file_index;
+ int32 line_number;
+ int32 orig_file_index;
+ int32 orig_line_number;
+} brief_location;
typedef struct assembly_operand_t
{ int type; /* ?_OT value */
typedef struct verbt {
int lines;
- int *l; /* alloced array */
+ int *l; /* alloced array of grammar line indexes
+ (positions in grammar_lines[]) */
int size; /* allocated size of l */
+ brief_location line; /* originally defined at */
+ int used; /* only set at locate_dead_grammar_lines() time */
} verbt;
typedef struct actioninfo_s {
int value;
int quality;
int freq;
+ int textpos; /* in abbreviations_text */
+ int textlen;
} abbreviation;
typedef struct maybe_file_position_S
int reference_count;
} debug_locations;
-typedef struct brief_location_s
-{ int32 file_index;
- int32 line_number;
- int32 orig_file_index;
- int32 orig_line_number;
-} brief_location;
-
typedef struct debug_location_beginning_s
{ debug_locations *head;
int32 beginning_byte_index;
char *text; /* points at lextexts array */
int32 value;
int type; /* a *_TT value */
+ int newsymbol; /* (for SYMBOL_TT) this token created the symbol */
debug_location location;
int lextext; /* index of text string in lextexts */
int context; /* lexical context used to interpret this token */
#define picture_table_zc 115
#define print_unicode_zc 116
#define check_unicode_zc 117
+#define set_true_colour_zc 118
+#define buffer_screen_zc 119
/* ------------------------------------------------------------------------- */
#define dstore_gm 3
-#define SYMBOL_TT 0 /* value = index in symbol table */
-#define NUMBER_TT 1 /* value = the number */
-#define DQ_TT 2 /* no value */
-#define SQ_TT 3 /* no value */
-#define SEP_TT 4 /* value = the _SEP code */
-#define EOF_TT 5 /* no value */
+#define SYMBOL_TT 0 /* symbol.
+ value = index in symbol table */
+#define NUMBER_TT 1 /* number (including hex, float,
+ etc).
+ value = the number */
+#define DQ_TT 2 /* double-quoted string.
+ no value; look at the text */
+#define SQ_TT 3 /* single-quoted string.
+ no value */
+#define UQ_TT 4 /* unquoted string; only when
+ dont_enter_into_symbol_table
+ is true.
+ no value */
+#define SEP_TT 5 /* separator (punctuation).
+ value = the _SEP code */
+#define EOF_TT 6 /* end of file.
+ no value */
#define STATEMENT_TT 100 /* a statement keyword */
#define SEGMENT_MARKER_TT 101 /* with/has/class etc. */
/* Symbol flag definitions (in no significant order) */
/* ------------------------------------------------------------------------- */
-#define UNKNOWN_SFLAG 1
-#define REPLACE_SFLAG 2
-#define USED_SFLAG 4
-#define DEFCON_SFLAG 8
-#define STUB_SFLAG 16
-#define IMPORT_SFLAG 32
-#define EXPORT_SFLAG 64
-#define ALIASED_SFLAG 128
+#define UNKNOWN_SFLAG 1 /* no definition known */
+#define REPLACE_SFLAG 2 /* routine marked for Replace */
+#define USED_SFLAG 4 /* referred to in code */
+#define DEFCON_SFLAG 8 /* defined by Default */
+#define STUB_SFLAG 16 /* defined by Stub */
+#define UNHASHED_SFLAG 32 /* removed from hash chain */
+#define DISCARDED_SFLAG 64 /* removed and should never have been used */
+#define ALIASED_SFLAG 128 /* defined as property/attribute alias name */
-#define CHANGE_SFLAG 256
-#define SYSTEM_SFLAG 512
-#define INSF_SFLAG 1024
-#define UERROR_SFLAG 2048
-#define ACTION_SFLAG 4096
-#define REDEFINABLE_SFLAG 8192
-#define STAR_SFLAG 16384
+#define CHANGE_SFLAG 256 /* defined by Default with a value,
+ or symbol has a backpatchable value */
+#define SYSTEM_SFLAG 512 /* created by compiler */
+#define INSF_SFLAG 1024 /* created in System_File */
+#define UERROR_SFLAG 2048 /* "No such constant" error issued */
+#define ACTION_SFLAG 4096 /* action name constant (Foo_A) */
+#define REDEFINABLE_SFLAG 8192 /* built-in symbol that can be redefined
+ by the user */
+#define STAR_SFLAG 16384 /* function defined with "*" or property named
+ "foo_to" */
/* ------------------------------------------------------------------------- */
/* Symbol type definitions */
#define OBJECT_MV 16 /* Ref to internal object number */
#define STATIC_ARRAY_MV 17 /* Ref to internal static array address */
-#define LARGEST_BPATCH_MV 17 /* Larger marker values are never written
+#define ERROR_MV 18 /* An error was reported while
+ generating this value */
+#define LARGEST_BPATCH_MV 18 /* Larger marker values are never written
to backpatch tables */
/* Values 32-35 were used only for module import/export. */
extern int assemble_forward_label_no(int n);
extern void assemble_jump(int n);
extern void define_symbol_label(int symbol);
-extern int32 assemble_routine_header(int no_locals, int debug_flag,
+extern int32 assemble_routine_header(int debug_flag,
char *name, int embedded_flag, int the_symbol);
extern void assemble_routine_end(int embedded_flag, debug_locations locations);
extern int backpatch_marker, backpatch_error_flag;
extern char *describe_mv(int mval);
+extern char *describe_mv_short(int mval);
extern int32 backpatch_value(int32 value);
extern void backpatch_zmachine_image_z(void);
extern brief_location routine_starts_line;
-extern int no_routines, no_named_routines, no_locals, no_termcs;
+extern int no_routines, no_named_routines, no_termcs;
extern int terminating_characters[];
extern int parse_given_directive(int internal_flag);
extern ErrorPosition ErrorReport;
extern void fatalerror(char *s) NORETURN;
+extern void fatalerror_fmt(const char *format, ...) NORETURN;
extern void fatalerror_named(char *s1, char *s2) NORETURN;
-extern void memory_out_error(int32 size, int32 howmany, char *name) NORETURN;
-extern void error_max_dynamic_strings(int index);
-extern void error_max_abbreviations(int index);
+extern void fatalerror_memory_out(int32 size, int32 howmany, char *name) NORETURN;
+
extern void error(char *s);
+extern void error_fmt(const char *format, ...);
extern void error_named(char *s1, char *s2);
-extern void error_numbered(char *s1, int val);
extern void error_named_at(char *s1, char *s2, brief_location report_line);
extern void ebf_error(char *s1, char *s2);
+extern void ebf_curtoken_error(char *s);
extern void ebf_symbol_error(char *s1, char *name, char *type, brief_location report_line);
extern void char_error(char *s, int ch);
extern void unicode_char_error(char *s, int32 uni);
-extern void no_such_label(char *lname);
+extern void error_max_dynamic_strings(int index);
+extern void error_max_abbreviations(int index);
+
extern void warning(char *s);
-extern void warning_numbered(char *s1, int val);
+extern void warning_fmt(const char *format, ...);
extern void warning_named(char *s1, char *s2);
+extern void warning_at(char *name, brief_location report_line);
extern void symtype_warning(char *context, char *name, char *type, char *wanttype);
extern void dbnu_warning(char *type, char *name, brief_location report_line);
extern void uncalled_routine_warning(char *type, char *name, brief_location report_line);
extern void obsolete_warning(char *s1);
+
extern int compiler_error(char *s);
extern int compiler_error_named(char *s1, char *s2);
extern void print_sorry_message(void);
+extern char *current_location_text(void);
#ifdef ARC_THROWBACK
extern int throwback_switch;
extern int32 value_of_system_constant(int t);
extern char *name_of_system_constant(int t);
extern void clear_expression_space(void);
-extern void show_tree(assembly_operand AO, int annotate);
+extern void show_tree(const assembly_operand *AO, int annotate);
extern assembly_operand parse_expression(int context);
extern int test_for_incdec(assembly_operand AO);
+extern int test_constant_op_list(const assembly_operand *AO, assembly_operand *ops_found, int max_ops_found);
/* ------------------------------------------------------------------------- */
/* Extern definitions for "files" */
extern int oddeven_packing_switch;
extern int glulx_mode, compression_switch;
-extern int32 requested_glulx_version;
+extern int32 requested_glulx_version, final_glulx_version;
extern int error_format, store_the_text, asm_trace_setting,
expr_trace_setting, tokens_trace_setting,
extern int dont_enter_into_symbol_table;
extern int return_sp_as_variable;
extern int next_token_begins_syntax_line;
-extern identstruct *local_variable_names;
+extern int no_locals;
+extern int *local_variable_name_offsets;
extern int32 token_value;
extern int token_type;
extern debug_locations get_token_location_end(debug_location_beginning beginning);
extern void describe_token_triple(const char *text, int32 value, int type);
+#define describe_current_token() describe_token_triple(token_text, token_value, token_type)
/* The describe_token() macro works on both token_data and lexeme_data structs. */
#define describe_token(t) describe_token_triple((t)->text, (t)->value, (t)->type)
extern void construct_local_variable_tables(void);
+extern void clear_local_variables(void);
+extern void add_local_variable(char *name);
+extern char *get_local_variable_name(int index);
+
extern void declare_systemfile(void);
extern int is_systemfile(void);
extern void report_errors_at_current_line(void);
extern int DICT_WORD_SIZE, DICT_CHAR_SIZE, DICT_WORD_BYTES;
extern int ZCODE_HEADER_EXT_WORDS, ZCODE_HEADER_FLAGS_3;
extern int ZCODE_LESS_DICT_DATA;
+extern int ZCODE_MAX_INLINE_STRING;
extern int NUM_ATTR_BYTES, GLULX_OBJECT_EXT_BYTES;
extern int WARN_UNUSED_ROUTINES, OMIT_UNUSED_ROUTINES;
extern int STRIP_UNREACHABLE_LABELS;
+extern int OMIT_SYMBOL_TABLE;
+extern int LONG_DICT_FLAG_BUG;
extern int TRANSCRIPT_FORMAT;
/* These macros define offsets that depend on the value of NUM_ATTR_BYTES.
extern int hash_code_from_string(char *p);
extern int strcmpcis(char *p, char *q);
extern int get_symbol_index(char *p);
-extern int symbol_index(char *lexeme_text, int hashcode);
-extern void end_symbol_scope(int k);
+extern int symbol_index(char *lexeme_text, int hashcode, int *created);
+extern void end_symbol_scope(int k, int neveruse);
extern void describe_symbol(int k);
extern void list_symbols(int level);
extern void assign_marked_symbol(int index, int marker, int32 value, int type);
extern void match_close_bracket(void);
extern void parse_statement(int break_label, int continue_label);
+extern void parse_statement_singleexpr(assembly_operand AO);
extern int parse_label(void);
/* ------------------------------------------------------------------------- */
extern int no_abbreviations;
extern int abbrevs_lookup_table_made, is_abbreviation;
-extern uchar *abbreviations_at;
extern abbreviation *abbreviations;
extern int32 total_chars_trans, total_bytes_trans,
extern int32 translate_text(int32 p_limit, char *s_text, int strctx);
extern void optimise_abbreviations(void);
extern void make_abbreviation(char *text);
+extern char *abbreviation_text(int num);
extern void show_dictionary(int level);
extern void word_to_ascii(uchar *p, char *result);
extern void print_dict_word(int node);
extern void find_the_actions(void);
extern void make_fake_action(void);
extern assembly_operand action_of_name(char *name);
+extern void locate_dead_grammar_lines(void);
extern void make_verb(void);
extern void extend_verb(void);
extern void list_verb_table(void);
/* "inform" : The top level of Inform: switches, pathnames, filenaming */
/* conventions, ICL (Inform Command Line) files, main */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
int32 scale_factor, /* packed address multiplier */
length_scale_factor; /* length-in-header multiplier */
-int32 requested_glulx_version;
+int32 requested_glulx_version; /* version requested via -v switch */
+int32 final_glulx_version; /* requested version combined with game
+ feature requirements */
extern void select_version(int vn)
{ version_number = vn;
if (INDIV_PROP_START < 256) {
INDIV_PROP_START = 256;
- warning_numbered("INDIV_PROP_START should be at least 256 in Glulx. Setting to", INDIV_PROP_START);
+ warning_fmt("INDIV_PROP_START should be at least 256 in Glulx; setting to %d", INDIV_PROP_START);
}
if (NUM_ATTR_BYTES % 4 != 3) {
NUM_ATTR_BYTES += (3 - (NUM_ATTR_BYTES % 4));
- warning_numbered("NUM_ATTR_BYTES must be a multiple of four, plus three. Increasing to", NUM_ATTR_BYTES);
+ warning_fmt("NUM_ATTR_BYTES must be a multiple of four, plus three; increasing to %d", NUM_ATTR_BYTES);
}
if (DICT_CHAR_SIZE != 1 && DICT_CHAR_SIZE != 4) {
DICT_CHAR_SIZE = 4;
- warning_numbered("DICT_CHAR_SIZE must be either 1 or 4. Setting to", DICT_CHAR_SIZE);
+ warning_fmt("DICT_CHAR_SIZE must be either 1 or 4; setting to %d", DICT_CHAR_SIZE);
}
}
MAX_LOCAL_VARIABLES = MAX_KEYWORD_GROUP_SIZE;
}
- if (DICT_WORD_SIZE > MAX_DICT_WORD_SIZE) {
- DICT_WORD_SIZE = MAX_DICT_WORD_SIZE;
- warning_numbered(
- "DICT_WORD_SIZE cannot exceed MAX_DICT_WORD_SIZE; resetting",
- MAX_DICT_WORD_SIZE);
- /* MAX_DICT_WORD_SIZE can be increased in header.h without fear. */
- }
if (NUM_ATTR_BYTES > MAX_NUM_ATTR_BYTES) {
NUM_ATTR_BYTES = MAX_NUM_ATTR_BYTES;
- warning_numbered(
- "NUM_ATTR_BYTES cannot exceed MAX_NUM_ATTR_BYTES; resetting",
+ warning_fmt(
+ "NUM_ATTR_BYTES cannot exceed MAX_NUM_ATTR_BYTES; resetting to %d",
MAX_NUM_ATTR_BYTES);
/* MAX_NUM_ATTR_BYTES can be increased in header.h without fear. */
}
compression_switch = TRUE;
glulx_mode = FALSE;
requested_glulx_version = 0;
+ final_glulx_version = 0;
/* These aren't switches, but for clarity we reset them too. */
asm_trace_level = 0;
sort_dictionary();
if (track_unused_routines)
locate_dead_functions();
+ locate_dead_grammar_lines();
construct_storyfile();
}
run_pass();
+ if (no_errors==0) { output_file(); output_has_occurred = TRUE; }
+ else { output_has_occurred = FALSE; }
+
if (transcript_switch)
{ write_dictionary_to_transcript();
close_transcript_file();
}
- if (no_errors==0) { output_file(); output_has_occurred = TRUE; }
- else { output_has_occurred = FALSE; }
-
if (debugfile_switch)
{ end_debug_file();
}
printf(
"\nThis program is a compiler of Infocom format (also called \"Z-machine\")\n\
story files, as well as \"Glulx\" story files:\n\
-Copyright (c) Graham Nelson 1993 - 2022.\n\n");
+Copyright (c) Graham Nelson 1993 - 2024.\n\n");
/* For people typing just "inform", a summary only: */
static void execute_icl_command(char *p);
static int execute_dashdash_command(char *p, char *p2);
+/* Open a file and see whether the initial lines match the "!% ..." format
+ used for ICL commands. Stop when we reach a line that doesn't.
+
+ This does not do line break conversion. It just reads to the next
+ \n (and ignores \r as whitespace). Therefore it will work on Unix and
+ DOS source files, but fail to cope with Mac-Classic (\r) source files.
+ I am not going to worry about this, because files from the Mac-Classic
+ era shouldn't have "!%" lines; that convention was invented well after
+ Mac switched over to \n format.
+ */
static int execute_icl_header(char *argname)
{
FILE *command_file;
do
{ x = translate_in_filename(x, filename, argname, 0, 1);
- command_file = fopen(filename,"r");
+ command_file = fopen(filename,"rb");
} while ((command_file == NULL) && (x != 0));
if (!command_file) {
/* Fail silently. The regular compiler will try to open the file
/* ------------------------------------------------------------------------- */
/* "lexer" : Lexical analyser */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
(generally as a result of an error
message or the start of pass) */
dont_enter_into_symbol_table, /* Return names as text (with
- token type DQ_TT, i.e., as if
- they had double-quotes around)
- and not as entries in the symbol
- table, when TRUE. If -2, only the
+ token type UQ_TT) and not as
+ entries in the symbol table,
+ when TRUE. If -2, only the
keyword table is searched. */
return_sp_as_variable; /* When TRUE, the word "sp" denotes
the stack pointer variable
typedef struct lextext_s {
char *text;
- size_t size; /* Allocated size (including terminal null)
- This is always at least MAX_IDENTIFIER_LENGTH+1 */
+ size_t size; /* Allocated size (including terminal null) */
} lextext;
static lextext *lextexts; /* Allocated to no_lextexts */
/* ------------------------------------------------------------------------- */
/* The lexer itself needs up to 3 characters of lookahead (it uses an */
/* LR(3) grammar to translate characters into tokens). */
+/* */
+/* Past the end of the stream, we fill in zeros. This has the awkward */
+/* side effect that a zero byte in a source file will silently terminate */
+/* it, rather than producing an "illegal source character" error. */
+/* On the up side, we can compile veneer routines (which are null- */
+/* terminated strings) with no extra work. */
/* ------------------------------------------------------------------------- */
#define LOOKAHEAD_SIZE 3
static int current, lookahead, /* The latest character read, and */
lookahead2, lookahead3; /* the three characters following it */
+ /* (zero means end-of-stream) */
static int pipeline_made; /* Whether or not the pipeline of
characters has been constructed
break;
case SQ_TT: printf("string '%s'", text);
break;
+ case UQ_TT: printf("barestring %s", text);
+ break;
case SEP_TT: printf("separator '%s'", text);
break;
case EOF_TT: printf("end of file");
"get_wind_prop", "scroll_window", "pop_stack", "read_mouse",
"mouse_window", "push_stack", "put_wind_prop", "print_form",
"make_menu", "picture_table", "print_unicode", "check_unicode",
+ "set_true_colour", "buffer_screen",
""
};
always translate to the same output tokens whenever the context
is the same.
- In fact, for efficiency reasons this number omits the bit of
- information held in the variable "dont_enter_into_symbol_table".
- Inform never needs to backtrack through tokens parsed in that
- way (thankfully, as it would be expensive indeed to check
- the tokens). */
+ (For many years, the "dont_enter_into_symbol_table" variable
+ was omitted from this number. But now we can include it.) */
int c = 0;
if (opcode_names.enabled) c |= 1;
if (local_variables.enabled) c |= 1024;
if (return_sp_as_variable) c |= 2048;
+ if (dont_enter_into_symbol_table) c |= 4096;
+
return(c);
}
static void print_context(int c)
{
+ if (c < 0) {
+ printf("??? ");
+ return;
+ }
if ((c & 1) != 0) printf("OPC ");
if ((c & 2) != 0) printf("DIR ");
if ((c & 4) != 0) printf("TK ");
if ((c & 512) != 0) printf("SCON ");
if ((c & 1024) != 0) printf("LV ");
if ((c & 2048) != 0) printf("sp ");
+ if ((c & 4096) != 0) printf("dontent ");
}
static int *keywords_hash_table;
119 for Glulx.
*/
+/* The number of local variables in the current routine. */
+int no_locals;
+
/* Names of local variables in the current routine.
+ The values are positions in local_variable_names_memlist.
This is allocated to MAX_LOCAL_VARIABLES-1. (The stack pointer "local"
is not included in this array.)
(This could be a memlist, growing as needed up to MAX_LOCAL_VARIABLES-1.
But right now we just allocate the max.)
*/
-identstruct *local_variable_names;
+int *local_variable_name_offsets;
+
+static memory_list local_variable_names_memlist;
+/* How much of local_variable_names_memlist is used by the no_local locals. */
+static int local_variable_names_usage;
static char one_letter_locals[128];
}
}
+extern void clear_local_variables(void)
+{
+ no_locals = 0;
+ local_variable_names_usage = 0;
+}
+
+extern void add_local_variable(char *name)
+{
+ int len;
+
+ if (no_locals >= MAX_LOCAL_VARIABLES-1) {
+ /* This should have been caught before we got here */
+ error("too many local variables");
+ return;
+ }
+
+ len = strlen(name)+1;
+ ensure_memory_list_available(&local_variable_names_memlist, local_variable_names_usage + len);
+ local_variable_name_offsets[no_locals++] = local_variable_names_usage;
+ strcpy((char *)local_variable_names_memlist.data+local_variable_names_usage, name);
+ local_variable_names_usage += len;
+}
+
+extern char *get_local_variable_name(int index)
+{
+ if (index < 0 || index >= no_locals)
+ return "???"; /* shouldn't happen */
+
+ return (char *)local_variable_names_memlist.data + local_variable_name_offsets[index];
+}
+
/* Look at the strings stored in local_variable_names (from 0 to no_locals).
Set local_variables.keywords to point to these, and also prepare the
- hash tables. */
+ hash tables.
+ This must be called after add_local_variable(), but before we start
+ compiling function code. */
extern void construct_local_variable_tables(void)
{ int i, h;
for (i=0; i<HASH_TAB_SIZE; i++) local_variable_hash_table[i] = -1;
for (i=0; i<no_locals; i++)
{
- char *p = local_variable_names[i].text;
+ char *p = (char *)local_variable_names_memlist.data + local_variable_name_offsets[i];
local_variables.keywords[i] = p;
if (p[1] == 0)
{ one_letter_locals[(uchar)p[0]] = i;
}
}
-static void interpret_identifier(char *p, int pos, int dirs_only_flag)
+static void interpret_identifier(char *p, int pos)
{ int index, hashcode;
/* An identifier is either a keyword or a "symbol", a name which the
lexical analyser leaves to higher levels of Inform to understand. */
+ circle[pos].newsymbol = FALSE;
+
hashcode = hash_code_from_string(p);
- if (dirs_only_flag) goto KeywordSearch;
+ /* If dont_enter_into_symbol_table is true, we skip all keywords
+ (and variables) and just mark the name as an unquoted string.
+ Except that if dont_enter_into_symbol_table is -2, we recognize
+ directive keywords (only).
+ */
+ if (dont_enter_into_symbol_table) {
+
+ if (dont_enter_into_symbol_table == -2) {
+ /* This is a simplified version of the keyword-checking loop
+ below. */
+ index = keywords_hash_table[hashcode];
+ while (index >= 0)
+ { int *i = keywords_data_table + 3*index;
+ keyword_group *kg = keyword_groups[*i];
+ if (kg == &directives)
+ { char *q = kg->keywords[*(i+1)];
+ if (((kg->case_sensitive) && (strcmp(p, q)==0))
+ || ((!(kg->case_sensitive)) && (strcmpcis(p, q)==0)))
+ { circle[pos].type = kg->change_token_type;
+ circle[pos].value = *(i+1);
+ return;
+ }
+ }
+ index = *(i+2);
+ }
+ }
+
+ circle[pos].type = UQ_TT;
+ circle[pos].value = 0;
+ return;
+ }
+
/* If this is assembly language, perhaps it is "sp"? */
if (return_sp_as_variable && (p[0]=='s') && (p[1]=='p') && (p[2]==0))
if (index >= 0)
{ for (;index<no_locals;index++)
{ if (hashcode == local_variable_hash_codes[index])
- { if (strcmpcis(p, local_variable_names[index].text)==0)
+ {
+ char *locname = (char *)local_variable_names_memlist.data + local_variable_name_offsets[index];
+ if (strcmpcis(p, locname)==0)
{ circle[pos].type = LOCAL_VARIABLE_TT;
circle[pos].value = index+1;
return;
/* Now the bulk of the keywords. Note that the lexer doesn't recognise
the name of a system function which has been Replaced. */
- KeywordSearch:
index = keywords_hash_table[hashcode];
while (index >= 0)
{ int *i = keywords_data_table + 3*index;
keyword_group *kg = keyword_groups[*i];
- if (((!dirs_only_flag) && (kg->enabled))
- || (dirs_only_flag && (kg == &directives)))
+ if (kg->enabled)
{ char *q = kg->keywords[*(i+1)];
if (((kg->case_sensitive) && (strcmp(p, q)==0))
|| ((!(kg->case_sensitive)) && (strcmpcis(p, q)==0)))
index = *(i+2);
}
- if (dirs_only_flag) return;
-
/* Search for the name; create it if necessary. */
- circle[pos].value = symbol_index(p, hashcode);
+ circle[pos].value = symbol_index(p, hashcode, &circle[pos].newsymbol);
circle[pos].type = SYMBOL_TT;
}
tokeniser_grid[0] = EOF_CODE;
tokeniser_grid[' '] = WHITESPACE_CODE;
tokeniser_grid['\n'] = WHITESPACE_CODE;
+ tokeniser_grid['\r'] = WHITESPACE_CODE;
tokeniser_grid['$'] = RADIX_CODE;
tokeniser_grid['!'] = COMMENT_CODE;
/* */
/* Note that file_load_chars(p, size) loads "size" bytes into buffer "p" */
/* from the current input file. If the file runs out, then if it was */
-/* the last source file 4 EOF characters are placed in the buffer: if it */
+/* the last source file 4 null characters are placed in the buffer: if it */
/* was only an Include file ending, then a '\n' character is placed there */
/* (essentially to force termination of any comment line) followed by */
/* three harmless spaces. */
CurrentLB->chars_read++;
if (forerrors_pointer < FORERRORS_SIZE-1)
forerrors_buff[forerrors_pointer++] = current;
- if (current == '\n') reached_new_line();
+
+ /* The file is open in binary mode, so we have to do our own newline
+ conversion. (We want to do it consistently across all platforms.)
+
+ The strategy is to convert all \r (CR) characters to \n (LF), but
+ *don't* advance the line counter for \r if it's followed by \n.
+ The rest of the lexer treats multiple \n characters the same as
+ one, so the simple conversion will work out okay.
+
+ (Note that, for historical reasons, a ctrl-L (formfeed) is also
+ treated as \r. This conversion has already been handled by
+ source_to_iso_grid[].)
+ */
+ if (current == '\n') {
+ reached_new_line();
+ }
+ else if (current == '\r') {
+ current = '\n';
+ if (lookahead != '\n')
+ reached_new_line();
+ }
+
return(current);
}
/* ------------------------------------------------------------------------- */
-/* Source 2: from a string */
+/* Source 2: from a (null-terminated) string */
/* ------------------------------------------------------------------------- */
static int source_to_analyse_pointer; /* Current read position */
CurrentLB->chars_read++;
if (forerrors_pointer < FORERRORS_SIZE-1)
forerrors_buff[forerrors_pointer++] = current;
+
+ /* We shouldn't have \r when compiling from string (veneer function).
+ If we do, just shove it under the carpet. */
+ if (current == '\r') current = '\n';
if (current == '\n') reached_new_line();
+
return(current);
}
/* */
/* restart_lexer(source, name) if source is NULL, initialise the lexer */
/* to read from source files; */
-/* otherwise, to read from this string. */
+/* otherwise, to read from this null- */
+/* terminated string. */
/* ------------------------------------------------------------------------- */
extern void release_token_texts(void)
extern void put_token_back(void)
{ tokens_put_back++;
+ int pos = circle_position - tokens_put_back + 1;
+ if (pos<0) pos += CIRCLE_SIZE;
+
if (tokens_trace_level > 0)
- { if (tokens_trace_level == 1) printf("<- ");
- else printf("<-\n");
+ {
+ printf("<- ");
+ if (tokens_trace_level > 1) {
+ describe_token(&circle[pos]);
+ printf("\n");
+ }
}
+ if (circle[pos].type == SYMBOL_TT && circle[pos].newsymbol) {
+ /* Remove the symbol from the symbol table. (Or mark it as unreachable
+ anyhow.) */
+ end_symbol_scope(circle[pos].value, TRUE);
+ /* Remove new-symbol flag, and force reinterpretation next time
+ we see the symbol. */
+ circle[pos].newsymbol = FALSE;
+ circle[pos].context = -1;
+ }
+
/* The following error, of course, should never happen! */
if (tokens_put_back == CIRCLE_SIZE)
}
extern void get_next_token(void)
-{ int d, i, j, k, quoted_size, e, radix, context; int32 n; char *r;
+{ int d, i, j, k, quoted_size, e, radix, context;
+ uint32 n;
+ char *r;
int floatend;
int returning_a_put_back_token = TRUE;
if (context != circle[i].context)
{ j = circle[i].type;
if ((j==0) || ((j>=100) && (j<200)))
- interpret_identifier(circle[i].text, i, FALSE);
+ interpret_identifier(circle[i].text, i);
circle[i].context = context;
}
goto ReturnBack;
/* fresh lextext block; must init it */
no_lextexts = lex_index+1;
ensure_memory_list_available(&lextexts_memlist, no_lextexts);
- lextexts[lex_index].size = MAX_IDENTIFIER_LENGTH + 1;
+ lextexts[lex_index].size = 64; /* this can grow */
lextexts[lex_index].text = my_malloc(lextexts[lex_index].size, "one lexeme text");
}
lex_pos = 0;
circle[circle_position].text = NULL; /* will fill in later */
circle[circle_position].value = 0;
circle[circle_position].type = 0;
+ circle[circle_position].newsymbol = FALSE;
circle[circle_position].context = context;
StartTokenAgain:
goto StartTokenAgain;
case COMMENT_CODE:
- while ((lookahead != '\n') && (lookahead != 0))
+ while ((lookahead != '\n') && (lookahead != '\r') && (lookahead != 0))
(*get_next_char)();
goto StartTokenAgain;
lexaddc(0);
circle[circle_position].type = NUMBER_TT;
- circle[circle_position].value = n;
+ circle[circle_position].value = (int32)n;
break;
FloatNumber:
quoted_size=0;
do
{ e = d; d = (*get_next_char)(); lexaddc(d);
- if (quoted_size++==64)
- { error(
- "Too much text for one pair of quotations '...' to hold");
- lexaddc('\''); break;
- }
+ quoted_size++;
if ((d == '\'') && (e != '@'))
{ if (quoted_size == 1)
{ d = (*get_next_char)(); lexaddc(d);
}
break;
}
- } while (d != EOF);
- if (d==EOF) ebf_error("'\''", "end of file");
+ } while (d != 0);
+ if (d==0) ebf_error("'\''", "end of file");
lexdelc();
circle[circle_position].type = SQ_TT;
break;
case DQUOTE_CODE: /* Double-quotes: scan a literal string */
- quoted_size=0;
do
{ d = (*get_next_char)(); lexaddc(d);
if (d == '\n')
{ lex_pos--;
while (lexlastc() == ' ') lex_pos--;
if (lexlastc() != '^') lexaddc(' ');
- while ((lookahead != EOF) &&
+ while ((lookahead != 0) &&
(tokeniser_grid[lookahead] == WHITESPACE_CODE))
(*get_next_char)();
}
else if (d == '\\')
{ int newline_passed = FALSE;
lex_pos--;
- while ((lookahead != EOF) &&
+ while ((lookahead != 0) &&
(tokeniser_grid[lookahead] == WHITESPACE_CODE))
if ((d = (*get_next_char)()) == '\n')
newline_passed = TRUE;
chb);
}
}
- } while ((d != EOF) && (d!='\"'));
- if (d==EOF) ebf_error("'\"'", "end of file");
+ } while ((d != 0) && (d!='\"'));
+ if (d==0) ebf_error("'\"'", "end of file");
lexdelc();
circle[circle_position].type = DQ_TT;
break;
case IDENTIFIER_CODE: /* Letter or underscore: an identifier */
lexaddc(d); n=1;
- while ((n<=MAX_IDENTIFIER_LENGTH)
- && ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
+ while (((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
|| (tokeniser_grid[lookahead] == DIGIT_CODE)))
n++, lexaddc((*get_next_char)());
lexaddc(0);
- if (n > MAX_IDENTIFIER_LENGTH)
- { char bad_length[100];
- sprintf(bad_length,
- "Name exceeds the maximum length of %d characters:",
- MAX_IDENTIFIER_LENGTH);
- error_named(bad_length, lextexts[lex_index].text);
- /* Eat any further extra characters in the identifier */
- while (((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
- || (tokeniser_grid[lookahead] == DIGIT_CODE)))
- (*get_next_char)();
- /* Trim token so that it doesn't violate
- MAX_IDENTIFIER_LENGTH during error recovery */
- lextexts[lex_index].text[MAX_IDENTIFIER_LENGTH] = 0;
- }
-
- if (dont_enter_into_symbol_table)
- { circle[circle_position].type = DQ_TT;
- circle[circle_position].value = 0;
- if (dont_enter_into_symbol_table == -2)
- interpret_identifier(lextexts[lex_index].text, circle_position, TRUE);
- break;
- }
-
- interpret_identifier(lextexts[lex_index].text, circle_position, FALSE);
+ interpret_identifier(lextexts[lex_index].text, circle_position);
break;
default:
else
{ printf("-> "); describe_token(&circle[i]);
printf(" ");
- if (tokens_trace_level > 2) print_context(circle[i].context);
+ if (tokens_trace_level > 2) {
+ if (circle[i].newsymbol) printf("newsym ");
+ print_context(circle[i].context);
+ }
printf("\n");
}
}
for (i=0; i<CIRCLE_SIZE; i++)
{ circle[i].type = 0;
circle[i].value = 0;
+ circle[i].newsymbol = FALSE;
circle[i].text = "(if this is ever visible, there is a bug)";
circle[i].lextext = -1;
circle[i].context = 0;
cur_lextexts = 0;
lex_index = -1;
lex_pos = -1;
+
+ no_locals = 0;
+ local_variable_names_usage = 0;
blank_brief_location.file_index = -1;
blank_brief_location.line_number = 0;
pipeline_made = FALSE;
+ no_locals = 0;
+
restart_lexer(NULL, NULL);
}
keywords_data_table = my_calloc(sizeof(int), 3*MAX_KEYWORDS,
"keyword hashing linked list");
- local_variable_names = my_calloc(sizeof(identstruct), MAX_LOCAL_VARIABLES-1,
+ initialise_memory_list(&local_variable_names_memlist,
+ sizeof(char), MAX_LOCAL_VARIABLES*32, NULL,
"text of local variable names");
+ local_variable_name_offsets = my_calloc(sizeof(int), MAX_LOCAL_VARIABLES-1,
+ "offsets of local variable names");
local_variable_hash_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
"local variable hash table");
local_variable_hash_codes = my_calloc(sizeof(int), MAX_LOCAL_VARIABLES,
my_free(&keywords_hash_ends_table, "keyword hash end table");
my_free(&keywords_data_table, "keyword hashing linked list");
- my_free(&local_variable_names, "text of local variable names");
+ deallocate_memory_list(&local_variable_names_memlist);
+ my_free(&local_variable_name_offsets, "offsets of local variable names");
my_free(&local_variable_hash_table, "local variable hash table");
my_free(&local_variable_hash_codes, "local variable hash codes");
/* ------------------------------------------------------------------------- */
/* "memory" : Memory management and ICL memory setting commands */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* Wrappers for malloc(), realloc(), etc.
- Note that all of these functions call memory_out_error() on failure.
+ Note that all of these functions call fatalerror_memory_out() on failure.
This is a fatal error and does not return. However, we check my_malloc()
return values anyway as a matter of good habit.
*/
if (size==0) return(NULL);
c=(char _huge *)halloc(size,1);
malloced_bytes+=size;
- if (c==0) memory_out_error(size, 1, whatfor);
+ if (c==0) fatalerror_memory_out(size, 1, whatfor);
return(c);
}
}
c=halloc(size,1);
malloced_bytes+=(size-oldsize);
- if (c==0) memory_out_error(size, 1, whatfor);
+ if (c==0) fatalerror_memory_out(size, 1, whatfor);
if (memout_switch)
printf("Increasing allocation from %ld to %ld bytes for %s was (%08lx) now (%08lx)\n",
(long int) oldsize, (long int) size, whatfor,
if ((size*howmany) == 0) return(NULL);
c=(void _huge *)halloc(howmany*size,1);
malloced_bytes+=size*howmany;
- if (c==0) memory_out_error(size, howmany, whatfor);
+ if (c==0) fatalerror_memory_out(size, howmany, whatfor);
return(c);
}
}
c=(void _huge *)halloc(size*howmany,1);
malloced_bytes+=size*(howmany-oldhowmany);
- if (c==0) memory_out_error(size, howmany, whatfor);
+ if (c==0) fatalerror_memory_out(size, howmany, whatfor);
if (memout_switch)
printf("Increasing allocation from %ld to %ld bytes: array (%ld entries size %ld) for %s was (%08lx) now (%08lx)\n",
((long int)size) * ((long int)oldhowmany),
if (size==0) return(NULL);
c=malloc(size);
malloced_bytes+=size;
- if (c==0) memory_out_error(size, 1, whatfor);
+ if (c==0) fatalerror_memory_out(size, 1, whatfor);
if (memout_switch)
- printf("Allocating %ld bytes for %s at (%08lx)\n",
- (long int) size,whatfor,(long int) c);
+ printf("Allocating %ld bytes for %s at (%p)\n",
+ (long int) size, whatfor, c);
return(c);
}
}
c=realloc(*(int **)pointer, size);
malloced_bytes+=(size-oldsize);
- if (c==0) memory_out_error(size, 1, whatfor);
+ if (c==0) fatalerror_memory_out(size, 1, whatfor);
if (memout_switch)
- printf("Increasing allocation from %ld to %ld bytes for %s was (%08lx) now (%08lx)\n",
- (long int) oldsize, (long int) size, whatfor,
- (long int) (*(int **)pointer),
- (long int) c);
+ printf("Increasing allocation from %ld to %ld bytes for %s was (%p) now (%p)\n",
+ (long int) oldsize, (long int) size, whatfor, pointer, c);
*(int **)pointer = c;
}
if (size*howmany==0) return(NULL);
c=calloc(howmany, size);
malloced_bytes+=size*howmany;
- if (c==0) memory_out_error(size, howmany, whatfor);
+ if (c==0) fatalerror_memory_out(size, howmany, whatfor);
if (memout_switch)
printf("Allocating %ld bytes: array (%ld entries size %ld) \
-for %s at (%08lx)\n",
+for %s at (%p)\n",
((long int)size) * ((long int)howmany),
- (long int)howmany,(long int)size,whatfor,
- (long int) c);
+ (long int)howmany,(long int)size, whatfor, c);
return(c);
}
}
c=realloc(*(int **)pointer, size*howmany);
malloced_bytes+=size*(howmany-oldhowmany);
- if (c==0) memory_out_error(size, howmany, whatfor);
+ if (c==0) fatalerror_memory_out(size, howmany, whatfor);
if (memout_switch)
- printf("Increasing allocation from %ld to %ld bytes: array (%ld entries size %ld) for %s was (%08lx) now (%08lx)\n",
+ printf("Increasing allocation from %ld to %ld bytes: array (%ld entries size %ld) for %s was (%p) now (%p)\n",
((long int)size) * ((long int)oldhowmany),
((long int)size) * ((long int)howmany),
(long int)howmany, (long int)size, whatfor,
- (long int) *(int **)pointer, (long int) c);
+ pointer, c);
*(int **)pointer = c;
}
{
if (*(int **)pointer != NULL)
{ if (memout_switch)
- printf("Freeing memory for %s at (%08lx)\n",
- whatitwas, (long int) (*(int **)pointer));
+ printf("Freeing memory for %s at (%p)\n",
+ whatitwas, pointer);
#ifdef PC_QUICKC
hfree(*(int **)pointer);
#else
int ZCODE_HEADER_EXT_WORDS; /* (zcode 1.0) requested header extension size */
int ZCODE_HEADER_FLAGS_3; /* (zcode 1.1) value to place in Flags 3 word */
int ZCODE_LESS_DICT_DATA; /* (zcode) use 2 data bytes per dict word instead of 3 */
+int ZCODE_MAX_INLINE_STRING; /* (zcode) length of string literals that can be inlined */
int NUM_ATTR_BYTES;
int GLULX_OBJECT_EXT_BYTES; /* (glulx) extra bytes for each object record */
int32 MAX_STACK_SIZE;
int WARN_UNUSED_ROUTINES; /* 0: no, 1: yes except in system files, 2: yes always */
int OMIT_UNUSED_ROUTINES; /* 0: no, 1: yes */
int STRIP_UNREACHABLE_LABELS; /* 0: no, 1: yes (default) */
+int OMIT_SYMBOL_TABLE; /* 0: no, 1: yes */
+int LONG_DICT_FLAG_BUG; /* 0: no bug, 1: bug (default for historic reasons) */
int TRANSCRIPT_FORMAT; /* 0: classic, 1: prefixed */
/* The way memory sizes are set causes great nuisance for those parameters
printf("| %25s = %-7d |\n","ZCODE_HEADER_FLAGS_3",ZCODE_HEADER_FLAGS_3);
if (!glulx_mode)
printf("| %25s = %-7d |\n","ZCODE_LESS_DICT_DATA",ZCODE_LESS_DICT_DATA);
+ if (!glulx_mode)
+ printf("| %25s = %-7d |\n","ZCODE_MAX_INLINE_STRING",ZCODE_MAX_INLINE_STRING);
printf("| %25s = %-7d |\n","INDIV_PROP_START", INDIV_PROP_START);
if (glulx_mode)
printf("| %25s = %-7d |\n","MEMORY_MAP_EXTENSION",
printf("| %25s = %-7d |\n","WARN_UNUSED_ROUTINES",WARN_UNUSED_ROUTINES);
printf("| %25s = %-7d |\n","OMIT_UNUSED_ROUTINES",OMIT_UNUSED_ROUTINES);
printf("| %25s = %-7d |\n","STRIP_UNREACHABLE_LABELS",STRIP_UNREACHABLE_LABELS);
+ printf("| %25s = %-7d |\n","OMIT_SYMBOL_TABLE",OMIT_SYMBOL_TABLE);
+ printf("| %25s = %-7d |\n","LONG_DICT_FLAG_BUG",LONG_DICT_FLAG_BUG);
printf("+--------------------------------------+\n");
}
ZCODE_HEADER_EXT_WORDS = 3;
ZCODE_HEADER_FLAGS_3 = 0;
ZCODE_LESS_DICT_DATA = 0;
+ ZCODE_MAX_INLINE_STRING = 32;
GLULX_OBJECT_EXT_BYTES = 0;
MEMORY_MAP_EXTENSION = 0;
/* We estimate the default Glulx stack size at 4096. That's about
OMIT_UNUSED_ROUTINES = 0;
WARN_UNUSED_ROUTINES = 0;
STRIP_UNREACHABLE_LABELS = 1;
+ OMIT_SYMBOL_TABLE = 0;
+ LONG_DICT_FLAG_BUG = 1;
TRANSCRIPT_FORMAT = 0;
adjust_memory_sizes();
rather than three. (Z-code only.)\n");
return;
}
+ if (strcmp(command,"ZCODE_MAX_INLINE_STRING")==0)
+ { printf(
+" ZCODE_MAX_INLINE_STRING is the length beyond which string literals cannot\n\
+ be inlined in assembly opcodes. (Z-code only.)\n");
+ return;
+ }
if (strcmp(command,"GLULX_OBJECT_EXT_BYTES")==0)
{ printf(
" GLULX_OBJECT_EXT_BYTES is an amount of additional space to add to each \n\
will be compiled, at the cost of less optimized code. The default is 1.\n");
return;
}
+ if (strcmp(command,"OMIT_SYMBOL_TABLE")==0)
+ {
+ printf(
+" OMIT_SYMBOL_TABLE, if set to 1, will skip compiling debug symbol names \n\
+ into the game file.\n");
+ return;
+ }
+ if (strcmp(command,"LONG_DICT_FLAG_BUG")==0)
+ {
+ printf(
+" LONG_DICT_FLAG_BUG, if set to 0, will fix the old bug which ignores \n\
+ the '//p' flag in long dictionary words. If 1, the buggy behavior is \n\
+ retained.\n");
+ return;
+ }
if (strcmp(command,"SERIAL")==0)
{
printf(
printf(" FREQ: show how efficient abbreviations were (same as -f)\n (only meaningful with -e)\n");
printf(" MAP: print memory map of the virtual machine (same as -z)\n");
printf(" MAP=2: also show percentage of VM that each segment occupies\n");
+ printf(" MAP=3: also show number of bytes that each segment occupies\n");
printf(" MEM: show internal memory allocations\n");
printf(" OBJECTS: display the object table\n");
printf(" PROPS: show attributes and properties defined\n");
ZCODE_HEADER_FLAGS_3=j, flag=1;
if (strcmp(command,"ZCODE_LESS_DICT_DATA")==0)
ZCODE_LESS_DICT_DATA=j, flag=1;
+ if (strcmp(command,"ZCODE_MAX_INLINE_STRING")==0)
+ ZCODE_MAX_INLINE_STRING=j, flag=1;
if (strcmp(command,"GLULX_OBJECT_EXT_BYTES")==0)
GLULX_OBJECT_EXT_BYTES=j, flag=1;
if (strcmp(command,"MAX_STATIC_DATA")==0)
if (STRIP_UNREACHABLE_LABELS > 1 || STRIP_UNREACHABLE_LABELS < 0)
STRIP_UNREACHABLE_LABELS = 1;
}
+ if (strcmp(command,"OMIT_SYMBOL_TABLE")==0)
+ {
+ OMIT_SYMBOL_TABLE=j, flag=1;
+ if (OMIT_SYMBOL_TABLE > 1 || OMIT_SYMBOL_TABLE < 0)
+ OMIT_SYMBOL_TABLE = 1;
+ }
+ if (strcmp(command,"LONG_DICT_FLAG_BUG")==0)
+ {
+ LONG_DICT_FLAG_BUG=j, flag=1;
+ if (LONG_DICT_FLAG_BUG > 1 || LONG_DICT_FLAG_BUG < 0)
+ LONG_DICT_FLAG_BUG = 1;
+ }
if (strcmp(command,"SERIAL")==0)
{
if (j >= 0 && j <= 999999)
/* checks syntax and translates such directives into */
/* specifications for the object-maker. */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
are allocated dynamically as
memory-lists */
-static char shortname_buffer[766]; /* Text buffer to hold the short name
+static char *shortname_buffer; /* Text buffer to hold the short name
(which is read in first, but
written almost last) */
+static memory_list shortname_buffer_memlist;
+
static int parent_of_this_obj;
static memory_list current_object_name; /* The name of the object currently
/* Print a PROPS trace line. The f flag is 0 for an attribute, 1 for
a common property, 2 for an individual property. */
static void trace_s(char *name, int32 number, int f)
-{ if (!printprops_switch) return;
- char *stype = "";
+{ char *stype = "";
+ if (!printprops_switch) return;
if (f == 0) stype = "Attr";
else if (f == 1) stype = "Prop";
else if (f == 2) stype = "Indiv";
if (f != 1) printf(" ");
else printf("%s%s",(commonprops[number].is_long)?"L":" ",
(commonprops[number].is_additive)?"A":" ");
- printf(" %s\n", name);
+ printf(" %-24s (%s)\n", name, current_location_text());
}
extern void make_attribute(void)
else {
if (no_attributes==NUM_ATTR_BYTES*8) {
discard_token_location(beginning_debug_location);
- error_numbered(
- "All attributes already declared -- increase NUM_ATTR_BYTES to use \
-more than",
+ error_fmt(
+ "All %d attributes already declared -- increase NUM_ATTR_BYTES to use \
+more",
NUM_ATTR_BYTES*8);
panic_mode_error_recovery();
put_token_back();
/* We hold onto token_text through the end of this Property directive, which should be okay. */
if (token_type != SYMBOL_TT)
{ discard_token_location(beginning_debug_location);
- ebf_error("new attribute name", token_text);
+ ebf_curtoken_error("new attribute name");
panic_mode_error_recovery();
put_token_back();
return;
if (!((token_type == SYMBOL_TT)
&& (symbols[token_value].type == ATTRIBUTE_T)))
{ discard_token_location(beginning_debug_location);
- ebf_error("an existing attribute name after 'alias'",
- token_text);
+ ebf_curtoken_error("an existing attribute name after 'alias'");
panic_mode_error_recovery();
put_token_back();
return;
/* We hold onto token_text through the end of this Property directive, which should be okay. */
if (token_type != SYMBOL_TT)
{ discard_token_location(beginning_debug_location);
- ebf_error("new property name", token_text);
+ ebf_curtoken_error("new property name");
panic_mode_error_recovery();
put_token_back();
return;
get_next_token();
if (!((token_type == SYMBOL_TT)
&& (symbols[token_value].type == PROPERTY_T)))
- { ebf_error("an existing property name after 'alias'",
- token_text);
+ { ebf_curtoken_error("an existing property name after 'alias'");
panic_mode_error_recovery();
put_token_back();
return;
}
else {
if (no_properties==INDIV_PROP_START) {
- char error_b[128];
discard_token_location(beginning_debug_location);
- sprintf(error_b,
+ error_fmt(
"All %d properties already declared (increase INDIV_PROP_START to get more)",
INDIV_PROP_START-3);
- error(error_b);
panic_mode_error_recovery();
put_token_back();
return;
for (i=full_object.pp[k].l;
i<full_object.pp[k].l+prop_length/2; i++)
- { if (i >= 32)
+ {
+ if (i >= 32)
{ error("An additive property has inherited \
so many values that the list has overflowed the maximum 32 entries");
break;
}
+ if ((version_number==3) && i >= 4)
+ { error("An additive property has inherited \
+so many values that the list has overflowed the maximum 4 entries");
+ break;
+ }
INITAOTV(&full_object.pp[k].ao[i], LONG_CONSTANT_OT, mark + j);
j += 2;
full_object.pp[k].ao[i].marker = INHERIT_MV;
}
for (k=0; k<full_object.pp[j].l; k++)
- { if (full_object.pp[j].ao[k].marker != 0)
+ {
+ if (k >= 32) {
+ /* We catch this earlier, but we'll check again to avoid overflowing ao[] */
+ error("Too many values for Z-machine property");
+ break;
+ }
+ if (full_object.pp[j].ao[k].marker != 0)
backpatch_zmachine(full_object.pp[j].ao[k].marker,
PROP_ZA, mark);
properties_table[mark++] = full_object.pp[j].ao[k].value/256;
if (shortname != NULL)
{
+ /* The limit of 510 bytes, or 765 Z-characters, is a Z-spec limit. */
i = translate_text(510,shortname,STRCTX_OBJNAME);
if (i < 0) {
error ("Short name of object exceeded 765 Z-characters");
}
if (token_type != SYMBOL_TT)
- { ebf_error("property name", token_text);
+ { ebf_curtoken_error("property name");
return;
}
}
else
if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
- { char error_b[128+2*MAX_IDENTIFIER_LENGTH];
- sprintf(error_b,
+ {
+ error_fmt(
"Property given twice in the same declaration, because \
-the names '%s' and '%s' actually refer to the same property",
+the names \"%s\" and \"%s\" actually refer to the same property",
symbols[defined_this_segment[i]].name,
symbols[token_value].name);
- error(error_b);
}
property_name_symbol = token_value;
AO = parse_expression(ARRAY_CONTEXT);
}
+ /* length is in bytes here, but we report the limit in words. */
+
if (length == 64)
{ error_named("Limit (of 32 values) exceeded for property",
symbols[property_name_symbol].name);
break;
}
+ if ((version_number==3) && (!individual_property) && length == 8)
+ { error_named("Limit (of 4 values) exceeded for property",
+ symbols[property_name_symbol].name);
+ break;
+ }
+
if (individual_property)
{ if (AO.marker != 0)
backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
}
}
- if ((version_number==3) && (!individual_property))
- { if (length > 8)
- {
- warning_named("Version 3 limit of 4 values per property exceeded \
-(use -v5 to get 32), so truncating property",
- symbols[property_name_symbol].name);
- length = 8;
- }
- }
-
if (individual_property)
{
ensure_memory_list_available(&individuals_table_memlist, individuals_length+length+3);
}
if (token_type != SYMBOL_TT)
- { ebf_error("property name", token_text);
+ { ebf_curtoken_error("property name");
return;
}
}
else
if (symbols[defined_this_segment[i]].value == symbols[token_value].value)
- { char error_b[128+2*MAX_IDENTIFIER_LENGTH];
- sprintf(error_b,
+ {
+ error_fmt(
"Property given twice in the same declaration, because \
-the names '%s' and '%s' actually refer to the same property",
+the names \"%s\" and \"%s\" actually refer to the same property",
symbols[defined_this_segment[i]].name,
symbols[token_value].name);
- error(error_b);
}
property_name_symbol = token_value;
|| (token_type == EOF_TT)
|| ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
{ if (!truth_state)
- ebf_error("attribute name after '~'", token_text);
+ ebf_curtoken_error("attribute name after '~'");
put_token_back(); return;
}
if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
if ((token_type != SYMBOL_TT)
|| (symbols[token_value].type != ATTRIBUTE_T))
- { ebf_error("name of an already-declared attribute", token_text);
+ { ebf_curtoken_error("name of an already-declared attribute");
return;
}
if ((token_type != SYMBOL_TT)
|| (symbols[token_value].type != CLASS_T))
- { ebf_error("name of an already-declared class", token_text);
+ { ebf_curtoken_error("name of an already-declared class");
return;
}
if (current_defn_is_class && token_value == current_classname_symbol)
if (metaclass_flag)
{ token_text = metaclass_name;
- token_value = symbol_index(token_text, -1);
+ token_value = symbol_index(token_text, -1, NULL);
token_type = SYMBOL_TT;
}
else
{ get_next_token();
if (token_type != SYMBOL_TT)
{ discard_token_location(beginning_debug_location);
- ebf_error("new class name", token_text);
+ ebf_curtoken_error("new class name");
panic_mode_error_recovery();
return;
}
/* Each class also creates a modest object representing itself: */
+ ensure_memory_list_available(&shortname_buffer_memlist, strlen(token_text)+1);
strcpy(shortname_buffer, token_text);
assign_symbol(token_value, class_number, CLASS_T);
}
}
+ ensure_memory_list_available(&shortname_buffer_memlist, 2);
sprintf(shortname_buffer, "?");
segment_markers.enabled = TRUE;
if (token_type == DQ_TT) textual_name = token_text;
else
{ if (token_type != SYMBOL_TT) {
- ebf_error("name for new object or its textual short name",
- token_text);
+ ebf_curtoken_error("name for new object or its textual short name");
}
else if (!(symbols[token_value].flags & UNKNOWN_SFLAG)) {
ebf_symbol_error("new object", token_text, typename(symbols[token_value].type), symbols[token_value].line);
{ if ((token_type != SYMBOL_TT)
|| (symbols[token_value].flags & UNKNOWN_SFLAG))
{ if (textual_name == NULL)
- ebf_error("parent object or the object's textual short name",
- token_text);
+ ebf_curtoken_error("parent object or the object's textual short name");
else
- ebf_error("parent object", token_text);
+ ebf_curtoken_error("parent object");
}
else goto SpecParent;
}
if (end_of_header()) goto HeaderPassed;
if (specified_parent != -1)
- ebf_error("body of object definition", token_text);
+ ebf_curtoken_error("body of object definition");
else
{ SpecParent:
if ((symbols[token_value].type == OBJECT_T)
{ specified_parent = symbols[token_value].value;
symbols[token_value].flags |= USED_SFLAG;
}
- else ebf_error("name of (the parent) object", token_text);
+ else ebf_curtoken_error("name of (the parent) object");
}
/* Now it really has to be the body of the definition. */
get_next_token_with_directives();
if (end_of_header()) goto HeaderPassed;
- ebf_error("body of object definition", token_text);
+ ebf_curtoken_error("body of object definition");
HeaderPassed:
if (specified_class == -1) put_token_back();
assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
if (textual_name == NULL)
- { if (internal_name_symbol > 0)
+ {
+ if (internal_name_symbol > 0) {
+ ensure_memory_list_available(&shortname_buffer_memlist, strlen(symbols[internal_name_symbol].name)+4);
sprintf(shortname_buffer, "(%s)",
symbols[internal_name_symbol].name);
- else
+ }
+ else {
+ ensure_memory_list_available(&shortname_buffer_memlist, 32);
sprintf(shortname_buffer, "(%d)", no_objects+1);
+ }
}
else
- { if (strlen(textual_name)>765)
- error("Short name of object (in quotes) exceeded 765 characters");
- strncpy(shortname_buffer, textual_name, 765);
+ {
+ if (!glulx_mode) {
+ /* This check is only advisory. It's possible that a string of less than 765 characters will encode to more than 510 bytes. We'll double-check in write_property_block_z(). */
+ if (strlen(textual_name)>765)
+ error("Short name of object (in quotes) exceeded 765 Z-characters");
+ ensure_memory_list_available(&shortname_buffer_memlist, 766);
+ strncpy(shortname_buffer, textual_name, 765);
+ }
+ else {
+ ensure_memory_list_available(&shortname_buffer_memlist, strlen(textual_name)+1);
+ strcpy(shortname_buffer, textual_name);
+ }
}
if (specified_parent != -1)
properties_table = NULL;
individuals_table = NULL;
commonprops = NULL;
-
+ shortname_buffer = NULL;
+
objectsz = NULL;
objectsg = NULL;
objectatts = NULL;
initialise_memory_list(¤t_object_name,
sizeof(char), 32, NULL,
"object name currently being defined");
+ initialise_memory_list(&shortname_buffer_memlist,
+ sizeof(char), 768, (void**)&shortname_buffer,
+ "textual name of object currently being defined");
initialise_memory_list(&embedded_function_name,
sizeof(char), 32, NULL,
"temporary storage for inline function name");
my_free(&commonprops, "common property info");
deallocate_memory_list(¤t_object_name);
+ deallocate_memory_list(&shortname_buffer_memlist);
deallocate_memory_list(&embedded_function_name);
deallocate_memory_list(&objectsz_memlist);
deallocate_memory_list(&objectsg_memlist);
/* ------------------------------------------------------------------------- */
/* "states" : Statement translator */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
of a 'for' loop specification: replacing ';' with ':'");
else
if (token_value != COLON_SEP)
- { ebf_error("':'", token_text);
+ { ebf_curtoken_error("':'");
panic_mode_error_recovery();
return(FALSE);
}
}
else
- { ebf_error("':'", token_text);
+ { ebf_curtoken_error("':'");
panic_mode_error_recovery();
return(FALSE);
}
{ get_next_token();
if ((token_type == SEP_TT) && (token_value == OPENB_SEP)) return;
put_token_back();
- ebf_error("'('", token_text);
+ ebf_curtoken_error("'('");
}
extern void match_close_bracket(void)
{ get_next_token();
if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP)) return;
put_token_back();
- ebf_error("')'", token_text);
+ ebf_curtoken_error("')'");
}
static void parse_action(void)
codegen_action = TRUE;
}
else
- { codegen_action = FALSE;
+ {
+ if (token_type != UQ_TT) {
+ ebf_curtoken_error("name of action");
+ }
+ codegen_action = FALSE;
AO2 = action_of_name(token_text);
}
}
if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
{
- ebf_error("',' or '>'", token_text);
+ ebf_curtoken_error("',' or '>'");
}
if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
get_next_token();
if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
{
- ebf_error("'>'", token_text);
+ ebf_curtoken_error("'>'");
}
}
{ get_next_token();
if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
{ put_token_back();
- ebf_error("'>>'", token_text);
+ ebf_curtoken_error("'>>'");
}
}
return(symbols[token_value].value);
}
- ebf_error("label name", token_text);
+ ebf_curtoken_error("label name");
return 0;
}
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
switch(token_type)
{ case DQ_TT:
- if (strlen(token_text) > 32)
+ if (token_text[0] == '^' && token_text[1] == '\0') {
+ /* The string "^" is always a simple newline. */
+ assemblez_0(new_line_zc);
+ break;
+ }
+ if ((int)strlen(token_text) > ZCODE_MAX_INLINE_STRING)
{ INITAOT(&AO, LONG_CONSTANT_OT);
AO.marker = STRING_MV;
AO.value = compile_string(token_text, STRCTX_GAME);
AO.marker = IROUTINE_MV;
AO.symindex = token_value;
if (symbols[token_value].type != ROUTINE_T)
- ebf_error("printing routine name", token_text);
+ ebf_curtoken_error("printing routine name");
}
symbols[token_value].flags |= USED_SFLAG;
QUANTITY_CONTEXT, -1), temp_var1);
goto PrintTermDone;
- default: ebf_error("print specification", token_text);
+ default: ebf_curtoken_error("print specification");
get_next_token();
assemblez_1(print_num_zc,
code_generate(parse_expression(QUANTITY_CONTEXT),
get_next_token();
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
if ((token_type != SEP_TT) || (token_value != COMMA_SEP))
- { ebf_error("comma", token_text);
+ { ebf_curtoken_error("comma");
panic_mode_error_recovery(); return;
}
else get_next_token();
} while(TRUE);
- if (count == 0) ebf_error("something to print", token_text);
+ if (count == 0) ebf_curtoken_error("something to print");
if (finally_return)
{ assemblez_0(new_line_zc);
assemblez_0(rtrue_zc);
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
switch(token_type)
{ case DQ_TT:
+ if (token_text[0] == '^' && token_text[1] == '\0') {
+ /* The string "^" is always a simple newline. */
+ INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
+ assembleg_1(streamchar_gc, AO);
+ break;
+ }
/* We can't compile a string into the instruction,
so this always goes into the string area. */
{ INITAOT(&AO, CONSTANT_OT);
get_next_token();
if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
{ assembly_operand AO1;
- int ln, ln2;
put_token_back(); put_token_back();
local_variables.enabled = FALSE;
AO1 = code_generate(
parse_expression(QUANTITY_CONTEXT),
QUANTITY_CONTEXT, -1);
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
- { assembleg_2(stkpeek_gc, zero_operand,
- stack_pointer);
+ if (is_constant_ot(AO1.type) && AO1.marker == 0) {
+ if (AO1.value >= 0 && AO1.value < 0x100)
+ assembleg_1(streamchar_gc, AO1);
+ else
+ assembleg_1(streamunichar_gc, AO1);
+ }
+ else {
+ assembleg_1(streamunichar_gc, AO1);
}
- INITAOTV(&AO2, HALFCONSTANT_OT, 0x100);
- assembleg_2_branch(jgeu_gc, AO1, AO2,
- ln = next_label++);
- ln2 = next_label++;
- assembleg_1(streamchar_gc, AO1);
- assembleg_jump(ln2);
- assemble_label_no(ln);
- assembleg_1(streamunichar_gc, AO1);
- assemble_label_no(ln2);
goto PrintTermDone;
case ADDRESS_MK:
if (runtime_error_checking_switch)
AO.marker = IROUTINE_MV;
AO.symindex = token_value;
if (symbols[token_value].type != ROUTINE_T)
- ebf_error("printing routine name", token_text);
+ ebf_curtoken_error("printing routine name");
}
symbols[token_value].flags |= USED_SFLAG;
AO2);
goto PrintTermDone;
- default: ebf_error("print specification", token_text);
+ default: ebf_curtoken_error("print specification");
get_next_token();
assembleg_1(streamnum_gc,
code_generate(parse_expression(QUANTITY_CONTEXT),
get_next_token();
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
if ((token_type != SEP_TT) || (token_value != COMMA_SEP))
- { ebf_error("comma", token_text);
+ { ebf_curtoken_error("comma");
panic_mode_error_recovery(); return;
}
else get_next_token();
} while(TRUE);
- if (count == 0) ebf_error("something to print", token_text);
+ if (count == 0) ebf_curtoken_error("something to print");
if (finally_return)
{
INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
get_next_token();
if (token_type != SYMBOL_TT)
{
- ebf_error("label name", token_text);
+ ebf_curtoken_error("label name");
return TRUE;
}
}
else
{ if (symbols[token_value].type != LABEL_T) {
- ebf_error("label name", token_text);
+ ebf_curtoken_error("label name");
return TRUE;
}
if (symbols[token_value].flags & CHANGE_SFLAG)
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
+ { ebf_curtoken_error("';'");
put_token_back(); return FALSE;
}
{ parse_action(); goto StatementTerminator; }
if (token_type == EOF_TT)
- { ebf_error("statement", token_text); return; }
+ { ebf_curtoken_error("statement"); return; }
+ /* If we don't see a keyword, this must be a function call or
+ other expression-with-side-effects. */
if (token_type != STATEMENT_TT)
{ put_token_back();
AO = parse_expression(VOID_CONTEXT);
if ((token_type==SEP_TT)&&(token_value==SEMICOLON_SEP))
break;
if (token_type != DQ_TT)
- ebf_error("text of box line in double-quotes",
- token_text);
+ ebf_curtoken_error("text of box line in double-quotes");
{ int i, j;
for (i=0, j=0; token_text[i] != 0; j++)
if (token_text[i] == '@')
if ((token_type != MISC_KEYWORD_TT)
|| ((token_value != ON_MK)
&& (token_value != OFF_MK)))
- { ebf_error("'on' or 'off'", token_text);
+ { ebf_curtoken_error("'on' or 'off'");
panic_mode_error_recovery();
break;
}
{ get_next_token();
if ((token_type != SEP_TT)
|| (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
+ { ebf_curtoken_error("';'");
put_token_back();
}
}
misc_keywords.enabled = FALSE;
if ((token_type != MISC_KEYWORD_TT)
|| (token_value != TO_MK))
- { ebf_error("'to'", token_text);
+ { ebf_curtoken_error("'to'");
panic_mode_error_recovery();
return;
}
(symbols[token_value].type == GLOBAL_VARIABLE_T))
AO.value = symbols[token_value].value;
else
- { ebf_error("'objectloop' variable", token_text);
+ { ebf_curtoken_error("'objectloop' variable");
panic_mode_error_recovery(); break;
}
misc_keywords.enabled = TRUE;
&& (token_value != BOLD_MK)
&& (token_value != UNDERLINE_MK)
&& (token_value != FIXED_MK)))
- { ebf_error(
-"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
- token_text);
+ { ebf_curtoken_error(
+"'roman', 'bold', 'underline', 'reverse' or 'fixed'");
panic_mode_error_recovery();
break;
}
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
+ { ebf_curtoken_error("';'");
put_token_back();
}
}
{ parse_action(); goto StatementTerminator; }
if (token_type == EOF_TT)
- { ebf_error("statement", token_text); return; }
+ { ebf_curtoken_error("statement"); return; }
+ /* If we don't see a keyword, this must be a function call or
+ other expression-with-side-effects. */
if (token_type != STATEMENT_TT)
{ put_token_back();
AO = parse_expression(VOID_CONTEXT);
if ((token_type==SEP_TT)&&(token_value==SEMICOLON_SEP))
break;
if (token_type != DQ_TT)
- ebf_error("text of box line in double-quotes",
- token_text);
+ ebf_curtoken_error("text of box line in double-quotes");
{ int i, j;
for (i=0, j=0; token_text[i] != 0; j++)
if (token_text[i] == '@')
if ((token_type != MISC_KEYWORD_TT)
|| ((token_value != ON_MK)
&& (token_value != OFF_MK)))
- { ebf_error("'on' or 'off'", token_text);
+ { ebf_curtoken_error("'on' or 'off'");
panic_mode_error_recovery();
break;
}
{ get_next_token();
if ((token_type != SEP_TT)
|| (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
+ { ebf_curtoken_error("';'");
put_token_back();
}
}
misc_keywords.enabled = FALSE;
if ((token_type != MISC_KEYWORD_TT)
|| (token_value != TO_MK))
- { ebf_error("'to'", token_text);
+ { ebf_curtoken_error("'to'");
panic_mode_error_recovery();
return;
}
INITAOTV(&AO, GLOBALVAR_OT, symbols[token_value].value);
}
else {
- ebf_error("'objectloop' variable", token_text);
+ ebf_curtoken_error("'objectloop' variable");
panic_mode_error_recovery();
break;
}
}
sequence_point_follows = TRUE;
- ln = symbol_index("Class", -1);
- INITAOT(&AO2, CONSTANT_OT);
- AO2.value = symbols[ln].value;
- AO2.marker = OBJECT_MV;
+ ln = get_symbol_index("Class");
+ if (ln < 0) {
+ error("No 'Class' object found");
+ AO2 = zero_operand;
+ }
+ else {
+ INITAOT(&AO2, CONSTANT_OT);
+ AO2.value = symbols[ln].value;
+ AO2.marker = OBJECT_MV;
+ }
assembleg_store(AO, AO2);
assemble_label_no(ln = next_label++);
&& (token_value != BOLD_MK)
&& (token_value != UNDERLINE_MK)
&& (token_value != FIXED_MK)))
- { ebf_error(
-"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
- token_text);
+ { ebf_curtoken_error(
+"'roman', 'bold', 'underline', 'reverse' or 'fixed'");
panic_mode_error_recovery();
break;
}
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
+ { ebf_curtoken_error("';'");
put_token_back();
}
}
execution_never_reaches_here &= ~EXECSTATE_ENTIRE;
}
+/* This does the same work as parse_statement(), but it's called if you've
+ already parsed an expression (in void context) and you want to generate
+ it as a statement. Essentially it's a copy of parse_statement() and
+ parse_statement_z/g(), except we skip straight to the "expression-with-
+ side-effects" bit and omit everything else.
+
+ The caller doesn't need to pass break_label/continue_label; they're
+ not used for this code path.
+*/
+extern void parse_statement_singleexpr(assembly_operand AO)
+{
+ int res;
+ int saved_entire_flag;
+
+ res = parse_named_label_statements();
+ if (!res)
+ return;
+
+ saved_entire_flag = (execution_never_reaches_here & EXECSTATE_ENTIRE);
+ if (execution_never_reaches_here)
+ execution_never_reaches_here |= EXECSTATE_ENTIRE;
+
+ code_generate(AO, VOID_CONTEXT, -1);
+
+ if (vivc_flag) {
+ panic_mode_error_recovery();
+ }
+ else {
+ /* StatementTerminator... */
+ get_next_token();
+ if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+ { ebf_curtoken_error("';'");
+ put_token_back();
+ }
+ }
+
+ if (saved_entire_flag)
+ execution_never_reaches_here |= EXECSTATE_ENTIRE;
+ else
+ execution_never_reaches_here &= ~EXECSTATE_ENTIRE;
+}
+
/* ========================================================================= */
/* Data structure management routines */
/* ------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------- */
/* "symbols" : The symbols table; creating stock of reserved words */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
static memory_list symbols_memlist;
symboldebuginfo *symbol_debug_info; /* Allocated up to no_symbols */
static memory_list symbol_debug_info_memlist;
+static char *temp_symbol_buf; /* used in write_the_identifier_names() */
+static memory_list temp_symbol_buf_memlist;
/* ------------------------------------------------------------------------- */
/* Memory to hold the text of symbol names: note that this memory is */
-/* allocated as needed in chunks of size SYMBOLS_CHUNK_SIZE. */
+/* allocated as needed in chunks of size SYMBOLS_CHUNK_SIZE. (Or */
+/* larger, if needed for a particularly enormous symbol.) */
/* ------------------------------------------------------------------------- */
#define SYMBOLS_CHUNK_SIZE (4096)
return -1;
}
-extern int symbol_index(char *p, int hashcode)
+extern int symbol_index(char *p, int hashcode, int *created)
{
/* Return the index in the symbols array of symbol "p", creating a
- new symbol with that name if it isn't already there.
+ new symbol with that name if it isn't already there. This
+ always returns a valid symbol index.
+
+ The optional created argument receives TRUE if the symbol
+ was newly created.
+
+ Pass in the hashcode of p if you know it, or -1 if you don't.
New symbols are created with flag UNKNOWN_SFLAG, value 0x100
(a 2-byte quantity in Z-machine terms) and type CONSTANT_T.
{
if (track_unused_routines)
df_note_function_symbol(this);
+ if (created) *created = FALSE;
return this;
}
if (new_entry > 0) break;
} while (this != -1);
if (symdef_trace_setting)
- printf("Encountered symbol %d '%s'\n", no_symbols, p);
+ printf("%s: Encountered symbol %d '%s'\n", current_location_text(), no_symbols, p);
ensure_memory_list_available(&symbols_memlist, no_symbols+1);
if (debugfile_switch)
}
len = strlen(p);
- if (symbols_free_space+len+1 >= symbols_ceiling)
- { symbols_free_space
- = my_malloc(SYMBOLS_CHUNK_SIZE, "symbol names chunk");
- symbols_ceiling = symbols_free_space + SYMBOLS_CHUNK_SIZE;
+ if (!symbols_free_space || symbols_free_space+len+1 >= symbols_ceiling)
+ {
+ /* Allocate a new chunk whose size is big enough for the current
+ symbol, or SYMBOLS_CHUNK_SIZE, whichever is greater. */
+ int chunklen = SYMBOLS_CHUNK_SIZE;
+ if (chunklen < len+1)
+ chunklen = len+1;
+ symbols_free_space
+ = my_malloc(chunklen, "symbol names chunk");
+ symbols_ceiling = symbols_free_space + chunklen;
ensure_memory_list_available(&symbol_name_space_chunks_memlist, no_symbol_name_space_chunks+1);
symbol_name_space_chunks[no_symbol_name_space_chunks++]
= symbols_free_space;
- if (symbols_free_space+len+1 >= symbols_ceiling)
- {
- /* This should be impossible, since SYMBOLS_CHUNK_SIZE > MAX_IDENTIFIER_LENGTH. */
- fatalerror("Symbol exceeds the maximum possible length");
- }
}
strcpy(symbols_free_space, p);
if (track_unused_routines)
df_note_function_symbol(no_symbols);
+ if (created) *created = TRUE;
return(no_symbols++);
}
-extern void end_symbol_scope(int k)
+extern void end_symbol_scope(int k, int neveruse)
{
/* Remove the given symbol from the hash table, making it
- invisible to symbol_index. This is used by the Undef directive.
- If the symbol is not found, this silently does nothing.
+ invisible to symbol_index. This is used by the Undef directive
+ and put_token_back().
+
+ If you know the symbol has never been used, set neveruse and
+ it will be flagged as an error if it *is* used.
+
+ If the symbol is not found in the hash table, this silently does
+ nothing.
*/
int j;
+
+ symbols[k].flags |= UNHASHED_SFLAG;
+ if (neveruse)
+ symbols[k].flags |= DISCARDED_SFLAG;
+
j = hash_code_from_string(symbols[k].name);
if (start_of_list[j] == k)
{ start_of_list[j] = symbols[k].next_entry;
if (flags & USED_SFLAG) printf("(used) ");
if (flags & DEFCON_SFLAG) printf("(Defaulted) ");
if (flags & STUB_SFLAG) printf("(Stubbed) ");
- if (flags & IMPORT_SFLAG) printf("(Imported) ");
- if (flags & EXPORT_SFLAG) printf("(Exported) ");
+ if (flags & UNHASHED_SFLAG) printf("(not in hash chain) ");
+ if (flags & DISCARDED_SFLAG) printf("(removed, do not use) ");
if (flags & ALIASED_SFLAG) printf("(aliased) ");
if (flags & CHANGE_SFLAG) printf("(value will change) ");
if (flags & SYSTEM_SFLAG) printf("(System) ");
}
/* Now back to mark anything necessary as used */
- i = symbol_index("Main", -1);
- if (!(symbols[i].flags & UNKNOWN_SFLAG)) symbols[i].flags |= USED_SFLAG;
+ i = get_symbol_index("Main");
+ if (i >= 0 && !(symbols[i].flags & UNKNOWN_SFLAG)) {
+ symbols[i].flags |= USED_SFLAG;
+ }
for (i=0;i<no_symbols;i++)
{ if (((symbols[i].flags
- & (SYSTEM_SFLAG + UNKNOWN_SFLAG + EXPORT_SFLAG
+ & (SYSTEM_SFLAG + UNKNOWN_SFLAG
+ INSF_SFLAG + USED_SFLAG + REPLACE_SFLAG)) == 0)
- && (symbols[i].type != OBJECT_T))
+ && (symbols[i].type != OBJECT_T)) {
dbnu_warning(typename(symbols[i].type), symbols[i].name, symbols[i].line);
+ }
+ if ((symbols[i].flags & DISCARDED_SFLAG)
+ && (symbols[i].flags & USED_SFLAG)) {
+ error_named_at("Symbol was removed from the symbol table, but seems to be in use anyway", symbols[i].name, symbols[i].line);
+ }
}
}
/* ------------------------------------------------------------------------- */
/* These are arrays used only during story file creation, and not */
-/* allocated until then. */
+/* allocated until just before write_the_identifier_names() time. */
int32 *individual_name_strings; /* Packed addresses of Z-encoded
strings of the names of the
int32 *array_name_strings; /* Ditto for arrays */
extern void write_the_identifier_names(void)
-{ int i, j, k, t, null_value; char idname_string[256];
+{ int i, j, k, t, null_value;
static char unknown_attribute[20] = "<unknown attribute>";
for (i=0; i<no_individual_properties; i++)
if ((t == INDIVIDUAL_PROPERTY_T) || (t == PROPERTY_T))
{ if (symbols[i].flags & ALIASED_SFLAG)
{ if (individual_name_strings[symbols[i].value] == 0)
- { sprintf(idname_string, "%s", symbols[i].name);
+ {
+ int sleni = strlen(symbols[i].name);
+ ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+ sprintf(temp_symbol_buf, "%s", symbols[i].name);
for (j=i+1, k=0; (j<no_symbols && k<3); j++)
{ if ((symbols[j].type == symbols[i].type)
&& (symbols[j].value == symbols[i].value))
- { sprintf(idname_string+strlen(idname_string),
+ {
+ int slenj = strlen(symbols[j].name);
+ ensure_memory_list_available(&temp_symbol_buf_memlist, strlen(temp_symbol_buf)+1+slenj+1);
+ sprintf(temp_symbol_buf+strlen(temp_symbol_buf),
"/%s", symbols[j].name);
k++;
}
}
individual_name_strings[symbols[i].value]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
}
}
else
- { sprintf(idname_string, "%s", symbols[i].name);
-
+ {
individual_name_strings[symbols[i].value]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(symbols[i].name, STRCTX_SYMBOL);
}
}
if (t == ATTRIBUTE_T)
- { if (symbols[i].flags & ALIASED_SFLAG)
+ {
+ if (symbols[i].flags & ALIASED_SFLAG)
{ if (attribute_name_strings[symbols[i].value] == null_value)
- { sprintf(idname_string, "%s", symbols[i].name);
+ {
+ int sleni = strlen(symbols[i].name);
+ ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+ sprintf(temp_symbol_buf, "%s", symbols[i].name);
for (j=i+1, k=0; (j<no_symbols && k<3); j++)
{ if ((symbols[j].type == symbols[i].type)
&& (symbols[j].value == symbols[i].value))
- { sprintf(idname_string+strlen(idname_string),
+ {
+ int slenj = strlen(symbols[j].name);
+ ensure_memory_list_available(&temp_symbol_buf_memlist, strlen(temp_symbol_buf)+1+slenj+1);
+ sprintf(temp_symbol_buf+strlen(temp_symbol_buf),
"/%s", symbols[j].name);
k++;
}
}
attribute_name_strings[symbols[i].value]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
}
}
else
- { sprintf(idname_string, "%s", symbols[i].name);
-
+ {
attribute_name_strings[symbols[i].value]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(symbols[i].name, STRCTX_SYMBOL);
}
}
+
if (symbols[i].flags & ACTION_SFLAG)
- { sprintf(idname_string, "%s", symbols[i].name);
- idname_string[strlen(idname_string)-3] = 0;
+ {
+ int sleni = strlen(symbols[i].name);
+ ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+ sprintf(temp_symbol_buf, "%s", symbols[i].name);
+ temp_symbol_buf[strlen(temp_symbol_buf)-3] = 0;
if (debugfile_switch)
{ debug_file_printf("<action>");
debug_file_printf
- ("<identifier>##%s</identifier>", idname_string);
+ ("<identifier>##%s</identifier>", temp_symbol_buf);
debug_file_printf("<value>%d</value>", symbols[i].value);
debug_file_printf("</action>");
}
action_name_strings[symbols[i].value]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
}
}
for (i=0; i<no_symbols; i++)
{ if (symbols[i].type == FAKE_ACTION_T)
- { sprintf(idname_string, "%s", symbols[i].name);
- idname_string[strlen(idname_string)-3] = 0;
+ {
+ int sleni = strlen(symbols[i].name);
+ ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
+ sprintf(temp_symbol_buf, "%s", symbols[i].name);
+ temp_symbol_buf[strlen(temp_symbol_buf)-3] = 0;
action_name_strings[symbols[i].value
- ((grammar_version_number==1)?256:4096) + no_actions]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
}
}
for (j=0; j<no_arrays; j++)
- { i = arrays[j].symbol;
- sprintf(idname_string, "%s", symbols[i].name);
-
+ {
+ i = arrays[j].symbol;
array_name_strings[j]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(symbols[i].name, STRCTX_SYMBOL);
}
- if (define_INFIX_switch)
- { for (i=0; i<no_symbols; i++)
- { if (symbols[i].type == GLOBAL_VARIABLE_T)
- { sprintf(idname_string, "%s", symbols[i].name);
- array_name_strings[no_arrays + symbols[i].value -16]
- = compile_string(idname_string, STRCTX_SYMBOL);
+
+ if (define_INFIX_switch)
+ {
+ for (i=0; i<no_symbols; i++)
+ { if (symbols[i].type == GLOBAL_VARIABLE_T)
+ {
+ array_name_strings[no_arrays + symbols[i].value -16]
+ = compile_string(symbols[i].name, STRCTX_SYMBOL);
+ }
}
- }
-
- for (i=0; i<no_named_routines; i++)
- { sprintf(idname_string, "%s", symbols[named_routine_symbols[i]].name);
+
+ for (i=0; i<no_named_routines; i++)
+ {
array_name_strings[no_arrays + no_globals + i]
- = compile_string(idname_string, STRCTX_SYMBOL);
- }
-
- for (i=0, no_named_constants=0; i<no_symbols; i++)
- { if (((symbols[i].type == OBJECT_T) || (symbols[i].type == CLASS_T)
- || (symbols[i].type == CONSTANT_T))
- && ((symbols[i].flags & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
- { sprintf(idname_string, "%s", symbols[i].name);
- array_name_strings[no_arrays + no_globals + no_named_routines
- + no_named_constants++]
- = compile_string(idname_string, STRCTX_SYMBOL);
+ = compile_string(symbols[named_routine_symbols[i]].name, STRCTX_SYMBOL);
+ }
+
+ for (i=0, no_named_constants=0; i<no_symbols; i++)
+ { if (((symbols[i].type == OBJECT_T) || (symbols[i].type == CLASS_T)
+ || (symbols[i].type == CONSTANT_T))
+ && ((symbols[i].flags & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
+ {
+ array_name_strings[no_arrays + no_globals + no_named_routines
+ + no_named_constants++]
+ = compile_string(symbols[i].name, STRCTX_SYMBOL);
+ }
}
}
- }
veneer_mode = FALSE;
}
assign_symbol_base(index, value, type);
symbols[index].marker = 0;
if (symdef_trace_setting)
- printf("Defined symbol %d '%s' as %d (%s)\n", index, symbols[index].name, value, typename(type));
+ printf("%s: Defined symbol %d '%s' as %d (%s)\n", current_location_text(), index, symbols[index].name, value, typename(type));
}
extern void assign_marked_symbol(int index, int marker, int32 value, int type)
assign_symbol_base(index, value, type);
symbols[index].marker = marker;
if (symdef_trace_setting)
- printf("Defined symbol %d '%s' as %s %d (%s)\n", index, symbols[index].name, describe_mv(marker), value, typename(type));
+ printf("%s: Defined symbol %d '%s' as %s %d (%s)\n", current_location_text(), index, symbols[index].name, describe_mv(marker), value, typename(type));
}
static void emit_debug_information_for_predefined_symbol
}
static void create_symbol(char *p, int32 value, int type)
-{ int i = symbol_index(p, -1);
+{ int i = symbol_index(p, -1, NULL);
if (!(symbols[i].flags & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))) {
/* Symbol already defined! */
if (symbols[i].value == value && symbols[i].type == type) {
}
static void create_rsymbol(char *p, int value, int type)
-{ int i = symbol_index(p, -1);
+{ int i = symbol_index(p, -1, NULL);
/* This is only called for a few symbols with known names.
They will not collide. */
symbols[i].value = value; symbols[i].type = type; symbols[i].line = blank_brief_location;
create_rsymbol("Grammar__Version", 1, CONSTANT_T);
else
create_rsymbol("Grammar__Version", 2, CONSTANT_T);
- grammar_version_symbol = symbol_index("Grammar__Version", -1);
+ grammar_version_symbol = get_symbol_index("Grammar__Version");
if (runtime_error_checking_switch)
create_rsymbol("STRICT_MODE",0, CONSTANT_T);
create_symbol("infix__watching", 0, ATTRIBUTE_T);
}
+ if (OMIT_SYMBOL_TABLE)
+ create_symbol("OMIT_SYMBOL_TABLE", 0, CONSTANT_T);
+
create_symbol("WORDSIZE", WORDSIZE, CONSTANT_T);
/* DICT_ENTRY_BYTES must be REDEFINABLE_SFLAG because the Version directive can change it. */
create_rsymbol("DICT_ENTRY_BYTES", DICT_ENTRY_BYTE_LENGTH, CONSTANT_T);
issue_unused_warnings(). But for the sake of thoroughness,
we'll mark them specially. */
- ix = symbol_index("Main__", -1);
- if (symbols[ix].type == ROUTINE_T) {
+ ix = get_symbol_index("Main__");
+ if (ix >= 0 && symbols[ix].type == ROUTINE_T) {
uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
tofunc = df_function_for_address(addr);
if (tofunc)
tofunc->usage |= DF_USAGE_MAIN;
}
- ix = symbol_index("Main", -1);
- if (symbols[ix].type == ROUTINE_T) {
+ ix = get_symbol_index("Main");
+ if (ix >= 0 && symbols[ix].type == ROUTINE_T) {
uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
tofunc = df_function_for_address(addr);
if (tofunc)
symbols = NULL;
start_of_list = NULL;
symbol_debug_info = NULL;
+ temp_symbol_buf = NULL;
symbol_name_space_chunks = NULL;
no_symbol_name_space_chunks = 0;
- symbols_free_space=NULL;
- symbols_ceiling=NULL;
+ symbols_free_space = NULL;
+ symbols_ceiling = NULL;
no_symbols = 0;
sizeof(symboldebuginfo), 6400, (void**)&symbol_debug_info,
"symbol debug backpatch info");
}
+
+ initialise_memory_list(&temp_symbol_buf_memlist,
+ sizeof(char), 64, (void**)&temp_symbol_buf,
+ "temporary symbol name");
+
start_of_list = my_calloc(sizeof(int32), HASH_TAB_SIZE,
"hash code list beginnings");
{
deallocate_memory_list(&symbol_debug_info_memlist);
}
+ deallocate_memory_list(&temp_symbol_buf_memlist);
+
my_free(&start_of_list, "hash code list beginnings");
if (symbol_replacements)
/* ------------------------------------------------------------------------- */
/* "syntax" : Syntax analyser and compiler */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
Object, where we want to support internal #ifdefs. (Although
function-parsing predates this and doesn't make use of it.) */
- int directives_save, segment_markers_save, statements_save;
-
while (TRUE)
{
+ int directives_save, segment_markers_save, statements_save,
+ conditions_save, local_variables_save, misc_keywords_save,
+ system_functions_save;
+
get_next_token();
/* If the first token is not a '#', return it directly. */
directives_save = directives.enabled;
segment_markers_save = segment_markers.enabled;
statements_save = statements.enabled;
+ conditions_save = conditions.enabled;
+ local_variables_save = local_variables.enabled;
+ misc_keywords_save = misc_keywords.enabled;
+ system_functions_save = system_functions.enabled;
directives.enabled = TRUE;
segment_markers.enabled = FALSE;
if (token_type == DIRECTIVE_TT)
parse_given_directive(TRUE);
else
- { ebf_error("directive", token_text);
+ { ebf_curtoken_error("directive");
return;
}
- /* Restore all the lexer flags. (We are squashing several of them
- into a single save variable, which I think is safe because that's
- what CKnight did.)
- */
+ /* Restore all the lexer flags. */
directive_keywords.enabled = FALSE;
directives.enabled = directives_save;
segment_markers.enabled = segment_markers_save;
- statements.enabled =
- conditions.enabled =
- local_variables.enabled =
- misc_keywords.enabled =
- system_functions.enabled = statements_save;
+ statements.enabled = statements_save;
+ conditions.enabled = conditions_save;
+ local_variables.enabled = local_variables_save;
+ misc_keywords.enabled = misc_keywords_save;
+ system_functions.enabled = system_functions_save;
}
}
get_next_token();
df_dont_note_global_symbols = FALSE;
if (token_type != SYMBOL_TT)
- { ebf_error("routine name", token_text);
+ { ebf_curtoken_error("routine name");
return(FALSE);
}
if ((!(symbols[token_value].flags & UNKNOWN_SFLAG))
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';' after ']'", token_text);
+ { ebf_curtoken_error("';' after ']'");
put_token_back();
}
return TRUE;
{ /* If we're internal, we expect only a directive here. If
we're top-level, the possibilities are broader. */
if (internal_flag)
- ebf_error("directive", token_text);
+ ebf_curtoken_error("directive");
else
- ebf_error("directive, '[' or class name", token_text);
+ ebf_curtoken_error("directive, '[' or class name");
panic_mode_error_recovery();
return TRUE;
}
return !(parse_given_directive(internal_flag));
}
-/* Check what's coming up after a switch case value. */
+/* Check what's coming up after a switch case value.
+ (This is "switch sign" in the sense of "worm sign", not like a signed
+ variable.) */
static int switch_sign(void)
{
if ((token_type == SEP_TT)&&(token_value == COLON_SEP)) return 1;
compile_alternatives_g(switch_value, n, stack_level, label, flag);
}
+static void generate_switch_spec(assembly_operand switch_value, int label, int label_after, int speccount);
+
static void parse_switch_spec(assembly_operand switch_value, int label,
int action_switch)
{
- int i, j, label_after = -1, spec_sp = 0;
- int max_equality_args = ((!glulx_mode) ? 3 : 1);
+ int label_after = -1, spec_sp = 0;
sequence_point_follows = FALSE;
do
{ if (spec_sp >= MAX_SPEC_STACK)
- { error("At most 32 values can be given in a single 'switch' case");
+ { error_fmt("At most %d values can be given in a single 'switch' case", MAX_SPEC_STACK);
panic_mode_error_recovery();
return;
}
if (action_switch)
{ get_next_token();
if (token_type == SQ_TT || token_type == DQ_TT) {
- ebf_error("action (or fake action) name", token_text);
+ ebf_curtoken_error("action (or fake action) name");
continue;
}
spec_stack[spec_sp] = action_of_name(token_text);
if (spec_stack[spec_sp].value == -1)
{ spec_stack[spec_sp].value = 0;
- ebf_error("action (or fake action) name", token_text);
+ ebf_curtoken_error("action (or fake action) name");
}
}
- else
+ else {
spec_stack[spec_sp] =
code_generate(parse_expression(CONSTANT_CONTEXT), CONSTANT_CONTEXT, -1);
+ }
misc_keywords.enabled = TRUE;
get_next_token();
switch(spec_type[spec_sp-1])
{ case 0:
if (action_switch)
- ebf_error("',' or ':'", token_text);
- else ebf_error("',', ':' or 'to'", token_text);
+ ebf_curtoken_error("',' or ':'");
+ else ebf_curtoken_error("',', ':' or 'to'");
panic_mode_error_recovery();
return;
case 1: goto GenSpecCode;
case 3: if (label_after == -1) label_after = next_label++;
}
- } while(TRUE);
-
- GenSpecCode:
-
- if ((spec_sp > max_equality_args) && (label_after == -1))
- label_after = next_label++;
-
- if (label_after == -1)
- { compile_alternatives(switch_value, spec_sp, 0, label, FALSE); return;
- }
-
- for (i=0; i<spec_sp;)
- {
- j=i; while ((j<spec_sp) && (spec_type[j] != 3)) j++;
-
- if (j > i)
- { if (j-i > max_equality_args) j=i+max_equality_args;
-
- if (j == spec_sp)
- compile_alternatives(switch_value, j-i, i, label, FALSE);
- else
- compile_alternatives(switch_value, j-i, i, label_after, TRUE);
-
- i=j;
- }
- else
- {
- if (!glulx_mode) {
- if (i == spec_sp - 2)
- { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
- label, TRUE);
- assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
- label, TRUE);
- }
- else
- { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
- next_label, TRUE);
- assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
- label_after, FALSE);
- assemble_label_no(next_label++);
- }
- }
- else {
- if (i == spec_sp - 2)
- { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
- label);
- assembleg_2_branch(jgt_gc, switch_value, spec_stack[i+1],
- label);
- }
- else
- { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
- next_label);
- assembleg_2_branch(jle_gc, switch_value, spec_stack[i+1],
- label_after);
- assemble_label_no(next_label++);
- }
- }
- i = i+2;
- }
- }
-
- assemble_label_no(label_after);
+ } while(TRUE);
+
+ GenSpecCode:
+ generate_switch_spec(switch_value, label, label_after, spec_sp);
+}
+
+/* Generate code for a switch case. The case values are in spec_stack[]
+ and spec_type[]. */
+static void generate_switch_spec(assembly_operand switch_value, int label, int label_after, int speccount)
+{
+ int i, j;
+ int max_equality_args = ((!glulx_mode) ? 3 : 1);
+
+ sequence_point_follows = FALSE;
+
+ if ((speccount > max_equality_args) && (label_after == -1))
+ label_after = next_label++;
+
+ if (label_after == -1)
+ { compile_alternatives(switch_value, speccount, 0, label, FALSE); return;
+ }
+
+ for (i=0; i<speccount;)
+ {
+ j=i; while ((j<speccount) && (spec_type[j] != 3)) j++;
+
+ if (j > i)
+ { if (j-i > max_equality_args) j=i+max_equality_args;
+
+ if (j == speccount)
+ compile_alternatives(switch_value, j-i, i, label, FALSE);
+ else
+ compile_alternatives(switch_value, j-i, i, label_after, TRUE);
+
+ i=j;
+ }
+ else
+ {
+ if (!glulx_mode) {
+ if (i == speccount - 2)
+ { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
+ label, TRUE);
+ assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
+ label, TRUE);
+ }
+ else
+ { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
+ next_label, TRUE);
+ assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
+ label_after, FALSE);
+ assemble_label_no(next_label++);
+ }
+ }
+ else {
+ if (i == speccount - 2)
+ { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
+ label);
+ assembleg_2_branch(jgt_gc, switch_value, spec_stack[i+1],
+ label);
+ }
+ else
+ { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
+ next_label);
+ assembleg_2_branch(jle_gc, switch_value, spec_stack[i+1],
+ label_after);
+ assemble_label_no(next_label++);
+ }
+ }
+ i = i+2;
+ }
+ }
+
+ assemble_label_no(label_after);
}
extern int32 parse_routine(char *source, int embedded_flag, char *name,
restart_lexer(lexical_source, name);
}
- no_locals = 0;
-
- for (i=0;i<MAX_LOCAL_VARIABLES-1;i++)
- local_variable_names[i].text[0] = 0;
+ clear_local_variables();
do
{ statements.enabled = TRUE;
{ debug_flag = TRUE; continue;
}
- if (token_type != DQ_TT)
+ if (token_type != UQ_TT)
{ if ((token_type == SEP_TT)
&& (token_value == SEMICOLON_SEP)) break;
- ebf_error("local variable name or ';'", token_text);
- panic_mode_error_recovery();
- break;
- }
-
- if (strlen(token_text) > MAX_IDENTIFIER_LENGTH)
- { error_named("Local variable identifier too long:", token_text);
+ ebf_curtoken_error("local variable name or ';'");
panic_mode_error_recovery();
break;
}
if (no_locals == MAX_LOCAL_VARIABLES-1)
- { error_numbered("Too many local variables for a routine; max is",
+ { error_fmt("Too many local variables for a routine; max is %d",
MAX_LOCAL_VARIABLES-1);
panic_mode_error_recovery();
break;
}
for (i=0;i<no_locals;i++) {
- if (strcmpcis(token_text, local_variable_names[i].text)==0)
+ if (strcmpcis(token_text, get_local_variable_name(i))==0)
error_named("Local variable defined twice:", token_text);
}
- strcpy(local_variable_names[no_locals++].text, token_text);
+ add_local_variable(token_text);
} while(TRUE);
/* Set up the local variable hash and the local_variables.keywords
if ((embedded_flag == FALSE) && (veneer_mode == FALSE) && debug_flag)
symbols[r_symbol].flags |= STAR_SFLAG;
- packed_address = assemble_routine_header(no_locals, debug_flag,
+ packed_address = assemble_routine_header(debug_flag,
name, embedded_flag, r_symbol);
do
get_next_token();
if (token_type == EOF_TT)
- { ebf_error("']'", token_text);
+ { ebf_curtoken_error("']'");
assemble_routine_end
(embedded_flag,
get_token_location_end(beginning_debug_location));
get_next_token();
if ((token_type == SEP_TT) &&
(token_value == COLON_SEP)) continue;
- ebf_error("':' after 'default'", token_text);
+ ebf_curtoken_error("':' after 'default'");
panic_mode_error_recovery();
continue;
}
/* Only check for the form of a case switch if the initial token
isn't double-quoted text, as that would mean it was a print_ret
statement: this is a mild ambiguity in the grammar.
- Action statements also cannot be cases. */
+ Action statements also cannot be cases.
+ We don't try to handle parenthesized expressions as cases
+ at the top level. */
if ((token_type != DQ_TT) && (token_type != SEP_TT))
{ get_next_token();
break;
}
if (token_type == EOF_TT)
- { ebf_error("'}'", token_text);
+ { ebf_curtoken_error("'}'");
break;
}
get_next_token();
if ((token_type == SEP_TT) &&
(token_value == COLON_SEP)) continue;
- ebf_error("':' after 'default'", token_text);
+ ebf_curtoken_error("':' after 'default'");
panic_mode_error_recovery();
continue;
}
/* Decide: is this an ordinary statement, or the start
of a new case? */
+ /* Again, double-quoted text is a print_ret statement. */
if (token_type == DQ_TT) goto NotASwitchCase;
+ if ((token_type == SEP_TT)&&(token_value == OPENB_SEP)) {
+ /* An open-paren means we need to parse a full
+ expression. */
+ assembly_operand AO;
+ int constcount;
+ put_token_back();
+ AO = parse_expression(VOID_CONTEXT);
+ /* If this expression is followed by a colon, we'll
+ handle it as a switch case. */
+ constcount = test_constant_op_list(&AO, spec_stack, MAX_SPEC_STACK);
+ if ((token_type == SEP_TT)&&(token_value == COLON_SEP)) {
+ int ix;
+
+ if (!constcount)
+ {
+ ebf_error("constant", "<expression>");
+ panic_mode_error_recovery();
+ continue;
+ }
+
+ if (constcount > MAX_SPEC_STACK)
+ { error_fmt("At most %d values can be given in a single 'switch' case", MAX_SPEC_STACK);
+ panic_mode_error_recovery();
+ continue;
+ }
+
+ get_next_token();
+ /* Gotta fill in the spec_type values for the
+ spec_stacks. */
+ for (ix=0; ix<constcount-1; ix++)
+ spec_type[ix] = 2; /* comma */
+ spec_type[constcount-1] = 1; /* colon */
+
+ /* The rest of this is parallel to the
+ parse_switch_spec() case below. */
+ /* Before you ask: yes, the spec_stacks values
+ appear in the reverse order from how
+ parse_switch_spec() would do it. The results
+ are the same because we're just comparing
+ temp_var1 with a bunch of constants. */
+ if (default_clause_made)
+ error("'default' must be the last 'switch' case");
+
+ if (switch_clause_made)
+ { if (!execution_never_reaches_here)
+ { sequence_point_follows = FALSE;
+ assemble_jump(break_label);
+ }
+ assemble_label_no(switch_label);
+ }
+
+ switch_label = next_label++;
+ switch_clause_made = TRUE;
+
+ AO = temp_var1;
+ generate_switch_spec(AO, switch_label, -1, constcount);
+ continue;
+ }
+
+ /* Otherwise, treat this as a statement. Imagine
+ we've jumped down to NotASwitchCase, except that
+ we have the expression AO already parsed. */
+ sequence_point_follows = TRUE;
+ parse_statement_singleexpr(AO);
+ continue;
+ }
+
unary_minus_flag
= ((token_type == SEP_TT)&&(token_value == MINUS_SEP));
if (unary_minus_flag) get_next_token();
}
if ((switch_rule != 0) && (!switch_clause_made))
- ebf_error("switch value", token_text);
+ ebf_curtoken_error("switch value");
NotASwitchCase:
sequence_point_follows = TRUE;
}
else {
if (switch_rule != 0)
- ebf_error("braced code block after 'switch'", token_text);
+ ebf_curtoken_error("braced code block after 'switch'");
/* Parse a single statement. */
parse_statement(break_label, continue_label);
/* of dynamic memory, gluing together all the required */
/* tables. */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* 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 ability to work out today's date */
time_t tt; tt=time(0);
- if (serial_code_given_in_program)
+ if (serial_code_given_in_program) {
strcpy(buffer, serial_code_buffer);
- else
+ }
+ else {
#ifdef TIME_UNAVAILABLE
sprintf(buffer,"970000");
#else
- strftime(buffer,10,"%y%m%d",localtime(&tt));
+ /* Write a six-digit date, null-terminated. Fall back to "970000"
+ if that fails. */
+ int len = strftime(buffer,7,"%y%m%d",localtime(&tt));
+ if (len != 6)
+ sprintf(buffer,"970000");
#endif
+ }
}
-static char percentage_buffer[32];
+static char percentage_buffer[64];
static char *show_percentage(int32 x, int32 total)
{
else if (x == 0) {
sprintf(percentage_buffer, " ( --- )");
}
- else {
+ else if (memory_map_setting < 3) {
sprintf(percentage_buffer, " (%.1f %%)", (float)x * 100.0 / (float)total);
}
+ else {
+ sprintf(percentage_buffer, " (%.1f %%, %d bytes)", (float)x * 100.0 / (float)total, x);
+ }
return percentage_buffer;
}
case 4: return "Plus";
case 5: return "Advanced";
case 6: return "Graphical";
+ case 7: return "Extended Alternate";
case 8: return "Extended";
}
return "experimental format";
grammar_table_at=0, charset_at=0, headerext_at=0,
terminating_chars_at=0, unicode_at=0, id_names_length=0,
static_arrays_at=0;
+ int32 rough_size;
int skip_backpatching = FALSE;
char *output_called = "story file";
ASSERT_ZCODE();
- individual_name_strings =
- my_calloc(sizeof(int32), no_individual_properties,
- "identifier name strings");
- action_name_strings =
- my_calloc(sizeof(int32), no_actions + no_fake_actions,
- "action name strings");
- attribute_name_strings =
- my_calloc(sizeof(int32), 48,
- "attribute name strings");
- array_name_strings =
- my_calloc(sizeof(int32),
- no_symbols,
- "array name strings");
+ if (!OMIT_SYMBOL_TABLE) {
+ individual_name_strings =
+ my_calloc(sizeof(int32), no_individual_properties,
+ "identifier name strings");
+ action_name_strings =
+ my_calloc(sizeof(int32), no_actions + no_fake_actions,
+ "action name strings");
+ attribute_name_strings =
+ my_calloc(sizeof(int32), 48,
+ "attribute name strings");
+ array_name_strings =
+ my_calloc(sizeof(int32),
+ no_symbols,
+ "array name strings");
- write_the_identifier_names();
+ write_the_identifier_names();
+ }
/* We now know how large the buffer to hold our construction has to be */
- zmachine_paged_memory = my_malloc(rough_size_of_paged_memory_z(),
- "output buffer");
+ rough_size = rough_size_of_paged_memory_z();
+ zmachine_paged_memory = my_malloc(rough_size, "output buffer");
/* Foolish code to make this routine compile on all ANSI compilers */
points its value will be recorded for milestones like
"dictionary table start". It begins at 0x40, just after the header */
- mark = 0x40;
+ for (mark=0; mark<0x40; mark++)
+ p[mark] = 0x0;
/* ----------------- Low Strings and Abbreviations -------------------- */
identifier_names_offset = mark;
- if (TRUE)
+ if (!OMIT_SYMBOL_TABLE)
{ p[mark++] = no_individual_properties/256;
p[mark++] = no_individual_properties%256;
for (i=1; i<no_individual_properties; i++)
id_names_length = (mark - identifier_names_offset)/2;
}
+ else {
+ attribute_names_offset = mark;
+ action_names_offset = mark;
+ fake_action_names_offset = mark;
+ array_names_offset = mark;
+ global_names_offset = mark;
+ routine_names_offset = mark;
+ constant_names_offset = mark;
+ id_names_length = 0;
+ }
+
routine_flags_array_offset = mark;
if (define_INFIX_switch)
for (i=0; i<no_Inform_verbs; i++)
{ p[grammar_table_at + i*2] = (mark/256);
p[grammar_table_at + i*2 + 1] = (mark%256);
+ if (!Inform_verbs[i].used) {
+ /* This verb was marked unused at locate_dead_grammar_lines()
+ time. Omit the grammar lines. */
+ p[mark++] = 0;
+ continue;
+ }
p[mark++] = Inform_verbs[i].lines;
for (j=0; j<Inform_verbs[i].lines; j++)
{ k = Inform_verbs[i].l[j];
}
/* -------------------------- Code Area ------------------------------- */
- /* (From this point on we don't write any more into the "p" buffer.) */
+ /* (From this point on we don't write any higher into the "p" buffer.) */
/* -------------------------------------------------------------------- */
+ if (mark > rough_size)
+ compiler_error("Paged size exceeds rough estimate.");
+
Write_Code_At = mark;
if (!OMIT_UNUSED_ROUTINES) {
code_length = zmachine_pc;
}
if (excess > 0)
- { char memory_full_error[80];
- sprintf(memory_full_error,
+ {
+ fatalerror_fmt(
"The %s exceeds version-%d limit (%dK) by %d bytes",
output_called, version_number, limit, excess);
- fatalerror(memory_full_error);
}
/* --------------------------- Offsets -------------------------------- */
*/
excess = code_length + code_offset - (scale_factor*((int32) 0x10000L));
if (excess > 0)
- { char code_full_error[80];
- sprintf(code_full_error,
+ {
+ fatalerror_fmt(
"The code area limit has been exceeded by %d bytes",
excess);
- fatalerror(code_full_error);
}
excess = strings_length + strings_offset - (scale_factor*((int32) 0x10000L));
if (excess > 0)
- { char strings_full_error[140];
+ {
if (oddeven_packing_switch)
- sprintf(strings_full_error,
+ fatalerror_fmt(
"The strings area limit has been exceeded by %d bytes",
excess);
else
- sprintf(strings_full_error,
+ fatalerror_fmt(
"The code+strings area limit has been exceeded by %d bytes. \
Try running Inform again with -B on the command line.",
excess);
- fatalerror(strings_full_error);
}
}
else
if (!skip_backpatching)
{ backpatch_zmachine_image_z();
- for (i=1; i<id_names_length; i++)
- { int32 v = 256*p[identifier_names_offset + i*2]
- + p[identifier_names_offset + i*2 + 1];
- if (v!=0) v += strings_offset/scale_factor;
- p[identifier_names_offset + i*2] = v/256;
- p[identifier_names_offset + i*2 + 1] = v%256;
+
+ if (!OMIT_SYMBOL_TABLE) {
+ for (i=1; i<id_names_length; i++)
+ { int32 v = 256*p[identifier_names_offset + i*2]
+ + p[identifier_names_offset + i*2 + 1];
+ if (v!=0) v += strings_offset/scale_factor;
+ p[identifier_names_offset + i*2] = v/256;
+ p[identifier_names_offset + i*2 + 1] = v%256;
+ }
}
mark = actions_at;
abbrevs_at, prop_defaults_at, object_tree_at, object_props_at,
grammar_table_at, arrays_at, static_arrays_at;
int32 threespaces, code_length;
+ int32 rough_size;
ASSERT_GLULX();
/* We now know how large the buffer to hold our construction has to be */
- zmachine_paged_memory = my_malloc(rough_size_of_paged_memory_g(),
- "output buffer");
+ rough_size = rough_size_of_paged_memory_g();
+ zmachine_paged_memory = my_malloc(rough_size, "output buffer");
/* Foolish code to make this routine compile on all ANSI compilers */
number of actions
*/
- identifier_names_offset = mark;
- mark += 32; /* eight pairs of values, to be filled in. */
-
- WriteInt32(p+identifier_names_offset+0, Write_RAM_At + mark);
- WriteInt32(p+identifier_names_offset+4, no_properties);
- for (i=0; i<no_properties; i++) {
- j = individual_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
- WriteInt32(p+identifier_names_offset+8, Write_RAM_At + mark);
- WriteInt32(p+identifier_names_offset+12,
- no_individual_properties-INDIV_PROP_START);
- for (i=INDIV_PROP_START; i<no_individual_properties; i++) {
- j = individual_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
- WriteInt32(p+identifier_names_offset+16, Write_RAM_At + mark);
- WriteInt32(p+identifier_names_offset+20, NUM_ATTR_BYTES*8);
- for (i=0; i<NUM_ATTR_BYTES*8; i++) {
- j = attribute_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
+ if (!OMIT_SYMBOL_TABLE) {
+ identifier_names_offset = mark;
+ mark += 32; /* eight pairs of values, to be filled in. */
+
+ WriteInt32(p+identifier_names_offset+0, Write_RAM_At + mark);
+ WriteInt32(p+identifier_names_offset+4, no_properties);
+ for (i=0; i<no_properties; i++) {
+ j = individual_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ WriteInt32(p+identifier_names_offset+8, Write_RAM_At + mark);
+ WriteInt32(p+identifier_names_offset+12,
+ no_individual_properties-INDIV_PROP_START);
+ for (i=INDIV_PROP_START; i<no_individual_properties; i++) {
+ j = individual_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ WriteInt32(p+identifier_names_offset+16, Write_RAM_At + mark);
+ WriteInt32(p+identifier_names_offset+20, NUM_ATTR_BYTES*8);
+ for (i=0; i<NUM_ATTR_BYTES*8; i++) {
+ j = attribute_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ WriteInt32(p+identifier_names_offset+24, Write_RAM_At + mark);
+ WriteInt32(p+identifier_names_offset+28, no_actions + no_fake_actions);
+ action_names_offset = mark;
+ fake_action_names_offset = mark + 4*no_actions;
+ for (i=0; i<no_actions + no_fake_actions; i++) {
+ j = action_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ array_names_offset = mark;
+ WriteInt32(p+mark, no_arrays);
mark += 4;
+ for (i=0; i<no_arrays; i++) {
+ j = array_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
}
-
- WriteInt32(p+identifier_names_offset+24, Write_RAM_At + mark);
- WriteInt32(p+identifier_names_offset+28, no_actions + no_fake_actions);
- action_names_offset = mark;
- fake_action_names_offset = mark + 4*no_actions;
- for (i=0; i<no_actions + no_fake_actions; i++) {
- j = action_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
- mark += 4;
+ else {
+ identifier_names_offset = mark;
+ action_names_offset = mark;
+ fake_action_names_offset = mark;
+ array_names_offset = mark;
}
- array_names_offset = mark;
- WriteInt32(p+mark, no_arrays);
- mark += 4;
- for (i=0; i<no_arrays; i++) {
- j = array_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
individuals_offset = mark;
/* ------------------------ Grammar Table ----------------------------- */
for (i=0; i<no_Inform_verbs; i++) {
j = mark + Write_RAM_At;
WriteInt32(p+(grammar_table_at+4+i*4), j);
+ if (!Inform_verbs[i].used) {
+ /* This verb was marked unused at locate_dead_grammar_lines()
+ time. Omit the grammar lines. */
+ p[mark++] = 0;
+ continue;
+ }
p[mark++] = Inform_verbs[i].lines;
for (j=0; j<Inform_verbs[i].lines; j++) {
int tok;
RAM_Size = mark;
+ if (RAM_Size > rough_size)
+ compiler_error("RAM size exceeds rough estimate.");
+
Out_Size = Write_RAM_At + RAM_Size;
/* --------------------------- Offsets -------------------------------- */
for (i=0; i<no_abbreviations; i++) {
int32 saving;
+ char *astr;
if (!glulx_mode)
saving = 2*((abbreviations[i].freq-1)*abbreviations[i].quality)/3;
else
saving = (abbreviations[i].freq-1)*abbreviations[i].quality;
+
+ astr = abbreviation_text(i);
+ /* Print the abbreviation text, left-padded to ten spaces, with
+ spaces replaced by underscores. */
+ for (j=strlen(astr); j<10; j++) {
+ putchar(' ');
+ }
+ for (j=0; astr[j]; j++) {
+ putchar(astr[j] == ' ' ? '_' : astr[j]);
+ }
- char abbrev_string[MAX_ABBREV_LENGTH];
- strcpy(abbrev_string,
- (char *)abbreviations_at+i*MAX_ABBREV_LENGTH);
- for (j=0; abbrev_string[j]!=0; j++)
- if (abbrev_string[j]==' ') abbrev_string[j]='_';
-
- printf("%10s %5d/%5d ",abbrev_string,abbreviations[i].freq, saving);
+ printf(" %5d/%5d ", abbreviations[i].freq, saving);
if ((i%3)==2) printf("\n");
}
/* ------------------------------------------------------------------------- */
/* "text" : Text translation, the abbreviations optimiser, the dictionary */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
abbreviation *abbreviations; /* Allocated up to no_abbreviations */
static memory_list abbreviations_memlist;
-/* Memory to hold the text of any abbreviation strings declared. This is
- counted in units of MAX_ABBREV_LENGTH bytes. (An abbreviation must fit
- in that many bytes, null included.) */
-uchar *abbreviations_at; /* Allocated up to no_abbreviations */
-static memory_list abbreviations_at_memlist;
+/* Memory to hold the text of any abbreviation strings declared. */
+static int32 abbreviations_totaltext;
+static char *abbreviations_text; /* Allocated up to abbreviations_totaltext */
+static memory_list abbreviations_text_memlist;
static int *abbreviations_optimal_parse_schedule;
static memory_list abbreviations_optimal_parse_schedule_memlist;
static_strings_area below */
static memory_list translated_text_memlist;
+static char *temp_symbol; /* Temporary symbol name used while
+ processing "@(...)". */
+static memory_list temp_symbol_memlist;
+
+
static int32 text_out_pos; /* The "program counter" during text
translation: the next position to
write Z-coded text output to */
/* ------------------------------------------------------------------------- */
static void make_abbrevs_lookup(void)
-{ int bubble_sort, j, k, l; char p[MAX_ABBREV_LENGTH]; char *p1, *p2;
+{ int bubble_sort, j, k;
+ char *p1, *p2;
do
{ bubble_sort = FALSE;
for (j=0; j<no_abbreviations; j++)
for (k=j+1; k<no_abbreviations; k++)
- { p1=(char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
- p2=(char *)abbreviations_at+k*MAX_ABBREV_LENGTH;
+ { p1=abbreviation_text(j);
+ p2=abbreviation_text(k);
if (strcmp(p1,p2)<0)
- { strcpy(p,p1); strcpy(p1,p2); strcpy(p2,p);
- l=abbreviations[j].value; abbreviations[j].value=abbreviations[k].value;
- abbreviations[k].value=l;
- l=abbreviations[j].quality; abbreviations[j].quality=abbreviations[k].quality;
- abbreviations[k].quality=l;
+ {
+ abbreviation temp = abbreviations[j];
+ abbreviations[j] = abbreviations[k];
+ abbreviations[k] = temp;
bubble_sort = TRUE;
}
}
} while (bubble_sort);
for (j=no_abbreviations-1; j>=0; j--)
- { p1=(char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
+ { p1=abbreviation_text(j);
abbrevs_lookup[(uchar)p1[0]]=j;
abbreviations[j].freq=0;
}
static int try_abbreviations_from(unsigned char *text, int i, int from)
{ int j, k; uchar *p, c;
c=text[i];
- for (j=from, p=(uchar *)abbreviations_at+from*MAX_ABBREV_LENGTH;
- (j<no_abbreviations)&&(c==p[0]); j++, p+=MAX_ABBREV_LENGTH)
- { if (text[i+1]==p[1])
+ for (j=from;
+ j<no_abbreviations;
+ j++)
+ {
+ p=(uchar *)abbreviations_text+abbreviations[j].textpos;
+ if (c != p[0]) break;
+ if (text[i+1]==p[1])
{ for (k=2; p[k]!=0; k++)
if (text[i+k]!=p[k]) goto NotMatched;
if (!glulx_mode) {
return(-1);
}
+/* Create an abbreviation. */
extern void make_abbreviation(char *text)
{
+ int alen;
+ int32 pos;
+
/* If -e mode is off, we won't waste space creating an abbreviation entry. */
if (!economy_switch)
return;
+
+ alen = strlen(text);
+ pos = abbreviations_totaltext;
ensure_memory_list_available(&abbreviations_memlist, no_abbreviations+1);
- ensure_memory_list_available(&abbreviations_at_memlist, no_abbreviations+1);
-
- strcpy((char *)abbreviations_at
- + no_abbreviations*MAX_ABBREV_LENGTH, text);
+ ensure_memory_list_available(&abbreviations_text_memlist, pos+alen+1);
+
+ strcpy(abbreviations_text+pos, text);
+ abbreviations_totaltext += (alen+1);
+ abbreviations[no_abbreviations].textpos = pos;
+ abbreviations[no_abbreviations].textlen = alen;
abbreviations[no_abbreviations].value = compile_string(text, STRCTX_ABBREV);
abbreviations[no_abbreviations].freq = 0;
no_abbreviations++;
}
+/* Return a pointer to the (uncompressed) abbreviation text.
+ This should be treated as temporary; it is only valid until the next
+ make_abbreviation() call. */
+extern char *abbreviation_text(int num)
+{
+ if (num < 0 || num >= no_abbreviations) {
+ compiler_error("Invalid abbrev for abbreviation_text()");
+ return "";
+ }
+
+ return abbreviations_text + abbreviations[num].textpos;
+}
+
/* ------------------------------------------------------------------------- */
/* The front end routine for text translation. */
/* strctx indicates the purpose of the string. This is mostly used for */
/* specially during compilation. */
/* ------------------------------------------------------------------------- */
+/* TODO: When called from a print statement (parse_print()), it would be
+ nice to detect if the generated string is exactly one character. In that
+ case, we could return the character value and a flag to indicate the
+ caller could use @print_char/@streamchar/@new_line/@streamunichar
+ instead of printing a compiled string.
+
+ We'd need a new STRCTX value or two to distinguish direct-printed strings
+ from referenceable strings.
+
+ Currently, parse_print() checks for the "^" case manually, which is a
+ bit icky. */
+
extern int32 compile_string(char *b, int strctx)
{ int32 i, j, k;
uchar *c;
/* Helper routine to compute the weight, in units, of a character handled by the Z-Machine */
static int zchar_weight(int c)
{
- int lookup = iso_to_alphabet_grid[c];
+ int lookup;
+ if (c == ' ') return 1;
+ lookup = iso_to_alphabet_grid[c];
if (lookup < 0) return 4;
if (lookup < 26) return 1;
return 2;
{
c = text_in[j];
/* Loop on all abbreviations starting with what is in c. */
- for (k=from, q=(uchar *)abbreviations_at+from*MAX_ABBREV_LENGTH;
- (k<no_abbreviations)&&(c==q[0]); k++, q+=MAX_ABBREV_LENGTH)
- {
+ for (k=from;
+ k<no_abbreviations;
+ k++)
+ {
+ q=(uchar *)abbreviations_text+abbreviations[k].textpos;
+ if (c!=q[0]) break;
/* Let's compare; we also keep track of the length of the abbreviation. */
for (l=1; q[l]!=0; l++)
{ if (text_in[j+l]!=q[l]) {goto NotMatched;}
((j = abbreviations_optimal_parse_schedule[i]) != -1))
{
/* Fill with 1s, which will get ignored by everyone else. */
- uchar *p = (uchar *)abbreviations_at+j*MAX_ABBREV_LENGTH;
+ uchar *p = (uchar *)abbreviation_text(j);
for (k=0; p[k]!=0; k++) text_in[i+k]=1;
/* Actually write the abbreviation in the story file. */
abbreviations[j].freq++;
else if (text_in[i+1]=='(')
{
/* @(...) (dynamic string) */
- char dsymbol[MAX_IDENTIFIER_LENGTH+1];
int len = 0, digits = 0;
i += 2;
/* This accepts "12xyz" as a symbol, which it really isn't,
but that just means it won't be found. */
- while ((text_in[i] == '_' || isalnum(text_in[i])) && len < MAX_IDENTIFIER_LENGTH) {
+ while ((text_in[i] == '_' || isalnum(text_in[i]))) {
char ch = text_in[i++];
if (isdigit(ch)) digits++;
- dsymbol[len++] = ch;
+ ensure_memory_list_available(&temp_symbol_memlist, len+1);
+ temp_symbol[len++] = ch;
}
- dsymbol[len] = '\0';
+ ensure_memory_list_available(&temp_symbol_memlist, len+1);
+ temp_symbol[len] = '\0';
j = -1;
- /* We would like to parse dsymbol as *either* a decimal
+ /* We would like to parse temp_symbol as *either* a decimal
number or a constant symbol. */
if (text_in[i] != ')' || len == 0) {
error("'@(...)' abbreviation must contain a symbol");
}
else if (digits == len) {
/* all digits; parse as decimal */
- j = atoi(dsymbol);
+ j = atoi(temp_symbol);
}
else {
- int sym = symbol_index(dsymbol, -1);
- if ((symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
- error_named("'@(...)' abbreviation expected a known constant value, but contained", dsymbol);
+ int sym = get_symbol_index(temp_symbol);
+ if (sym < 0 || (symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
+ error_named("'@(...)' abbreviation expected a known constant value, but contained", temp_symbol);
}
else {
symbols[sym].flags |= USED_SFLAG;
if ((economy_switch) && (compression_switch) && (!is_abbreviation)
&& ((k=abbrevs_lookup[text_in[i]])!=-1)
&& ((j=try_abbreviations_from(text_in, i, k)) != -1)) {
- char *cx = (char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
+ char *cx = abbreviation_text(j);
i += (strlen(cx)-1);
write_z_char_g('@');
write_z_char_g('A');
while (isdigit(text_in[i])) i++; i--;
}
else if (text_in[i+1]=='(') {
- char dsymbol[MAX_IDENTIFIER_LENGTH+1];
int len = 0, digits = 0;
i += 2;
/* This accepts "12xyz" as a symbol, which it really isn't,
but that just means it won't be found. */
- while ((text_in[i] == '_' || isalnum(text_in[i])) && len < MAX_IDENTIFIER_LENGTH) {
+ while ((text_in[i] == '_' || isalnum(text_in[i]))) {
char ch = text_in[i++];
if (isdigit(ch)) digits++;
- dsymbol[len++] = ch;
+ ensure_memory_list_available(&temp_symbol_memlist, len+1);
+ temp_symbol[len++] = ch;
}
- dsymbol[len] = '\0';
+ ensure_memory_list_available(&temp_symbol_memlist, len+1);
+ temp_symbol[len] = '\0';
j = -1;
- /* We would like to parse dsymbol as *either* a decimal
+ /* We would like to parse temp_symbol as *either* a decimal
number or a constant symbol. */
if (text_in[i] != ')' || len == 0) {
error("'@(...)' abbreviation must contain a symbol");
}
else if (digits == len) {
/* all digits; parse as decimal */
- j = atoi(dsymbol);
+ j = atoi(temp_symbol);
}
else {
- int sym = symbol_index(dsymbol, -1);
- if ((symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
- error_named("'@(...)' abbreviation expected a known constant value, but contained", dsymbol);
+ int sym = get_symbol_index(temp_symbol);
+ if (sym < 0 || (symbols[sym].flags & UNKNOWN_SFLAG) || symbols[sym].type != CONSTANT_T || symbols[sym].marker) {
+ error_named("'@(...)' abbreviation expected a known constant value, but contained", temp_symbol);
}
else {
symbols[sym].flags |= USED_SFLAG;
compression_table_size += 2;
break;
case 3:
- cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
+ cx = abbreviation_text(ent->u.val);
compression_table_size += (1 + 1 + strlen(cx));
break;
case 4:
int32 popularity;
int32 score;
int32 location;
- char text[MAX_ABBREV_LENGTH];
+ char *text; /* allocated to textsize, min 4 */
+ int32 textsize;
} optab;
static int32 MAX_BESTYET;
static optab *bestyet; /* High-score entries (up to MAX_BESTYET used/allocated) */
static optab *bestyet2; /* The selected entries (up to selected used; allocated to MAX_ABBREVS) */
+static void optab_copy(optab *dest, const optab *src)
+{
+ dest->length = src->length;
+ dest->popularity = src->popularity;
+ dest->score = src->score;
+ dest->location = src->location;
+ if (src->length+1 > dest->textsize) {
+ int32 oldsize = dest->textsize;
+ dest->textsize = (src->length+1)*2;
+ my_realloc(&dest->text, oldsize, dest->textsize, "bestyet2.text");
+ }
+ strcpy(dest->text, src->text);
+}
+
static int pass_no;
static void optimise_pass(void)
for (j=0; j<tlbtab[i].occurrences; j++)
{ for (j2=0; j2<tlbtab[i].occurrences; j2++) grandflags[j2]=1;
nl=2; noflags=tlbtab[i].occurrences;
- while ((noflags>=2)&&(nl<MAX_ABBREV_LENGTH-1))
+ while (noflags>=2)
{ nl++;
for (j2=0; j2<nl; j2++)
if (opttext[grandtable[tlbtab[i].intab+j]+j2]=='\n')
MAX_BESTYET = 4 * MAX_ABBREVS;
bestyet=my_calloc(sizeof(optab), MAX_BESTYET, "bestyet");
+ for (i=0; i<MAX_BESTYET; i++) {
+ bestyet[i].length = 0;
+ bestyet[i].popularity = 0;
+ bestyet[i].score = 0;
+ bestyet[i].location = 0;
+ bestyet[i].textsize = 4;
+ bestyet[i].text = my_malloc(bestyet[i].textsize, "bestyet.text");
+ }
+
bestyet2=my_calloc(sizeof(optab), MAX_ABBREVS, "bestyet2");
+ for (i=0; i<MAX_ABBREVS; i++) {
+ bestyet2[i].length = 0;
+ bestyet2[i].popularity = 0;
+ bestyet2[i].score = 0;
+ bestyet2[i].location = 0;
+ bestyet2[i].textsize = 4;
+ bestyet2[i].text = my_malloc(bestyet2[i].textsize, "bestyet2.text");
+ }
bestyet2[0].text[0]='.';
bestyet2[0].text[1]=' ';
if (bestyet[i].score!=0)
{ available++;
nl=bestyet[i].length;
+ if (nl+1 > bestyet[i].textsize) {
+ int32 oldsize = bestyet[i].textsize;
+ bestyet[i].textsize = (nl+1)*2;
+ my_realloc(&bestyet[i].text, oldsize, bestyet[i].textsize, "bestyet.text");
+ }
for (j2=0; j2<nl; j2++) bestyet[i].text[j2]=
opttext[bestyet[i].location+j2];
bestyet[i].text[nl]=0;
if (max>0)
{
char testtext[4];
- bestyet2[selected++]=bestyet[maxat];
+ optab_copy(&bestyet2[selected++], &bestyet[maxat]);
if (optabbrevs_trace_setting >= 1) {
printf(
/* In modifying the compiler for Glulx, I found it easier to discard the */
/* typedef, and operate directly on uchar arrays of length DICT_WORD_SIZE. */
/* In Z-code, DICT_WORD_SIZE will be 6, so the Z-code compiler will work */
-/* as before. In Glulx, it can be any value up to MAX_DICT_WORD_SIZE. */
-/* (That limit is defined as 40 in the header; it exists only for a few */
-/* static buffers, and can be increased without using significant memory.) */
+/* as before. In Glulx, it can be any value. */
/* */
-/* ...Well, that certainly bit me on the butt, didn't it. In further */
-/* modifying the compiler to generate a Unicode dictionary, I have to */
-/* store four-byte values in the uchar array. This is handled by making */
-/* the array size DICT_WORD_BYTES (which is DICT_WORD_SIZE*DICT_CHAR_SIZE).*/
+/* In further modifying the compiler to generate a Unicode dictionary, */
+/* I have to store four-byte values in the uchar array. We make the array */
+/* size DICT_WORD_BYTES (which is DICT_WORD_SIZE*DICT_CHAR_SIZE). */
/* Then we store the 32-bit character value big-endian. This lets us */
/* continue to compare arrays bytewise, which is a nice simplification. */
/* ------------------------------------------------------------------------- */
d1[i] = d2[i];
}
-static uchar prepared_sort[MAX_DICT_WORD_BYTES]; /* Holds the sort code
- of current word */
+static memory_list prepared_sort_memlist;
+static uchar *prepared_sort; /* Holds the sort code of current word */
-static int number_and_case;
+static int prepared_dictflags_pos; /* Dict flags set by the current word */
+static int prepared_dictflags_neg; /* Dict flags *not* set by the word */
/* Also used by verbs.c */
static void dictionary_prepare_z(char *dword, uchar *optresult)
-{ int i, j, k, k2, wd[13]; int32 tot;
+{ int i, j, k, k2, wd[13];
+ int32 tot;
+ int negflag;
/* A rapid text translation algorithm using only the simplified rules
applying to the text of dictionary entries: first produce a sequence
int dictsize = (version_number==3) ? 6 : 9;
- number_and_case = 0;
+ prepared_dictflags_pos = 0;
+ prepared_dictflags_neg = 0;
- for (i=0, j=0; dword[j]!=0; i++, j++)
- { if ((dword[j] == '/') && (dword[j+1] == '/'))
- { for (j+=2; dword[j] != 0; j++)
- { switch(dword[j])
- { case 'p': number_and_case |= 4; break;
+ for (i=0, j=0; dword[j]!=0; j++)
+ {
+ if ((dword[j] == '/') && (dword[j+1] == '/'))
+ {
+ /* The rest of the word is dict flags. Run through them. */
+ negflag = FALSE;
+ for (j+=2; dword[j] != 0; j++)
+ {
+ switch(dword[j])
+ {
+ case '~':
+ if (!dword[j+1])
+ error_named("'//~' with no flag character (pn) in dict word", dword);
+ negflag = !negflag;
+ break;
+ case 'p':
+ if (!negflag)
+ prepared_dictflags_pos |= 4;
+ else
+ prepared_dictflags_neg |= 4;
+ negflag = FALSE;
+ break;
+ case 'n':
+ if (!negflag)
+ prepared_dictflags_pos |= 128;
+ else
+ prepared_dictflags_neg |= 128;
+ negflag = FALSE;
+ break;
default:
- error_named("Expected 'p' after '//' \
-to give number of dictionary word", dword);
+ error_named("Expected flag character (pn~) after '//' in dict word", dword);
break;
}
}
break;
}
- if (i>=dictsize) break;
+
+ /* LONG_DICT_FLAG_BUG emulates the old behavior where we stop looping
+ at dictsize. */
+ if (LONG_DICT_FLAG_BUG && i>=dictsize)
+ break;
k=(int) dword[j];
if (k==(int) '\'')
char_error("Character can be printed but not input:", k);
else
{ /* Use 4 more Z-chars to encode a ZSCII escape sequence */
-
- wd[i++] = 5; wd[i++] = 6;
+ if (i<dictsize)
+ wd[i++] = 5;
+ if (i<dictsize)
+ wd[i++] = 6;
k2 = -k2;
- wd[i++] = k2/32; wd[i] = k2%32;
+ if (i<dictsize)
+ wd[i++] = k2/32;
+ if (i<dictsize)
+ wd[i++] = k2%32;
}
}
else
{ alphabet_used[k2] = 'Y';
- if ((k2/26)!=0)
+ if ((k2/26)!=0 && i<dictsize)
wd[i++]=3+(k2/26); /* Change alphabet for symbols */
- wd[i]=6+(k2%26); /* Write the Z character */
+ if (i<dictsize)
+ wd[i++]=6+(k2%26); /* Write the Z character */
}
}
- /* Fill up to the end of the dictionary block with PAD characters */
+ if (i > dictsize)
+ compiler_error("dict word buffer overflow");
+
+ /* Fill up to the end of the dictionary block with PAD characters
+ (for safety, we right-pad to 9 chars even in V3) */
for (; i<9; i++) wd[i]=5;
/* The array of Z-chars is converted to two or three 2-byte blocks */
-
+ ensure_memory_list_available(&prepared_sort_memlist, DICT_WORD_BYTES);
+
tot = wd[2] + wd[1]*(1<<5) + wd[0]*(1<<10);
prepared_sort[1]=tot%0x100;
prepared_sort[0]=(tot/0x100)%0x100;
{
int i, j, k;
int32 unicode;
+ int negflag;
- number_and_case = 0;
+ prepared_dictflags_pos = 0;
+ prepared_dictflags_neg = 0;
- for (i=0, j=0; (dword[j]!=0); i++, j++) {
+ for (i=0, j=0; (dword[j]!=0); j++) {
if ((dword[j] == '/') && (dword[j+1] == '/')) {
+ /* The rest of the word is dict flags. Run through them. */
+ negflag = FALSE;
for (j+=2; dword[j] != 0; j++) {
switch(dword[j]) {
+ case '~':
+ if (!dword[j+1])
+ error_named("'//~' with no flag character (pn) in dict word", dword);
+ negflag = !negflag;
+ break;
case 'p':
- number_and_case |= 4;
- break;
+ if (!negflag)
+ prepared_dictflags_pos |= 4;
+ else
+ prepared_dictflags_neg |= 4;
+ negflag = FALSE;
+ break;
+ case 'n':
+ if (!negflag)
+ prepared_dictflags_pos |= 128;
+ else
+ prepared_dictflags_neg |= 128;
+ negflag = FALSE;
+ break;
default:
- error_named("Expected 'p' after '//' \
-to give gender or number of dictionary word", dword);
+ error_named("Expected flag character (pn~) after '//' in dict word", dword);
break;
}
}
break;
}
- if (i>=DICT_WORD_SIZE) break;
+
+ /* LONG_DICT_FLAG_BUG emulates the old behavior where we stop looping
+ at DICT_WORD_SIZE. */
+ if (LONG_DICT_FLAG_BUG && i>=DICT_WORD_SIZE)
+ break;
k= ((unsigned char *)dword)[j];
if (k=='\'')
if (k >= (unsigned)'A' && k <= (unsigned)'Z')
k += ('a' - 'A');
+ ensure_memory_list_available(&prepared_sort_memlist, DICT_WORD_BYTES);
+
if (DICT_CHAR_SIZE == 1) {
- prepared_sort[i] = k;
+ if (i<DICT_WORD_SIZE)
+ prepared_sort[i++] = k;
}
else {
- prepared_sort[4*i] = (k >> 24) & 0xFF;
- prepared_sort[4*i+1] = (k >> 16) & 0xFF;
- prepared_sort[4*i+2] = (k >> 8) & 0xFF;
- prepared_sort[4*i+3] = (k) & 0xFF;
+ if (i<DICT_WORD_SIZE) {
+ prepared_sort[4*i] = (k >> 24) & 0xFF;
+ prepared_sort[4*i+1] = (k >> 16) & 0xFF;
+ prepared_sort[4*i+2] = (k >> 8) & 0xFF;
+ prepared_sort[4*i+3] = (k) & 0xFF;
+ i++;
+ }
}
}
+ if (i > DICT_WORD_SIZE)
+ compiler_error("dict word buffer overflow");
+
+ /* Right-pad with zeroes */
if (DICT_CHAR_SIZE == 1) {
for (; i<DICT_WORD_SIZE; i++)
prepared_sort[i] = 0;
}
/* ------------------------------------------------------------------------- */
-/* Add "dword" to the dictionary with (x,y,z) as its data fields; unless */
-/* it already exists, in which case OR the data with (x,y,z) */
+/* Add "dword" to the dictionary with (flag1,flag2,flag3) as its data */
+/* fields; unless it already exists, in which case OR the data fields with */
+/* those flags. */
/* */
/* These fields are one byte each in Z-code, two bytes each in Glulx. */
/* */
/* Returns: the accession number. */
/* ------------------------------------------------------------------------- */
-extern int dictionary_add(char *dword, int x, int y, int z)
+extern int dictionary_add(char *dword, int flag1, int flag2, int flag3)
{ int n; uchar *p;
int ggfr = 0, gfr = 0, fr = 0, r = 0;
int ggf = VACANT, gf = VACANT, f = VACANT, at = root;
int a, b;
int res=((version_number==3)?4:6);
+ /* Fill in prepared_sort and prepared_dictflags. */
dictionary_prepare(dword, NULL);
+ /* Adjust flag1 according to prepared_dictflags. */
+ flag1 &= (~prepared_dictflags_neg);
+ flag1 |= prepared_dictflags_pos;
+
if (root == VACANT)
{ root = 0; goto CreateEntry;
}
{
if (!glulx_mode) {
p = dictionary+7 + at*DICT_ENTRY_BYTE_LENGTH + res;
- p[0]=(p[0])|x; p[1]=(p[1])|y;
+ p[0] |= flag1; p[1] |= flag2;
if (!ZCODE_LESS_DICT_DATA)
- p[2]=(p[2])|z;
- if (x & 128) p[0] = (p[0])|number_and_case;
+ p[2] |= flag3;
}
else {
p = dictionary+4 + at*DICT_ENTRY_BYTE_LENGTH + DICT_ENTRY_FLAG_POS;
- p[0]=(p[0])|(x/256); p[1]=(p[1])|(x%256);
- p[2]=(p[2])|(y/256); p[3]=(p[3])|(y%256);
- p[4]=(p[4])|(z/256); p[5]=(p[5])|(z%256);
- if (x & 128) p[1] = (p[1]) | number_and_case;
+ p[0] |= (flag1/256); p[1] |= (flag1%256);
+ p[2] |= (flag2/256); p[3] |= (flag2%256);
+ p[4] |= (flag3/256); p[5] |= (flag3%256);
}
return at;
}
p[2]=prepared_sort[2]; p[3]=prepared_sort[3];
if (version_number > 3)
{ p[4]=prepared_sort[4]; p[5]=prepared_sort[5]; }
- p[res]=x; p[res+1]=y;
- if (!ZCODE_LESS_DICT_DATA) p[res+2]=z;
- if (x & 128) p[res] = (p[res])|number_and_case;
+ p[res]=flag1; p[res+1]=flag2;
+ if (!ZCODE_LESS_DICT_DATA) p[res+2]=flag3;
dictionary_top += DICT_ENTRY_BYTE_LENGTH;
p[i] = prepared_sort[i];
p += DICT_WORD_BYTES;
- p[0] = 0; p[1] = x;
- p[2] = y/256; p[3] = y%256;
- p[4] = 0; p[5] = z;
- if (x & 128)
- p[1] |= number_and_case;
+ p[0] = (flag1/256); p[1] = (flag1%256);
+ p[2] = (flag2/256); p[3] = (flag2%256);
+ p[4] = (flag3/256); p[5] = (flag3%256);
dictionary_top += DICT_ENTRY_BYTE_LENGTH;
flags = (int) p[res];
if (flags & 128)
- { printf("noun ");
- if (flags & 4) printf("p"); else printf(" ");
- printf(" ");
- }
- else printf(" ");
+ printf("noun ");
+ else
+ printf(" ");
+ if (flags & 4)
+ printf("p ");
+ else
+ printf(" ");
if (flags & 8)
{ if (grammar_version_number == 1)
printf("preposition:%d ", (int) p[res+2]);
for (i=0; i<DICT_ENTRY_BYTE_LENGTH; i++) printf("%02x ",p[i]);
}
if (flags & 128)
- { printf("noun ");
- if (flags & 4) printf("p"); else printf(" ");
- printf(" ");
- }
- else printf(" ");
+ printf("noun ");
+ else
+ printf(" ");
+ if (flags & 4)
+ printf("p ");
+ else
+ printf(" ");
if (flags & 8)
{ printf("preposition ");
}
grandtable = NULL;
grandflags = NULL;
+ translated_text = NULL;
+ temp_symbol = NULL;
all_text = NULL;
for (j=0; j<256; j++) abbrevs_lookup[j] = -1;
dtree = NULL;
final_dict_order = NULL;
dict_sort_codes = NULL;
+ prepared_sort = NULL;
dict_entries=0;
static_strings_area = NULL;
extern void text_begin_pass(void)
{ abbrevs_lookup_table_made = FALSE;
no_abbreviations=0;
+ abbreviations_totaltext=0;
total_chars_trans=0; total_bytes_trans=0;
all_text_top=0;
dictionary_begin_pass();
sizeof(uchar), 8000, (void**)&translated_text,
"translated text holding area");
+ initialise_memory_list(&temp_symbol_memlist,
+ sizeof(char), 32, (void**)&temp_symbol,
+ "temporary symbol name");
+
initialise_memory_list(&all_text_memlist,
sizeof(char), 0, (void**)&all_text,
"transcription text for optimise");
sizeof(uchar), 128, (void**)&static_strings_area,
"static strings area");
- initialise_memory_list(&abbreviations_at_memlist,
- MAX_ABBREV_LENGTH, 64, (void**)&abbreviations_at,
+ initialise_memory_list(&abbreviations_text_memlist,
+ sizeof(char), 64, (void**)&abbreviations_text,
"abbreviation text");
initialise_memory_list(&abbreviations_memlist,
initialise_memory_list(&dict_sort_codes_memlist,
sizeof(uchar), 1500*DICT_WORD_BYTES, (void**)&dict_sort_codes,
"dictionary sort codes");
+ initialise_memory_list(&prepared_sort_memlist,
+ sizeof(uchar), DICT_WORD_BYTES, (void**)&prepared_sort,
+ "prepared sort buffer");
final_dict_order = NULL; /* will be allocated at sort_dictionary() time */
extern void text_free_arrays(void)
{
deallocate_memory_list(&translated_text_memlist);
+ deallocate_memory_list(&temp_symbol_memlist);
deallocate_memory_list(&all_text_memlist);
deallocate_memory_list(&low_strings_memlist);
- deallocate_memory_list(&abbreviations_at_memlist);
+ deallocate_memory_list(&abbreviations_text_memlist);
deallocate_memory_list(&abbreviations_memlist);
deallocate_memory_list(&abbreviations_optimal_parse_schedule_memlist);
deallocate_memory_list(&dtree_memlist);
deallocate_memory_list(&dict_sort_codes_memlist);
+ deallocate_memory_list(&prepared_sort_memlist);
my_free(&final_dict_order, "final dictionary ordering table");
deallocate_memory_list(&dictionary_memlist);
extern void ao_free_arrays(void)
{
/* Called only after optimise_abbreviations() runs. */
+
+ int32 i;
+ if (bestyet) {
+ for (i=0; i<MAX_BESTYET; i++) {
+ my_free(&bestyet[i].text, "bestyet.text");
+ }
+ }
+ if (bestyet2) {
+ for (i=0; i<MAX_ABBREVS; i++) {
+ my_free(&bestyet2[i].text, "bestyet2.text");
+ }
+ }
my_free (&opttext,"stashed transcript for optimisation");
my_free (&bestyet,"bestyet");
/* by the compiler (e.g. DefArt) which the program doesn't */
/* provide */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
int32 j;
assembly_operand AO;
- j = symbol_index("Main__", -1);
+ j = symbol_index("Main__", -1, NULL);
+ clear_local_variables();
assign_symbol(j,
- assemble_routine_header(0, FALSE, "Main__", FALSE, j),
+ assemble_routine_header(FALSE, "Main__", FALSE, j),
ROUTINE_T);
symbols[j].flags |= SYSTEM_SFLAG + USED_SFLAG;
if (trace_fns_setting==3) symbols[j].flags |= STAR_SFLAG;
w = 0 -> 33;\
if (w == 0) w=80;\
w2 = (w - maxw)/2;\
+ if (w2 < 3) w2 = 3;\
style reverse;\
@sub w2 2 -> w;\
line = 5;\
prop = (i-->0) & $7fff;\
}\
}",
- "p = #identifiers_table;\
+ "#IFDEF OMIT_SYMBOL_TABLE;\
+ p = size = 0;\
+ print \"<number \", prop, \">\";\
+ #IFNOT;\
+ p = #identifiers_table;\
size = p-->0;\
if (prop<=0 || prop>=size || p-->prop==0)\
print \"<number \", prop, \">\";\
else print (string) p-->prop;\
+ #ENDIF;\
]", "", "", "", ""
},
"CA__Pr",
"obj id a b c d e f x y z s s2 n m;\
+ #IFV3;\
+ #Message error \"Object message calls are not supported in v3.\";\
+ obj = id = a = b = c = d = e = f = x = y = z = s = s2 = n = m = 0;\
+ #IFNOT;\
if (obj < 1 || obj > #largest_object-255)\
{ switch(Z__Region(obj))\
{ 2: if (id == call)\
default: return x-->m;\
}\
}\
+ #ENDIF;\
rfalse;\
]"
},
identifier = (identifier & $3f00) / $100;\
if (~~(obj ofclass cla)) rfalse; i=0-->5;\
if (cla == 2) return i+2*identifier-2;\
+ #IFV3;\
+ i = (i+60+cla*9)-->0;\
+ #IFNOT;\
i = 0-->((i+124+cla*14)/2);\
+ #ENDIF;\
i = CP__Tab(i + 2*(0->i) + 1, -1)+6;\
return CP__Tab(i, identifier);\
}\
},
{
/* RL__Pr: read the property length of an individual property value,
- returning 0 if it isn't provided by the given object */
+ returning 0 if it isn't provided by the given object.
+ This is also used for inherited values (of the form
+ class::prop). */
"RL__Pr",
"obj identifier x;\
if (identifier<64 && identifier>0) return obj.#identifier;\
x = obj..&identifier;\
if (x==0) rfalse;\
- if (identifier&$C000==$4000)\
+ if (identifier&$C000==$4000) {\
+ #IFV3;\
+ return 1+((x-1)->0)/$20;\
+ #IFNOT;\
switch (((x-1)->0)&$C0)\
{ 0: return 1; $40: return 2; $80: return ((x-1)->0)&$3F; }\
+ #ENDIF;\
+ }\
return (x-1)->0;\
]", "", "", "", "", ""
},
\" in the\"; switch(size&7){0,1:q=0; 2:print \" string\";\
q=1; 3:print \" table\";q=1; 4:print \" buffer\";q=WORDSIZE;} \
if(size&16) print\" (->)\"; if(size&8) print\" (-->)\";\
+ #IFDEF OMIT_SYMBOL_TABLE;\
+ \" array which has entries \", q, \" up to \",id,\" **]\";\
+ #IFNOT;\
\" array ~\", (string) #array_names_offset-->p,\
- \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
+ \"~, which has entries \", q, \" up to \",id,\" **]\";\
+ #ENDIF;\
+ }\
if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
else print \"write\"; print \" outside memory using \";\
switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
\", but it is longer than 2 bytes so you cannot use ~.~\";\
else\
{ print \" has no property \", (property) id;\
+ #IFNDEF OMIT_SYMBOL_TABLE;\
p = #identifiers_table;\
size = p-->0;\
if (id<0 || id>=size)\
print \" (and nor has any other object)\";\
+ #ENDIF;\
}\
print \" to \", (string) crime, \" **]^\";\
]", ""
"CP__Tab",
"x id n l;\
+ #IFV3;\
+ while (1)\
+ { n = x->0;\
+ if (n == 0) break;\
+ x++;\
+ if (id == (n & $1f)) return x;\
+ l = (n/$20)+1;\
+ x = x + l;\
+ }\
+ #IFNOT;\
while ((n=0->x) ~= 0)\
{ if (n & $80) { x++; l = (0->x) & $3f; }\
else { if (n & $40) l=2; else l=1; }\
if ((n & $3f) == id) return x;\
x = x + l;\
}\
+ #ENDIF;\
if (id<0) return x+1; rfalse; ]", "", "", "", "", ""
},
{ /* Cl__Ms: the five message-receiving properties of Classes */
"Cl__Ms",
"obj id y a b c d x;\
+ #IFV3;\
+ #Message error \"Class messages are not supported in v3.\";\
+ obj = id = y = a = b = c = d = x = 0;\
+ #IFNOT;\
switch(id)\
{ create:\
if (children(obj)<=1) rfalse; x=child(obj);\
{ RT__Err(\"copy\", b, -obj); rfalse; }\
Copy__Primitive(a, b); rfalse;\
}\
+ #ENDIF;\
]", "", "", ""
},
{ /* RT__ChT: check at run-time that a proposed object move is legal
print (name) cla, \"::\";\
@ushiftr prop 16 prop;\
}\
+ #IFDEF OMIT_SYMBOL_TABLE;\
+ ptab = maxcom = minind = maxind = str = 0;\
+ print \"<number \", prop, \">\";\
+ #IFNOT;\
ptab = #identifiers_table;\
maxcom = ptab-->1;\
minind = INDIV_PROP_START;\
print (string) str;\
else\
print \"<number \", prop, \">\";\
+ #ENDIF;\
]", "", "", "", "", ""
},
\" in the\"; switch(size&7){0,1:q=0; 2:print \" string\";\
q=1; 3:print \" table\";q=1; 4:print \" buffer\";q=WORDSIZE;} \
if(size&16) print\" (->)\"; if(size&8) print\" (-->)\";\
+ #IFDEF OMIT_SYMBOL_TABLE;\
+ \" array which has entries \", q, \" up to \",id,\" **]\";\
+ #IFNOT;\
\" array ~\", (string) #array_names_offset-->(p+1),\
- \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
+ \"~, which has entries \", q, \" up to \",id,\" **]\";\
+ #ENDIF;\
+ }\
if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
else print \"write\"; print \" outside memory using \";\
switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
if (id<0) print \"is not of class \", (name) -id;",
"else\
{ print \" has no property \", (property) id;\
+ #IFNDEF OMIT_SYMBOL_TABLE;\
p = #identifiers_table;\
size = INDIV_PROP_START + p-->3;\
if (id<0 || id>=size)\
print \" (and nor has any other object)\";\
+ #ENDIF;\
}\
print \" to \", (string) crime, \" **]^\";\
]", ""
{ int32 j, nl, arrays_l, routines_l, constants_l;
assembly_operand AO, AO2, AO3;
+ clear_local_variables();
/* Assign local var names for the benefit of the debugging information
file. (We don't set local_variable.keywords because we're not
going to be parsing any code.) */
- strcpy(local_variable_names[0].text, "dummy1");
- strcpy(local_variable_names[1].text, "dummy2");
+ add_local_variable("dummy1");
+ add_local_variable("dummy2");
- veneer_mode = TRUE; j = symbol_index("Symb__Tab", -1);
+ veneer_mode = TRUE; j = symbol_index("Symb__Tab", -1, NULL);
assign_symbol(j,
- assemble_routine_header(2, FALSE, "Symb__Tab", FALSE, j),
+ assemble_routine_header(FALSE, "Symb__Tab", FALSE, j),
ROUTINE_T);
symbols[j].flags |= SYSTEM_SFLAG + USED_SFLAG;
if (trace_fns_setting==3) symbols[j].flags |= STAR_SFLAG;
{ try_veneer_again = FALSE;
for (i=0; i<VENEER_ROUTINES; i++)
{ if (veneer_routine_needs_compilation[i] == VR_CALLED)
- { j = symbol_index(VRs[i].name, -1);
+ { j = symbol_index(VRs[i].name, -1, NULL);
if (symbols[j].flags & UNKNOWN_SFLAG)
{ veneer_mode = TRUE;
strcpy(veneer_source_area, VRs[i].source1);
/* "verbs" : Manages actions and grammar tables; parses the directives */
/* Verb and Extend. */
/* */
-/* Part of Inform 6.41 */
-/* copyright (c) Graham Nelson 1993 - 2022 */
+/* Part of Inform 6.42 */
+/* copyright (c) Graham Nelson 1993 - 2024 */
/* */
/* Inform is free software: you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
int32 *adjectives; /* Allocated to no_adjectives */
static memory_list adjectives_memlist;
- static uchar *adjective_sort_code; /* Allocated to no_adjectives*DICT_WORD_BYTES */
+ static uchar *adjective_sort_code; /* Allocated to no_adjectives*DICT_WORD_BYTES, except it's sometimes no_adjectives+1 because we can bump it tentatively */
static memory_list adjective_sort_code_memlist;
+ static memory_list action_symname_memlist; /* Used for temporary symbols */
+
/* ------------------------------------------------------------------------- */
/* Tracing for compiler maintenance */
/* ------------------------------------------------------------------------- */
At present just a hook for some tracing code. */
if (printactions_switch)
- printf("Action '%s' is numbered %d\n",b,c);
+ printf("%s: Action '%s' is numbered %d\n", current_location_text(), b, c);
}
/* Note that fake actions are numbered from a high base point upwards;
real actions are numbered from 0 upward in GV2. */
extern void make_fake_action(void)
-{ int i;
- char action_sub[MAX_IDENTIFIER_LENGTH+4];
+{ char *action_sub;
+ int i;
debug_location_beginning beginning_debug_location =
get_token_location_beginning();
get_next_token();
if (token_type != SYMBOL_TT)
{ discard_token_location(beginning_debug_location);
- ebf_error("new fake action name", token_text);
+ ebf_curtoken_error("new fake action name");
panic_mode_error_recovery(); return;
}
+
+ /* Enough space for "token__A". */
+ ensure_memory_list_available(&action_symname_memlist, strlen(token_text)+4);
+ action_sub = action_symname_memlist.data;
+ strcpy(action_sub, token_text);
+ strcat(action_sub, "__A");
+
/* Action symbols (including fake_actions) may collide with other kinds of symbols. So we don't check that. */
- snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", token_text);
- i = symbol_index(action_sub, -1);
+ i = symbol_index(action_sub, -1, NULL);
if (!(symbols[i].flags & UNKNOWN_SFLAG))
{ discard_token_location(beginning_debug_location);
/* Returns the action number of the given name, creating it as a new
action name if it isn't already known as such. */
- char action_sub[MAX_IDENTIFIER_LENGTH+4];
+ char *action_sub;
int j;
assembly_operand AO;
- snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", name);
- j = symbol_index(action_sub, -1);
+ /* Enough space for "name__A". */
+ ensure_memory_list_available(&action_symname_memlist, strlen(name)+4);
+ action_sub = action_symname_memlist.data;
+ strcpy(action_sub, name);
+ strcat(action_sub, "__A");
+
+ j = symbol_index(action_sub, -1, NULL);
if (symbols[j].type == FAKE_ACTION_T)
{ INITAO(&AO);
extern void find_the_actions(void)
{ int i; int32 j;
- char action_name[MAX_IDENTIFIER_LENGTH+4];
- char action_sub[MAX_IDENTIFIER_LENGTH+4];
for (i=0; i<no_actions; i++)
- { strcpy(action_name, symbols[actions[i].symbol].name);
- action_name[strlen(action_name) - 3] = '\0'; /* remove "__A" */
+ {
+ /* The name looks like "action__A". We're going to convert that to
+ "actionSub". Allocate enough space for both. */
+ int namelen = strlen(symbols[actions[i].symbol].name);
+ char *action_sub, *action_name;
+ ensure_memory_list_available(&action_symname_memlist, 2*(namelen+1));
+ action_sub = action_symname_memlist.data;
+ action_name = (char *)action_symname_memlist.data + (namelen+1);
+
+ strcpy(action_name, symbols[actions[i].symbol].name);
+ action_name[namelen - 3] = '\0'; /* remove "__A" */
strcpy(action_sub, action_name);
strcat(action_sub, "Sub");
- j = symbol_index(action_sub, -1);
+ j = symbol_index(action_sub, -1, NULL);
if (symbols[j].flags & UNKNOWN_SFLAG)
{
error_named_at("No ...Sub action routine found for action:", action_name, symbols[actions[i].symbol].line);
}
- else
- if (symbols[j].type != ROUTINE_T)
+ else if (symbols[j].type != ROUTINE_T)
{
- error_named_at("No ...Sub action routine found for action:", action_name, symbols[actions[i].symbol].line);
- error_named_at("-- ...Sub symbol found, but not a routine:", action_sub, symbols[j].line);
+ ebf_symbol_error("action's ...Sub routine", action_sub, typename(symbols[j].type), symbols[j].line);
}
else
{ actions[i].byte_offset = symbols[j].value;
This routine is used only in grammar version 1: the corresponding
table is left empty in GV2. */
+ uchar *new_sort_code;
int i;
- uchar new_sort_code[MAX_DICT_WORD_BYTES];
if (no_adjectives >= 255) {
error("Grammar version 1 cannot support more than 255 prepositions");
error("Grammar version 1 cannot be used with ZCODE_LESS_DICT_DATA");
return 0;
}
+
+ /* Allocate the extra space even though we might not need it. We'll use
+ the prospective new adjective_sort_code slot as a workspace. */
ensure_memory_list_available(&adjectives_memlist, no_adjectives+1);
ensure_memory_list_available(&adjective_sort_code_memlist, (no_adjectives+1) * DICT_WORD_BYTES);
+ new_sort_code = adjective_sort_code+no_adjectives*DICT_WORD_BYTES;
dictionary_prepare(English_word, new_sort_code);
for (i=0; i<no_adjectives; i++)
if (compare_sorts(new_sort_code,
return(0xff-i);
adjectives[no_adjectives]
= dictionary_add(English_word,8,0,0xff-no_adjectives);
- copy_sorts(adjective_sort_code+no_adjectives*DICT_WORD_BYTES,
- new_sort_code);
return(0xff-no_adjectives++);
}
p=English_verb_list;
while (p < English_verb_list+English_verb_list_size)
{
- int val = (p[1] << 8) | p[2];
+ int val = ((uchar)p[1] << 8) | (uchar)p[2];
if (val == num) {
return p+3;
}
/* We set a hard limit of MAX_VERB_WORD_SIZE=120 because the
English_verb_list table stores length in a leading byte. (We could
- raise that to 250, really, but there's little point when
- MAX_DICT_WORD_SIZE is 40.) */
+ raise that to 250, really.) */
entrysize = strlen(English_verb)+4;
if (entrysize > MAX_VERB_WORD_SIZE+4)
- error_numbered("Verb word is too long -- max length is", MAX_VERB_WORD_SIZE);
+ error_fmt("Verb word is too long -- max length is %d", MAX_VERB_WORD_SIZE);
ensure_memory_list_available(&English_verb_list_memlist, English_verb_list_size + entrysize);
top = English_verb_list + English_verb_list_size;
English_verb_list_size += entrysize;
return j;
}
- ebf_error("an English verb in quotes", token_text);
+ ebf_curtoken_error("an English verb in quotes");
return -1;
}
+void locate_dead_grammar_lines()
+{
+ /* Run through the grammar table and check whether each entry is
+ associated with a verb word. (Some might have been detached by
+ "Extend only".)
+ */
+ int verb;
+ char *p;
+
+ for (verb=0; verb<no_Inform_verbs; verb++) {
+ Inform_verbs[verb].used = FALSE;
+ }
+
+ p=English_verb_list;
+ while (p < English_verb_list+English_verb_list_size)
+ {
+ verb = ((uchar)p[1] << 8) | (uchar)p[2];
+ if (verb < 0 || verb >= no_Inform_verbs) {
+ error_named("An entry in the English verb list had an invalid verb number", p+3);
+ }
+ else {
+ Inform_verbs[verb].used = TRUE;
+ }
+ p=p+(uchar)p[0];
+ }
+
+ for (verb=0; verb<no_Inform_verbs; verb++) {
+ if (!Inform_verbs[verb].used) {
+ warning_at("Verb declaration no longer has any verbs associated. Use \"Extend replace\" instead of \"Extend only\"?", Inform_verbs[verb].line);
+ }
+ }
+}
+
/* ------------------------------------------------------------------------- */
/* Grammar lines for Verb/Extend directives. */
/* ------------------------------------------------------------------------- */
}
if (!((token_type == SEP_TT) && (token_value == TIMES_SEP)))
{ discard_token_location(beginning_debug_location);
- ebf_error("'*' divider", token_text);
+ ebf_curtoken_error("'*' divider");
panic_mode_error_recovery();
return FALSE;
}
bytecode = 0; wordcode = 0;
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
{ discard_token_location(beginning_debug_location);
- ebf_error("'->' clause", token_text);
+ ebf_curtoken_error("'->' clause");
return FALSE;
}
if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
{ if (last_was_slash && (grammar_token>0))
- ebf_error("grammar token", token_text);
+ ebf_curtoken_error("grammar token");
break;
}
{ if (grammar_version_number == 1)
error("'/' can only be used with Library 6/3 or later");
if (last_was_slash)
- ebf_error("grammar token or '->'", token_text);
+ ebf_curtoken_error("grammar token or '->'");
else
{ last_was_slash = TRUE;
slash_mode = TRUE;
if ((token_type != SYMBOL_TT)
|| (symbols[token_value].type != ROUTINE_T))
{ discard_token_location(beginning_debug_location);
- ebf_error("routine name after 'noun='", token_text);
+ ebf_curtoken_error("routine name after 'noun='");
panic_mode_error_recovery();
return FALSE;
}
get_next_token();
if (!((token_type==SEP_TT)&&(token_value==SETEQUALS_SEP)))
{ discard_token_location(beginning_debug_location);
- ebf_error("'=' after 'scope'", token_text);
+ ebf_curtoken_error("'=' after 'scope'");
panic_mode_error_recovery();
return FALSE;
}
if ((token_type != SYMBOL_TT)
|| (symbols[token_value].type != ROUTINE_T))
{ discard_token_location(beginning_debug_location);
- ebf_error("routine name after 'scope='", token_text);
+ ebf_curtoken_error("routine name after 'scope='");
panic_mode_error_recovery();
return FALSE;
}
get_next_token();
dont_enter_into_symbol_table = FALSE;
- if (token_type != DQ_TT)
+ if (token_type != UQ_TT)
{ discard_token_location(beginning_debug_location);
- ebf_error("name of new or existing action", token_text);
+ ebf_curtoken_error("name of new or existing action");
panic_mode_error_recovery();
return FALSE;
}
}
if (no_given == 0)
- { ebf_error("English verb in quotes", token_text);
+ { ebf_curtoken_error("English verb in quotes");
panic_mode_error_recovery(); return;
}
if (Inform_verb == -1) return;
get_next_token();
if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- ebf_error("';' after English verb", token_text);
+ ebf_curtoken_error("';' after English verb");
}
else
{ verb_equals_form = FALSE;
error("Z-code is limited to 255 verbs.");
panic_mode_error_recovery(); return;
}
+ if (no_Inform_verbs >= 65535) {
+ error("Inform is limited to 65535 verbs.");
+ panic_mode_error_recovery(); return;
+ }
ensure_memory_list_available(&Inform_verbs_memlist, no_Inform_verbs+1);
Inform_verb = no_Inform_verbs;
Inform_verbs[no_Inform_verbs].lines = 0;
Inform_verbs[no_Inform_verbs].size = 4;
Inform_verbs[no_Inform_verbs].l = my_malloc(sizeof(int) * Inform_verbs[no_Inform_verbs].size, "grammar lines for one verb");
+ Inform_verbs[no_Inform_verbs].line = get_brief_location(&ErrorReport);
+ Inform_verbs[no_Inform_verbs].used = FALSE;
}
for (i=0, pos=0; i<no_given; i++) {
error("Z-code is limited to 255 verbs.");
panic_mode_error_recovery(); return;
}
+ if (no_Inform_verbs >= 65535) {
+ error("Inform is limited to 65535 verbs.");
+ panic_mode_error_recovery(); return;
+ }
ensure_memory_list_available(&Inform_verbs_memlist, no_Inform_verbs+1);
l = -1;
while (get_next_token(),
Inform_verbs[no_Inform_verbs].l = my_malloc(sizeof(int) * Inform_verbs[no_Inform_verbs].size, "grammar lines for one verb");
for (k=0; k<l; k++)
Inform_verbs[no_Inform_verbs].l[k] = Inform_verbs[Inform_verb].l[k];
+ Inform_verbs[no_Inform_verbs].line = get_brief_location(&ErrorReport);
+ Inform_verbs[no_Inform_verbs].used = FALSE;
Inform_verb = no_Inform_verbs++;
}
else
extend_mode = EXTEND_LAST;
if (extend_mode==0)
- { ebf_error("'replace', 'last', 'first' or '*'", token_text);
+ { ebf_curtoken_error("'replace', 'last', 'first' or '*'");
extend_mode = EXTEND_LAST;
}
}
sizeof(uchar), 50*DICT_WORD_BYTES, (void**)&adjective_sort_code,
"adjective sort codes");
+ initialise_memory_list(&action_symname_memlist,
+ sizeof(uchar), 32, NULL,
+ "action temporary symbols");
+
initialise_memory_list(&English_verb_list_memlist,
sizeof(char), 2048, (void**)&English_verb_list,
"register of verbs");
deallocate_memory_list(&grammar_token_routine_memlist);
deallocate_memory_list(&adjectives_memlist);
deallocate_memory_list(&adjective_sort_code_memlist);
+ deallocate_memory_list(&action_symname_memlist);
deallocate_memory_list(&English_verb_list_memlist);
deallocate_memory_list(&English_verbs_given_memlist);
}
projects / inform.git / commitdiff