ifhub/inform7
1
0
Fork 0
mirror of https://github.com/ganelson/inform.git synced 2024-06-26 04:00:43 +03:00
Code Issues Projects Releases Wiki Activity

Adopted Inform 6.42

Browse source
This commit is contained in:
Graham Nelson 2024-02-11 23:08:33 +00:00
parent 2b7d85d300
commit b6a7130952
443 changed files with 3550 additions and 13588 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
README.md
View file

@ -1,6 +1,6 @@
# Inform 7
[Version](notes/versioning.md): 10.2.0-beta+6X34 'Krypton' (7 February 2024)
[Version](notes/versioning.md): 10.2.0-beta+6X35 'Krypton' (11 February 2024)
## About Inform
@ -180,7 +180,7 @@ Stable versions of the following are periodically copied into this repository,
but this is not where development on them is done, and no pull requests will
be accepted. (Note that these are not git submodules.)
* inform6 - The Inform 6 compiler (used by I7 as a code generator). - __1641__ - from [https://github.com/DavidKinder/Inform6], maintained by [David Kinder](https://github.com/DavidKinder)
* inform6 - The Inform 6 compiler (used by I7 as a code generator). - __1642__ - from [https://github.com/DavidKinder/Inform6], maintained by [David Kinder](https://github.com/DavidKinder)
* inform6/Tests/Assistants/dumb-frotz - A dumb-terminal Z-machine interpreter. - unversioned: modified from [Alembic Petrofsky's 1998 Teletype port of Frotz](https://github.com/sussman/ircbot-collection/tree/master/dumb-frotz)
* inform6/Tests/Assistants/dumb-glulx/glulxe - A dumb-terminal Glulx interpreter. - __0.6.1__ - [erkyrath/glulxe](https://github.com/erkyrath/glulxe), maintained by [Andrew Plotkin](https://github.com/erkyrath)
* inform6/Tests/Assistants/dumb-glulx/cheapglk - A basic Glk implementation to support dumb-glulxe. - __1.0.6.__ - [erkyrath/cheapglk](https://github.com/erkyrath/cheapglk), maintained by [Andrew Plotkin](https://github.com/erkyrath)

4
build.txt
View file

@ -1,3 +1,3 @@
Prerelease: beta
Build Date: 7 February 2024
Build Number: 6X34
Build Date: 11 February 2024
Build Number: 6X35

4
docs/final-module/4-fi6.html
View file

@ -205,6 +205,9 @@ we will need for the code we are compiling. But this seems a good time to make i
<pre class="displayed-code all-displayed-code code-font">
<span class="plain-syntax"> </span><span class="reserved-syntax">segmentation_pos</span><span class="plain-syntax"> </span><span class="identifier-syntax">saved</span><span class="plain-syntax"> = </span><a href="2-cg.html#SP12" class="function-link"><span class="function-syntax">CodeGen::select</span></a><span class="plain-syntax">(</span><span class="identifier-syntax">gen</span><span class="plain-syntax">, </span><span class="constant-syntax">compiler_versioning_matter_I7CGS</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">text_stream</span><span class="plain-syntax"> *</span><span class="identifier-syntax">OUT</span><span class="plain-syntax"> = </span><a href="2-cg.html#SP14" class="function-link"><span class="function-syntax">CodeGen::current</span></a><span class="plain-syntax">(</span><span class="identifier-syntax">gen</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"#ifndef VN_1642;\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"#message fatalerror \"Inform 7 generates code requiring Inform 6.42 or later\";\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"#endif;\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"Constant Grammar__Version 2;\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"Global debug_flag;\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"Global or_tmp_var;\n"</span><span class="plain-syntax">);</span>
@ -213,6 +216,7 @@ we will need for the code we are compiling. But this seems a good time to make i
<span class="plain-syntax"> </span><span class="identifier-syntax">OUT</span><span class="plain-syntax"> = </span><a href="2-cg.html#SP14" class="function-link"><span class="function-syntax">CodeGen::current</span></a><span class="plain-syntax">(</span><span class="identifier-syntax">gen</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"!%% -Cu\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"!%% $ZCODE_LESS_DICT_DATA=1;\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"!%% $LONG_DICT_FLAG_BUG=0;\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><span class="reserved-syntax">if</span><span class="plain-syntax"> (</span><span class="identifier-syntax">omit_ur</span><span class="plain-syntax">) </span><span class="identifier-syntax">WRITE</span><span class="plain-syntax">(</span><span class="string-syntax">"!%% $OMIT_UNUSED_ROUTINES=1;\n"</span><span class="plain-syntax">);</span>
<span class="plain-syntax"> </span><a href="2-cg.html#SP12" class="function-link"><span class="function-syntax">CodeGen::deselect</span></a><span class="plain-syntax">(</span><span class="identifier-syntax">gen</span><span class="plain-syntax">, </span><span class="identifier-syntax">saved</span><span class="plain-syntax">);</span>
</pre>

10
inblorb/Tests/Test Cases/_Blurb_Ideal/Plain.blurb
View file

@ -1,18 +1,18 @@
! Blurb file created by Inform Inform 7.99.99 (build 9Z99)
status "inform7/Internal/HTML/CblorbModel.html" "/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.inform/Build/StatusCblorb.html"
status "inform7/Internal/HTML/CblorbModel.html" "/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.inform/Build/StatusCblorb.html"
! Identification
project folder "/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.inform"
release to "/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.materials/Release"
project folder "/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.inform"
release to "/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.materials/Release"
! Blorb instructions
storyfile leafname "story.gblorb"
storyfile "/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.inform/Build/output.ulx" include
ifiction "/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.inform/Metadata.iFiction" include
storyfile "/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.inform/Build/output.ulx" include
ifiction "/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.inform/Metadata.iFiction" include
cover "inform7/Internal/Miscellany/DefaultCover.jpg"
picture 1 "inform7/Internal/Miscellany/DefaultCover.jpg"

4
inblorb/Tests/Test Cases/_Console_Ideal/Plain.txt
View file

@ -1,5 +1,5 @@
! inblorb 99.99 [executing on Thursday 28 April 2016 at 11:00.00]
! The blorb spell (safely protect a small object as though in a strong box).
! Release folder: </Users/gnelson/Natural Inform/intest/Workspace/T4/Example.materials/Release>
Copy blorb to: [[/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.materials/Release/story.gblorb]]
! Release folder: </Users/gnelson/Natural Inform/intest/Workspace/T0/Example.materials/Release>
Copy blorb to: [[/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.materials/Release/story.gblorb]]
! Completed: wrote blorb file with 1 picture(s), 0 sound(s), 0 data file(s)

2
inblorb/Tests/Test Cases/_Scan_Ideal/Plain.txt
View file

@ -1,4 +1,4 @@
Reading "/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.inform/Build/output.gblorb"...
Reading "/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.inform/Build/output.gblorb"...
List of resources:
Usage 'Exec' number 0: chunk 1

2
inblorb/Tests/Test Cases/_Tree_Ideal/Plain.txt
View file

@ -1 +1 @@
/Users/gnelson/Natural Inform/intest/Workspace/T4/Example.materials/Release
/Users/gnelson/Natural Inform/intest/Workspace/T0/Example.materials/Release

2
inform6/Inform6/README.md Executable file → Normal file
View file

@ -1,6 +1,6 @@
# Inform 6
This is Inform 6.41, copyright (c) Graham Nelson 1993 - 2022, a compiler for
This is Inform 6.42, copyright (c) Graham Nelson 1993 - 2024, a compiler for
interactive fiction (text adventure games).
Release notes, manuals, executables and more are available from

134
inform6/Inform6/ReleaseNotes.html Executable file → Normal file
View file

@ -15,7 +15,8 @@ to implement has been governed by two factors:
<li><p>Avoidance of changes which might cause existing games to misbehave; and
<li><p>Minimisation of features which would require updates to the <i>Inform Designer&rsquo;s Manual</i>.
</ul>
Since the first release of the Inform 6.3 compiler, the Inform 6 library has been split into a separate project,
Older release notes (Inform 6.30 through 6.36) are <a href="https://inform-fiction.org/manual/ReleaseNotes-6.3x.html">archived here</a>.
<p>Since the first release of the Inform 6.3 compiler, the Inform 6 library has been split into a separate project,
maintained at <a href="https://gitlab.com/DavidGriffith/inform6lib">https://gitlab.com/DavidGriffith/inform6lib</a>.
<h2>Acknowledgements</h2>
@ -25,6 +26,137 @@ listed. So instead, this is a general thank-you to everybody who has made this r
specific ones to Graham Nelson for permitting it in the first place, and to Andrew Plotkin, who is responsible
for most of the actual changes to the compiler code.
<h2>Inform 6.42</h2>
These are the changes delivered in version 6.42 of the Inform compiler.
<h3>Features added</h3>
<ul>
<li><p>The compiler can now handle switch cases which are expressions, rather than just looking for bare literals
and symbols. The expression must still evaluate to a constant, but now parentheses and constant-folded arithmetic
are handled:
<pre>
Constant CONST = 5;
! These have always worked.
switch (x) {
0: return 0;
1: return 1;
-2: return -2;
}
! These now also work.
switch (x) {
(0): return 0;
(-(1)): return -1;
(CONST): return 5;
(CONST+1): return 6;
}
</pre>
For backwards compatibility, the expression must be wrapped in parens, so <tt>-(1):</tt> is not a valid case. Lists
of expressions are also supported. Expression parsing applies as long as the first value is wrapped in parens.
Wrapping the entire list in parens also works:
<pre>
switch (x) {
1, 2, 3: return 0; ! old style
(4), (CONST), (CONST+1): return 1; ! new style
(10), CONST+6, CONST+7: return 2; ! this also works
(20, CONST+16, CONST+17): return 3; ! as does this
}
</pre>
Note that the <tt>to</tt> keyword does not support expressions. You cannot say <tt>(CONST) to (CONST+5):</tt>
as a case. Also, case expressions only work within a switch statement. Top-level action cases must still be bare
action names.
<li><p>Inform identifiers can now be any length, and the entire identifier is significant. Dictionary words can also
be any length. The DICT_WORD_SIZE limit still applies, but now dictionary words are silently trimmed to DICT_WORD_SIZE.
For Glulx, DICT_WORD_SIZE can now be increased without limit.
<li><p>Arbitrary bytes and words can be compiled into the game, using two new statements:
<pre>
@ -> BYTE BYTE BYTE ...;
@ --> WORD WORD WORD ...;
</pre>
The given bytes or words are directly copied out into the function. (Words are two bytes in Z-code, and four bytes in
Glulx.) The compiler assumes that the data forms valid opcodes, but does nothing to verify this. Bytes must be numeric
constants, while words are either numeric constants or symbols, such as the name of a function.
<li><p>A new setting exists to omit the symbol names table, <tt>$OMIT_SYMBOL_TABLE</tt>. The symbol names table
contains the names of all properties, attributes, fake actions, and arrays as strings, and is generally only used by
debug library code and debug veneer error messages. When <tt>$OMIT_SYMBOL_TABLE=1</tt> is set:
<ul>
<li>The symbol names table is omitted from the game file, for both Glulx and Z-code.
<li>The <tt>print (property) p</tt> statement will print <tt>&lt;number 72&gt;</tt> (etc.) instead of the property name.
<li>The runtime error for a non-existent property <tt>(obj has no property prop to read)</tt> will similarly print
a number instead of the property name.
<li>The runtime error for array overflow <tt>(tried to read from -->5 in the array "arr"...)</tt> will omit the
array name.
<li>The following system constants are not available, and trying to use one is a compile-time error:
<tt>#identifiers_table</tt>, <tt>#attribute_names_array</tt>, <tt>#property_names_array</tt>, <tt>#action_names_array</tt>,
<tt>#fake_action_names_array</tt>, <tt>#array_names_offset</tt>, <tt>#global_names_array</tt>, <tt>#routine_names_array</tt>,
<tt>#constant_names_array</tt>.
</ul><br>
Note that the Inform 6 library uses <tt>#identifiers_table</tt> for some debugging verbs, and the Infix library
extension uses all the affected constants. To update such code, the relevant logic that uses these symbol names and
constants would be put in a <tt>#Ifndef OMIT_SYMBOL_TABLE;</tt> block.
<li><p>A new setting <tt>$ZCODE_MAX_INLINE_STRING</tt> has been added to determine how long a string can be and still
be compiled to a <tt>@print</tt> opcode, rather than be added to the string segment and compiled to a <tt>@print_paddr</tt>
opcode. This setting has a default value of 32, which matches the previous behaviour of the compiler, where this limit
was hard-coded at 32 characters.
<li><p>The <tt>Abbreviate</tt> directive now accepts abbreviations of any length.
<li><p>The <tt>-u</tt> option, which computes abbreviations, can now generate abbreviations of any length.
<li><p>Inform is now able to correctly set the plural flag on long dictionary words (e.g. <tt>'directions//p'</tt>).
However, due to the way Inform 7 has defined plural kind names in the past, fixing this will affect the parsing of
Inform 7 games if the output Inform 6 code is then compiled with a version of Inform 6 that fixes this issue. As a result,
there is a new setting <tt>$LONG_DICT_FLAG_BUG</tt>, which defaults to 1. The new behaviour is only enabled if this setting
is set to 0.
<li><p>Flags for dictionary words now include setting the NOUN flag, and also provides a way to explicitly not set a
flag. The possible choices are:
<ul>
<li><tt>//p</tt> sets the PLURAL flag (bit 2)
<li><tt>//n</tt> sets the NOUN flag (bit 7)
<li><tt>//~p</tt> means do not set the PLURAL flag at this point
<li><tt>//~n</tt> means do not set the NOUN flag at this point
</ul>
<br>Dictionary words used in most contexts default to <tt>//n</tt>.
<li><p>The <tt>--trace PROPS</tt> and <tt>--trace SYMDEF</tt> options now display the line number that each property
or symbol is defined at.
<li><p>The <tt>--trace ASM=2</tt> option now shows backpatch markers as a short descriptive string, rather than as a
number.
<li><p>The statement <tt>print "^";</tt> now compiles to a single opcode (<tt>@new_line</tt> for Z-code, or
<tt>@streamchar 10</tt> for Glulx) rather than printing a one character string.
<li><p>For Glulx, with strict mode turned off, <tt>print (char) X;</tt> compiles to either <tt>@streamchar X</tt> or
<tt>@streamunichar X</tt>, depending on whether X is a compile-time constant less than 256, or not.
<li><p>Grammar table lines entries which have no verb are now omitted. When this occurs a warning is printed, as this
most likely indicates an oversight in the game's source code.
<li><p>Error messages about invalid tokens are now more informative.
<li><p>Inform now handles line breaks itself, rather than relying on the C standard library. This gives consistent
handling of Windows and Unix style line breaks on all platforms.
<li><p>The output file "gametext.txt" now includes the Z-code or Glulx version being compiled to.
<li><p>The Z-Machine opcodes added in revision 1.1 of the Z-Machine Specification Standard, <tt>set_true_colour</tt>
and <tt>buffer_screen</tt>, are now supported.
</ul>
<h3>Bugs fixed</h3>
<ul>
<li><p>The Glulx build-in function <b>random(x)</b> built-in function now follows the DM4 specification: if <b>x</b>
is positive, the function returns the result of <tt>1+(@random x)</tt>; if zero or negative, <tt>@setrandom x</tt> is called.
<li><p>In several places (local variable declarations, action names and the <tt>Switches</tt> directive) the compiler would
accept quoted strings and then ignore the quotes. This is now an error.
<li><p>The case of a property having too many entries is now always an error, and is checked correctly in the case
of compiling to Z-code V3.
<li><p>An unclosed double quote at the end of a source file no longer causes the compiler to hang.
<li><p>A number of issues relating to error messages giving incorrect information have been fixed by improving how the
compiler handles backtracking through parsed symbols in some tricky cases.
<li><p>The Z-code version of the veneer function <tt>Box__Routine</tt> (which is used in the implementation of the
<tt>box</tt> statement) now contains a check to prevent calling the <tt>@set_cursor</tt> opcode with negative
co-ordinates.
<li><p>The veneer functions <tt>RA__Pr()</tt>, <tt>RL__Pr()</tt> and <tt>CP__Tab()</tt> are now correct for Z-code V3.
<li><p>Errors in the declaration of arrays could sometimes cause the compiler to emit a large number of error messages,
this is now fixed so that only the initial error is printed.
<li><p>Invalid expressions like <tt>(a++ b)</tt>, <tt>(a ~b)</tt>, <tt>(a++ ~b)</tt>, and <tt>(a++ --b)</tt> previously
caused an internal compiler error, but now produce a sensible error message.
<li><p>When computing abbreviations, the space character is now correctly treated as only occupying one byte, not four.
<li><p>The argument supplied to the Z-machine opcode <tt>@jump</tt> is now interpreted correctly. Previously this was
only done properly for the <tt>jump</tt> statement, not the opcode.
</ul>
<h2>Inform 6.41</h2>
These are the changes delivered in version 6.41 of the Inform compiler.

31
inform6/Inform6/arrays.c Executable file → Normal file
View file

@ -3,8 +3,8 @@
/* 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 */
/* */
/* ------------------------------------------------------------------------- */
@ -279,7 +279,7 @@ extern void make_global()
int name_length;
assembly_operand AO;
int32 globalnum;
uint32 globalnum;
int32 global_symbol;
debug_location_beginning beginning_debug_location =
get_token_location_beginning();
@ -309,7 +309,7 @@ extern void make_global()
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;
}
@ -400,7 +400,7 @@ extern void make_global()
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;
@ -443,7 +443,7 @@ extern void make_array()
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;
}
@ -479,7 +479,7 @@ extern void make_array()
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;
}
@ -503,8 +503,7 @@ extern void make_array()
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;
}
@ -619,6 +618,8 @@ extern void make_array()
put_token_back();
AO = parse_expression(ARRAY_CONTEXT);
if (AO.marker == ERROR_MV)
break;
if (i == 0)
{ get_next_token();
@ -643,7 +644,7 @@ extern void make_array()
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";
}
@ -692,6 +693,7 @@ advance as part of 'Zcharacter table':", unicode);
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. */
@ -706,11 +708,14 @@ advance as part of 'Zcharacter table':", unicode);
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++;
}
}
@ -851,7 +856,7 @@ extern void arrays_allocate_arrays(void)
"global variable values");
initialise_memory_list(&current_array_name,
sizeof(char), MAX_IDENTIFIER_LENGTH+1, NULL,
sizeof(char), 32, NULL,
"array name currently being defined");
}

492
inform6/Inform6/asm.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -79,11 +79,9 @@ static char opcode_syntax_string[128]; /* Text buffer holding the correct
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;
@ -309,7 +307,7 @@ extern int is_variable_ot(int otval)
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");
@ -644,7 +642,12 @@ static opcodez opcodes_table_z[] =
/* 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 */
@ -859,6 +862,7 @@ static opcodez internal_number_to_opcode_z(int32 i)
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;
@ -906,6 +910,7 @@ static void make_opcode_syntax_g(opcodeg opco)
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,
@ -1237,6 +1242,8 @@ extern void assemblez_instruction(const assembly_instruction *AI)
{ 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]);
}
}
@ -1304,7 +1311,7 @@ static void assembleg_macro(const assembly_instruction *AI)
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);
@ -1320,7 +1327,7 @@ static void assembleg_macro(const assembly_instruction *AI)
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);
@ -1634,9 +1641,9 @@ extern void assembleg_instruction(const assembly_instruction *AI)
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(" ");
}
}
@ -1709,22 +1716,22 @@ extern void define_symbol_label(int symbol)
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;
@ -1787,7 +1794,8 @@ extern int32 assemble_routine_header(int no_locals,
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++;
@ -2031,7 +2039,7 @@ void assemble_routine_end(int embedded_flag, debug_locations locations)
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)
@ -2057,7 +2065,7 @@ void assemble_routine_end(int embedded_flag, debug_locations locations)
/* 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);
@ -2203,7 +2211,7 @@ static void transfer_routine_z(void)
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;
@ -2234,7 +2242,7 @@ static void transfer_routine_z(void)
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;
@ -2247,6 +2255,7 @@ static void transfer_routine_z(void)
default:
switch(zcode_markers[i] & 0x7f)
{ case NULL_MV: break;
case ERROR_MV: break;
case VARIABLE_MV:
case OBJECT_MV:
case ACTION_MV:
@ -2472,6 +2481,8 @@ static void transfer_routine_g(void)
switch(zcode_markers[i] & 0x7f) {
case NULL_MV:
break;
case ERROR_MV:
break;
case ACTION_MV:
case IDENT_MV:
break;
@ -3048,7 +3059,9 @@ static assembly_operand parse_operand_z(void)
}
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;
@ -3094,8 +3107,7 @@ static void parse_assembly_z(void)
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;
@ -3111,10 +3123,9 @@ static void parse_assembly_z(void)
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;
}
}
@ -3135,9 +3146,74 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
}
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;
}
@ -3146,11 +3222,12 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
}
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();
@ -3159,7 +3236,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
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;
@ -3177,7 +3254,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
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
@ -3217,7 +3294,7 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
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;
@ -3236,10 +3313,16 @@ T (text), I (indirect addressing), F** (set this Flags 2 bit)");
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();
@ -3336,151 +3419,218 @@ static assembly_operand parse_operand_g(void)
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;
if (token_type == DQ_TT) {
char *cx;
int badflags;
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.
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;
badflags = FALSE;
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), \
S (store), SS (two stores), R (execution never continues)");
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);
}
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;
}
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);
}
return_sp_as_variable = TRUE;
while (1) {
opcode_names.enabled = TRUE;
opcode_macros.enabled = TRUE;
get_next_token();
if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
break;
opcode_names.enabled = FALSE;
opcode_macros.enabled = FALSE;
if (AI.operand_count == 8) {
error("No assembly instruction may have more than 8 operands");
panic_mode_error_recovery();
break;
if (token_type == DQ_TT) {
char *cx;
int badflags;
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.
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;
badflags = FALSE;
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), \
S (store), SS (two stores), R (execution never continues)");
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);
}
O = custom_opcode_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 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 {
put_token_back();
AO = parse_operand_g();
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);
}
return_sp_as_variable = TRUE;
while (1) {
get_next_token();
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 ((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)
@ -3558,7 +3708,7 @@ extern void asm_allocate_arrays(void)
"code area");
initialise_memory_list(&current_routine_name,
sizeof(char), 3*MAX_IDENTIFIER_LENGTH, NULL,
sizeof(char), 64, NULL,
"routine name currently being defined");
}

72
inform6/Inform6/bpatch.c Executable file → Normal file
View file

@ -2,8 +2,8 @@
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -34,6 +34,7 @@ extern char *describe_mv(int mval)
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");
@ -49,10 +50,53 @@ extern char *describe_mv(int mval)
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 */
/* ------------------------------------------------------------------------- */
@ -130,9 +174,17 @@ static int32 backpatch_value_z(int32 value)
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)
@ -277,9 +329,17 @@ static int32 backpatch_value_g(int32 value)
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)

9
inform6/Inform6/chars.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 uses six different character representations: */
@ -322,8 +322,9 @@ static void read_source_to_iso_file(uchar *uccg)
/* */
/* 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 '?' */
@ -346,7 +347,7 @@ static void make_source_to_iso_grid(void)
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] = ' ';

132
inform6/Inform6/directs.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -10,7 +10,6 @@
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];
@ -26,23 +25,23 @@ static int ifdef_stack[MAX_IFDEF_STACK], ifdef_sp;
/* ------------------------------------------------------------------------- */
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;
}
@ -109,13 +108,7 @@ extern int parse_given_directive(int internal_flag)
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);
@ -154,12 +147,12 @@ extern int parse_given_directive(int internal_flag)
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);
@ -237,7 +230,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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)
@ -283,7 +276,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
*/
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;
@ -387,7 +380,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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.
@ -493,7 +486,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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");
@ -557,13 +550,13 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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);
@ -597,13 +590,13 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
}
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;
@ -634,26 +627,25 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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;
/* --------------------------------------------------------------------- */
@ -702,16 +694,14 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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)
@ -720,8 +710,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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)
@ -792,9 +781,9 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
}
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;
@ -811,7 +800,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
}
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
@ -849,7 +838,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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;
@ -865,7 +854,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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;
@ -876,7 +865,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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;
@ -890,13 +879,14 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
(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,
@ -924,8 +914,8 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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) {
@ -997,7 +987,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
'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;
@ -1087,7 +1077,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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 */
@ -1101,7 +1091,10 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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;
@ -1159,8 +1152,8 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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))
{
@ -1196,18 +1189,18 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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:
@ -1228,13 +1221,11 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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();
}
@ -1251,8 +1242,7 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
= token_value;
break;
default:
return ebf_error_recover("ZSCII number",
token_text);
return ebf_error_recover("ZSCII number");
}
get_next_token();
}
@ -1260,13 +1250,12 @@ Fake_Action directives to a point after the inclusion of \"Parser\".)");
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;
@ -1279,7 +1268,7 @@ a 'table' or 'terminating' command or a single character", token_text);
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
@ -1301,7 +1290,6 @@ extern void init_directs_vars(void)
extern void directs_begin_pass(void)
{ no_routines = 0;
no_named_routines = 0;
no_locals = 0;
no_termcs = 0;
constant_made_yet = FALSE;
ifdef_sp = 0;

87
inform6/Inform6/errors.c Executable file → Normal file
View file

@ -2,8 +2,8 @@
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -158,6 +158,14 @@ static char *location_text(brief_location report_line)
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
@ -191,13 +199,23 @@ extern void fatalerror(char *s)
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);
@ -265,15 +283,18 @@ extern void error(char *s)
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);
}
@ -292,16 +313,35 @@ extern void error_named_at(char *s1, char *s2, brief_location report_line)
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();
@ -394,9 +434,13 @@ extern void warning(char *s1)
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);
}
@ -409,6 +453,19 @@ extern void warning_named(char *s1, char *s2)
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; }

75
inform6/Inform6/expressc.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -1071,10 +1071,16 @@ static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
/* 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);
}
@ -1092,10 +1098,16 @@ static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
}
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);
@ -2630,11 +2642,48 @@ static void generate_code_from(int n, int void_flag)
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;
@ -2988,7 +3037,7 @@ assembly_operand code_generate(assembly_operand AO, int context, int label)
}
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)
@ -3008,7 +3057,7 @@ assembly_operand code_generate(assembly_operand AO, int context, int label)
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));

268
inform6/Inform6/expressp.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -54,6 +54,8 @@ static int comma_allowed, arrow_allowed, superclass_allowed,
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;
@ -311,8 +313,8 @@ but not used as a value:", unicode);
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);
@ -363,7 +365,7 @@ but not used as a value:", unicode);
"'#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:
@ -375,13 +377,14 @@ but not used as a value:", unicode);
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;
@ -459,27 +462,31 @@ but not used as a value:", unicode);
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 */
const int prec_table[] = {
#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 */
/* a .......... ( ) end op term */
const int prec_table[49] = {
/* 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
/* a ....... ( ) end op:pre op:bin op:post term */
/* 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
};
@ -488,7 +495,7 @@ static int find_prec(const token_data *a, const token_data *b)
/* We are comparing the precedence of tokens a and b
(where a occurs to the left of b). If the expression is correct,
the only possible values are GREATER_P, LOWER_P or EQUAL_P;
if it is malformed then one of e1 to e5 results.
if it is malformed then one of the *_E results.
Note that this routine is not symmetrical and that the relation
is not trichotomous.
@ -499,25 +506,50 @@ static int find_prec(const token_data *a, const token_data *b)
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;
@ -537,7 +569,7 @@ static int find_prec(const token_data *a, const token_data *b)
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;
}
@ -593,8 +625,32 @@ int z_system_constant_list[] =
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:
@ -1029,7 +1085,7 @@ static void add_bracket_layer_to_emitter_stack(int depth)
{ /* There's no point in tracking bracket layers that don't fence off any values. */
if (emitter_sp < depth + 1) return;
if (expr_trace_level >= 2)
printf("Adding bracket layer\n");
printf("Adding bracket layer (depth %d)\n", depth);
++emitter_stack[emitter_sp-depth-1].bracket_count;
}
@ -1202,7 +1258,7 @@ static void emit_token(const token_data *t)
default:
warning("Property name in expression is not qualified by object");
}
} /* if (is_property_t */
}
}
switch(arity)
@ -1210,7 +1266,12 @@ static void emit_token(const token_data *t)
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;
@ -1377,23 +1438,24 @@ static void emit_token(const token_data *t)
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:
@ -1466,10 +1528,10 @@ static void show_node(int n, int depth, int annotate)
if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
}
extern void show_tree(assembly_operand AO, int annotate)
{ if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
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");
}
}
@ -1869,8 +1931,11 @@ extern assembly_operand parse_expression(int context)
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;
@ -1912,7 +1977,8 @@ extern assembly_operand parse_expression(int context)
directives.enabled = FALSE;
if (get_next_etoken() == FALSE)
{ ebf_error("expression", token_text);
{ ebf_curtoken_error("expression");
AO.marker = ERROR_MV;
return AO;
}
@ -1926,6 +1992,7 @@ extern assembly_operand parse_expression(int context)
if (sr_sp == 0)
{ compiler_error("SR error: stack empty");
AO.marker = ERROR_MV;
return(AO);
}
@ -1935,10 +2002,12 @@ extern assembly_operand parse_expression(int context)
{ 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;
}
@ -1946,7 +2015,7 @@ extern assembly_operand parse_expression(int context)
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);
@ -1966,6 +2035,7 @@ extern assembly_operand parse_expression(int context)
if (context == CONSTANT_CONTEXT)
if (!is_constant_ot(AO.type))
{ AO = zero_operand;
AO.marker = ERROR_MV;
ebf_error("constant", "<expression>");
}
put_token_back();
@ -1975,7 +2045,7 @@ extern assembly_operand parse_expression(int context)
switch(find_prec(&a,&b))
{
case e5: /* Associativity error */
case ASSOC_E: /* Associativity error */
error_named("Brackets mandatory to clarify order of:",
a.text);
@ -2035,8 +2105,10 @@ extern assembly_operand parse_expression(int context)
} 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;
@ -2044,13 +2116,15 @@ extern assembly_operand parse_expression(int context)
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;
@ -2058,7 +2132,7 @@ extern assembly_operand parse_expression(int context)
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;
@ -2086,6 +2160,80 @@ extern int test_for_incdec(assembly_operand AO)
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 */
/* ------------------------------------------------------------------------- */

71
inform6/Inform6/files.c Executable file → Normal file
View file

@ -7,8 +7,8 @@
/* 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 */
/* */
/* ------------------------------------------------------------------------- */
@ -27,7 +27,7 @@ int32 total_chars_read; /* Characters read in (from all
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 */
/* ------------------------------------------------------------------------- */
@ -102,7 +102,7 @@ extern void load_sourcefile(char *filename_given, int same_directory_flag)
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");
@ -287,16 +287,16 @@ static void sf_put(int c)
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;
}
@ -344,7 +344,7 @@ static void output_compression(int entnum, int32 *size, int *count)
(*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++;
@ -606,7 +606,6 @@ static void output_file_z(void)
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;
@ -633,35 +632,33 @@ static void output_file_g(void)
/* 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;
}
}
@ -674,10 +671,10 @@ game features require version 0x%08lx", (long)requested_glulx_version, (long)Ver
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));
@ -1207,9 +1204,9 @@ extern void open_transcript_file(char *what_of)
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);
@ -1229,10 +1226,22 @@ extern void close_transcript_file(void)
{ char botline_buffer[256];
char sn_buffer[7];
write_serial_number(sn_buffer);
sprintf(botline_buffer, "[End of transcript: release %d, serial %s]",
release_number, sn_buffer);
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);
snprintf(botline_buffer, 256, "[End of transcript: release %d, serial %s]",
release_number, sn_buffer);
write_to_transcript_file(botline_buffer, STRCTX_INFO);
write_to_transcript_file("", STRCTX_INFO);

158
inform6/Inform6/header.h Executable file → Normal file
View file

@ -1,10 +1,10 @@
/* ------------------------------------------------------------------------- */
/* 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 */
/* */
/* Manuals for this language are available from the IF-Archive at */
/* https://www.ifarchive.org/ */
@ -31,8 +31,8 @@
/* ------------------------------------------------------------------------- */
/* 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
@ -567,14 +567,14 @@
#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), \
@ -599,10 +599,6 @@
/* ------------------------------------------------------------------------- */
#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
@ -647,10 +643,12 @@ typedef struct memory_list_s
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 */
@ -670,8 +668,11 @@ typedef struct variableinfo_s {
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 {
@ -762,6 +763,8 @@ typedef struct abbreviation_s {
int value;
int quality;
int freq;
int textpos; /* in abbreviations_text */
int textlen;
} abbreviation;
typedef struct maybe_file_position_S
@ -789,13 +792,6 @@ typedef struct debug_locations_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;
@ -819,6 +815,7 @@ typedef struct lexeme_data_s {
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 */
@ -1115,6 +1112,8 @@ typedef struct operator_s
#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
/* ------------------------------------------------------------------------- */
@ -1223,12 +1222,23 @@ typedef struct operator_s
#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. */
@ -1275,22 +1285,25 @@ typedef struct operator_s
/* 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 */
@ -1917,7 +1930,9 @@ typedef struct operator_s
#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. */
@ -2139,7 +2154,7 @@ extern void assemble_label_no(int n);
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);
@ -2245,6 +2260,7 @@ extern int32 zcode_backpatch_size, staticarray_backpatch_size,
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);
@ -2287,7 +2303,7 @@ extern void make_upper_case(char *str);
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);
@ -2304,29 +2320,35 @@ extern int no_errors, no_warnings, no_suppressed_warnings, no_compiler_errors;
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;
@ -2364,9 +2386,10 @@ extern int glulx_system_constant_list[];
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" */
@ -2458,7 +2481,7 @@ extern int
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,
@ -2498,7 +2521,8 @@ extern int total_source_line_count;
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;
@ -2511,10 +2535,15 @@ extern void discard_token_location(debug_location_beginning beginning);
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);
@ -2552,9 +2581,12 @@ extern int MAX_LOCAL_VARIABLES;
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.
@ -2637,8 +2669,8 @@ extern char *typename(int type);
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);
@ -2681,6 +2713,7 @@ extern void parse_code_block(int break_label, int continue_label,
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);
/* ------------------------------------------------------------------------- */
@ -2725,7 +2758,6 @@ extern int32 low_strings_top;
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,
@ -2793,6 +2825,7 @@ extern int32 compile_string(char *b, int strctx);
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);
@ -2835,6 +2868,7 @@ extern int32 *grammar_token_routine,
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);

47
inform6/Inform6/inform.c Executable file → Normal file
View file

@ -2,8 +2,8 @@
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -34,7 +34,9 @@ int version_number, /* 3 to 8 (Z-code) */
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;
@ -141,17 +143,17 @@ static void select_target(int targ)
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);
}
}
@ -160,17 +162,10 @@ static void select_target(int targ)
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. */
}
@ -341,6 +336,7 @@ static void reset_switch_settings(void)
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;
@ -1028,6 +1024,7 @@ static void run_pass(void)
sort_dictionary();
if (track_unused_routines)
locate_dead_functions();
locate_dead_grammar_lines();
construct_storyfile();
}
@ -1115,14 +1112,14 @@ disabling -X switch\n");
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();
}
@ -1156,7 +1153,7 @@ static void cli_print_help(int help_level)
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: */
@ -1529,6 +1526,16 @@ static int strcpyupper(char *to, char *from, int max)
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;
@ -1541,7 +1548,7 @@ static int execute_icl_header(char *argname)
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

270
inform6/Inform6/lexer.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -16,10 +16,9 @@ int total_source_line_count, /* Number of source lines so far */
(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
@ -256,8 +255,7 @@ static lexeme_data circle[CIRCLE_SIZE];
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 */
@ -273,12 +271,19 @@ static int lex_pos; /* Current write position in that lextext */
/* ------------------------------------------------------------------------- */
/* 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
@ -324,6 +329,8 @@ extern void describe_token_triple(const char *text, int32 value, int type)
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");
@ -427,6 +434,7 @@ static char *opcode_list_z[] = {
"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",
""
};
@ -592,11 +600,8 @@ static int lexical_context(void)
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;
@ -612,11 +617,17 @@ static int lexical_context(void)
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 ");
@ -629,6 +640,7 @@ static void print_context(int c)
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;
@ -644,14 +656,22 @@ static int *local_variable_hash_codes;
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];
@ -716,9 +736,42 @@ static void make_keywords_tables(void)
}
}
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;
@ -726,7 +779,7 @@ extern void construct_local_variable_tables(void)
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;
@ -745,16 +798,49 @@ extern void construct_local_variable_tables(void)
}
}
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))
@ -777,7 +863,9 @@ static void interpret_identifier(char *p, int pos, int dirs_only_flag)
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;
@ -790,13 +878,11 @@ static void interpret_identifier(char *p, int pos, int dirs_only_flag)
/* 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)))
@ -811,11 +897,9 @@ static void interpret_identifier(char *p, int pos, int dirs_only_flag)
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;
}
@ -888,6 +972,7 @@ static void make_tokeniser_grid(void)
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;
@ -1365,7 +1450,7 @@ static int32 construct_double(int wanthigh, int signbit, double intv, double fra
/* */
/* 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. */
@ -1528,12 +1613,33 @@ static int get_next_char_from_pipeline(void)
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 */
@ -1552,7 +1658,12 @@ static int get_next_char_from_string(void)
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);
}
@ -1573,7 +1684,8 @@ static int get_next_char_from_string(void)
/* */
/* 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)
@ -1619,11 +1731,28 @@ 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)
@ -1682,7 +1811,9 @@ static void lexadds(char *str)
}
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;
@ -1695,7 +1826,7 @@ extern void get_next_token(void)
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;
@ -1710,7 +1841,7 @@ extern void get_next_token(void)
/* 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;
@ -1720,6 +1851,7 @@ extern void get_next_token(void)
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:
@ -1745,7 +1877,7 @@ extern void get_next_token(void)
goto StartTokenAgain;
case COMMENT_CODE:
while ((lookahead != '\n') && (lookahead != 0))
while ((lookahead != '\n') && (lookahead != '\r') && (lookahead != 0))
(*get_next_char)();
goto StartTokenAgain;
@ -1766,7 +1898,7 @@ extern void get_next_token(void)
lexaddc(0);
circle[circle_position].type = NUMBER_TT;
circle[circle_position].value = n;
circle[circle_position].value = (int32)n;
break;
FloatNumber:
@ -1856,11 +1988,7 @@ extern void get_next_token(void)
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);
@ -1869,28 +1997,27 @@ extern void get_next_token(void)
}
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;
@ -1902,8 +2029,8 @@ extern void get_next_token(void)
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;
@ -1911,37 +2038,13 @@ extern void get_next_token(void)
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:
@ -2046,7 +2149,10 @@ extern void get_next_token(void)
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");
}
}
@ -2060,6 +2166,7 @@ extern void restart_lexer(char *lexical_source, char *name)
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;
@ -2112,6 +2219,9 @@ extern void init_lexer_vars(void)
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;
@ -2131,6 +2241,8 @@ extern void lexer_begin_pass(void)
pipeline_made = FALSE;
no_locals = 0;
restart_lexer(NULL, NULL);
}
@ -2158,8 +2270,11 @@ extern void lexer_allocate_arrays(void)
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,
@ -2204,7 +2319,8 @@ extern void lexer_free_arrays(void)
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");

0
inform6/Inform6/licence.txt Executable file → Normal file
View file

91
inform6/Inform6/memory.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -12,7 +12,7 @@ size_t malloced_bytes=0; /* Total amount of memory allocated */
/* 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.
*/
@ -26,7 +26,7 @@ extern void *my_malloc(size_t size, char *whatfor)
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);
}
@ -39,7 +39,7 @@ extern void my_realloc(void *pointer, size_t oldsize, size_t size,
}
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,
@ -58,7 +58,7 @@ extern void *my_calloc(size_t size, size_t howmany, char *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);
}
@ -71,7 +71,7 @@ extern void my_recalloc(void *pointer, size_t size, size_t oldhowmany,
}
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),
@ -90,10 +90,10 @@ extern void *my_malloc(size_t size, char *whatfor)
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);
}
@ -106,12 +106,10 @@ extern void my_realloc(void *pointer, size_t oldsize, size_t size,
}
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;
}
@ -120,13 +118,12 @@ extern void *my_calloc(size_t size, size_t howmany, char *whatfor)
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);
}
@ -139,13 +136,13 @@ extern void my_recalloc(void *pointer, size_t size, size_t oldhowmany,
}
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;
}
@ -155,8 +152,8 @@ extern void my_free(void *pointer, char *whatitwas)
{
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
@ -264,6 +261,7 @@ int DICT_WORD_BYTES; /* DICT_WORD_SIZE*DICT_CHAR_SIZE */
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;
@ -271,6 +269,8 @@ int32 MEMORY_MAP_EXTENSION;
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
@ -302,6 +302,8 @@ static void list_memory_sizes(void)
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",
@ -316,6 +318,8 @@ static void list_memory_sizes(void)
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");
}
@ -336,6 +340,7 @@ extern void set_memory_sizes(void)
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
@ -347,6 +352,8 @@ extern void set_memory_sizes(void)
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();
@ -419,6 +426,12 @@ static void explain_parameter(char *command)
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\
@ -491,6 +504,21 @@ static void explain_parameter(char *command)
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(
@ -616,6 +644,7 @@ static void set_trace_option(char *command)
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");
@ -788,6 +817,8 @@ extern void memory_command(char *command)
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)
@ -896,6 +927,18 @@ extern void memory_command(char *command)
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)

144
inform6/Inform6/objects.c Executable file → Normal file
View file

@ -6,8 +6,8 @@
/* 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 */
/* */
/* ------------------------------------------------------------------------- */
@ -37,9 +37,11 @@ static fproptg full_object_g; /* Equivalent for Glulx. This object
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
@ -86,8 +88,8 @@ int no_attributes, /* Number of attributes defined so far */
/* 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";
@ -95,7 +97,7 @@ static void trace_s(char *name, int32 number, int f)
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)
@ -119,9 +121,9 @@ game to get an extra 16)");
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();
@ -134,7 +136,7 @@ more than",
/* 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;
@ -156,8 +158,7 @@ more than",
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;
@ -252,7 +253,7 @@ extern void make_property(void)
/* 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;
@ -313,8 +314,7 @@ extern void make_property(void)
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;
@ -347,12 +347,10 @@ Advanced game to get 32 more)");
}
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;
@ -576,11 +574,17 @@ static void property_inheritance_z(void)
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;
@ -850,7 +854,13 @@ static int write_properties_between(int mark, int from, int to)
}
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;
@ -880,6 +890,7 @@ static int write_property_block_z(char *shortname)
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");
@ -1148,7 +1159,7 @@ static void properties_segment_z(int this_segment)
}
if (token_type != SYMBOL_TT)
{ ebf_error("property name", token_text);
{ ebf_curtoken_error("property name");
return;
}
@ -1229,13 +1240,12 @@ not 'private':", token_text);
}
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;
@ -1326,12 +1336,20 @@ the names '%s' and '%s' actually refer to the same property",
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,
@ -1369,16 +1387,6 @@ the names '%s' and '%s' actually refer to the same property",
}
}
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);
@ -1421,7 +1429,7 @@ static void properties_segment_g(int this_segment)
}
if (token_type != SYMBOL_TT)
{ ebf_error("property name", token_text);
{ ebf_curtoken_error("property name");
return;
}
@ -1497,13 +1505,12 @@ not 'private':", token_text);
}
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;
@ -1664,7 +1671,7 @@ static void attributes_segment(void)
|| (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;
@ -1675,7 +1682,7 @@ static void attributes_segment(void)
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;
}
@ -1758,7 +1765,7 @@ static void classes_segment(void)
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)
@ -1871,14 +1878,14 @@ inconvenience, please contact the maintainers.");
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;
}
@ -1892,6 +1899,7 @@ inconvenience, please contact the maintainers.");
/* 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);
@ -2072,6 +2080,7 @@ extern void make_object(int nearby_flag,
}
}
ensure_memory_list_available(&shortname_buffer_memlist, 2);
sprintf(shortname_buffer, "?");
segment_markers.enabled = TRUE;
@ -2084,8 +2093,7 @@ extern void make_object(int nearby_flag,
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);
@ -2113,10 +2121,9 @@ extern void make_object(int nearby_flag,
{ 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;
}
@ -2127,7 +2134,7 @@ extern void make_object(int nearby_flag,
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)
@ -2135,7 +2142,7 @@ extern void make_object(int nearby_flag,
{ 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. */
@ -2143,7 +2150,7 @@ extern void make_object(int nearby_flag,
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();
@ -2152,16 +2159,30 @@ extern void make_object(int nearby_flag,
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)
@ -2258,7 +2279,8 @@ extern void init_objects_vars(void)
properties_table = NULL;
individuals_table = NULL;
commonprops = NULL;
shortname_buffer = NULL;
objectsz = NULL;
objectsg = NULL;
objectatts = NULL;
@ -2366,6 +2388,9 @@ extern void objects_allocate_arrays(void)
initialise_memory_list(&current_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");
@ -2396,6 +2421,7 @@ extern void objects_free_arrays(void)
my_free(&commonprops, "common property info");
deallocate_memory_list(&current_object_name);
deallocate_memory_list(&shortname_buffer_memlist);
deallocate_memory_list(&embedded_function_name);
deallocate_memory_list(&objectsz_memlist);
deallocate_memory_list(&objectsg_memlist);

182
inform6/Inform6/states.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -16,13 +16,13 @@ static int match_colon(void)
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);
}
@ -33,14 +33,14 @@ static void match_open_bracket(void)
{ 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)
@ -85,7 +85,11 @@ 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);
}
@ -108,7 +112,7 @@ static void parse_action(void)
}
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))
@ -122,7 +126,7 @@ static void parse_action(void)
get_next_token();
if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
{
ebf_error("'>'", token_text);
ebf_curtoken_error("'>'");
}
}
@ -130,7 +134,7 @@ static void parse_action(void)
{ get_next_token();
if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
{ put_token_back();
ebf_error("'>>'", token_text);
ebf_curtoken_error("'>>'");
}
}
@ -259,7 +263,7 @@ extern int parse_label(void)
return(symbols[token_value].value);
}
ebf_error("label name", token_text);
ebf_curtoken_error("label name");
return 0;
}
@ -292,7 +296,12 @@ static void parse_print_z(int finally_return)
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);
@ -428,7 +437,7 @@ static void parse_print_z(int finally_return)
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;
@ -449,7 +458,7 @@ static void parse_print_z(int finally_return)
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),
@ -479,13 +488,13 @@ static void parse_print_z(int finally_return)
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);
@ -522,6 +531,12 @@ static void parse_print_g(int finally_return)
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);
@ -551,7 +566,6 @@ static void parse_print_g(int finally_return)
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;
@ -578,19 +592,15 @@ static void parse_print_g(int finally_return)
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)
@ -665,7 +675,7 @@ static void parse_print_g(int finally_return)
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;
@ -679,7 +689,7 @@ static void parse_print_g(int finally_return)
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),
@ -709,13 +719,13 @@ static void parse_print_g(int finally_return)
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);
@ -735,7 +745,7 @@ static int parse_named_label_statements()
get_next_token();
if (token_type != SYMBOL_TT)
{
ebf_error("label name", token_text);
ebf_curtoken_error("label name");
return TRUE;
}
@ -748,7 +758,7 @@ static int parse_named_label_statements()
}
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)
@ -761,7 +771,7 @@ static int parse_named_label_statements()
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
{ ebf_error("';'", token_text);
{ ebf_curtoken_error("';'");
put_token_back(); return FALSE;
}
@ -811,8 +821,10 @@ static void parse_statement_z(int break_label, int continue_label)
{ 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);
@ -841,8 +853,7 @@ static void parse_statement_z(int break_label, int continue_label)
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] == '@')
@ -930,7 +941,7 @@ static void parse_statement_z(int break_label, int continue_label)
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;
}
@ -1194,7 +1205,7 @@ static void parse_statement_z(int break_label, int continue_label)
{ get_next_token();
if ((token_type != SEP_TT)
|| (token_value != SEMICOLON_SEP))
{ ebf_error("';'", token_text);
{ ebf_curtoken_error("';'");
put_token_back();
}
}
@ -1305,7 +1316,7 @@ static void parse_statement_z(int break_label, int continue_label)
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;
}
@ -1350,7 +1361,7 @@ static void parse_statement_z(int break_label, int continue_label)
(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;
@ -1682,9 +1693,8 @@ static void parse_statement_z(int break_label, int continue_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;
}
@ -1749,7 +1759,7 @@ static void parse_statement_z(int break_label, int continue_label)
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
{ ebf_error("';'", token_text);
{ ebf_curtoken_error("';'");
put_token_back();
}
}
@ -1781,8 +1791,10 @@ static void parse_statement_g(int break_label, int continue_label)
{ 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);
@ -1810,8 +1822,7 @@ static void parse_statement_g(int break_label, int continue_label)
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] == '@')
@ -1897,7 +1908,7 @@ static void parse_statement_g(int break_label, int continue_label)
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;
}
@ -2182,7 +2193,7 @@ static void parse_statement_g(int break_label, int continue_label)
{ get_next_token();
if ((token_type != SEP_TT)
|| (token_value != SEMICOLON_SEP))
{ ebf_error("';'", token_text);
{ ebf_curtoken_error("';'");
put_token_back();
}
}
@ -2319,7 +2330,7 @@ static void parse_statement_g(int break_label, int continue_label)
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;
}
@ -2362,7 +2373,7 @@ static void parse_statement_g(int break_label, int continue_label)
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;
}
@ -2459,10 +2470,16 @@ static void parse_statement_g(int break_label, int continue_label)
}
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++);
@ -2618,9 +2635,8 @@ static void parse_statement_g(int break_label, int continue_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;
}
@ -2714,7 +2730,7 @@ static void parse_statement_g(int break_label, int continue_label)
get_next_token();
if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
{ ebf_error("';'", token_text);
{ ebf_curtoken_error("';'");
put_token_back();
}
}
@ -2743,6 +2759,48 @@ extern void parse_statement(int break_label, int continue_label)
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 */
/* ------------------------------------------------------------------------- */

226
inform6/Inform6/symbols.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -56,10 +56,13 @@ symbolinfo *symbols; /* Allocated up to no_symbols */
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)
@ -224,10 +227,16 @@ extern int get_symbol_index(char *p)
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.
@ -251,6 +260,7 @@ extern int symbol_index(char *p, int hashcode)
{
if (track_unused_routines)
df_note_function_symbol(this);
if (created) *created = FALSE;
return this;
}
if (new_entry > 0) break;
@ -260,7 +270,7 @@ extern int symbol_index(char *p, int hashcode)
} 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)
@ -276,18 +286,19 @@ extern int symbol_index(char *p, int hashcode)
}
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);
@ -309,17 +320,29 @@ extern int symbol_index(char *p, int hashcode)
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;
@ -375,8 +398,8 @@ static void describe_flags(int flags)
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) ");
@ -514,15 +537,22 @@ extern void issue_unused_warnings(void)
}
/* 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);
}
}
}
@ -539,7 +569,7 @@ extern void issue_debug_symbol_warnings(void)
/* ------------------------------------------------------------------------- */
/* 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
@ -550,7 +580,7 @@ extern void issue_debug_symbol_warnings(void)
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++)
@ -566,114 +596,133 @@ extern void write_the_identifier_names(void)
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;
}
@ -696,7 +745,7 @@ extern void assign_symbol(int index, int32 value, int type)
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)
@ -704,7 +753,7 @@ 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
@ -756,7 +805,7 @@ 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) {
@ -776,7 +825,7 @@ static void create_symbol(char *p, int32 value, int 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;
@ -802,7 +851,7 @@ static void stockup_symbols(void)
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);
@ -815,6 +864,9 @@ static void stockup_symbols(void)
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);
@ -1223,15 +1275,15 @@ extern void locate_dead_functions(void)
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)
@ -1524,11 +1576,12 @@ extern void init_symbols_vars(void)
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;
@ -1568,6 +1621,11 @@ extern void symbols_allocate_arrays(void)
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");
@ -1621,6 +1679,8 @@ extern void symbols_free_arrays(void)
{
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)

287
inform6/Inform6/syntax.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -73,10 +73,12 @@ extern void get_next_token_with_directives(void)
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. */
@ -87,6 +89,10 @@ extern void get_next_token_with_directives(void)
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;
@ -106,22 +112,19 @@ extern void get_next_token_with_directives(void)
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;
}
}
@ -173,7 +176,7 @@ extern int parse_directive(int internal_flag)
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))
@ -223,7 +226,7 @@ extern int parse_directive(int internal_flag)
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;
@ -243,9 +246,9 @@ extern int parse_directive(int internal_flag)
{ /* 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;
}
@ -253,7 +256,9 @@ extern int parse_directive(int internal_flag)
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;
@ -310,17 +315,18 @@ static void compile_alternatives(assembly_operand switch_value, int n,
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;
}
@ -328,19 +334,20 @@ static void parse_switch_spec(assembly_operand switch_value, int label,
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();
@ -350,75 +357,86 @@ static void parse_switch_spec(assembly_operand switch_value, int label,
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);
} while(TRUE);
GenSpecCode:
GenSpecCode:
generate_switch_spec(switch_value, label, label_after, spec_sp);
}
if ((spec_sp > max_equality_args) && (label_after == -1))
label_after = next_label++;
/* 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);
if (label_after == -1)
{ compile_alternatives(switch_value, spec_sp, 0, label, FALSE); return;
}
sequence_point_follows = FALSE;
for (i=0; i<spec_sp;)
{
j=i; while ((j<spec_sp) && (spec_type[j] != 3)) j++;
if ((speccount > max_equality_args) && (label_after == -1))
label_after = next_label++;
if (j > i)
{ if (j-i > max_equality_args) j=i+max_equality_args;
if (label_after == -1)
{ compile_alternatives(switch_value, speccount, 0, label, FALSE); return;
}
if (j == spec_sp)
compile_alternatives(switch_value, j-i, i, label, FALSE);
else
compile_alternatives(switch_value, j-i, i, label_after, TRUE);
for (i=0; i<speccount;)
{
j=i; while ((j<speccount) && (spec_type[j] != 3)) j++;
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;
}
}
if (j > i)
{ if (j-i > max_equality_args) j=i+max_equality_args;
assemble_label_no(label_after);
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,
@ -437,10 +455,7 @@ 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;
@ -452,32 +467,26 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
{ 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
@ -491,7 +500,7 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
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
@ -500,7 +509,7 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
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));
@ -543,7 +552,7 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
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;
}
@ -551,7 +560,9 @@ extern int32 parse_routine(char *source, int embedded_flag, char *name,
/* 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();
@ -641,7 +652,7 @@ extern void parse_code_block(int break_label, int continue_label,
break;
}
if (token_type == EOF_TT)
{ ebf_error("'}'", token_text);
{ ebf_curtoken_error("'}'");
break;
}
@ -666,7 +677,7 @@ extern void parse_code_block(int break_label, int continue_label,
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;
}
@ -674,8 +685,76 @@ extern void parse_code_block(int break_label, int continue_label,
/* 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();
@ -718,7 +797,7 @@ extern void parse_code_block(int break_label, int continue_label,
}
if ((switch_rule != 0) && (!switch_clause_made))
ebf_error("switch value", token_text);
ebf_curtoken_error("switch value");
NotASwitchCase:
sequence_point_follows = TRUE;
@ -728,7 +807,7 @@ extern void parse_code_block(int break_label, int continue_label,
}
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);

265
inform6/Inform6/tables.c Executable file → Normal file
View file

@ -3,8 +3,8 @@
/* 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 */
/* */
/* ------------------------------------------------------------------------- */
@ -99,17 +99,23 @@ extern void write_serial_number(char *buffer)
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)
{
@ -119,9 +125,12 @@ 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;
}
@ -133,6 +142,7 @@ static char *version_name(int v)
case 4: return "Plus";
case 5: return "Advanced";
case 6: return "Graphical";
case 7: return "Extended Alternate";
case 8: return "Extended";
}
return "experimental format";
@ -250,31 +260,34 @@ static void construct_storyfile_z(void)
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 */
@ -284,7 +297,8 @@ static void construct_storyfile_z(void)
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 -------------------- */
@ -431,7 +445,7 @@ static void construct_storyfile_z(void)
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++)
@ -465,6 +479,17 @@ static void construct_storyfile_z(void)
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)
@ -517,6 +542,12 @@ table format requested (producing number 2 format instead)");
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];
@ -637,9 +668,12 @@ or less.");
}
/* -------------------------- 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;
@ -684,11 +718,10 @@ or less.");
}
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 -------------------------------- */
@ -722,26 +755,24 @@ or less.");
*/
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
@ -835,12 +866,15 @@ or less.");
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;
@ -1029,6 +1063,7 @@ static void construct_storyfile_g(void)
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();
@ -1053,8 +1088,8 @@ static void construct_storyfile_g(void)
/* 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 */
@ -1233,63 +1268,71 @@ static void construct_storyfile_g(void)
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);
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+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;
else {
identifier_names_offset = mark;
action_names_offset = mark;
fake_action_names_offset = mark;
array_names_offset = mark;
}
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;
}
individuals_offset = mark;
/* ------------------------ Grammar Table ----------------------------- */
@ -1310,6 +1353,12 @@ table format requested (producing number 2 format instead)");
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;
@ -1371,6 +1420,9 @@ table format requested (producing number 2 format instead)");
RAM_Size = mark;
if (RAM_Size > rough_size)
compiler_error("RAM size exceeds rough estimate.");
Out_Size = Write_RAM_At + RAM_Size;
/* --------------------------- Offsets -------------------------------- */
@ -1577,18 +1629,23 @@ static void display_frequencies()
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");
}

430
inform6/Inform6/text.c Executable file → Normal file
View file

@ -1,8 +1,8 @@
/* ------------------------------------------------------------------------- */
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -92,11 +92,10 @@ static int unicode_entity_index(int32 unicode);
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;
@ -124,6 +123,11 @@ uchar *translated_text; /* Area holding translated strings
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 */
@ -149,26 +153,26 @@ static int text_out_overflow; /* During text translation, becomes
/* ------------------------------------------------------------------------- */
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;
}
@ -193,9 +197,13 @@ static void make_abbrevs_lookup(void)
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) {
@ -209,18 +217,27 @@ static int try_abbreviations_from(unsigned char *text, int i, int from)
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;
@ -236,6 +253,19 @@ extern void make_abbreviation(char *text)
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 */
@ -243,6 +273,18 @@ extern void make_abbreviation(char *text)
/* 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;
@ -412,7 +454,9 @@ static void write_z_char_g(int i)
/* 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;
@ -530,9 +574,12 @@ extern int32 translate_text(int32 p_limit, char *s_text, int strctx)
{
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;}
@ -589,7 +636,7 @@ extern int32 translate_text(int32 p_limit, char *s_text, int strctx)
((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++;
@ -650,31 +697,32 @@ advance as part of 'Zcharacter table':", unicode);
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;
@ -823,7 +871,7 @@ advance as part of 'Zcharacter table':", unicode);
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');
@ -849,31 +897,32 @@ string.");
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;
@ -1371,7 +1420,7 @@ static void compress_makebits(int entnum, int depth, int prevbit,
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:
@ -1410,12 +1459,27 @@ typedef struct optab_s
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)
@ -1446,7 +1510,7 @@ 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')
@ -1549,7 +1613,24 @@ extern void optimise_abbreviations(void)
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]=' ';
@ -1661,6 +1742,11 @@ extern void optimise_abbreviations(void)
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;
@ -1685,7 +1771,7 @@ extern void optimise_abbreviations(void)
if (max>0)
{
char testtext[4];
bestyet2[selected++]=bestyet[maxat];
optab_copy(&bestyet2[selected++], &bestyet[maxat]);
if (optabbrevs_trace_setting >= 1) {
printf(
@ -1800,14 +1886,11 @@ int dict_entries; /* Total number of records entered */
/* 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. */
/* ------------------------------------------------------------------------- */
@ -1827,14 +1910,17 @@ extern void copy_sorts(uchar *d1, uchar *d2)
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
@ -1842,22 +1928,50 @@ static void dictionary_prepare_z(char *dword, uchar *optresult)
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) '\'')
@ -1888,26 +2002,37 @@ apostrophe in", dword);
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;
@ -1934,25 +2059,48 @@ static void dictionary_prepare_g(char *dword, uchar *optresult)
{
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=='\'')
@ -1983,17 +2131,27 @@ Define DICT_CHAR_SIZE=4 for a Unicode-compatible dictionary.");
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;
@ -2112,23 +2270,29 @@ static int dictionary_find(char *dword)
}
/* ------------------------------------------------------------------------- */
/* 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;
}
@ -2139,17 +2303,15 @@ extern int dictionary_add(char *dword, int x, int y, int z)
{
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;
}
@ -2257,9 +2419,8 @@ extern int dictionary_add(char *dword, int x, int y, int z)
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;
@ -2275,11 +2436,9 @@ extern int dictionary_add(char *dword, int x, int y, int z)
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;
@ -2499,11 +2658,13 @@ static void recursively_show_z(int node, int level)
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]);
@ -2558,11 +2719,13 @@ static void recursively_show_g(int node, int level)
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 ");
}
@ -2658,6 +2821,8 @@ extern void init_text_vars(void)
grandtable = NULL;
grandflags = NULL;
translated_text = NULL;
temp_symbol = NULL;
all_text = NULL;
for (j=0; j<256; j++) abbrevs_lookup[j] = -1;
@ -2669,6 +2834,7 @@ extern void init_text_vars(void)
dtree = NULL;
final_dict_order = NULL;
dict_sort_codes = NULL;
prepared_sort = NULL;
dict_entries=0;
static_strings_area = NULL;
@ -2684,6 +2850,7 @@ extern void init_text_vars(void)
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();
@ -2705,6 +2872,10 @@ extern void text_allocate_arrays(void)
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");
@ -2713,8 +2884,8 @@ extern void text_allocate_arrays(void)
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,
@ -2734,6 +2905,9 @@ extern void text_allocate_arrays(void)
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 */
@ -2792,11 +2966,12 @@ extern void extract_all_text()
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);
@ -2804,6 +2979,7 @@ extern void text_free_arrays(void)
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);
@ -2820,6 +2996,18 @@ extern void text_free_arrays(void)
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");

87
inform6/Inform6/veneer.c Executable file → Normal file
View file

@ -3,8 +3,8 @@
/* 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 */
/* */
/* ------------------------------------------------------------------------- */
@ -33,9 +33,10 @@ extern void compile_initial_routine(void)
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;
@ -111,6 +112,7 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
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;\
@ -198,11 +200,16 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
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;\
]", "", "", "", ""
},
@ -253,6 +260,10 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
"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)\
@ -314,6 +325,7 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
default: return x-->m;\
}\
}\
#ENDIF;\
rfalse;\
]"
},
@ -404,7 +416,11 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
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);\
}\
@ -425,16 +441,23 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
},
{
/* 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;\
]", "", "", "", "", ""
},
@ -570,8 +593,13 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
\" 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:\"--> **]\"; } }\
@ -605,10 +633,12 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
\", 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, \" **]^\";\
]", ""
@ -674,6 +704,16 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
"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; }\
@ -681,12 +721,17 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
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);\
@ -717,6 +762,7 @@ static VeneerRoutine VRs_z[VENEER_ROUTINES] =
{ 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
@ -973,6 +1019,10 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
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;\
@ -988,6 +1038,7 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
print (string) str;\
else\
print \"<number \", prop, \">\";\
#ENDIF;\
]", "", "", "", "", ""
},
@ -1416,8 +1467,13 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
\" 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:\"--> **]\"; } }\
@ -1449,10 +1505,12 @@ static VeneerRoutine VRs_g[VENEER_ROUTINES] =
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, \" **]^\";\
]", ""
@ -2190,15 +2248,16 @@ static void compile_symbol_table_routine(void)
{ 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;
@ -2350,7 +2409,7 @@ extern void compile_veneer(void)
{ 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);

151
inform6/Inform6/verbs.c Executable file → Normal file
View file

@ -2,8 +2,8 @@
/* "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 */
/* */
/* ------------------------------------------------------------------------- */
@ -97,9 +97,11 @@ static memory_list English_verbs_given_memlist;
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 */
/* ------------------------------------------------------------------------- */
@ -300,28 +302,34 @@ static void new_action(char *b, int c)
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);
@ -354,12 +362,17 @@ extern assembly_operand action_of_name(char *name)
/* 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);
@ -398,24 +411,29 @@ extern assembly_operand action_of_name(char *name)
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;
@ -439,8 +457,8 @@ static int make_adjective(char *English_word)
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");
@ -451,9 +469,13 @@ static int make_adjective(char *English_word)
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,
@ -461,8 +483,6 @@ static int make_adjective(char *English_word)
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++);
}
@ -525,7 +545,7 @@ static char *find_verb_by_number(int num)
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;
}
@ -548,11 +568,10 @@ static void register_verb(char *English_verb, int number)
/* 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;
@ -579,11 +598,44 @@ static int get_verb(void)
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. */
/* ------------------------------------------------------------------------- */
@ -639,7 +691,7 @@ static int grammar_line(int verbnum, int line)
}
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;
}
@ -667,12 +719,12 @@ static int grammar_line(int verbnum, int line)
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;
}
@ -681,7 +733,7 @@ static int grammar_line(int verbnum, int line)
{ 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;
@ -711,7 +763,7 @@ static int grammar_line(int verbnum, int line)
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;
}
@ -766,7 +818,7 @@ are using Library 6/3 or later");
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;
}
@ -775,7 +827,7 @@ are using Library 6/3 or later");
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;
}
@ -852,9 +904,9 @@ tokens in any line (unless you're compiling with library 6/3 or later)");
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;
}
@ -944,7 +996,7 @@ extern void make_verb(void)
}
if (no_given == 0)
{ ebf_error("English verb in quotes", token_text);
{ ebf_curtoken_error("English verb in quotes");
panic_mode_error_recovery(); return;
}
@ -955,7 +1007,7 @@ extern void make_verb(void)
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;
@ -963,11 +1015,17 @@ extern void make_verb(void)
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++) {
@ -1019,6 +1077,10 @@ extern void extend_verb(void)
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(),
@ -1048,6 +1110,8 @@ extern void extend_verb(void)
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
@ -1071,7 +1135,7 @@ extern void extend_verb(void)
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;
}
}
@ -1166,6 +1230,10 @@ extern void verbs_allocate_arrays(void)
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");
@ -1188,6 +1256,7 @@ extern void verbs_free_arrays(void)
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);
}

2
inform6/Tests/Test Cases/_Console_Ideal/Advent-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent-abbrev-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent-abbrev.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent-abbrev_e-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent-abbrev_e.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent_d-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent_d_z8.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent_ns-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent_z8.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent_z8_ns.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Advent_zldd_1.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Hello-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/Hello.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/abbrevtest-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

25
inform6/Tests/Test Cases/_Console_Ideal/abbrevtest.txt
View file

@ -1,24 +1 @@
Inform 6.36 (24th January 2022)
line 28: Warning: Abbreviation does not save any characters: "be"
> Abbreviate "be"
line 33: Warning: Abbreviation does not save any characters: "by"
> Abbreviate "by"
line 63: Warning: Abbreviation does not save any characters: "in"
> Abbreviate "in"
line 65: Warning: Abbreviation does not save any characters: "is"
> Abbreviate "is"
line 67: Warning: Abbreviation does not save any characters: "it"
> Abbreviate "it"
line 82: Warning: Abbreviation does not save any characters: "of"
> Abbreviate "of"
line 83: Warning: Abbreviation does not save any characters: "or"
> Abbreviate "or"
line 96: Warning: Abbreviation does not save any characters: "so"
> Abbreviate "so"
line 107: Warning: Abbreviation does not save any characters: "to"
> Abbreviate "to"
line 110: Warning: Abbreviation does not save any characters: "us"
> Abbreviate "us"
line 112: Warning: Abbreviation does not save any characters: "we"
> Abbreviate "we"
Compiled with 11 warnings
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/abbrevtest_e-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/abbrevtest_e.txt
View file

@ -1,4 +1,4 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 28: Warning: Abbreviation does not save any characters: "be"
> Abbreviate "be"
line 33: Warning: Abbreviation does not save any characters: "by"

1792
inform6/Tests/Test Cases/_Console_Ideal/abbrevtest_ma.txt
View file

File diff suppressed because it is too large Load diff

2
inform6/Tests/Test Cases/_Console_Ideal/actionextension-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/actionextension.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/box_quote_test.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/classcopytest-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/classcopytest.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/classordertest-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/classordertest.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

7
inform6/Tests/Test Cases/_Console_Ideal/cloak-metro84-v3test_e_z3.txt
View file

@ -1 +1,6 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 2039: Warning: This statement can never be reached
> m=#adjectives_table;
line 3814: Warning: This statement can never be reached
> if (n==2) {print "That's already "; if (x1==1) "on."; els ...etc
Compiled with 2 warnings

7
inform6/Tests/Test Cases/_Console_Ideal/cloak-metro84-v3test_e_z4.txt
View file

@ -1 +1,6 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 2039: Warning: This statement can never be reached
> m=#adjectives_table;
line 3814: Warning: This statement can never be reached
> if (n==2) {print "That's already "; if (x1==1) "on."; els ...etc
Compiled with 2 warnings

7
inform6/Tests/Test Cases/_Console_Ideal/cloak-metro84-v3test_e_z5.txt
View file

@ -1 +1,6 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 2039: Warning: This statement can never be reached
> m=#adjectives_table;
line 3814: Warning: This statement can never be reached
> if (n==2) {print "That's already "; if (x1==1) "on."; els ...etc
Compiled with 2 warnings

7
inform6/Tests/Test Cases/_Console_Ideal/cloak-metro84-v3test_z3.txt
View file

@ -1 +1,6 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 2039: Warning: This statement can never be reached
> m=#adjectives_table;
line 3814: Warning: This statement can never be reached
> if (n==2) {print "That's already "; if (x1==1) "on."; els ...etc
Compiled with 2 warnings

7
inform6/Tests/Test Cases/_Console_Ideal/cloak-metro84-v3test_z4.txt
View file

@ -1 +1,6 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 2039: Warning: This statement can never be reached
> m=#adjectives_table;
line 3814: Warning: This statement can never be reached
> if (n==2) {print "That's already "; if (x1==1) "on."; els ...etc
Compiled with 2 warnings

7
inform6/Tests/Test Cases/_Console_Ideal/cloak-metro84-v3test_z5.txt
View file

@ -1 +1,6 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 2039: Warning: This statement can never be reached
> m=#adjectives_table;
line 3814: Warning: This statement can never be reached
> if (n==2) {print "That's already "; if (x1==1) "on."; els ...etc
Compiled with 2 warnings

2
inform6/Tests/Test Cases/_Console_Ideal/common_props_plus_test.txt
View file

@ -1,4 +1,4 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 6: Warning: Property "p0" declared but not used
line 7: Warning: Property "p1" declared but not used
line 8: Warning: Property "p2" declared but not used

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_WORDSIZE_2.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_Wordsize_4-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_d-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_d.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_d_debug-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_d_debug.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_d_debug_0-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_d_debug_0.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_many.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/defineopttest_xfoo_3_3.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-cutoff-alttest_z4.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-cutoff-alttest_z5.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-cutoff-alttest_z8.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-cutoff-v3test_z3.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-cutoff-v3test_z4.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-cutoff-v3test_z5.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_1.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_10.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_11.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

5
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_2.txt
View file

@ -1 +1,4 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 2: Warning: Obsolete usage: the Version directive is deprecated and may produce incorrect results. Use -vN instead, as either a command-line argument or a header comment.
> Version 3;
Compiled with 1 warning

2
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_4.txt
View file

@ -1,4 +1,4 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)
line 6: Warning: The third dictionary field will be ignored because ZCODE_LESS_DICT_DATA is set
> Dictionary 'foo' 1 2
Compiled with 1 warning

2
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_5.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_7.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-entry-size-test_9.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-size-v3test.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dict-size-v3test_z5.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dictflagtest-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/dictflagtest.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/forwardproptest-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/forwardproptest.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/forwardproptest_ns-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/forwardproptest_ns.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/fwconst_dictionary_test_fca_fcb-G.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

2
inform6/Tests/Test Cases/_Console_Ideal/fwconst_dictionary_test_fca_fcb.txt
View file

@ -1 +1 @@
Inform 6.36 (24th January 2022)
Inform 6.42 for MacOS (10th February 2024)

Some files were not shown because too many files have changed in this diff Show more