--- /dev/null
+.gitattributes export-ignore
+.gitignore export-ignore
\ No newline at end of file
--- /dev/null
+/Makefile
+/Makefile.in
+/aclocal.m4
+/autom4te.cache/
+/compile
+/config.log
+/config.status
+/configure
+/depcomp
+/install-sh
+/missing
+/src/*.o
+/src/.deps
+/src/Makefile
+/src/Makefile.in
+/src/inform
\ No newline at end of file
--- /dev/null
+Installation Instructions
+*************************
+
+ Copyright (C) 1994-1996, 1999-2002, 2004-2016 Free Software
+Foundation, Inc.
+
+ Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved. This file is offered as-is,
+without warranty of any kind.
+
+Basic Installation
+==================
+
+ Briefly, after you have run autoreconf --install, the shell
+command './configure && make && make install' should configure, build,
+and install this package. The following more-detailed instructions
+are generic; see the 'README' file for instructions specific to this
+package. Some packages provide this 'INSTALL' file but do not
+implement all of the features documented below. The lack of an
+optional feature in a given package is not necessarily a bug. More
+recommendations for GNU packages can be found in *note Makefile
+Conventions: (standards)Makefile Conventions.
+
+ The 'configure' shell script attempts to guess correct values for
+various system-dependent variables used during compilation. It uses
+those values to create a 'Makefile' in each directory of the package.
+It may also create one or more '.h' files containing system-dependent
+definitions. Finally, it creates a shell script 'config.status' that
+you can run in the future to recreate the current configuration, and a
+file 'config.log' containing compiler output (useful mainly for
+debugging 'configure').
+
+ It can also use an optional file (typically called 'config.cache' and
+enabled with '--cache-file=config.cache' or simply '-C') that saves the
+results of its tests to speed up reconfiguring. Caching is disabled by
+default to prevent problems with accidental use of stale cache files.
+
+ If you need to do unusual things to compile the package, please try
+to figure out how 'configure' could check whether to do them, and mail
+diffs or instructions to the address given in the 'README' so they can
+be considered for the next release. If you are using the cache, and at
+some point 'config.cache' contains results you don't want to keep, you
+may remove or edit it.
+
+ The file 'configure.ac' (or 'configure.in') is used to create
+'configure' by a program called 'autoconf'. You need 'configure.ac' if
+you want to change it or regenerate 'configure' using a newer version of
+'autoconf'.
+
+ The simplest way to compile this package is:
+
+ 1. 'cd' to the directory containing the package's source code and type
+ './configure' to configure the package for your system.
+
+ Running 'configure' might take a while. While running, it prints
+ some messages telling which features it is checking for.
+
+ 2. Type 'make' to compile the package.
+
+ 3. Optionally, type 'make check' to run any self-tests that come with
+ the package, generally using the just-built uninstalled binaries.
+
+ 4. Type 'make install' to install the programs and any data files and
+ documentation. When installing into a prefix owned by root, it is
+ recommended that the package be configured and built as a regular
+ user, and only the 'make install' phase executed with root
+ privileges.
+
+ 5. Optionally, type 'make installcheck' to repeat any self-tests, but
+ this time using the binaries in their final installed location.
+ This target does not install anything. Running this target as a
+ regular user, particularly if the prior 'make install' required
+ root privileges, verifies that the installation completed
+ correctly.
+
+ 6. You can remove the program binaries and object files from the
+ source code directory by typing 'make clean'. To also remove the
+ files that 'configure' created (so you can compile the package for
+ a different kind of computer), type 'make distclean'. There is
+ also a 'make maintainer-clean' target, but that is intended mainly
+ for the package's developers. If you use it, you may have to get
+ all sorts of other programs in order to regenerate files that came
+ with the distribution.
+
+ 7. Often, you can also type 'make uninstall' to remove the installed
+ files again. In practice, not all packages have tested that
+ uninstallation works correctly, even though it is required by the
+ GNU Coding Standards.
+
+ 8. Some packages, particularly those that use Automake, provide 'make
+ distcheck', which can by used by developers to test that all other
+ targets like 'make install' and 'make uninstall' work correctly.
+ This target is generally not run by end users.
+
+Compilers and Options
+=====================
+
+ Some systems require unusual options for compilation or linking that
+the 'configure' script does not know about. Run './configure --help'
+for details on some of the pertinent environment variables.
+
+ You can give 'configure' initial values for configuration parameters
+by setting variables in the command line or in the environment. Here is
+an example:
+
+ ./configure CC=c99 CFLAGS=-g LIBS=-lposix
+
+ *Note Defining Variables::, for more details.
+
+Compiling For Multiple Architectures
+====================================
+
+ You can compile the package for more than one kind of computer at the
+same time, by placing the object files for each architecture in their
+own directory. To do this, you can use GNU 'make'. 'cd' to the
+directory where you want the object files and executables to go and run
+the 'configure' script. 'configure' automatically checks for the source
+code in the directory that 'configure' is in and in '..'. This is known
+as a "VPATH" build.
+
+ With a non-GNU 'make', it is safer to compile the package for one
+architecture at a time in the source code directory. After you have
+installed the package for one architecture, use 'make distclean' before
+reconfiguring for another architecture.
+
+ On MacOS X 10.5 and later systems, you can create libraries and
+executables that work on multiple system types--known as "fat" or
+"universal" binaries--by specifying multiple '-arch' options to the
+compiler but only a single '-arch' option to the preprocessor. Like
+this:
+
+ ./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
+ CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
+ CPP="gcc -E" CXXCPP="g++ -E"
+
+ This is not guaranteed to produce working output in all cases, you
+may have to build one architecture at a time and combine the results
+using the 'lipo' tool if you have problems.
+
+Installation Names
+==================
+
+ By default, 'make install' installs the package's commands under
+'/usr/local/bin', include files under '/usr/local/include', etc. You
+can specify an installation prefix other than '/usr/local' by giving
+'configure' the option '--prefix=PREFIX', where PREFIX must be an
+absolute file name.
+
+ You can specify separate installation prefixes for
+architecture-specific files and architecture-independent files. If you
+pass the option '--exec-prefix=PREFIX' to 'configure', the package uses
+PREFIX as the prefix for installing programs and libraries.
+Documentation and other data files still use the regular prefix.
+
+ In addition, if you use an unusual directory layout you can give
+options like '--bindir=DIR' to specify different values for particular
+kinds of files. Run 'configure --help' for a list of the directories
+you can set and what kinds of files go in them. In general, the default
+for these options is expressed in terms of '${prefix}', so that
+specifying just '--prefix' will affect all of the other directory
+specifications that were not explicitly provided.
+
+ The most portable way to affect installation locations is to pass the
+correct locations to 'configure'; however, many packages provide one or
+both of the following shortcuts of passing variable assignments to the
+'make install' command line to change installation locations without
+having to reconfigure or recompile.
+
+ The first method involves providing an override variable for each
+affected directory. For example, 'make install
+prefix=/alternate/directory' will choose an alternate location for all
+directory configuration variables that were expressed in terms of
+'${prefix}'. Any directories that were specified during 'configure',
+but not in terms of '${prefix}', must each be overridden at install time
+for the entire installation to be relocated. The approach of makefile
+variable overrides for each directory variable is required by the GNU
+Coding Standards, and ideally causes no recompilation. However, some
+platforms have known limitations with the semantics of shared libraries
+that end up requiring recompilation when using this method, particularly
+noticeable in packages that use GNU Libtool.
+
+ The second method involves providing the 'DESTDIR' variable. For
+example, 'make install DESTDIR=/alternate/directory' will prepend
+'/alternate/directory' before all installation names. The approach of
+'DESTDIR' overrides is not required by the GNU Coding Standards, and
+does not work on platforms that have drive letters. On the other hand,
+it does better at avoiding recompilation issues, and works well even
+when some directory options were not specified in terms of '${prefix}'
+at 'configure' time.
+
+Optional Features
+=================
+
+ If the package supports it, you can cause programs to be installed
+with an extra prefix or suffix on their names by giving 'configure' the
+option '--program-prefix=PREFIX' or '--program-suffix=SUFFIX'.
+
+ Some packages pay attention to '--enable-FEATURE' options to
+'configure', where FEATURE indicates an optional part of the package.
+They may also pay attention to '--with-PACKAGE' options, where PACKAGE
+is something like 'gnu-as' or 'x' (for the X Window System). The
+'README' should mention any '--enable-' and '--with-' options that the
+package recognizes.
+
+ For packages that use the X Window System, 'configure' can usually
+find the X include and library files automatically, but if it doesn't,
+you can use the 'configure' options '--x-includes=DIR' and
+'--x-libraries=DIR' to specify their locations.
+
+ Some packages offer the ability to configure how verbose the
+execution of 'make' will be. For these packages, running './configure
+--enable-silent-rules' sets the default to minimal output, which can be
+overridden with 'make V=1'; while running './configure
+--disable-silent-rules' sets the default to verbose, which can be
+overridden with 'make V=0'.
+
+Particular systems
+==================
+
+ On HP-UX, the default C compiler is not ANSI C compatible. If GNU CC
+is not installed, it is recommended to use the following options in
+order to use an ANSI C compiler:
+
+ ./configure CC="cc -Ae -D_XOPEN_SOURCE=500"
+
+and if that doesn't work, install pre-built binaries of GCC for HP-UX.
+
+ HP-UX 'make' updates targets which have the same time stamps as their
+prerequisites, which makes it generally unusable when shipped generated
+files such as 'configure' are involved. Use GNU 'make' instead.
+
+ On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot
+parse its '<wchar.h>' header file. The option '-nodtk' can be used as a
+workaround. If GNU CC is not installed, it is therefore recommended to
+try
+
+ ./configure CC="cc"
+
+and if that doesn't work, try
+
+ ./configure CC="cc -nodtk"
+
+ On Solaris, don't put '/usr/ucb' early in your 'PATH'. This
+directory contains several dysfunctional programs; working variants of
+these programs are available in '/usr/bin'. So, if you need '/usr/ucb'
+in your 'PATH', put it _after_ '/usr/bin'.
+
+ On Haiku, software installed for all users goes in '/boot/common',
+not '/usr/local'. It is recommended to use the following options:
+
+ ./configure --prefix=/boot/common
+
+Specifying the System Type
+==========================
+
+ There may be some features 'configure' cannot figure out
+automatically, but needs to determine by the type of machine the package
+will run on. Usually, assuming the package is built to be run on the
+_same_ architectures, 'configure' can figure that out, but if it prints
+a message saying it cannot guess the machine type, give it the
+'--build=TYPE' option. TYPE can either be a short name for the system
+type, such as 'sun4', or a canonical name which has the form:
+
+ CPU-COMPANY-SYSTEM
+
+where SYSTEM can have one of these forms:
+
+ OS
+ KERNEL-OS
+
+ See the file 'config.sub' for the possible values of each field. If
+'config.sub' isn't included in this package, then this package doesn't
+need to know the machine type.
+
+ If you are _building_ compiler tools for cross-compiling, you should
+use the option '--target=TYPE' to select the type of system they will
+produce code for.
+
+ If you want to _use_ a cross compiler, that generates code for a
+platform different from the build platform, you should specify the
+"host" platform (i.e., that on which the generated programs will
+eventually be run) with '--host=TYPE'.
+
+Sharing Defaults
+================
+
+ If you want to set default values for 'configure' scripts to share,
+you can create a site shell script called 'config.site' that gives
+default values for variables like 'CC', 'cache_file', and 'prefix'.
+'configure' looks for 'PREFIX/share/config.site' if it exists, then
+'PREFIX/etc/config.site' if it exists. Or, you can set the
+'CONFIG_SITE' environment variable to the location of the site script.
+A warning: not all 'configure' scripts look for a site script.
+
+Defining Variables
+==================
+
+ Variables not defined in a site shell script can be set in the
+environment passed to 'configure'. However, some packages may run
+configure again during the build, and the customized values of these
+variables may be lost. In order to avoid this problem, you should set
+them in the 'configure' command line, using 'VAR=value'. For example:
+
+ ./configure CC=/usr/local2/bin/gcc
+
+causes the specified 'gcc' to be used as the C compiler (unless it is
+overridden in the site shell script).
+
+Unfortunately, this technique does not work for 'CONFIG_SHELL' due to an
+Autoconf limitation. Until the limitation is lifted, you can use this
+workaround:
+
+ CONFIG_SHELL=/bin/bash ./configure CONFIG_SHELL=/bin/bash
+
+'configure' Invocation
+======================
+
+ 'configure' recognizes the following options to control how it
+operates.
+
+'--help'
+'-h'
+ Print a summary of all of the options to 'configure', and exit.
+
+'--help=short'
+'--help=recursive'
+ Print a summary of the options unique to this package's
+ 'configure', and exit. The 'short' variant lists options used only
+ in the top level, while the 'recursive' variant lists options also
+ present in any nested packages.
+
+'--version'
+'-V'
+ Print the version of Autoconf used to generate the 'configure'
+ script, and exit.
+
+'--cache-file=FILE'
+ Enable the cache: use and save the results of the tests in FILE,
+ traditionally 'config.cache'. FILE defaults to '/dev/null' to
+ disable caching.
+
+'--config-cache'
+'-C'
+ Alias for '--cache-file=config.cache'.
+
+'--quiet'
+'--silent'
+'-q'
+ Do not print messages saying which checks are being made. To
+ suppress all normal output, redirect it to '/dev/null' (any error
+ messages will still be shown).
+
+'--srcdir=DIR'
+ Look for the package's source code in directory DIR. Usually
+ 'configure' can determine that directory automatically.
+
+'--prefix=DIR'
+ Use DIR as the installation prefix. *note Installation Names:: for
+ more details, including other options available for fine-tuning the
+ installation locations.
+
+'--no-create'
+'-n'
+ Run the configure checks, but stop before creating any output
+ files.
+
+'configure' also accepts some other, not widely useful, options. Run
+'configure --help' for more details.
--- /dev/null
+# This file is part of Inform.
+#
+# Inform is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# theFree Software Foundation, either version 3 of the License, or
+#(at your option) any later version.
+#
+# Inform is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Inform. If not, see https://gnu.org/licenses/
+
+SUBDIRS = src
\ No newline at end of file
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "arrays" : Parses array declarations and constructs arrays from them; */
-/* likewise global variables, which are in some ways a */
-/* simpler form of the same thing. */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-/* ------------------------------------------------------------------------- */
-/* Arrays defined below: */
-/* */
-/* int dynamic_array_area[] Initial values for the bytes of */
-/* the dynamic array area */
-/* int32 global_initial_value[n] The initialised value of the nth */
-/* global variable (counting 0 - 239) */
-/* */
-/* The "dynamic array area" is the Z-machine area holding the current */
-/* values of the global variables (in 240x2 = 480 bytes) followed by any */
-/* (dynamic) arrays which may be defined. Owing to a poor choice of name */
-/* some years ago, this is also called the "static data area", which is */
-/* why the memory setting for its maximum extent is "MAX_STATIC_DATA". */
-/* */
-/* In Glulx, that 240 is changed to MAX_GLOBAL_VAR_NUMBER, and we take */
-/* correspondingly more space for the globals. This *really* ought to be */
-/* split into two segments. */
-/* ------------------------------------------------------------------------- */
-int *dynamic_array_area; /* See above */
-int32 *global_initial_value;
-
-int no_globals; /* Number of global variables used
- by the programmer (Inform itself
- uses the top seven -- but these do
- not count) */
- /* In Glulx, Inform uses the bottom
- ten. */
-
-int dynamic_array_area_size; /* Size in bytes */
-
-int no_arrays;
-int32 *array_symbols;
-int *array_sizes, *array_types;
-
-static int array_entry_size, /* 1 for byte array, 2 for word array */
- array_base; /* Offset in dynamic array area of the
- array being constructed. During the
- same time, dynamic_array_area_size
- is the offset of the initial entry
- in the array: so for "table" and
- "string" arrays, these numbers are
- different (by 2 and 1 bytes resp) */
-
- /* In Glulx, of course, that will be
- 4 instead of 2. */
-
-extern void finish_array(int32 i)
-{
- /* Write the array size into the 0th byte/word of the array, if it's
- a "table" or "string" array */
- if (!glulx_mode) {
-
- if (array_base!=dynamic_array_area_size)
- { if (dynamic_array_area_size-array_base==2)
- { dynamic_array_area[array_base] = i/256;
- dynamic_array_area[array_base+1] = i%256;
- }
- else
- { if (i>=256)
- error("A 'string' array can have at most 256 entries");
- dynamic_array_area[array_base] = i;
- }
- }
-
- }
- else {
- if (array_base!=dynamic_array_area_size)
- { if (dynamic_array_area_size-array_base==4)
- {
- dynamic_array_area[array_base] = (i >> 24) & 0xFF;
- dynamic_array_area[array_base+1] = (i >> 16) & 0xFF;
- dynamic_array_area[array_base+2] = (i >> 8) & 0xFF;
- dynamic_array_area[array_base+3] = (i) & 0xFF;
- }
- else
- { if (i>=256)
- error("A 'string' array can have at most 256 entries");
- dynamic_array_area[array_base] = i;
- }
- }
-
- }
-
- /* Move on the dynamic array size so that it now points to the next
- available free space */
-
- dynamic_array_area_size += i*array_entry_size;
-
-}
-
-extern void array_entry(int32 i, assembly_operand VAL)
-{
- if (!glulx_mode) {
- /* Array entry i (initial entry has i=0) is set to Z-machine value j */
-
- if (dynamic_array_area_size+(i+1)*array_entry_size > MAX_STATIC_DATA)
- memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
-
- if (array_entry_size==1)
- { dynamic_array_area[dynamic_array_area_size+i] = (VAL.value)%256;
-
- if (VAL.marker != 0)
- error("Entries in byte arrays and strings must be known constants");
-
- /* If the entry is too large for a byte array, issue a warning
- and truncate the value */
- else
- if (VAL.value >= 256)
- warning("Entry in '->', 'string' or 'buffer' array not in range 0 to 255");
- }
- else
- { dynamic_array_area[dynamic_array_area_size + 2*i] = (VAL.value)/256;
- dynamic_array_area[dynamic_array_area_size + 2*i+1] = (VAL.value)%256;
- if (VAL.marker != 0)
- backpatch_zmachine(VAL.marker, DYNAMIC_ARRAY_ZA,
- dynamic_array_area_size + 2*i);
- }
- }
- else {
- /* Array entry i (initial entry has i=0) is set to value j */
-
- if (dynamic_array_area_size+(i+1)*array_entry_size > MAX_STATIC_DATA)
- memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
-
- if (array_entry_size==1)
- { dynamic_array_area[dynamic_array_area_size+i] = (VAL.value) & 0xFF;
-
- if (VAL.marker != 0)
- error("Entries in byte arrays and strings must be known constants");
-
- /* If the entry is too large for a byte array, issue a warning
- and truncate the value */
- else
- if (VAL.value >= 256)
- warning("Entry in '->', 'string' or 'buffer' array not in range 0 to 255");
- }
- else if (array_entry_size==4)
- { dynamic_array_area[dynamic_array_area_size + 4*i] = (VAL.value >> 24) & 0xFF;
- dynamic_array_area[dynamic_array_area_size + 4*i+1] = (VAL.value >> 16) & 0xFF;
- dynamic_array_area[dynamic_array_area_size + 4*i+2] = (VAL.value >> 8) & 0xFF;
- dynamic_array_area[dynamic_array_area_size + 4*i+3] = (VAL.value) & 0xFF;
- if (VAL.marker != 0)
- backpatch_zmachine(VAL.marker, ARRAY_ZA,
- dynamic_array_area_size - 4*MAX_GLOBAL_VARIABLES + 4*i);
- }
- else
- {
- error("Somehow created an array of shorts");
- }
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Global and Array directives. */
-/* */
-/* Global <variablename> | */
-/* | = <value> */
-/* | <array specification> */
-/* */
-/* Array <arrayname> <array specification> */
-/* */
-/* where an array specification is: */
-/* */
-/* | -> | <number-of-entries> */
-/* | --> | <entry-1> ... <entry-n> */
-/* | string | [ <entry-1> [,] [;] <entry-2> ... <entry-n> ]; */
-/* | table */
-/* */
-/* ------------------------------------------------------------------------- */
-
-extern void set_variable_value(int i, int32 v)
-{ global_initial_value[i]=v;
-}
-
-/* There are four ways to initialise arrays: */
-
-#define UNSPECIFIED_AI -1
-#define NULLS_AI 0
-#define DATA_AI 1
-#define ASCII_AI 2
-#define BRACKET_AI 3
-
-extern void make_global(int array_flag, int name_only)
-{
- /* array_flag is TRUE for an Array directive, FALSE for a Global;
- name_only is only TRUE for parsing an imported variable name, so
- array_flag is always FALSE in that case. */
-
- int32 i;
- int array_type, data_type;
- assembly_operand AO;
-
- int32 global_symbol;
- const char *global_name;
- debug_location_beginning beginning_debug_location =
- get_token_location_beginning();
-
- directive_keywords.enabled = FALSE;
- get_next_token();
- i = token_value;
- global_symbol = i;
- global_name = token_text;
-
- if (!glulx_mode) {
- if ((token_type==SYMBOL_TT) && (stypes[i]==GLOBAL_VARIABLE_T)
- && (svals[i] >= LOWEST_SYSTEM_VAR_NUMBER))
- goto RedefinitionOfSystemVar;
- }
- else {
- if ((token_type==SYMBOL_TT) && (stypes[i]==GLOBAL_VARIABLE_T))
- goto RedefinitionOfSystemVar;
- }
-
- if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
- { discard_token_location(beginning_debug_location);
- if (array_flag)
- ebf_error("new array name", token_text);
- else ebf_error("new global variable name", token_text);
- panic_mode_error_recovery(); return;
- }
-
- if ((!array_flag) && (sflags[i] & USED_SFLAG))
- error_named("Variable must be defined before use:", token_text);
-
- if (array_flag)
- {
- if (!glulx_mode)
- assign_symbol(i, dynamic_array_area_size, ARRAY_T);
- else
- assign_symbol(i,
- dynamic_array_area_size - 4*MAX_GLOBAL_VARIABLES, ARRAY_T);
- if (no_arrays == MAX_ARRAYS)
- memoryerror("MAX_ARRAYS", MAX_ARRAYS);
- array_symbols[no_arrays] = i;
- }
- else
- { if (!glulx_mode && no_globals==233)
- { discard_token_location(beginning_debug_location);
- error("All 233 global variables already declared");
- panic_mode_error_recovery();
- return;
- }
- if (glulx_mode && no_globals==MAX_GLOBAL_VARIABLES)
- { discard_token_location(beginning_debug_location);
- memoryerror("MAX_GLOBAL_VARIABLES", MAX_GLOBAL_VARIABLES);
- panic_mode_error_recovery();
- return;
- }
-
- variable_tokens[MAX_LOCAL_VARIABLES+no_globals] = i;
- assign_symbol(i, MAX_LOCAL_VARIABLES+no_globals, GLOBAL_VARIABLE_T);
- variable_tokens[svals[i]] = i;
-
- if (name_only) import_symbol(i);
- else global_initial_value[no_globals++]=0;
- }
-
- directive_keywords.enabled = TRUE;
-
- RedefinitionOfSystemVar:
-
- if (name_only)
- { discard_token_location(beginning_debug_location);
- return;
- }
-
- get_next_token();
-
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { if (array_flag)
- { discard_token_location(beginning_debug_location);
- ebf_error("array definition", token_text);
- }
- put_token_back();
- if (debugfile_switch && !array_flag)
- { debug_file_printf("<global-variable>");
- debug_file_printf("<identifier>%s</identifier>", global_name);
- debug_file_printf("<address>");
- write_debug_global_backpatch(svals[global_symbol]);
- debug_file_printf("</address>");
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</global-variable>");
- }
- return;
- }
-
- if (!array_flag)
- {
- if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
- { AO = parse_expression(CONSTANT_CONTEXT);
- if (!glulx_mode) {
- if (AO.marker != 0)
- backpatch_zmachine(AO.marker, DYNAMIC_ARRAY_ZA,
- 2*(no_globals-1));
- }
- else {
- if (AO.marker != 0)
- backpatch_zmachine(AO.marker, GLOBALVAR_ZA,
- 4*(no_globals-1));
- }
- global_initial_value[no_globals-1] = AO.value;
- if (debugfile_switch)
- { debug_file_printf("<global-variable>");
- debug_file_printf("<identifier>%s</identifier>", global_name);
- debug_file_printf("<address>");
- write_debug_global_backpatch(svals[global_symbol]);
- debug_file_printf("</address>");
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</global-variable>");
- }
- return;
- }
-
- obsolete_warning("more modern to use 'Array', not 'Global'");
-
- if (!glulx_mode) {
- backpatch_zmachine(ARRAY_MV, DYNAMIC_ARRAY_ZA, 2*(no_globals-1));
- global_initial_value[no_globals-1]
- = dynamic_array_area_size+variables_offset;
- }
- else {
- backpatch_zmachine(ARRAY_MV, GLOBALVAR_ZA, 4*(no_globals-1));
- global_initial_value[no_globals-1]
- = dynamic_array_area_size - 4*MAX_GLOBAL_VARIABLES;
- }
- }
-
- array_type = BYTE_ARRAY; data_type = UNSPECIFIED_AI;
-
- if ((!array_flag) &&
- ((token_type==DIR_KEYWORD_TT)&&(token_value==DATA_DK)))
- data_type=NULLS_AI;
- else if ((!array_flag) &&
- ((token_type==DIR_KEYWORD_TT)&&(token_value==INITIAL_DK)))
- data_type=DATA_AI;
- else if ((!array_flag) &&
- ((token_type==DIR_KEYWORD_TT)&&(token_value==INITSTR_DK)))
- data_type=ASCII_AI;
-
- else if ((token_type==SEP_TT)&&(token_value==ARROW_SEP))
- array_type = BYTE_ARRAY;
- else if ((token_type==SEP_TT)&&(token_value==DARROW_SEP))
- array_type = WORD_ARRAY;
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==STRING_DK))
- array_type = STRING_ARRAY;
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==TABLE_DK))
- array_type = TABLE_ARRAY;
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==BUFFER_DK))
- array_type = BUFFER_ARRAY;
- else
- { discard_token_location(beginning_debug_location);
- if (array_flag)
- ebf_error
- ("'->', '-->', 'string', 'table' or 'buffer'", token_text);
- else
- ebf_error
- ("'=', '->', '-->', 'string', 'table' or 'buffer'", token_text);
- panic_mode_error_recovery();
- return;
- }
-
- array_entry_size=1;
- if ((array_type==WORD_ARRAY) || (array_type==TABLE_ARRAY))
- array_entry_size=WORDSIZE;
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { discard_token_location(beginning_debug_location);
- error("No array size or initial values given");
- put_token_back();
- return;
- }
-
- switch(data_type)
- { case UNSPECIFIED_AI:
- if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
- data_type = BRACKET_AI;
- else
- { data_type = NULLS_AI;
- if (token_type == DQ_TT) data_type = ASCII_AI;
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- data_type = DATA_AI;
- put_token_back();
- put_token_back();
- }
- break;
- case NULLS_AI: obsolete_warning("use '->' instead of 'data'"); break;
- case DATA_AI: obsolete_warning("use '->' instead of 'initial'"); break;
- case ASCII_AI: obsolete_warning("use '->' instead of 'initstr'"); break;
- }
-
- array_base = dynamic_array_area_size;
-
- /* Leave room to write the array size in later, if string/table array */
-
- if ((array_type==STRING_ARRAY) || (array_type==TABLE_ARRAY))
- dynamic_array_area_size += array_entry_size;
- if (array_type==BUFFER_ARRAY)
- dynamic_array_area_size += WORDSIZE;
- array_types[no_arrays] = array_type;
-
- switch(data_type)
- {
- case NULLS_AI:
-
- AO = parse_expression(CONSTANT_CONTEXT);
-
- CalculatedArraySize:
-
- if (module_switch && (AO.marker != 0))
- { error("Array sizes must be known now, not externally defined");
- break;
- }
-
- if (!glulx_mode) {
- if ((AO.value <= 0) || (AO.value >= 32768))
- { error("An array must have between 1 and 32767 entries");
- AO.value = 1;
- }
- }
- else {
- if (AO.value <= 0 || (AO.value & 0x80000000))
- { error("An array may not have 0 or fewer entries");
- AO.value = 1;
- }
- }
-
- { for (i=0; i<AO.value; i++) array_entry(i, zero_operand);
- }
- break;
-
- case DATA_AI:
-
- /* In this case the array is initialised to the sequence of
- constant values supplied on the same line */
-
- i=0;
- do
- { get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- break;
-
- if ((token_type == SEP_TT)
- && ((token_value == OPEN_SQUARE_SEP)
- || (token_value == CLOSE_SQUARE_SEP)))
- { discard_token_location(beginning_debug_location);
- error("Missing ';' to end the initial array values "
- "before \"[\" or \"]\"");
- return;
- }
- put_token_back();
-
- AO = parse_expression(ARRAY_CONTEXT);
-
- if (i == 0)
- { get_next_token();
- put_token_back();
- if ((token_type == SEP_TT)
- && (token_value == SEMICOLON_SEP))
- { data_type = NULLS_AI;
- goto CalculatedArraySize;
- }
- }
-
- array_entry(i, AO);
- i++;
- } while (TRUE);
- put_token_back();
- break;
-
- case ASCII_AI:
-
- /* In this case the array is initialised to the ASCII values of
- the characters of a given "quoted string" */
-
- get_next_token();
- if (token_type != DQ_TT)
- { ebf_error("literal text in double-quotes", token_text);
- token_text = "error";
- }
-
- { assembly_operand chars;
-
- int j;
- INITAO(&chars);
- for (i=0,j=0; token_text[j]!=0; i++,j+=textual_form_length)
- {
- int32 unicode; int zscii;
- unicode = text_to_unicode(token_text+j);
- if (glulx_mode)
- {
- if (array_entry_size == 1 && (unicode < 0 || unicode >= 256))
- {
- error("Unicode characters beyond Latin-1 cannot be used in a byte array");
- }
- else
- {
- chars.value = unicode;
- }
- }
- else /* Z-code */
- {
- zscii = unicode_to_zscii(unicode);
- if ((zscii != 5) && (zscii < 0x100)) chars.value = zscii;
- else
- { unicode_char_error("Character can only be used if declared in \
-advance as part of 'Zcharacter table':", unicode);
- chars.value = '?';
- }
- }
- chars.marker = 0;
- set_constant_ot(&chars);
- array_entry(i, chars);
- }
- }
- break;
-
- case BRACKET_AI:
-
- /* In this case the array is initialised to the sequence of
- constant values given over a whole range of compiler-lines,
- between square brackets [ and ] */
-
- i = 0;
- while (TRUE)
- { get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- continue;
- if ((token_type == SEP_TT) && (token_value == CLOSE_SQUARE_SEP))
- break;
- if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
- { /* Minimal error recovery: we assume that a ] has
- been missed, and the programmer is now starting
- a new routine */
-
- ebf_error("']'", token_text);
- put_token_back(); break;
- }
- put_token_back();
- array_entry(i, parse_expression(ARRAY_CONTEXT));
- i++;
- }
- }
-
- finish_array(i);
-
- if (debugfile_switch)
- { debug_file_printf("<array>");
- debug_file_printf("<identifier>%s</identifier>", global_name);
- debug_file_printf("<value>");
- write_debug_array_backpatch(svals[global_symbol]);
- debug_file_printf("</value>");
- debug_file_printf
- ("<byte-count>%d</byte-count>",
- dynamic_array_area_size - array_base);
- debug_file_printf
- ("<bytes-per-element>%d</bytes-per-element>",
- array_entry_size);
- debug_file_printf
- ("<zeroth-element-holds-length>%s</zeroth-element-holds-length>",
- (array_type == STRING_ARRAY || array_type == TABLE_ARRAY) ?
- "true" : "false");
- get_next_token();
- write_debug_locations(get_token_location_end(beginning_debug_location));
- put_token_back();
- debug_file_printf("</array>");
- }
-
- if ((array_type==BYTE_ARRAY) || (array_type==WORD_ARRAY)) i--;
- if (array_type==BUFFER_ARRAY) i+=WORDSIZE-1;
- array_sizes[no_arrays++] = i;
-}
-
-extern int32 begin_table_array(void)
-{
- /* The "box" statement needs to be able to construct (static) table
- arrays of strings like this */
-
- array_base = dynamic_array_area_size;
- array_entry_size = WORDSIZE;
-
- /* Leave room to write the array size in later */
-
- dynamic_array_area_size += array_entry_size;
-
- if (!glulx_mode)
- return array_base;
- else
- return array_base - WORDSIZE * MAX_GLOBAL_VARIABLES;
-}
-
-extern int32 begin_word_array(void)
-{
- /* The "random(a, b, ...)" function needs to be able to construct
- (static) word arrays like this */
-
- array_base = dynamic_array_area_size;
- array_entry_size = WORDSIZE;
-
- if (!glulx_mode)
- return array_base;
- else
- return array_base - WORDSIZE * MAX_GLOBAL_VARIABLES;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_arrays_vars(void)
-{ dynamic_array_area = NULL;
- global_initial_value = NULL;
- array_sizes = NULL; array_symbols = NULL; array_types = NULL;
-}
-
-extern void arrays_begin_pass(void)
-{ no_arrays = 0;
- if (!glulx_mode)
- no_globals=0;
- else
- no_globals=11;
- dynamic_array_area_size = WORDSIZE * MAX_GLOBAL_VARIABLES;
-}
-
-extern void arrays_allocate_arrays(void)
-{ dynamic_array_area = my_calloc(sizeof(int), MAX_STATIC_DATA,
- "static data");
- array_sizes = my_calloc(sizeof(int), MAX_ARRAYS, "array sizes");
- array_types = my_calloc(sizeof(int), MAX_ARRAYS, "array types");
- array_symbols = my_calloc(sizeof(int32), MAX_ARRAYS, "array symbols");
- global_initial_value = my_calloc(sizeof(int32), MAX_GLOBAL_VARIABLES,
- "global values");
-}
-
-extern void arrays_free_arrays(void)
-{ my_free(&dynamic_array_area, "static data");
- my_free(&global_initial_value, "global values");
- my_free(&array_sizes, "array sizes");
- my_free(&array_types, "array sizes");
- my_free(&array_symbols, "array sizes");
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "asm" : The Inform assembler */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-uchar *zcode_holding_area; /* Area holding code yet to be transferred
- to either zcode_area or temp file no 1 */
-uchar *zcode_markers; /* Bytes holding marker values for this
- code */
-static int zcode_ha_size; /* Number of bytes in holding area */
-
-memory_block zcode_area; /* Block to hold assembled code (if
- temporary files are not being used) */
-
-int32 zmachine_pc; /* PC position of assembly (byte offset
- from start of Z-code area) */
-
-int32 no_instructions; /* Number of instructions assembled */
-int execution_never_reaches_here, /* TRUE if the current PC value in the
- code area cannot be reached: e.g. if
- the previous instruction was a "quit"
- opcode and no label is set to here */
- next_label, /* Used to count the labels created all
- over Inform in current routine, from 0 */
- next_sequence_point; /* Likewise, for sequence points */
-int no_sequence_points; /* Kept for statistics purposes only */
-
-static int label_moved_error_already_given;
- /* When one label has moved, all subsequent
- ones probably have too, and this flag
- suppresses the runaway chain of error
- messages which would otherwise result */
-
-int sequence_point_follows; /* Will the next instruction assembled */
- /* be at a sequence point in the routine? */
-
-int uses_unicode_features; /* Makes use of Glulx Unicode (3.0)
- features? */
-int uses_memheap_features; /* Makes use of Glulx mem/heap (3.1)
- features? */
-int uses_acceleration_features; /* Makes use of Glulx acceleration (3.1.1)
- features? */
-int uses_float_features; /* Makes use of Glulx floating-point (3.1.2)
- features? */
-
-debug_location statement_debug_location;
- /* Location of current statement */
-
-
-int32 *variable_tokens; /* The allocated size is
- (MAX_LOCAL_VARIABLES +
- MAX_GLOBAL_VARIABLES). The entries
- MAX_LOCAL_VARIABLES and up give the
- symbol table index for the names of
- the global variables */
-int *variable_usage; /* TRUE if referred to, FALSE otherwise */
-
-assembly_instruction AI; /* A structure used to hold the full
- specification of a single Z-code
- instruction: effectively this is the
- input to the routine
- assemble_instruction() */
-
-static char opcode_syntax_string[128]; /* Text buffer holding the correct
- syntax for an opcode: used to produce
- helpful assembler error messages */
-
-static int routine_symbol; /* The symbol index of the routine currently
- being compiled */
-static char *routine_name; /* The name of the routine currently being
- compiled */
-static int routine_locals; /* The number of local variables used by
- the routine currently being compiled */
-
-static int32 routine_start_pc;
-
-int32 *named_routine_symbols;
-
-static void transfer_routine_z(void);
-static void transfer_routine_g(void);
-
-/* ------------------------------------------------------------------------- */
-/* Label data */
-/* ------------------------------------------------------------------------- */
-
-static int first_label, last_label;
-static int32 *label_offsets; /* Double-linked list of label offsets */
-static int *label_next, /* (i.e. zmachine_pc values) in PC order */
- *label_prev;
-static int32 *label_symbols; /* Symbol numbers if defined in source */
-
-static int *sequence_point_labels;
- /* Label numbers for each */
-static debug_location *sequence_point_locations;
- /* Source code references for each */
- /* (used for making debugging file) */
-
-static void set_label_offset(int label, int32 offset)
-{
- if (label >= MAX_LABELS) memoryerror("MAX_LABELS", MAX_LABELS);
-
- label_offsets[label] = offset;
- if (last_label == -1)
- { label_prev[label] = -1;
- first_label = label;
- }
- else
- { label_prev[label] = last_label;
- label_next[last_label] = label;
- }
- last_label = label;
- label_next[label] = -1;
- label_symbols[label] = -1;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Useful tool for building operands */
-/* ------------------------------------------------------------------------- */
-
-extern void set_constant_ot(assembly_operand *AO)
-{
- if (!glulx_mode) {
- if (AO->value >= 0 && AO->value <= 255)
- AO->type = SHORT_CONSTANT_OT;
- else
- AO->type = LONG_CONSTANT_OT;
- }
- else {
- if (AO->value == 0)
- AO->type = ZEROCONSTANT_OT;
- else if (AO->value >= -0x80 && AO->value < 0x80)
- AO->type = BYTECONSTANT_OT;
- else if (AO->value >= -0x8000 && AO->value < 0x8000)
- AO->type = HALFCONSTANT_OT;
- else
- AO->type = CONSTANT_OT;
- }
-}
-
-extern int is_constant_ot(int otval)
-{
- if (!glulx_mode) {
- return ((otval == LONG_CONSTANT_OT)
- || (otval == SHORT_CONSTANT_OT));
- }
- else {
- return ((otval == CONSTANT_OT)
- || (otval == HALFCONSTANT_OT)
- || (otval == BYTECONSTANT_OT)
- || (otval == ZEROCONSTANT_OT));
- }
-}
-
-extern int is_variable_ot(int otval)
-{
- if (!glulx_mode) {
- return (otval == VARIABLE_OT);
- }
- else {
- return ((otval == LOCALVAR_OT)
- || (otval == GLOBALVAR_OT));
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Used in printing assembly traces */
-/* ------------------------------------------------------------------------- */
-
-extern char *variable_name(int32 i)
-{
- if (i==0) return("sp");
- if (i<MAX_LOCAL_VARIABLES) return local_variable_texts[i-1];
-
- if (!glulx_mode) {
- if (i==255) return("TEMP1");
- if (i==254) return("TEMP2");
- if (i==253) return("TEMP3");
- if (i==252) return("TEMP4");
- if (i==251) return("self");
- if (i==250) return("sender");
- if (i==249) return("sw__var");
- if (i >= 256 && i < 286)
- { if (i - 256 < NUMBER_SYSTEM_FUNCTIONS) return system_functions.keywords[i - 256];
- return "<unnamed system function>";
- }
- }
- else {
- switch (i - MAX_LOCAL_VARIABLES) {
- case 0: return "temp_global";
- case 1: return "temp__global2";
- case 2: return "temp__global3";
- case 3: return "temp__global4";
- case 4: return "self";
- case 5: return "sender";
- case 6: return "sw__var";
- case 7: return "sys__glob0";
- case 8: return "sys__glob1";
- case 9: return "sys__glob2";
- case 10: return "sys_statusline_flag";
- }
- }
-
- return ((char *) symbs[variable_tokens[i]]);
-}
-
-static void print_operand_z(assembly_operand o)
-{ switch(o.type)
- { case EXPRESSION_OT: printf("expr_"); break;
- case LONG_CONSTANT_OT: printf("long_"); break;
- case SHORT_CONSTANT_OT: printf("short_"); break;
- case VARIABLE_OT:
- if (o.value==0) { printf("sp"); return; }
- printf("%s", variable_name(o.value)); return;
- case OMITTED_OT: printf("<no value>"); return;
- }
- printf("%d", o.value);
-}
-
-static void print_operand_g(assembly_operand o)
-{
- switch (o.type) {
- case EXPRESSION_OT: printf("expr_"); break;
- case CONSTANT_OT: printf("long_"); break;
- case HALFCONSTANT_OT: printf("short_"); break;
- case BYTECONSTANT_OT: printf("byte_"); break;
- case ZEROCONSTANT_OT: printf("zero_"); return;
- case DEREFERENCE_OT: printf("*"); break;
- case GLOBALVAR_OT:
- printf("%s (global_%d)", variable_name(o.value), o.value);
- return;
- case LOCALVAR_OT:
- if (o.value == 0)
- printf("stackptr");
- else
- printf("%s (local_%d)", variable_name(o.value), o.value-1);
- return;
- case SYSFUN_OT:
- if (o.value >= 0 && o.value < NUMBER_SYSTEM_FUNCTIONS)
- printf("%s", system_functions.keywords[o.value]);
- else
- printf("<unnamed system function>");
- return;
- case OMITTED_OT: printf("<no value>"); return;
- default: printf("???_"); break;
- }
- printf("%d", o.value);
-}
-
-extern void print_operand(assembly_operand o)
-{
- if (!glulx_mode)
- print_operand_z(o);
- else
- print_operand_g(o);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Writing bytes to the code area */
-/* ------------------------------------------------------------------------- */
-
-static void byteout(int32 i, int mv)
-{ if (zcode_ha_size >= MAX_ZCODE_SIZE)
- memoryerror("MAX_ZCODE_SIZE",MAX_ZCODE_SIZE);
- zcode_markers[zcode_ha_size] = (uchar) mv;
- zcode_holding_area[zcode_ha_size++] = (uchar) i;
- zmachine_pc++;
-}
-
-/* ------------------------------------------------------------------------- */
-/* A database of the 115 canonical Infocom opcodes in Versions 3 to 6 */
-/* And of the however-many-there-are Glulx opcode */
-/* ------------------------------------------------------------------------- */
-
-typedef struct opcodez
-{ uchar *name; /* Lower case standard name */
- int version1; /* Valid from this version number... */
- int version2; /* ...until this one (or forever if this is 0) */
- int extension; /* In later versions, see this line in extension table:
- if -1, the opcode is illegal in later versions */
- int code; /* Opcode number within its operand-number block */
- int flags; /* Flags (see below) */
- int op_rules; /* Any unusual operand rule applying (see below) */
- int flags2_set; /* If not zero, set this bit in Flags 2 in the header
- of any game using the opcode */
- int no; /* Number of operands (see below) */
-} opcodez;
-
-typedef struct opcodeg
-{ uchar *name; /* Lower case standard name */
- int32 code; /* Opcode number */
- int flags; /* Flags (see below) */
- int op_rules; /* Any unusual operand rule applying (see below) */
- int no; /* Number of operands */
-} opcodeg;
-
- /* Flags which can be set */
-
-#define St 1 /* Store */
-#define Br 2 /* Branch */
-#define Rf 4 /* "Return flag": execution never continues after this
- opcode (e.g., is a return or unconditional jump) */
-#define St2 8 /* Store2 (second-to-last operand is store (Glulx)) */
-
- /* Codes for any unusual operand assembly rules */
-
- /* Z-code: */
-
-#define VARIAB 1 /* First operand expected to be a variable name and
- assembled to a short constant: the variable number */
-#define TEXT 2 /* One text operand, to be Z-encoded into the program */
-#define LABEL 3 /* One operand, a label, given as long constant offset */
-#define CALL 4 /* First operand is name of a routine, to be assembled
- as long constant (the routine's packed address):
- as if the name were prefixed by #r$ */
-
- /* Glulx: (bit flags for Glulx VM features) */
-
-#define GOP_Unicode 1 /* uses_unicode_features */
-#define GOP_MemHeap 2 /* uses_memheap_features */
-#define GOP_Acceleration 4 /* uses_acceleration_features */
-#define GOP_Float 8 /* uses_float_features */
-
- /* Codes for the number of operands */
-
-#define TWO 1 /* 2 (with certain types of operand, compiled as VAR) */
-#define VAR 2 /* 0 to 4 */
-#define VAR_LONG 3 /* 0 to 8 */
-#define ONE 4 /* 1 */
-#define ZERO 5 /* 0 */
-#define EXT 6 /* Extended opcode set VAR: 0 to 4 */
-#define EXT_LONG 7 /* Extended: 0 to 8 (not used by the canonical opcodes) */
-
-static opcodez opcodes_table_z[] =
-{
- /* Opcodes introduced in Version 3 */
-
-/* 0 */ { (uchar *) "je", 3, 0, -1, 0x01, Br, 0, 0, TWO },
-/* 1 */ { (uchar *) "jl", 3, 0, -1, 0x02, Br, 0, 0, TWO },
-/* 2 */ { (uchar *) "jg", 3, 0, -1, 0x03, Br, 0, 0, TWO },
-/* 3 */ { (uchar *) "dec_chk", 3, 0, -1, 0x04, Br, VARIAB, 0, TWO },
-/* 4 */ { (uchar *) "inc_chk", 3, 0, -1, 0x05, Br, VARIAB, 0, TWO },
-/* 5 */ { (uchar *) "jin", 3, 0, -1, 0x06, Br, 0, 0, TWO },
-/* 6 */ { (uchar *) "test", 3, 0, -1, 0x07, Br, 0, 0, TWO },
-/* 7 */ { (uchar *) "or", 3, 0, -1, 0x08, St, 0, 0, TWO },
-/* 8 */ { (uchar *) "and", 3, 0, -1, 0x09, St, 0, 0, TWO },
-/* 9 */ { (uchar *) "test_attr", 3, 0, -1, 0x0A, Br, 0, 0, TWO },
-/* 10 */ {(uchar *) "set_attr", 3, 0, -1, 0x0B, 0, 0, 0, TWO },
-/* 11 */ {(uchar *) "clear_attr", 3, 0, -1, 0x0C, 0, 0, 0, TWO },
-/* 12 */ {(uchar *) "store", 3, 0, -1, 0x0D, 0, VARIAB, 0, TWO },
-/* 13 */ {(uchar *) "insert_obj", 3, 0, -1, 0x0E, 0, 0, 0, TWO },
-/* 14 */ {(uchar *) "loadw", 3, 0, -1, 0x0F, St, 0, 0, TWO },
-/* 15 */ {(uchar *) "loadb", 3, 0, -1, 0x10, St, 0, 0, TWO },
-/* 16 */ {(uchar *) "get_prop", 3, 0, -1, 0x11, St, 0, 0, TWO },
-/* 17 */ {(uchar *) "get_prop_addr", 3, 0, -1, 0x12, St, 0, 0, TWO },
-/* 18 */ {(uchar *) "get_next_prop", 3, 0, -1, 0x13, St, 0, 0, TWO },
-/* 19 */ {(uchar *) "add", 3, 0, -1, 0x14, St, 0, 0, TWO },
-/* 20 */ {(uchar *) "sub", 3, 0, -1, 0x15, St, 0, 0, TWO },
-/* 21 */ {(uchar *) "mul", 3, 0, -1, 0x16, St, 0, 0, TWO },
-/* 22 */ {(uchar *) "div", 3, 0, -1, 0x17, St, 0, 0, TWO },
-/* 23 */ {(uchar *) "mod", 3, 0, -1, 0x18, St, 0, 0, TWO },
-/* 24 */ {(uchar *) "call", 3, 0, -1, 0x20, St, CALL, 0, VAR },
-/* 25 */ {(uchar *) "storew", 3, 0, -1, 0x21, 0, 0, 0, VAR },
-/* 26 */ {(uchar *) "storeb", 3, 0, -1, 0x22, 0, 0, 0, VAR },
-/* 27 */ {(uchar *) "put_prop", 3, 0, -1, 0x23, 0, 0, 0, VAR },
- /* This is the version of "read" called "sread" internally: */
-/* 28 */ {(uchar *) "read", 3, 0, -1, 0x24, 0, 0, 0, VAR },
-/* 29 */ {(uchar *) "print_char", 3, 0, -1, 0x25, 0, 0, 0, VAR },
-/* 30 */ {(uchar *) "print_num", 3, 0, -1, 0x26, 0, 0, 0, VAR },
-/* 31 */ {(uchar *) "random", 3, 0, -1, 0x27, St, 0, 0, VAR },
-/* 32 */ {(uchar *) "push", 3, 0, -1, 0x28, 0, 0, 0, VAR },
-/* 33 */ {(uchar *) "pull", 3, 5, 6, 0x29, 0, VARIAB, 0, VAR },
-/* 34 */ {(uchar *) "split_window", 3, 0, -1, 0x2A, 0, 0, 0, VAR },
-/* 35 */ {(uchar *) "set_window", 3, 0, -1, 0x2B, 0, 0, 0, VAR },
-/* 36 */ {(uchar *) "output_stream", 3, 0, -1, 0x33, 0, 0, 0, VAR },
-/* 37 */ {(uchar *) "input_stream", 3, 0, -1, 0x34, 0, 0, 0, VAR },
-/* 38 */ {(uchar *) "sound_effect", 3, 0, -1, 0x35, 0, 0, 7, VAR },
-/* 39 */ {(uchar *) "jz", 3, 0, -1, 0x00, Br, 0, 0, ONE },
-/* 40 */ {(uchar *) "get_sibling", 3, 0, -1, 0x01, St+Br, 0, 0, ONE },
-/* 41 */ {(uchar *) "get_child", 3, 0, -1, 0x02, St+Br, 0, 0, ONE },
-/* 42 */ {(uchar *) "get_parent", 3, 0, -1, 0x03, St, 0, 0, ONE },
-/* 43 */ {(uchar *) "get_prop_len", 3, 0, -1, 0x04, St, 0, 0, ONE },
-/* 44 */ {(uchar *) "inc", 3, 0, -1, 0x05, 0, VARIAB, 0, ONE },
-/* 45 */ {(uchar *) "dec", 3, 0, -1, 0x06, 0, VARIAB, 0, ONE },
-/* 46 */ {(uchar *) "print_addr", 3, 0, -1, 0x07, 0, 0, 0, ONE },
-/* 47 */ {(uchar *) "remove_obj", 3, 0, -1, 0x09, 0, 0, 0, ONE },
-/* 48 */ {(uchar *) "print_obj", 3, 0, -1, 0x0A, 0, 0, 0, ONE },
-/* 49 */ {(uchar *) "ret", 3, 0, -1, 0x0B, Rf, 0, 0, ONE },
-/* 50 */ {(uchar *) "jump", 3, 0, -1, 0x0C, Rf, LABEL, 0, ONE },
-/* 51 */ {(uchar *) "print_paddr", 3, 0, -1, 0x0D, 0, 0, 0, ONE },
-/* 52 */ {(uchar *) "load", 3, 0, -1, 0x0E, St, VARIAB, 0, ONE },
-/* 53 */ {(uchar *) "not", 3, 3, 0, 0x0F, St, 0, 0, ONE },
-/* 54 */ {(uchar *) "rtrue", 3, 0, -1, 0x00, Rf, 0, 0,ZERO },
-/* 55 */ {(uchar *) "rfalse", 3, 0, -1, 0x01, Rf, 0, 0,ZERO },
-/* 56 */ {(uchar *) "print", 3, 0, -1, 0x02, 0, TEXT, 0,ZERO },
-/* 57 */ {(uchar *) "print_ret", 3, 0, -1, 0x03, Rf, TEXT, 0,ZERO },
-/* 58 */ {(uchar *) "nop", 3, 0, -1, 0x04, 0, 0, 0,ZERO },
-/* 59 */ {(uchar *) "save", 3, 3, 1, 0x05, Br, 0, 0,ZERO },
-/* 60 */ {(uchar *) "restore", 3, 3, 2, 0x06, Br, 0, 0,ZERO },
-/* 61 */ {(uchar *) "restart", 3, 0, -1, 0x07, 0, 0, 0,ZERO },
-/* 62 */ {(uchar *) "ret_popped", 3, 0, -1, 0x08, Rf, 0, 0,ZERO },
-/* 63 */ {(uchar *) "pop", 3, 4, -1, 0x09, 0, 0, 0,ZERO },
-/* 64 */ {(uchar *) "quit", 3, 0, -1, 0x0A, Rf, 0, 0,ZERO },
-/* 65 */ {(uchar *) "new_line", 3, 0, -1, 0x0B, 0, 0, 0,ZERO },
-/* 66 */ {(uchar *) "show_status", 3, 3, -1, 0x0C, 0, 0, 0,ZERO },
-/* 67 */ {(uchar *) "verify", 3, 0, -1, 0x0D, Br, 0, 0,ZERO },
-
- /* Opcodes introduced in Version 4 */
-
-/* 68 */ {(uchar *) "call_2s", 4, 0, -1, 0x19, St, CALL, 0, TWO },
-/* 69 */ {(uchar *) "call_vs", 4, 0, -1, 0x20, St, CALL, 0, VAR },
- /* This is the version of "read" called "aread" internally: */
-/* 70 */ {(uchar *) "read", 4, 0, -1, 0x24, St, 0, 0, VAR },
-/* 71 */ {(uchar *) "call_vs2", 4, 0, -1, 0x2C, St, CALL, 0,
- VAR_LONG },
-/* 72 */ {(uchar *) "erase_window", 4, 0, -1, 0x2D, 0, 0, 0, VAR },
-/* 73 */ {(uchar *) "erase_line", 4, 0, -1, 0x2E, 0, 0, 0, VAR },
-/* 74 */ {(uchar *) "set_cursor", 4, 0, -1, 0x2F, 0, 0, 0, VAR },
-/* 75 */ {(uchar *) "get_cursor", 4, 0, -1, 0x30, 0, 0, 0, VAR },
-/* 76 */ {(uchar *) "set_text_style", 4, 0, -1, 0x31, 0, 0, 0, VAR },
-/* 77 */ {(uchar *) "buffer_mode", 4, 0, -1, 0x32, 0, 0, 0, VAR },
-/* 78 */ {(uchar *) "read_char", 4, 0, -1, 0x36, St, 0, 0, VAR },
-/* 79 */ {(uchar *) "scan_table", 4, 0, -1, 0x37, St+Br, 0, 0, VAR },
-/* 80 */ {(uchar *) "call_1s", 4, 0, -1, 0x08, St, CALL, 0, ONE },
-
- /* Opcodes introduced in Version 5 */
-
-/* 81 */ {(uchar *) "call_2n", 5, 0, -1, 0x1a, 0, CALL, 0, TWO },
-/* 82 */ {(uchar *) "set_colour", 5, 0, -1, 0x1b, 0, 0, 6, TWO },
-/* 83 */ {(uchar *) "throw", 5, 0, -1, 0x1c, 0, 0, 0, TWO },
-/* 84 */ {(uchar *) "call_vn", 5, 0, -1, 0x39, 0, CALL, 0, VAR },
-/* 85 */ {(uchar *) "call_vn2", 5, 0, -1, 0x3a, 0, CALL, 0,
- VAR_LONG },
-/* 86 */ {(uchar *) "tokenise", 5, 0, -1, 0x3b, 0, 0, 0, VAR },
-/* 87 */ {(uchar *) "encode_text", 5, 0, -1, 0x3c, 0, 0, 0, VAR },
-/* 88 */ {(uchar *) "copy_table", 5, 0, -1, 0x3d, 0, 0, 0, VAR },
-/* 89 */ {(uchar *) "print_table", 5, 0, -1, 0x3e, 0, 0, 0, VAR },
-/* 90 */ {(uchar *) "check_arg_count", 5, 0, -1, 0x3f, Br, 0, 0, VAR },
-/* 91 */ {(uchar *) "call_1n", 5, 0, -1, 0x0F, 0, CALL, 0, ONE },
-/* 92 */ {(uchar *) "catch", 5, 0, -1, 0x09, St, 0, 0, ZERO },
-/* 93 */ {(uchar *) "piracy", 5, 0, -1, 0x0F, Br, 0, 0, ZERO },
-/* 94 */ {(uchar *) "log_shift", 5, 0, -1, 0x02, St, 0, 0, EXT },
-/* 95 */ {(uchar *) "art_shift", 5, 0, -1, 0x03, St, 0, 0, EXT },
-/* 96 */ {(uchar *) "set_font", 5, 0, -1, 0x04, St, 0, 0, EXT },
-/* 97 */ {(uchar *) "save_undo", 5, 0, -1, 0x09, St, 0, 4, EXT },
-/* 98 */ {(uchar *) "restore_undo", 5, 0, -1, 0x0A, St, 0, 4, EXT },
-
- /* Opcodes introduced in Version 6 */
-
-/* 99 */ { (uchar *) "draw_picture", 6, 6, -1, 0x05, 0, 0, 3, EXT },
-/* 100 */ { (uchar *) "picture_data", 6, 6, -1, 0x06, Br, 0, 3, EXT },
-/* 101 */ { (uchar *) "erase_picture", 6, 6, -1, 0x07, 0, 0, 3, EXT },
-/* 102 */ { (uchar *) "set_margins", 6, 6, -1, 0x08, 0, 0, 0, EXT },
-/* 103 */ { (uchar *) "move_window", 6, 6, -1, 0x10, 0, 0, 0, EXT },
-/* 104 */ { (uchar *) "window_size", 6, 6, -1, 0x11, 0, 0, 0, EXT },
-/* 105 */ { (uchar *) "window_style", 6, 6, -1, 0x12, 0, 0, 0, EXT },
-/* 106 */ { (uchar *) "get_wind_prop", 6, 6, -1, 0x13, St, 0, 0, EXT },
-/* 107 */ { (uchar *) "scroll_window", 6, 6, -1, 0x14, 0, 0, 0, EXT },
-/* 108 */ { (uchar *) "pop_stack", 6, 6, -1, 0x15, 0, 0, 0, EXT },
-/* 109 */ { (uchar *) "read_mouse", 6, 6, -1, 0x16, 0, 0, 5, EXT },
-/* 110 */ { (uchar *) "mouse_window", 6, 6, -1, 0x17, 0, 0, 5, EXT },
-/* 111 */ { (uchar *) "push_stack", 6, 6, -1, 0x18, Br, 0, 0, EXT },
-/* 112 */ { (uchar *) "put_wind_prop", 6, 6, -1, 0x19, 0, 0, 0, EXT },
-/* 113 */ { (uchar *) "print_form", 6, 6, -1, 0x1a, 0, 0, 0, EXT },
-/* 114 */ { (uchar *) "make_menu", 6, 6, -1, 0x1b, Br, 0, 8, EXT },
-/* 115 */ { (uchar *) "picture_table", 6, 6, -1, 0x1c, 0, 0, 3, EXT },
-
- /* 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 }
-};
-
- /* Subsequent forms for opcodes whose meaning changes with version */
-
-static opcodez extension_table_z[] =
-{
-/* 0 */ { (uchar *) "not", 4, 4, 3, 0x0F, St, 0, 0, ONE },
-/* 1 */ { (uchar *) "save", 4, 4, 4, 0x05, St, 0, 0,ZERO },
-/* 2 */ { (uchar *) "restore", 4, 4, 5, 0x06, St, 0, 0,ZERO },
-/* 3 */ { (uchar *) "not", 5, 0, -1, 0x38, St, 0, 0, VAR },
-/* 4 */ { (uchar *) "save", 5, 0, -1, 0x00, St, 0, 0, EXT },
-/* 5 */ { (uchar *) "restore", 5, 0, -1, 0x01, St, 0, 0, EXT },
-/* 6 */ { (uchar *) "pull", 6, 6, -1, 0x29, St, 0, 0, VAR }
-};
-
-static opcodez invalid_opcode_z =
- { (uchar *) "invalid", 0, 0, -1, 0xff, 0, 0, 0, ZERO};
-
-static opcodez custom_opcode_z;
-
-/* Note that this table assumes that all opcodes have at most two
- branch-label or store operands, and that if they exist, they are the
- last operands. Glulx does not actually guarantee this. But it is
- true for all opcodes in the current Glulx spec, so we will assume
- it for now.
-
- Also note that Inform can only compile branches to constant offsets,
- even though the Glulx machine can handle stack or memory-loaded
- operands in a branch instruction.
-*/
-
-static opcodeg opcodes_table_g[] = {
- { (uchar *) "nop", 0x00, 0, 0, 0 },
- { (uchar *) "add", 0x10, St, 0, 3 },
- { (uchar *) "sub", 0x11, St, 0, 3 },
- { (uchar *) "mul", 0x12, St, 0, 3 },
- { (uchar *) "div", 0x13, St, 0, 3 },
- { (uchar *) "mod", 0x14, St, 0, 3 },
- { (uchar *) "neg", 0x15, St, 0, 2 },
- { (uchar *) "bitand", 0x18, St, 0, 3 },
- { (uchar *) "bitor", 0x19, St, 0, 3 },
- { (uchar *) "bitxor", 0x1A, St, 0, 3 },
- { (uchar *) "bitnot", 0x1B, St, 0, 2 },
- { (uchar *) "shiftl", 0x1C, St, 0, 3 },
- { (uchar *) "sshiftr", 0x1D, St, 0, 3 },
- { (uchar *) "ushiftr", 0x1E, St, 0, 3 },
- { (uchar *) "jump", 0x20, Br|Rf, 0, 1 },
- { (uchar *) "jz", 0x22, Br, 0, 2 },
- { (uchar *) "jnz", 0x23, Br, 0, 2 },
- { (uchar *) "jeq", 0x24, Br, 0, 3 },
- { (uchar *) "jne", 0x25, Br, 0, 3 },
- { (uchar *) "jlt", 0x26, Br, 0, 3 },
- { (uchar *) "jge", 0x27, Br, 0, 3 },
- { (uchar *) "jgt", 0x28, Br, 0, 3 },
- { (uchar *) "jle", 0x29, Br, 0, 3 },
- { (uchar *) "jltu", 0x2A, Br, 0, 3 },
- { (uchar *) "jgeu", 0x2B, Br, 0, 3 },
- { (uchar *) "jgtu", 0x2C, Br, 0, 3 },
- { (uchar *) "jleu", 0x2D, Br, 0, 3 },
- { (uchar *) "call", 0x30, St, 0, 3 },
- { (uchar *) "return", 0x31, Rf, 0, 1 },
- { (uchar *) "catch", 0x32, Br|St, 0, 2 },
- { (uchar *) "throw", 0x33, Rf, 0, 2 },
- { (uchar *) "tailcall", 0x34, Rf, 0, 2 },
- { (uchar *) "copy", 0x40, St, 0, 2 },
- { (uchar *) "copys", 0x41, St, 0, 2 },
- { (uchar *) "copyb", 0x42, St, 0, 2 },
- { (uchar *) "sexs", 0x44, St, 0, 2 },
- { (uchar *) "sexb", 0x45, St, 0, 2 },
- { (uchar *) "aload", 0x48, St, 0, 3 },
- { (uchar *) "aloads", 0x49, St, 0, 3 },
- { (uchar *) "aloadb", 0x4A, St, 0, 3 },
- { (uchar *) "aloadbit", 0x4B, St, 0, 3 },
- { (uchar *) "astore", 0x4C, 0, 0, 3 },
- { (uchar *) "astores", 0x4D, 0, 0, 3 },
- { (uchar *) "astoreb", 0x4E, 0, 0, 3 },
- { (uchar *) "astorebit", 0x4F, 0, 0, 3 },
- { (uchar *) "stkcount", 0x50, St, 0, 1 },
- { (uchar *) "stkpeek", 0x51, St, 0, 2 },
- { (uchar *) "stkswap", 0x52, 0, 0, 0 },
- { (uchar *) "stkroll", 0x53, 0, 0, 2 },
- { (uchar *) "stkcopy", 0x54, 0, 0, 1 },
- { (uchar *) "streamchar", 0x70, 0, 0, 1 },
- { (uchar *) "streamnum", 0x71, 0, 0, 1 },
- { (uchar *) "streamstr", 0x72, 0, 0, 1 },
- { (uchar *) "gestalt", 0x0100, St, 0, 3 },
- { (uchar *) "debugtrap", 0x0101, 0, 0, 1 },
- { (uchar *) "getmemsize", 0x0102, St, 0, 1 },
- { (uchar *) "setmemsize", 0x0103, St, 0, 2 },
- { (uchar *) "jumpabs", 0x0104, Rf, 0, 1 },
- { (uchar *) "random", 0x0110, St, 0, 2 },
- { (uchar *) "setrandom", 0x0111, 0, 0, 1 },
- { (uchar *) "quit", 0x0120, Rf, 0, 0 },
- { (uchar *) "verify", 0x0121, St, 0, 1 },
- { (uchar *) "restart", 0x0122, 0, 0, 0 },
- { (uchar *) "save", 0x0123, St, 0, 2 },
- { (uchar *) "restore", 0x0124, St, 0, 2 },
- { (uchar *) "saveundo", 0x0125, St, 0, 1 },
- { (uchar *) "restoreundo", 0x0126, St, 0, 1 },
- { (uchar *) "protect", 0x0127, 0, 0, 2 },
- { (uchar *) "glk", 0x0130, St, 0, 3 },
- { (uchar *) "getstringtbl", 0x0140, St, 0, 1 },
- { (uchar *) "setstringtbl", 0x0141, 0, 0, 1 },
- { (uchar *) "getiosys", 0x0148, St|St2, 0, 2 },
- { (uchar *) "setiosys", 0x0149, 0, 0, 2 },
- { (uchar *) "linearsearch", 0x0150, St, 0, 8 },
- { (uchar *) "binarysearch", 0x0151, St, 0, 8 },
- { (uchar *) "linkedsearch", 0x0152, St, 0, 7 },
- { (uchar *) "callf", 0x0160, St, 0, 2 },
- { (uchar *) "callfi", 0x0161, St, 0, 3 },
- { (uchar *) "callfii", 0x0162, St, 0, 4 },
- { (uchar *) "callfiii", 0x0163, St, 0, 5 },
- { (uchar *) "streamunichar", 0x73, 0, GOP_Unicode, 1 },
- { (uchar *) "mzero", 0x170, 0, GOP_MemHeap, 2 },
- { (uchar *) "mcopy", 0x171, 0, GOP_MemHeap, 3 },
- { (uchar *) "malloc", 0x178, St, GOP_MemHeap, 2 },
- { (uchar *) "mfree", 0x179, 0, GOP_MemHeap, 1 },
- { (uchar *) "accelfunc", 0x180, 0, GOP_Acceleration, 2 },
- { (uchar *) "accelparam", 0x181, 0, GOP_Acceleration, 2 },
- { (uchar *) "numtof", 0x190, St, GOP_Float, 2 },
- { (uchar *) "ftonumz", 0x191, St, GOP_Float, 2 },
- { (uchar *) "ftonumn", 0x192, St, GOP_Float, 2 },
- { (uchar *) "ceil", 0x198, St, GOP_Float, 2 },
- { (uchar *) "floor", 0x199, St, GOP_Float, 2 },
- { (uchar *) "fadd", 0x1A0, St, GOP_Float, 3 },
- { (uchar *) "fsub", 0x1A1, St, GOP_Float, 3 },
- { (uchar *) "fmul", 0x1A2, St, GOP_Float, 3 },
- { (uchar *) "fdiv", 0x1A3, St, GOP_Float, 3 },
- { (uchar *) "fmod", 0x1A4, St|St2, GOP_Float, 4 },
- { (uchar *) "sqrt", 0x1A8, St, GOP_Float, 2 },
- { (uchar *) "exp", 0x1A9, St, GOP_Float, 2 },
- { (uchar *) "log", 0x1AA, St, GOP_Float, 2 },
- { (uchar *) "pow", 0x1AB, St, GOP_Float, 3 },
- { (uchar *) "sin", 0x1B0, St, GOP_Float, 2 },
- { (uchar *) "cos", 0x1B1, St, GOP_Float, 2 },
- { (uchar *) "tan", 0x1B2, St, GOP_Float, 2 },
- { (uchar *) "asin", 0x1B3, St, GOP_Float, 2 },
- { (uchar *) "acos", 0x1B4, St, GOP_Float, 2 },
- { (uchar *) "atan", 0x1B5, St, GOP_Float, 2 },
- { (uchar *) "atan2", 0x1B6, St, GOP_Float, 3 },
- { (uchar *) "jfeq", 0x1C0, Br, GOP_Float, 4 },
- { (uchar *) "jfne", 0x1C1, Br, GOP_Float, 4 },
- { (uchar *) "jflt", 0x1C2, Br, GOP_Float, 3 },
- { (uchar *) "jfle", 0x1C3, Br, GOP_Float, 3 },
- { (uchar *) "jfgt", 0x1C4, Br, GOP_Float, 3 },
- { (uchar *) "jfge", 0x1C5, Br, GOP_Float, 3 },
- { (uchar *) "jisnan", 0x1C8, Br, GOP_Float, 2 },
- { (uchar *) "jisinf", 0x1C9, Br, GOP_Float, 2 },
-};
-
-/* The opmacros table is used for fake opcodes. The opcode numbers are
- ignored; this table is only used for argument parsing. */
-static opcodeg opmacros_table_g[] = {
- { (uchar *) "pull", 0, St, 0, 1 },
- { (uchar *) "push", 0, 0, 0, 1 },
-};
-
-static opcodeg custom_opcode_g;
-
-static opcodez internal_number_to_opcode_z(int32 i)
-{ opcodez x;
- ASSERT_ZCODE();
- if (i == -1) return custom_opcode_z;
- x = opcodes_table_z[i];
- if (instruction_set_number < x.version1) return invalid_opcode_z;
- if (x.version2 == 0) return x;
- if (instruction_set_number <= x.version2) return x;
- i = x.extension;
- if (i < 0) return invalid_opcode_z;
- x = extension_table_z[i];
- if (instruction_set_number < x.version1) return invalid_opcode_z;
- if (x.version2 == 0) return x;
- if (instruction_set_number <= x.version2) return x;
- return extension_table_z[x.extension];
-}
-
-static void make_opcode_syntax_z(opcodez opco)
-{ char *p = "", *q = opcode_syntax_string;
- sprintf(q, "%s", opco.name);
- switch(opco.no)
- { case ONE: p=" <operand>"; break;
- case TWO: p=" <operand1> <operand2>"; break;
- case EXT:
- case VAR: p=" <0 to 4 operands>"; break;
- case VAR_LONG: p=" <0 to 8 operands>"; break;
- }
- switch(opco.op_rules)
- { case TEXT: sprintf(q+strlen(q), " <text>"); return;
- case LABEL: sprintf(q+strlen(q), " <label>"); return;
- case VARIAB:
- sprintf(q+strlen(q), " <variable>");
- case CALL:
- if (opco.op_rules==CALL) sprintf(q+strlen(q), " <routine>");
- switch(opco.no)
- { case ONE: p=""; break;
- case TWO: p=" <operand>"; break;
- case EXT:
- case VAR: p=" <1 to 4 operands>"; break;
- case VAR_LONG: p=" <1 to 8 operands>"; break;
- }
- break;
- }
- sprintf(q+strlen(q), "%s", p);
- if ((opco.flags & St) != 0) sprintf(q+strlen(q), " -> <result-variable>");
- if ((opco.flags & Br) != 0) sprintf(q+strlen(q), " ?[~]<label>");
-}
-
-static opcodeg internal_number_to_opcode_g(int32 i)
-{
- opcodeg x;
- if (i == -1) return custom_opcode_g;
- x = opcodes_table_g[i];
- return x;
-}
-
-static opcodeg internal_number_to_opmacro_g(int32 i)
-{
- return opmacros_table_g[i];
-}
-
-static void make_opcode_syntax_g(opcodeg opco)
-{
- int ix;
- char *cx;
- char *q = opcode_syntax_string;
-
- sprintf(q, "%s", opco.name);
- sprintf(q+strlen(q), " <%d operand%s", opco.no,
- ((opco.no==1) ? "" : "s"));
- if (opco.no) {
- cx = q+strlen(q);
- strcpy(cx, ": ");
- cx += strlen(cx);
- for (ix=0; ix<opco.no; ix++) {
- if (ix) {
- *cx = ' ';
- cx++;
- }
- if (ix == opco.no-1) {
- if (opco.flags & Br) {
- strcpy(cx, "Lb");
- }
- else if (opco.flags & St) {
- strcpy(cx, "S");
- }
- else {
- strcpy(cx, "L");
- }
- }
- else if (ix == opco.no-2 && (opco.flags & Br) && (opco.flags & St)) {
- strcpy(cx, "S");
- }
- else if (ix == opco.no-2 && (opco.flags & St2)) {
- strcpy(cx, "S");
- }
- else {
- strcpy(cx, "L");
- }
- cx += strlen(cx);
- sprintf(cx, "%d", ix+1);
- cx += strlen(cx);
- }
- }
- sprintf(q+strlen(q), ">");
-}
-
-
-/* ========================================================================= */
-/* The assembler itself does four things: */
-/* */
-/* assembles instructions */
-/* sets label N to the current code position */
-/* assembles routine headers */
-/* assembles routine ends */
-/* ------------------------------------------------------------------------- */
-
-/* This is for Z-code only. */
-static void write_operand(assembly_operand op)
-{ int32 j;
- if (module_switch && (op.marker != 0))
- { if ((op.marker != VARIABLE_MV) && (op.type == SHORT_CONSTANT_OT))
- op.type = LONG_CONSTANT_OT;
- }
- j=op.value;
- switch(op.type)
- { case LONG_CONSTANT_OT:
- byteout(j/256, op.marker); byteout(j%256, 0); return;
- case SHORT_CONSTANT_OT:
- if (op.marker == 0)
- byteout(j, 0);
- else byteout(j, 0x80 + op.marker); return;
- case VARIABLE_OT:
- byteout(j, (module_switch)?(0x80 + op.marker):0); return;
- case CONSTANT_OT:
- case HALFCONSTANT_OT:
- case BYTECONSTANT_OT:
- case ZEROCONSTANT_OT:
- case SYSFUN_OT:
- case DEREFERENCE_OT:
- case LOCALVAR_OT:
- case GLOBALVAR_OT:
- compiler_error("Glulx OT in Z-code assembly operand.");
- return;
- }
-}
-
-extern void assemblez_instruction(assembly_instruction *AI)
-{
- uchar *start_pc, *operands_pc;
- int32 offset, j, topbits=0, types_byte1, types_byte2;
- int operand_rules, min=0, max=0, no_operands_given, at_seq_point = FALSE;
- assembly_operand o1, o2;
- opcodez opco;
-
- ASSERT_ZCODE();
-
- offset = zmachine_pc;
-
- no_instructions++;
-
- if (veneer_mode) sequence_point_follows = FALSE;
- if (sequence_point_follows)
- { sequence_point_follows = FALSE; at_seq_point = TRUE;
- if (debugfile_switch)
- { sequence_point_labels[next_sequence_point] = next_label;
- sequence_point_locations[next_sequence_point] =
- statement_debug_location;
- set_label_offset(next_label++, zmachine_pc);
- }
- next_sequence_point++;
- }
-
- opco = internal_number_to_opcode_z(AI->internal_number);
- if (opco.version1==0)
- { error_named("Opcode unavailable in this Z-machine version",
- opcode_names.keywords[AI->internal_number]);
- return;
- }
-
- if (execution_never_reaches_here)
- warning("This statement can never be reached");
-
- operand_rules = opco.op_rules;
- execution_never_reaches_here = ((opco.flags & Rf) != 0);
-
- if (opco.flags2_set != 0) flags2_requirements[opco.flags2_set] = 1;
-
- no_operands_given = AI->operand_count;
-
- if ((opco.no == TWO) && ((no_operands_given==3)||(no_operands_given==4)))
- opco.no = VAR;
-
- /* 1. Write the opcode byte(s) */
-
- start_pc = zcode_holding_area + zcode_ha_size;
-
- switch(opco.no)
- { case VAR_LONG: topbits=0xc0; min=0; max=8; break;
- case VAR: topbits=0xc0; min=0; max=4; break;
- case ZERO: topbits=0xb0; min=0; max=0; break;
- case ONE: topbits=0x80; min=1; max=1; break;
- case TWO: topbits=0x00; min=2; max=2; break;
- case EXT: topbits=0x00; min=0; max=4;
- byteout(0xbe, 0); opco.no=VAR; break;
- case EXT_LONG: topbits=0x00; min=0; max=8;
- byteout(0xbe, 0); opco.no=VAR_LONG; break;
- }
- byteout(opco.code + topbits, 0);
-
- operands_pc = zcode_holding_area + zcode_ha_size;
-
- /* 2. Dispose of the special rules LABEL and TEXT */
-
- if (operand_rules==LABEL)
- { j = (AI->operand[0]).value;
- byteout(j/256, LABEL_MV); byteout(j%256, 0);
- goto Instruction_Done;
- }
-
- if (operand_rules==TEXT)
- { int32 i;
- uchar *tmp = translate_text(zcode_holding_area + zcode_ha_size, zcode_holding_area+MAX_ZCODE_SIZE, AI->text);
- if (!tmp)
- memoryerror("MAX_ZCODE_SIZE", MAX_ZCODE_SIZE);
- j = subtract_pointers(tmp, (zcode_holding_area + zcode_ha_size));
- for (i=0; i<j; i++) zcode_markers[zcode_ha_size++] = 0;
- zmachine_pc += j;
- goto Instruction_Done;
- }
-
- /* 3. Sort out the operands */
-
- if ((no_operands_given < min) || (no_operands_given > max))
- goto OpcodeSyntaxError;
-
- switch(opco.no)
- { case VAR:
- case VAR_LONG:
- byteout(0, 0);
- if (opco.no == VAR_LONG) byteout(0, 0);
- types_byte1=0xff; types_byte2=0xff;
- for (j=0; j<no_operands_given; j++)
- { int multi=0, mask=0;
- switch(j)
- { case 0: case 4: multi=0x40; mask=0xc0; break;
- case 1: case 5: multi=0x10; mask=0x30; break;
- case 2: case 6: multi=0x04; mask=0x0c; break;
- case 3: case 7: multi=0x01; mask=0x03; break;
- }
- o1 = AI->operand[j];
- write_operand(o1);
- if (j<4)
- types_byte1 = (types_byte1 & (~mask)) + o1.type*multi;
- else
- types_byte2 = (types_byte2 & (~mask)) + o1.type*multi;
- }
- *operands_pc=types_byte1;
- if (opco.no == VAR_LONG) *(operands_pc+1)=types_byte2;
- break;
-
- case ONE:
- o1 = AI->operand[0];
- *start_pc=(*start_pc) + o1.type*0x10;
- write_operand(o1);
- break;
-
- case TWO:
- o1 = AI->operand[0];
- o2 = AI->operand[1];
-
- /* Transfer to VAR form if either operand is a long constant */
-
- if ((o1.type==LONG_CONSTANT_OT)||(o2.type==LONG_CONSTANT_OT))
- { *start_pc=(*start_pc) + 0xc0;
- byteout(o1.type*0x40 + o2.type*0x10 + 0x0f, 0);
- }
- else
- { if (o1.type==VARIABLE_OT) *start_pc=(*start_pc) + 0x40;
- if (o2.type==VARIABLE_OT) *start_pc=(*start_pc) + 0x20;
- }
- write_operand(o1);
- write_operand(o2);
- break;
- }
-
- /* 4. Assemble a Store destination, if needed */
-
- if ((AI->store_variable_number) != -1)
- { if (AI->store_variable_number >= MAX_LOCAL_VARIABLES+MAX_GLOBAL_VARIABLES) {
- goto OpcodeSyntaxError;
- }
- o1.type = VARIABLE_OT;
- o1.value = AI->store_variable_number;
- variable_usage[o1.value] = TRUE;
- o1.marker = 0;
-
- /* Note that variable numbers 249 to 255 (i.e. globals 233 to 239)
- are used as scratch workspace, so need no mapping between
- modules and story files: nor do local variables 0 to 15 */
-
- if ((o1.value >= MAX_LOCAL_VARIABLES) && (o1.value < 249))
- o1.marker = VARIABLE_MV;
- write_operand(o1);
- }
-
- /* 5. Assemble a branch, if needed */
-
- if (AI->branch_label_number != -1)
- { int32 addr, long_form;
- int branch_on_true = (AI->branch_flag)?1:0;
-
- switch (AI->branch_label_number)
- { case -2: addr = 2; branch_on_true = 0; long_form = 0; break;
- /* branch nowhere, carry on */
- case -3: addr = 0; long_form = 0; break; /* rfalse on condition */
- case -4: addr = 1; long_form = 0; break; /* rtrue on condition */
- default:
- long_form = 1; addr = AI->branch_label_number;
- break;
- }
- if (addr > 0x7fff) fatalerror("Too many branch points in routine.");
- if (long_form==1)
- { byteout(branch_on_true*0x80 + addr/256, BRANCH_MV);
- byteout(addr%256, 0);
- }
- else
- byteout(branch_on_true*0x80+ 0x40 + (addr&0x3f), 0);
- }
-
- Instruction_Done:
-
- if (asm_trace_level > 0)
- { int i;
- printf("%5d +%05lx %3s %-12s ", ErrorReport.line_number,
- ((long int) offset),
- (at_seq_point)?"<*>":" ", opco.name);
-
- if ((AI->internal_number == print_zc)
- || (AI->internal_number == print_ret_zc))
- { printf("\"");
- for (i=0;(AI->text)[i]!=0 && i<35; i++) printf("%c",(AI->text)[i]);
- if (i == 35) printf("...");
- printf("\"");
- }
-
- for (i=0; i<AI->operand_count; i++)
- { if ((i==0) && (opco.op_rules == VARIAB))
- { if ((AI->operand[0]).type == VARIABLE_OT)
- { printf("["); print_operand_z(AI->operand[i]); }
- else
- printf("%s", variable_name((AI->operand[0]).value));
- }
- else
- if ((i==0) && (opco.op_rules == LABEL))
- { printf("L%d", AI->operand[0].value);
- }
- else print_operand_z(AI->operand[i]);
- printf(" ");
- }
- if (AI->store_variable_number != -1)
- { assembly_operand AO;
- printf("-> ");
- AO.type = VARIABLE_OT; AO.value = AI->store_variable_number;
- print_operand_z(AO); printf(" ");
- }
-
- switch(AI->branch_label_number)
- { case -4: printf("rtrue if %s", (AI->branch_flag)?"TRUE":"FALSE");
- break;
- case -3: printf("rfalse if %s", (AI->branch_flag)?"TRUE":"FALSE");
- break;
- case -2: printf("(no branch)"); break;
- case -1: break;
- default:
- printf("to L%d if %s", AI->branch_label_number,
- (AI->branch_flag)?"TRUE":"FALSE"); break;
- }
-
- if (asm_trace_level>=2)
- { for (j=0;start_pc<zcode_holding_area + zcode_ha_size;
- j++, start_pc++)
- { if (j%16==0) printf("\n ");
- printf("%02x ", *start_pc);
- }
- }
- printf("\n");
- }
-
- if (module_switch) flush_link_data();
-
- return;
-
- OpcodeSyntaxError:
-
- make_opcode_syntax_z(opco);
- error_named("Assembly mistake: syntax is", opcode_syntax_string);
-}
-
-static void assembleg_macro(assembly_instruction *AI)
-{
- /* validate macro syntax first */
- int ix, no_operands_given;
- opcodeg opco;
-
- opco = internal_number_to_opmacro_g(AI->internal_number);
- no_operands_given = AI->operand_count;
-
- if (no_operands_given != opco.no)
- goto OpcodeSyntaxError;
-
- for (ix = 0; ix < no_operands_given; ix++) {
- int type = AI->operand[ix].type;
- if ((opco.flags & St)
- && ((!(opco.flags & Br) && (ix == no_operands_given-1))
- || ((opco.flags & Br) && (ix == no_operands_given-2)))) {
- if (is_constant_ot(type)) {
- error("*** assembly macro tried to store to a constant ***");
- goto OpcodeSyntaxError;
- }
- }
- if ((opco.flags & St2)
- && (ix == no_operands_given-2)) {
- if (is_constant_ot(type)) {
- error("*** assembly macro tried to store to a constant ***");
- goto OpcodeSyntaxError;
- }
- }
- }
-
- /* expand the macro */
- switch (AI->internal_number) {
- case pull_gm:
- assembleg_store(AI->operand[0], stack_pointer);
- break;
-
- case push_gm:
- assembleg_store(stack_pointer, AI->operand[0]);
- break;
-
- default:
- compiler_error("Invalid Glulx assembly macro");
- break;
- }
-
- return;
-
- OpcodeSyntaxError:
-
- make_opcode_syntax_g(opco);
- error_named("Assembly mistake: syntax is", opcode_syntax_string);
-}
-
-extern void assembleg_instruction(assembly_instruction *AI)
-{
- uchar *start_pc, *opmodes_pc;
- int32 offset, j;
- int no_operands_given, at_seq_point = FALSE;
- int ix, k;
- opcodeg opco;
-
- ASSERT_GLULX();
-
- offset = zmachine_pc;
-
- no_instructions++;
-
- if (veneer_mode) sequence_point_follows = FALSE;
- if (sequence_point_follows)
- { sequence_point_follows = FALSE; at_seq_point = TRUE;
- if (debugfile_switch)
- { sequence_point_labels[next_sequence_point] = next_label;
- sequence_point_locations[next_sequence_point] =
- statement_debug_location;
- set_label_offset(next_label++, zmachine_pc);
- }
- next_sequence_point++;
- }
-
- opco = internal_number_to_opcode_g(AI->internal_number);
-
- if (execution_never_reaches_here)
- warning("This statement can never be reached");
-
- execution_never_reaches_here = ((opco.flags & Rf) != 0);
-
- if (opco.op_rules & GOP_Unicode) {
- uses_unicode_features = TRUE;
- }
- if (opco.op_rules & GOP_MemHeap) {
- uses_memheap_features = TRUE;
- }
- if (opco.op_rules & GOP_Acceleration) {
- uses_acceleration_features = TRUE;
- }
- if (opco.op_rules & GOP_Float) {
- uses_float_features = TRUE;
- }
-
- no_operands_given = AI->operand_count;
-
- /* 1. Write the opcode byte(s) */
-
- start_pc = zcode_holding_area + zcode_ha_size;
-
- if (opco.code < 0x80) {
- byteout(opco.code, 0);
- }
- else if (opco.code < 0x4000) {
- byteout(((opco.code >> 8) & 0xFF) | 0x80, 0);
- byteout((opco.code & 0xFF), 0);
- }
- else {
- byteout(((opco.code >> 24) & 0xFF) | 0xC0, 0);
- byteout(((opco.code >> 16) & 0xFF), 0);
- byteout(((opco.code >> 8) & 0xFF), 0);
- byteout(((opco.code) & 0xFF), 0);
- }
-
- /* ... and the operand addressing modes. There's one byte for
- every two operands (rounded up). We write zeroes for now;
- when the operands are written, we'll go back and fix them. */
-
- opmodes_pc = zcode_holding_area + zcode_ha_size;
-
- for (ix=0; ix<opco.no; ix+=2) {
- byteout(0, 0);
- }
-
- /* 2. Dispose of the special rules */
- /* There aren't any in Glulx. */
-
- /* 3. Sort out the operands */
-
- if (no_operands_given != opco.no) {
- goto OpcodeSyntaxError;
- }
-
- for (ix=0; ix<no_operands_given; ix++) {
- int marker = AI->operand[ix].marker;
- int type = AI->operand[ix].type;
- k = AI->operand[ix].value;
-
- if ((opco.flags & Br) && (ix == no_operands_given-1)) {
- if (!(marker >= BRANCH_MV && marker < BRANCHMAX_MV)) {
- compiler_error("Assembling branch without BRANCH_MV marker");
- goto OpcodeSyntaxError;
- }
- if (k == -2) {
- k = 2; /* branch no-op */
- type = BYTECONSTANT_OT;
- marker = 0;
- }
- else if (k == -3) {
- k = 0; /* branch return 0 */
- type = ZEROCONSTANT_OT;
- marker = 0;
- }
- else if (k == -4) {
- k = 1; /* branch return 1 */
- type = BYTECONSTANT_OT;
- marker = 0;
- }
- else {
- /* branch to label k */
- j = subtract_pointers((zcode_holding_area + zcode_ha_size),
- opmodes_pc);
- j = 2*j - ix;
- marker = BRANCH_MV + j;
- if (!(marker >= BRANCH_MV && marker < BRANCHMAX_MV)) {
- error("*** branch marker too far from opmode byte ***");
- goto OpcodeSyntaxError;
- }
- }
- }
- if ((opco.flags & St)
- && ((!(opco.flags & Br) && (ix == no_operands_given-1))
- || ((opco.flags & Br) && (ix == no_operands_given-2)))) {
- if (type == BYTECONSTANT_OT || type == HALFCONSTANT_OT
- || type == CONSTANT_OT) {
- error("*** instruction tried to store to a constant ***");
- goto OpcodeSyntaxError;
- }
- }
- if ((opco.flags & St2)
- && (ix == no_operands_given-2)) {
- if (type == BYTECONSTANT_OT || type == HALFCONSTANT_OT
- || type == CONSTANT_OT) {
- error("*** instruction tried to store to a constant ***");
- goto OpcodeSyntaxError;
- }
- }
-
- if (marker && (type == HALFCONSTANT_OT
- || type == BYTECONSTANT_OT
- || type == ZEROCONSTANT_OT)) {
- compiler_error("Assembling marker in less than 32-bit constant.");
- /* Actually we should store marker|0x80 for a byte constant,
- but let's hold off on that. */
- }
-
- switch (type) {
- case LONG_CONSTANT_OT:
- case SHORT_CONSTANT_OT:
- case VARIABLE_OT:
- j = 0;
- compiler_error("Z-code OT in Glulx assembly operand.");
- break;
- case CONSTANT_OT:
- j = 3;
- byteout((k >> 24) & 0xFF, marker);
- byteout((k >> 16) & 0xFF, 0);
- byteout((k >> 8) & 0xFF, 0);
- byteout((k & 0xFF), 0);
- break;
- case HALFCONSTANT_OT:
- j = 2;
- byteout((k >> 8) & 0xFF, marker);
- byteout((k & 0xFF), 0);
- break;
- case BYTECONSTANT_OT:
- j = 1;
- byteout((k & 0xFF), marker);
- break;
- case ZEROCONSTANT_OT:
- j = 0;
- break;
- case DEREFERENCE_OT:
- j = 7;
- byteout((k >> 24) & 0xFF, marker);
- byteout((k >> 16) & 0xFF, 0);
- byteout((k >> 8) & 0xFF, 0);
- byteout((k & 0xFF), 0);
- break;
- case GLOBALVAR_OT:
- /* Global variable -- a constant address. */
- k -= MAX_LOCAL_VARIABLES;
- if (/* DISABLES CODE */ (0)) {
- /* We could write the value as a marker and patch it later... */
- j = 7;
- byteout(((k) >> 24) & 0xFF, VARIABLE_MV);
- byteout(((k) >> 16) & 0xFF, 0);
- byteout(((k) >> 8) & 0xFF, 0);
- byteout(((k) & 0xFF), 0);
- }
- else {
- /* ...but it's more efficient to write it as a RAM operand,
- which can be 1, 2, or 4 bytes. Remember that global variables
- are the very first thing in RAM. */
- k = k * 4; /* each variable is four bytes */
- if (k <= 255) {
- j = 13;
- byteout(((k) & 0xFF), 0);
- }
- else if (k <= 65535) {
- j = 14;
- byteout(((k) >> 8) & 0xFF, 0);
- byteout(((k) & 0xFF), 0);
- }
- else {
- j = 15;
- byteout(((k) >> 24) & 0xFF, 0);
- byteout(((k) >> 16) & 0xFF, 0);
- byteout(((k) >> 8) & 0xFF, 0);
- byteout(((k) & 0xFF), 0);
- }
- }
- break;
- case LOCALVAR_OT:
- if (k == 0) {
- /* Stack-pointer magic variable */
- j = 8;
- }
- else {
- /* Local variable -- a byte or short offset from the
- frame pointer. It's an unsigned offset, so we can
- fit up to long 63 (offset 4*63) in a byte. */
- if ((k-1) < 64) {
- j = 9;
- byteout((k-1)*4, 0);
- }
- else {
- j = 10;
- byteout((((k-1)*4) >> 8) & 0xFF, 0);
- byteout(((k-1)*4) & 0xFF, 0);
- }
- }
- break;
- default:
- j = 0;
- break;
- }
-
- if (ix & 1)
- j = (j << 4);
- opmodes_pc[ix/2] |= j;
- }
-
- /* Print assembly trace. */
- if (asm_trace_level > 0) {
- int i;
- printf("%5d +%05lx %3s %-12s ", ErrorReport.line_number,
- ((long int) offset),
- (at_seq_point)?"<*>":" ", opco.name);
- for (i=0; i<AI->operand_count; i++) {
- if ((opco.flags & Br) && (i == opco.no-1)) {
- if (AI->operand[i].value == -4)
- printf("to rtrue");
- else if (AI->operand[i].value == -3)
- printf("to rfalse");
- else
- printf("to L%d", AI->operand[i].value);
- }
- else {
- print_operand_g(AI->operand[i]);
- }
- printf(" ");
- }
-
- if (asm_trace_level>=2) {
- for (j=0;
- start_pc<zcode_holding_area + zcode_ha_size;
- j++, start_pc++) {
- if (j%16==0) printf("\n ");
- if (/* DISABLES CODE */ (0)) {
- printf("%02x ", *start_pc);
- }
- else {
- printf("%02x", *start_pc);
- if (zcode_markers[start_pc-zcode_holding_area])
- printf("{%02x}", zcode_markers[start_pc-zcode_holding_area]);
- printf(" ");
- }
- }
- }
- printf("\n");
- }
-
- if (module_switch) flush_link_data();
-
- return;
-
- OpcodeSyntaxError:
-
- make_opcode_syntax_g(opco);
- error_named("Assembly mistake: syntax is", opcode_syntax_string);
-}
-
-extern void assemble_label_no(int n)
-{
- if (asm_trace_level > 0)
- printf("%5d +%05lx .L%d\n", ErrorReport.line_number,
- ((long int) zmachine_pc), n);
- set_label_offset(n, zmachine_pc);
- execution_never_reaches_here = FALSE;
-}
-
-extern void define_symbol_label(int symbol)
-{ label_symbols[svals[symbol]] = symbol;
-}
-
-extern int32 assemble_routine_header(int no_locals,
- int routine_asterisked, char *name, int embedded_flag, int the_symbol)
-{ int i, rv;
- int stackargs = FALSE;
- int name_length;
-
- execution_never_reaches_here = FALSE;
-
- routine_locals = no_locals;
- for (i=0; i<MAX_LOCAL_VARIABLES; i++) variable_usage[i] = FALSE;
-
- if (no_locals >= 1
- && !strcmp(local_variables.keywords[0], "_vararg_count")) {
- stackargs = TRUE;
- }
-
- if (veneer_mode) routine_starts_line = blank_brief_location;
- else routine_starts_line = get_brief_location(&ErrorReport);
-
- if (asm_trace_level > 0)
- { printf("\n%5d +%05lx [ %s ", ErrorReport.line_number,
- ((long int) zmachine_pc), name);
- for (i=1; i<=no_locals; i++) printf("%s ", variable_name(i));
- printf("\n\n");
- }
-
- routine_start_pc = zmachine_pc;
-
- if (track_unused_routines) {
- /* The name of an embedded function is in a temporary buffer,
- so we shouldn't keep a reference to it. (It is sad that we
- have to know this here.) */
- char *funcname = name;
- if (embedded_flag)
- funcname = "<embedded>";
-
- df_note_function_start(funcname, zmachine_pc, embedded_flag,
- routine_starts_line);
- }
-
- routine_symbol = the_symbol;
- name_length = strlen(name) + 1;
- routine_name =
- my_malloc(name_length * sizeof(char), "temporary copy of routine name");
- strncpy(routine_name, name, name_length);
-
- /* Update the routine counter */
-
- no_routines++;
-
- /* Actually assemble the routine header into the code area; note */
- /* Inform doesn't support the setting of local variables to default */
- /* values other than 0 in V3 and V4. (In V5+ the Z-Machine doesn't */
- /* provide the possibility in any case.) */
-
- if (!glulx_mode) {
-
- if (stackargs)
- warning("Z-code does not support stack-argument function definitions.");
-
- byteout(no_locals, 0);
-
- /* Not the packed address, but the scaled offset from code area start: */
-
- rv = zmachine_pc/scale_factor;
-
- if (instruction_set_number<5)
- for (i=0; i<no_locals; i++) { byteout(0,0); byteout(0,0); }
-
- next_label = 0; next_sequence_point = 0; last_label = -1;
-
- /* Compile code to print out text like "a=3, b=4, c=5" when the */
- /* function is called, if it's required. */
-
- if ((routine_asterisked) || (define_INFIX_switch))
- { char fnt[256]; assembly_operand PV, RFA, CON, STP, SLF; int ln, ln2;
-
- ln = next_label++;
- ln2 = next_label++;
-
- if (define_INFIX_switch)
- {
- if (embedded_flag)
- { SLF.value = 251; SLF.type = VARIABLE_OT; SLF.marker = 0;
- CON.value = 0; CON.type = SHORT_CONSTANT_OT; CON.marker = 0;
- assemblez_2_branch(test_attr_zc, SLF, CON, ln2, FALSE);
- }
- else
- { i = no_named_routines++;
- named_routine_symbols[i] = the_symbol;
- CON.value = i/8; CON.type = LONG_CONSTANT_OT; CON.marker = 0;
- RFA.value = routine_flags_array_SC;
- RFA.type = LONG_CONSTANT_OT; RFA.marker = INCON_MV;
- STP.value = 0; STP.type = VARIABLE_OT; STP.marker = 0;
- assemblez_2_to(loadb_zc, RFA, CON, STP);
- CON.value = (1 << (i%8)); CON.type = SHORT_CONSTANT_OT;
- assemblez_2_to(and_zc, STP, CON, STP);
- assemblez_1_branch(jz_zc, STP, ln2, TRUE);
- }
- }
- sprintf(fnt, "[ %s(", name);
- AI.text = fnt; assemblez_0(print_zc);
- for (i=1; (i<=7)&&(i<=no_locals); i++)
- { if (version_number >= 5)
- { PV.type = SHORT_CONSTANT_OT;
- PV.value = i; PV.marker = 0;
- assemblez_1_branch(check_arg_count_zc, PV, ln, FALSE);
- }
- sprintf(fnt, "%s%s = ", (i==1)?"":", ", variable_name(i));
- AI.text = fnt; assemblez_0(print_zc);
- PV.type = VARIABLE_OT; PV.value = i; PV.marker = 0;
- assemblez_1(print_num_zc, PV);
- }
- assemble_label_no(ln);
- sprintf(fnt, ") ]^"); AI.text = fnt;
- assemblez_0(print_zc);
- assemble_label_no(ln2);
- }
-
- }
- else {
- rv = zmachine_pc;
-
- if (stackargs)
- byteout(0xC0, 0); /* Glulx type byte for function */
- else
- byteout(0xC1, 0); /* Glulx type byte for function */
-
- /* Now the locals format list. This is simple; we only use
- four-byte locals. That's a single pair, unless we have more
- than 255 locals, or none at all. */
- i = no_locals;
- while (i) {
- int j = i;
- if (j > 255)
- j = 255;
- byteout(4, 0);
- byteout(j, 0);
- i -= j;
- }
- /* Terminate the list with a (0, 0) pair. */
- byteout(0, 0);
- byteout(0, 0);
-
- if (stackargs) {
- /* The top stack value is the number of function arguments. Let's
- move that into the first local, which is _vararg_count. */
- /* @copy sp _vararg_count; */
- byteout(0x40, 0); byteout(0x98, 0); byteout(0x00, 0);
- }
-
- next_label = 0; next_sequence_point = 0; last_label = -1;
-
- if ((routine_asterisked) || (define_INFIX_switch)) {
- int ix;
- char fnt[256];
- assembly_operand AO, AO2;
- if (define_INFIX_switch) {
- /* This isn't supported */
- if (embedded_flag) {
- }
- else {
- i = no_named_routines++;
- named_routine_symbols[i] = the_symbol;
- }
- }
- sprintf(fnt, "[ %s(", name);
- AO.marker = STRING_MV;
- AO.type = CONSTANT_OT;
- AO.value = compile_string(fnt, FALSE, FALSE);
- assembleg_1(streamstr_gc, AO);
-
- if (!stackargs) {
- for (ix=1; ix<=no_locals; ix++) {
- sprintf(fnt, "%s%s = ", (ix==1)?"":", ", variable_name(ix));
- AO.marker = STRING_MV;
- AO.type = CONSTANT_OT;
- AO.value = compile_string(fnt, FALSE, FALSE);
- assembleg_1(streamstr_gc, AO);
- AO.marker = 0;
- AO.type = LOCALVAR_OT;
- AO.value = ix;
- assembleg_1(streamnum_gc, AO);
- }
- }
- else {
- int lntop, lnbottom;
- sprintf(fnt, "%s = ", variable_name(1));
- AO.marker = STRING_MV;
- AO.type = CONSTANT_OT;
- AO.value = compile_string(fnt, FALSE, FALSE);
- assembleg_1(streamstr_gc, AO);
- AO.marker = 0;
- AO.type = LOCALVAR_OT;
- AO.value = 1;
- assembleg_1(streamnum_gc, AO);
- AO2.type = BYTECONSTANT_OT;
- AO2.marker = 0;
- AO2.value = ':';
- assembleg_1(streamchar_gc, AO2);
- AO2.type = BYTECONSTANT_OT;
- AO2.marker = 0;
- AO2.value = ' ';
- /* for (temp_var4=0 : temp_var4<_vararg_count : temp_var4++) {
- @streamchar ' ';
- @stkpeek temp_var4 sp;
- @stream_num sp;
- }
- */
- assembleg_store(temp_var4, zero_operand);
- lntop = next_label++;
- lnbottom = next_label++;
- assemble_label_no(lntop);
- assembleg_2_branch(jge_gc, temp_var4, AO, lnbottom); /* AO is _vararg_count */
- assembleg_1(streamchar_gc, AO2); /* AO2 is space */
- assembleg_2(stkpeek_gc, temp_var4, stack_pointer);
- assembleg_1(streamnum_gc, stack_pointer);
- assembleg_3(add_gc, temp_var4, one_operand, temp_var4);
- assembleg_0_branch(jump_gc, lntop);
- assemble_label_no(lnbottom);
- }
-
- AO.marker = STRING_MV;
- AO.type = CONSTANT_OT;
- AO.value = compile_string(") ]^", FALSE, FALSE);
- assembleg_1(streamstr_gc, AO);
- }
- }
-
- return rv;
-}
-
-void assemble_routine_end(int embedded_flag, debug_locations locations)
-{ int32 i;
-
- /* No marker is made in the Z-machine's code area to indicate the */
- /* end of a routine. Instead, we simply assemble a return opcode if */
- /* need be (it won't be if the last instruction was, say, a "quit"). */
- /* The return value is true (1) for normal routines, false (0) for */
- /* embedded routines (e.g. the library uses this for "before" */
- /* properties). */
-
- if (!execution_never_reaches_here)
- {
- if (!glulx_mode) {
- if (embedded_flag) assemblez_0(rfalse_zc);
- else assemblez_0(rtrue_zc);
- }
- else {
- assembly_operand AO;
- if (embedded_flag)
- AO = zero_operand;
- else
- AO = one_operand;
- assembleg_1(return_gc, AO);
- }
- }
-
- /* Dump the contents of the current routine into longer-term Z-code
- storage */
-
- if (!glulx_mode)
- transfer_routine_z();
- else
- transfer_routine_g();
-
- if (track_unused_routines)
- df_note_function_end(zmachine_pc);
-
- /* Tell the debugging file about the routine just ended. */
-
- if (debugfile_switch)
- {
- debug_file_printf("<routine>");
- if (embedded_flag)
- { debug_file_printf
- ("<identifier artificial=\"true\">%s</identifier>",
- routine_name);
- }
- else if (sflags[routine_symbol] & REPLACE_SFLAG)
- { /* The symbol type will be set to ROUTINE_T once the replaced
- version has been given; if it is already set, we must be dealing
- with a replacement, and we can use the routine name as-is.
- Otherwise we look for a rename. And if that doesn't work, we
- fall back to an artificial identifier. */
- if (stypes[routine_symbol] == ROUTINE_T)
- { /* Optional because there may be further replacements. */
- write_debug_optional_identifier(routine_symbol);
- }
- else if (find_symbol_replacement(&routine_symbol))
- { debug_file_printf
- ("<identifier>%s</identifier>", symbs[routine_symbol]);
- }
- else
- { debug_file_printf
- ("<identifier artificial=\"true\">%s (replaced)"
- "</identifier>",
- routine_name);
- }
- } else
- { debug_file_printf("<identifier>%s</identifier>", routine_name);
- }
- debug_file_printf("<value>");
- if (glulx_mode)
- { write_debug_code_backpatch(routine_start_pc);
- } else
- { write_debug_packed_code_backpatch(routine_start_pc);
- }
- debug_file_printf("</value>");
- debug_file_printf("<address>");
- write_debug_code_backpatch(routine_start_pc);
- debug_file_printf("</address>");
- debug_file_printf
- ("<byte-count>%d</byte-count>", zmachine_pc - routine_start_pc);
- write_debug_locations(locations);
- for (i = 1; i <= routine_locals; ++i)
- { debug_file_printf("<local-variable>");
- debug_file_printf("<identifier>%s</identifier>", variable_name(i));
- if (glulx_mode)
- { debug_file_printf
- ("<frame-offset>%d</frame-offset>", 4 * (i - 1));
- }
- else
- { debug_file_printf("<index>%d</index>", i);
- }
- debug_file_printf("</local-variable>");
- }
- for (i = 0; i < next_sequence_point; ++i)
- { debug_file_printf("<sequence-point>");
- debug_file_printf("<address>");
- write_debug_code_backpatch
- (label_offsets[sequence_point_labels[i]]);
- debug_file_printf("</address>");
- write_debug_location(sequence_point_locations[i]);
- debug_file_printf("</sequence-point>");
- }
- debug_file_printf("</routine>");
- }
-
- my_free(&routine_name, "temporary copy of routine name");
-
- /* Issue warnings about any local variables not used in the routine. */
-
- for (i=1; i<=routine_locals; i++)
- if (!(variable_usage[i]))
- dbnu_warning("Local variable", variable_name(i),
- routine_starts_line);
-
- for (i=0; i<next_label; i++)
- { int j = label_symbols[i];
- if (j != -1)
- { if (sflags[j] & CHANGE_SFLAG)
- error_named_at("Routine contains no such label as",
- (char *) symbs[j], slines[j]);
- else
- if ((sflags[j] & USED_SFLAG) == 0)
- dbnu_warning("Label", (char *) symbs[j], slines[j]);
- stypes[j] = CONSTANT_T;
- sflags[j] = UNKNOWN_SFLAG;
- }
- }
- no_sequence_points += next_sequence_point;
- next_label = 0; next_sequence_point = 0;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Called when the holding area contains an entire routine of code: */
-/* backpatches the labels, issues module markers, then dumps the routine */
-/* into longer-term storage. */
-/* Note that in the code received, all branches have long form, and their */
-/* contents are not an offset but the label numbers they branch to. */
-/* Similarly, LABEL operands (those of "jump" instructions) are label */
-/* numbers. So this routine must change the label numbers to offsets, */
-/* slimming the code down as it does so to take advantage of short-form */
-/* branch operands where possible. */
-/* ------------------------------------------------------------------------- */
-
-static int32 adjusted_pc;
-
-static void transfer_to_temp_file(uchar *c)
-{ fputc(*c,Temp2_fp);
- adjusted_pc++;
-}
-
-static void transfer_to_zcode_area(uchar *c)
-{ write_byte_to_memory_block(&zcode_area, adjusted_pc++, *c);
-}
-
-static void transfer_routine_z(void)
-{ int32 i, j, pc, new_pc, label, long_form, offset_of_next, addr,
- branch_on_true, rstart_pc;
- void (* transfer_byte)(uchar *);
-
- adjusted_pc = zmachine_pc - zcode_ha_size; rstart_pc = adjusted_pc;
-
- if (asm_trace_level >= 3)
- { printf("Backpatching routine at %05lx: initial size %d, %d labels\n",
- (long int) adjusted_pc, zcode_ha_size, next_label);
- }
-
- transfer_byte =
- (temporary_files_switch)?transfer_to_temp_file:transfer_to_zcode_area;
-
- /* (1) Scan through for branches and make short/long decisions in each
- case. Mark omitted bytes (2nd bytes in branches converted to
- short form) with DELETED_MV. */
-
- for (i=0, pc=adjusted_pc; i<zcode_ha_size; i++, pc++)
- { if (zcode_markers[i] == BRANCH_MV)
- { if (asm_trace_level >= 4)
- printf("Branch detected at offset %04x\n", pc);
- j = (256*zcode_holding_area[i] + zcode_holding_area[i+1]) & 0x7fff;
- if (asm_trace_level >= 4)
- printf("To label %d, which is %d from here\n",
- j, label_offsets[j]-pc);
- if ((label_offsets[j] >= pc+2) && (label_offsets[j] < pc+64))
- { if (asm_trace_level >= 4) printf("Short form\n");
- zcode_markers[i+1] = DELETED_MV;
- }
- }
- }
-
- /* (2) Calculate the new positions of the labels. Note that since the
- long/short decision was taken on the basis of the old labels,
- and since the new labels are slightly closer together because
- of branch bytes deleted, there may be a few further branch
- optimisations which are possible but which have been missed
- (if two labels move inside the "short" range as a result of
- a previous optimisation). However, this is acceptably uncommon. */
-
- if (next_label > 0)
- { if (asm_trace_level >= 4)
- { printf("Opening label: %d\n", first_label);
- for (i=0;i<next_label;i++)
- printf("Label %d offset %04x next -> %d previous -> %d\n",
- i, label_offsets[i], label_next[i], label_prev[i]);
- }
-
- for (i=0, pc=adjusted_pc, new_pc=adjusted_pc, label = first_label;
- i<zcode_ha_size; i++, pc++)
- { while ((label != -1) && (label_offsets[label] == pc))
- { if (asm_trace_level >= 4)
- printf("Position of L%d corrected from %04x to %04x\n",
- label, label_offsets[label], new_pc);
- label_offsets[label] = new_pc;
- label = label_next[label];
- }
- if (zcode_markers[i] != DELETED_MV) new_pc++;
- }
- }
-
- /* (3) As we are transferring, replace the label numbers in branch
- operands with offsets to those labels. Also issue markers, now
- that we know where they occur in the final Z-code area. */
-
- for (i=0, new_pc=adjusted_pc; i<zcode_ha_size; i++)
- { switch(zcode_markers[i])
- { case BRANCH_MV:
- long_form = 1; if (zcode_markers[i+1] == DELETED_MV) long_form = 0;
-
- j = (256*zcode_holding_area[i] + zcode_holding_area[i+1]) & 0x7fff;
- branch_on_true = ((zcode_holding_area[i]) & 0x80);
- offset_of_next = new_pc + long_form + 1;
-
- addr = label_offsets[j] - offset_of_next + 2;
- if (addr<-0x2000 || addr>0x1fff)
- fatalerror("Branch out of range: divide the routine up?");
- if (addr<0) addr+=(int32) 0x10000L;
-
- addr=addr&0x3fff;
- if (long_form==1)
- { zcode_holding_area[i] = branch_on_true + addr/256;
- zcode_holding_area[i+1] = addr%256;
- }
- else
- { if (addr >= 64)
- { compiler_error("Label out of range for branch");
- printf("Addr is %04x\n", addr);
- }
- zcode_holding_area[i] = branch_on_true + 0x40 + (addr&0x3f);
- }
- transfer_byte(zcode_holding_area + i); new_pc++;
- break;
-
- case LABEL_MV:
- j = 256*zcode_holding_area[i] + zcode_holding_area[i+1];
- addr = label_offsets[j] - new_pc;
- if (addr<-0x8000 || addr>0x7fff)
- fatalerror("Jump out of range: divide the routine up?");
- if (addr<0) addr += (int32) 0x10000L;
- zcode_holding_area[i] = addr/256;
- zcode_holding_area[i+1] = addr%256;
- transfer_byte(zcode_holding_area + i); new_pc++;
- break;
-
- case DELETED_MV:
- break;
-
- default:
- switch(zcode_markers[i] & 0x7f)
- { case NULL_MV: break;
- case VARIABLE_MV:
- case OBJECT_MV:
- case ACTION_MV:
- case IDENT_MV:
- if (!module_switch) break;
- default:
- if ((zcode_markers[i] & 0x7f) > LARGEST_BPATCH_MV)
- { compiler_error("Illegal code backpatch value");
- printf("Illegal value of %02x at PC = %04x\n",
- zcode_markers[i] & 0x7f, new_pc);
- break;
- }
-
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++,
- zcode_markers[i] + 32*(new_pc/65536));
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, (new_pc/256)%256);
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, new_pc%256);
- break;
- }
- transfer_byte(zcode_holding_area + i); new_pc++;
- break;
- }
- }
-
- if (asm_trace_level >= 3)
- { printf("After branch optimisation, routine length is %d bytes\n",
- new_pc - rstart_pc);
- }
-
- /* Insert null bytes if necessary to ensure the next routine address is */
- /* expressible as a packed address */
-
- { uchar zero[1];
- zero[0] = 0;
- if (oddeven_packing_switch)
- while ((adjusted_pc%(scale_factor*2))!=0) transfer_byte(zero);
- else
- while ((adjusted_pc%scale_factor)!=0) transfer_byte(zero);
- }
-
- zmachine_pc = adjusted_pc;
- zcode_ha_size = 0;
-}
-
-static void transfer_routine_g(void)
-{ int32 i, j, pc, new_pc, label, form_len, offset_of_next, addr,
- rstart_pc;
- void (* transfer_byte)(uchar *);
-
- adjusted_pc = zmachine_pc - zcode_ha_size; rstart_pc = adjusted_pc;
-
- if (asm_trace_level >= 3)
- { printf("Backpatching routine at %05lx: initial size %d, %d labels\n",
- (long int) adjusted_pc, zcode_ha_size, next_label);
- }
-
- transfer_byte =
- (temporary_files_switch)?transfer_to_temp_file:transfer_to_zcode_area;
-
- /* (1) Scan through for branches and make short/long decisions in each
- case. Mark omitted bytes (bytes 2-4 in branches converted to
- short form) with DELETED_MV. */
-
- for (i=0, pc=adjusted_pc; i<zcode_ha_size; i++, pc++) {
- if (zcode_markers[i] >= BRANCH_MV && zcode_markers[i] < BRANCHMAX_MV) {
- int opmodeoffset = (zcode_markers[i] - BRANCH_MV);
- int32 opmodebyte;
- if (asm_trace_level >= 4)
- printf("Branch detected at offset %04x\n", pc);
- j = ((zcode_holding_area[i] << 24)
- | (zcode_holding_area[i+1] << 16)
- | (zcode_holding_area[i+2] << 8)
- | (zcode_holding_area[i+3]));
- offset_of_next = pc + 4;
- addr = (label_offsets[j] - offset_of_next) + 2;
- if (asm_trace_level >= 4)
- printf("To label %d, which is (%d-2) = %d from here\n",
- j, addr, label_offsets[j] - offset_of_next);
- if (addr >= -0x80 && addr < 0x80) {
- if (asm_trace_level >= 4) printf("...Byte form\n");
- zcode_markers[i+1] = DELETED_MV;
- zcode_markers[i+2] = DELETED_MV;
- zcode_markers[i+3] = DELETED_MV;
- opmodebyte = i - ((opmodeoffset+1)/2);
- if ((opmodeoffset & 1) == 0)
- zcode_holding_area[opmodebyte] =
- (zcode_holding_area[opmodebyte] & 0xF0) | 0x01;
- else
- zcode_holding_area[opmodebyte] =
- (zcode_holding_area[opmodebyte] & 0x0F) | 0x10;
- }
- else if (addr >= -0x8000 && addr < 0x8000) {
- if (asm_trace_level >= 4) printf("...Short form\n");
- zcode_markers[i+2] = DELETED_MV;
- zcode_markers[i+3] = DELETED_MV;
- opmodebyte = i - ((opmodeoffset+1)/2);
- if ((opmodeoffset & 1) == 0)
- zcode_holding_area[opmodebyte] =
- (zcode_holding_area[opmodebyte] & 0xF0) | 0x02;
- else
- zcode_holding_area[opmodebyte] =
- (zcode_holding_area[opmodebyte] & 0x0F) | 0x20;
- }
- }
- }
-
- /* (2) Calculate the new positions of the labels. Note that since the
- long/short decision was taken on the basis of the old labels,
- and since the new labels are slightly closer together because
- of branch bytes deleted, there may be a few further branch
- optimisations which are possible but which have been missed
- (if two labels move inside the "short" range as a result of
- a previous optimisation). However, this is acceptably uncommon. */
- if (next_label > 0) {
- if (asm_trace_level >= 4) {
- printf("Opening label: %d\n", first_label);
- for (i=0;i<next_label;i++)
- printf("Label %d offset %04x next -> %d previous -> %d\n",
- i, label_offsets[i], label_next[i], label_prev[i]);
- }
-
- for (i=0, pc=adjusted_pc, new_pc=adjusted_pc, label = first_label;
- i<zcode_ha_size;
- i++, pc++) {
- while ((label != -1) && (label_offsets[label] == pc)) {
- if (asm_trace_level >= 4)
- printf("Position of L%d corrected from %04x to %04x\n",
- label, label_offsets[label], new_pc);
- label_offsets[label] = new_pc;
- label = label_next[label];
- }
- if (zcode_markers[i] != DELETED_MV) new_pc++;
- }
- }
-
- /* (3) As we are transferring, replace the label numbers in branch
- operands with offsets to those labels. Also issue markers, now
- that we know where they occur in the final Z-code area. */
-
- for (i=0, new_pc=adjusted_pc; i<zcode_ha_size; i++) {
-
- if (zcode_markers[i] >= BRANCH_MV && zcode_markers[i] < BRANCHMAX_MV) {
- form_len = 4;
- if (zcode_markers[i+1] == DELETED_MV) {
- form_len = 1;
- }
- else {
- if (zcode_markers[i+2] == DELETED_MV)
- form_len = 2;
- }
- j = ((zcode_holding_area[i] << 24)
- | (zcode_holding_area[i+1] << 16)
- | (zcode_holding_area[i+2] << 8)
- | (zcode_holding_area[i+3]));
-
- /* At the moment, we can safely assume that the branch operand
- is the end of the opcode, so the next opcode starts right
- after it. */
- offset_of_next = new_pc + form_len;
-
- addr = (label_offsets[j] - offset_of_next) + 2;
- if (asm_trace_level >= 4) {
- printf("Branch at offset %04x: %04x (%s)\n",
- new_pc, addr, ((form_len == 1) ? "byte" :
- ((form_len == 2) ? "short" : "long")));
- }
- if (form_len == 1) {
- if (addr < -0x80 && addr >= 0x80) {
- error("*** Label out of range for byte branch ***");
- }
- zcode_holding_area[i] = (addr) & 0xFF;
- }
- else if (form_len == 2) {
- if (addr < -0x8000 && addr >= 0x8000) {
- error("*** Label out of range for short branch ***");
- }
- zcode_holding_area[i] = (addr >> 8) & 0xFF;
- zcode_holding_area[i+1] = (addr) & 0xFF;
- }
- else {
- zcode_holding_area[i] = (addr >> 24) & 0xFF;
- zcode_holding_area[i+1] = (addr >> 16) & 0xFF;
- zcode_holding_area[i+2] = (addr >> 8) & 0xFF;
- zcode_holding_area[i+3] = (addr) & 0xFF;
- }
- transfer_byte(zcode_holding_area + i); new_pc++;
- }
- else if (zcode_markers[i] == LABEL_MV) {
- error("*** No LABEL opcodes in Glulx ***");
- }
- else if (zcode_markers[i] == DELETED_MV) {
- /* skip it */
- }
- else {
- switch(zcode_markers[i] & 0x7f) {
- case NULL_MV:
- break;
- case ACTION_MV:
- case IDENT_MV:
- if (!module_switch) break;
- case OBJECT_MV:
- case VARIABLE_MV:
- default:
- if ((zcode_markers[i] & 0x7f) > LARGEST_BPATCH_MV) {
- error("*** Illegal code backpatch value ***");
- printf("Illegal value of %02x at PC = %04x\n",
- zcode_markers[i] & 0x7f, new_pc);
- break;
- }
- /* The backpatch table format for Glulx:
- First, the marker byte (0..LARGEST_BPATCH_MV).
- Then a byte indicating the data size to be patched (1, 2, 4).
- Then the four-byte address (new_pc).
- */
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++,
- zcode_markers[i]);
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++,
- 4);
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, ((new_pc >> 24) & 0xFF));
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, ((new_pc >> 16) & 0xFF));
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, ((new_pc >> 8) & 0xFF));
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, (new_pc & 0xFF));
- break;
- }
- transfer_byte(zcode_holding_area + i); new_pc++;
- }
- }
-
- if (asm_trace_level >= 3)
- { printf("After branch optimisation, routine length is %d bytes\n",
- new_pc - rstart_pc);
- }
-
- zmachine_pc = adjusted_pc;
- zcode_ha_size = 0;
-}
-
-
-/* ========================================================================= */
-/* Front ends for the instruction assembler: convenient shorthand forms */
-/* used in various code generation routines all over Inform. */
-/* ------------------------------------------------------------------------- */
-
-void assemble_jump(int n)
-{
- if (!glulx_mode)
- assemblez_jump(n);
- else
- assembleg_jump(n);
-}
-
-void assemblez_0(int internal_number)
-{ AI.internal_number = internal_number;
- AI.operand_count = 0;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_0_to(int internal_number, assembly_operand o)
-{ AI.internal_number = internal_number;
- AI.operand_count = 0;
- AI.store_variable_number = o.value;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_0_branch(int internal_number, int label, int flag)
-{ AI.internal_number = internal_number;
- AI.operand_count = 0;
- AI.store_variable_number = -1;
- AI.branch_label_number = label;
- AI.branch_flag = flag;
- assemblez_instruction(&AI);
-}
-
-void assemblez_1(int internal_number, assembly_operand o1)
-{ AI.internal_number = internal_number;
- AI.operand_count = 1;
- AI.operand[0] = o1;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_1_to(int internal_number,
- assembly_operand o1, assembly_operand st)
-{ AI.internal_number = internal_number;
- AI.operand_count = 1;
- AI.operand[0] = o1;
- AI.store_variable_number = st.value;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_1_branch(int internal_number,
- assembly_operand o1, int label, int flag)
-{ AI.internal_number = internal_number;
- AI.operand_count = 1;
- AI.operand[0] = o1;
- AI.branch_label_number = label;
- AI.store_variable_number = -1;
- AI.branch_flag = flag;
- assemblez_instruction(&AI);
-}
-
-void assemblez_2(int internal_number,
- assembly_operand o1, assembly_operand o2)
-{ AI.internal_number = internal_number;
- AI.operand_count = 2;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_3(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3)
-{ AI.internal_number = internal_number;
- AI.operand_count = 3;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_3_to(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- assembly_operand st)
-{ AI.internal_number = internal_number;
- AI.operand_count = 3;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.store_variable_number = st.value;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_3_branch(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- int label, int flag)
-{ AI.internal_number = internal_number;
- AI.operand_count = 3;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.store_variable_number = -1;
- AI.branch_label_number = label;
- AI.branch_flag = flag;
- assemblez_instruction(&AI);
-}
-
-void assemblez_4(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- assembly_operand o4)
-{ AI.internal_number = internal_number;
- AI.operand_count = 4;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_5(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- assembly_operand o4, assembly_operand o5)
-{ AI.internal_number = internal_number;
- AI.operand_count = 5;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- AI.operand[4] = o5;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_6(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- assembly_operand o4, assembly_operand o5, assembly_operand o6)
-{ AI.internal_number = internal_number;
- AI.operand_count = 6;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- AI.operand[4] = o5;
- AI.operand[5] = o6;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_4_branch(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- assembly_operand o4, int label, int flag)
-{ AI.internal_number = internal_number;
- AI.operand_count = 4;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- AI.store_variable_number = -1;
- AI.branch_label_number = label;
- AI.branch_flag = flag;
- assemblez_instruction(&AI);
-}
-
-void assemblez_4_to(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- assembly_operand o4, assembly_operand st)
-{ AI.internal_number = internal_number;
- AI.operand_count = 4;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- AI.store_variable_number = st.value;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_5_to(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand o3,
- assembly_operand o4, assembly_operand o5, assembly_operand st)
-{ AI.internal_number = internal_number;
- AI.operand_count = 5;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- AI.operand[4] = o5;
- AI.store_variable_number = st.value;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_2_to(int internal_number,
- assembly_operand o1, assembly_operand o2, assembly_operand st)
-{ AI.internal_number = internal_number;
- AI.operand_count = 2;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.store_variable_number = st.value;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_2_branch(int internal_number,
- assembly_operand o1, assembly_operand o2, int label, int flag)
-{ AI.internal_number = internal_number;
- AI.operand_count = 2;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.branch_label_number = label;
- AI.store_variable_number = -1;
- AI.branch_flag = flag;
- assemblez_instruction(&AI);
-}
-
-void assemblez_objcode(int internal_number,
- assembly_operand o1, assembly_operand st, int label, int flag)
-{ AI.internal_number = internal_number;
- AI.operand_count = 1;
- AI.operand[0] = o1;
- AI.branch_label_number = label;
- AI.store_variable_number = st.value;
- AI.branch_flag = flag;
- assemblez_instruction(&AI);
-}
-
-extern void assemblez_inc(assembly_operand o1)
-{ int m = 0;
- if ((o1.value >= MAX_LOCAL_VARIABLES)
- && (o1.value<LOWEST_SYSTEM_VAR_NUMBER))
- m = VARIABLE_MV;
- AI.internal_number = inc_zc;
- AI.operand_count = 1;
- AI.operand[0].value = o1.value;
- AI.operand[0].type = SHORT_CONSTANT_OT;
- AI.operand[0].marker = m;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-extern void assemblez_dec(assembly_operand o1)
-{ int m = 0;
- if ((o1.value >= MAX_LOCAL_VARIABLES)
- && (o1.value<LOWEST_SYSTEM_VAR_NUMBER))
- m = VARIABLE_MV;
- AI.internal_number = dec_zc;
- AI.operand_count = 1;
- AI.operand[0].value = o1.value;
- AI.operand[0].type = SHORT_CONSTANT_OT;
- AI.operand[0].marker = m;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-extern void assemblez_store(assembly_operand o1, assembly_operand o2)
-{ int m = 0;
- if ((o1.value >= MAX_LOCAL_VARIABLES)
- && (o1.value<LOWEST_SYSTEM_VAR_NUMBER))
- m = VARIABLE_MV;
-
- if ((o2.type == VARIABLE_OT) && (o2.value == 0))
- {
- /* Assemble "pull VAR" rather than "store VAR sp",
- saving 1 byte */
-
- AI.internal_number = pull_zc;
- if (instruction_set_number == 6)
- { AI.operand_count = 0;
- AI.store_variable_number = o1.value;
- }
- else
- { AI.operand_count = 1;
- AI.operand[0].value = o1.value;
- AI.operand[0].type = SHORT_CONSTANT_OT;
- AI.operand[0].marker = m;
- AI.store_variable_number = -1;
- }
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
- return;
- }
-
- if ((o1.type == VARIABLE_OT) && (o1.value == 0))
- { /* Assemble "push VAR" rather than "store sp VAR",
- saving 1 byte */
-
- AI.internal_number = push_zc;
- AI.operand_count = 1;
- AI.operand[0] = o2;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
- return;
- }
- AI.internal_number = store_zc;
- AI.operand_count = 2;
- AI.operand[0].value = o1.value;
- AI.operand[0].type = SHORT_CONSTANT_OT;
- AI.operand[0].marker = m;
- AI.operand[1] = o2;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
-}
-
-void assemblez_jump(int n)
-{ assembly_operand AO;
- if (n==-4) assemblez_0(rtrue_zc);
- else if (n==-3) assemblez_0(rfalse_zc);
- else
- { AO.type = LONG_CONSTANT_OT; AO.value = n; AO.marker = 0;
- assemblez_1(jump_zc, AO);
- }
-}
-
-void assembleg_0(int internal_number)
-{ AI.internal_number = internal_number;
- AI.operand_count = 0;
- assembleg_instruction(&AI);
-}
-
-void assembleg_1(int internal_number, assembly_operand o1)
-{ AI.internal_number = internal_number;
- AI.operand_count = 1;
- AI.operand[0] = o1;
- assembleg_instruction(&AI);
-}
-
-void assembleg_2(int internal_number, assembly_operand o1,
- assembly_operand o2)
-{ AI.internal_number = internal_number;
- AI.operand_count = 2;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- assembleg_instruction(&AI);
-}
-
-void assembleg_3(int internal_number, assembly_operand o1,
- assembly_operand o2, assembly_operand o3)
-{ AI.internal_number = internal_number;
- AI.operand_count = 3;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- assembleg_instruction(&AI);
-}
-
-void assembleg_4(int internal_number, assembly_operand o1,
- assembly_operand o2, assembly_operand o3,
- assembly_operand o4)
-{ AI.internal_number = internal_number;
- AI.operand_count = 4;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- assembleg_instruction(&AI);
-}
-
-void assembleg_5(int internal_number, assembly_operand o1,
- assembly_operand o2, assembly_operand o3,
- assembly_operand o4, assembly_operand o5)
-{ AI.internal_number = internal_number;
- AI.operand_count = 5;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2] = o3;
- AI.operand[3] = o4;
- AI.operand[4] = o5;
- assembleg_instruction(&AI);
-}
-
-void assembleg_0_branch(int internal_number,
- int label)
-{
- AI.internal_number = internal_number;
- AI.operand_count = 1;
- AI.operand[0].type = CONSTANT_OT;
- AI.operand[0].value = label;
- AI.operand[0].marker = BRANCH_MV;
- assembleg_instruction(&AI);
-}
-
-void assembleg_1_branch(int internal_number,
- assembly_operand o1, int label)
-{
- /* Some clever optimizations first. A constant is always or never equal
- to zero. */
- if (o1.marker == 0 && is_constant_ot(o1.type)) {
- if ((internal_number == jz_gc && o1.value == 0)
- || (internal_number == jnz_gc && o1.value != 0)) {
- assembleg_0_branch(jump_gc, label);
- /* We clear the "can't reach statement" flag here,
- so that "if (1)" doesn't produce that warning. */
- execution_never_reaches_here = 0;
- return;
- }
- if ((internal_number == jz_gc && o1.value != 0)
- || (internal_number == jnz_gc && o1.value == 0)) {
- /* assemble nothing at all! */
- return;
- }
- }
- AI.internal_number = internal_number;
- AI.operand_count = 2;
- AI.operand[0] = o1;
- AI.operand[1].type = CONSTANT_OT;
- AI.operand[1].value = label;
- AI.operand[1].marker = BRANCH_MV;
- assembleg_instruction(&AI);
-}
-
-void assembleg_2_branch(int internal_number,
- assembly_operand o1, assembly_operand o2, int label)
-{
- AI.internal_number = internal_number;
- AI.operand_count = 3;
- AI.operand[0] = o1;
- AI.operand[1] = o2;
- AI.operand[2].type = CONSTANT_OT;
- AI.operand[2].value = label;
- AI.operand[2].marker = BRANCH_MV;
- assembleg_instruction(&AI);
-}
-
-void assembleg_call_1(assembly_operand oaddr, assembly_operand o1,
- assembly_operand odest)
-{
- assembleg_3(callfi_gc, oaddr, o1, odest);
-}
-
-void assembleg_call_2(assembly_operand oaddr, assembly_operand o1,
- assembly_operand o2, assembly_operand odest)
-{
- assembleg_4(callfii_gc, oaddr, o1, o2, odest);
-}
-
-void assembleg_call_3(assembly_operand oaddr, assembly_operand o1,
- assembly_operand o2, assembly_operand o3, assembly_operand odest)
-{
- assembleg_5(callfiii_gc, oaddr, o1, o2, o3, odest);
-}
-
-void assembleg_inc(assembly_operand o1)
-{
- AI.internal_number = add_gc;
- AI.operand_count = 3;
- AI.operand[0] = o1;
- AI.operand[1] = one_operand;
- AI.operand[2] = o1;
- assembleg_instruction(&AI);
-}
-
-void assembleg_dec(assembly_operand o1)
-{
- AI.internal_number = sub_gc;
- AI.operand_count = 3;
- AI.operand[0] = o1;
- AI.operand[1] = one_operand;
- AI.operand[2] = o1;
- assembleg_instruction(&AI);
-}
-
-void assembleg_store(assembly_operand o1, assembly_operand o2)
-{
- /* Note the order is reversed: "o1 = o2;" */
- assembleg_2(copy_gc, o2, o1);
-}
-
-void assembleg_jump(int n)
-{
- if (n==-4) {
- assembleg_1(return_gc, one_operand);
- }
- else if (n==-3) {
- assembleg_1(return_gc, zero_operand);
- }
- else {
- assembleg_0_branch(jump_gc, n);
- }
-}
-
-/* ========================================================================= */
-/* Parsing and then calling the assembler for @ (assembly language) */
-/* statements */
-/* ------------------------------------------------------------------------- */
-
-static assembly_operand parse_operand_z(void)
-{ assembly_operand AO;
-
- AO = parse_expression(ASSEMBLY_CONTEXT);
- if (AO.type == EXPRESSION_OT)
- { ebf_error("variable or constant", "expression");
- AO.type = SHORT_CONSTANT_OT;
- }
- return(AO);
-}
-
-static void parse_assembly_z(void)
-{ int n, min, max, indirect_addressed, error_flag = FALSE;
- opcodez O;
-
- AI.operand_count = 0;
- AI.store_variable_number = -1;
- AI.branch_label_number = -1;
- AI.text = NULL;
-
- opcode_names.enabled = TRUE;
- get_next_token();
- opcode_names.enabled = FALSE;
-
- if (token_type == DQ_TT)
- { int i;
- AI.internal_number = -1;
-
- custom_opcode_z.name = (uchar *) token_text;
- custom_opcode_z.version1 = instruction_set_number;
- custom_opcode_z.version2 = instruction_set_number;
- custom_opcode_z.extension = -1;
- custom_opcode_z.flags = 0;
- custom_opcode_z.op_rules = 0;
- custom_opcode_z.flags2_set = 0;
- custom_opcode_z.no = ZERO;
-
- for (i=0; token_text[i]!=0; i++)
- { if (token_text[i] == ':')
- { token_text[i++] = 0;
- break;
- }
- }
- if (token_text[i] == 0)
- error("Opcode specification should have form \"VAR:102\"");
-
- n = -1;
- if (strcmp(token_text, "0OP")==0) n=ZERO;
- if (strcmp(token_text, "1OP")==0) n=ONE;
- if (strcmp(token_text, "2OP")==0) n=TWO;
- if (strcmp(token_text, "VAR")==0) n=VAR;
- if (strcmp(token_text, "EXT")==0) n=EXT;
- if (strcmp(token_text, "VAR_LONG")==0) n=VAR_LONG;
- if (strcmp(token_text, "EXT_LONG")==0) n=EXT_LONG;
-
- 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);
- n = EXT;
- }
- custom_opcode_z.no = n;
-
- custom_opcode_z.code = atoi(token_text+i);
- while (isdigit(token_text[i])) i++;
-
- { max = 0; min = 0;
- switch(n)
- { case ZERO: case ONE: max = 16; break;
- case VAR: case VAR_LONG: min = 32; max = 64; break;
- case EXT: case EXT_LONG: max = 256; break;
- 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);
- custom_opcode_z.code = min;
- }
- }
-
- while (token_text[i++] != 0)
- { switch(token_text[i-1])
- { case 'B': custom_opcode_z.flags |= Br; break;
- case 'S': custom_opcode_z.flags |= St; break;
- case 'T': custom_opcode_z.op_rules = TEXT; break;
- case 'I': custom_opcode_z.op_rules = VARIAB; break;
- case 'F': custom_opcode_z.flags2_set = atoi(token_text+i);
- while (isdigit(token_text[i])) i++; break;
- default:
- error("Unknown flag: options are B (branch), S (store), \
-T (text), I (indirect addressing), F** (set this Flags 2 bit)");
- break;
- }
- }
- O = custom_opcode_z;
- }
- else
- { if (token_type != OPCODE_NAME_TT)
- { ebf_error("an opcode name", token_text);
- panic_mode_error_recovery();
- return;
- }
- AI.internal_number = token_value;
- O = internal_number_to_opcode_z(AI.internal_number);
- }
-
- indirect_addressed = (O.op_rules == VARIAB);
-
- if (O.op_rules == TEXT)
- { get_next_token();
- if (token_type != DQ_TT)
- ebf_error("literal text in double-quotes", token_text);
- AI.text = token_text;
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { assemblez_instruction(&AI);
- return;
- }
- ebf_error("semicolon ';' after print string", token_text);
- put_token_back();
- return;
- }
-
- return_sp_as_variable = TRUE;
- do
- { get_next_token();
-
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
-
- if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
- { if (AI.store_variable_number != -1)
- error("Only one '->' store destination can be given");
- get_next_token();
- if ((token_type != SYMBOL_TT)
- && (token_type != LOCAL_VARIABLE_TT))
- ebf_error("variable name or 'sp'", token_text);
- n = 255;
- if (token_type == LOCAL_VARIABLE_TT) n = token_value;
- else
- { if (strcmp(token_text, "sp") == 0) n = 0;
- else
- { if (stypes[token_value] != GLOBAL_VARIABLE_T)
- error_named(
- "Store '->' destination not 'sp' or a variable:",
- token_text);
- else n = svals[token_value];
- }
- }
- AI.store_variable_number = n;
- continue;
- }
-
- if ((token_type == SEP_TT) &&
- ((token_value == BRANCH_SEP) || (token_value == NBRANCH_SEP)))
- { if (AI.branch_label_number != -1)
- error("Only one '?' branch destination can be given");
-
- AI.branch_flag = (token_value == BRANCH_SEP);
-
- opcode_names.enabled = TRUE;
- get_next_token();
- opcode_names.enabled = FALSE;
-
- n = -2;
- if ((token_type == OPCODE_NAME_TT)
- && (token_value == rfalse_zc)) n = -3;
- else
- if ((token_type == OPCODE_NAME_TT)
- && (token_value == rtrue_zc)) n = -4;
- else
- { if (token_type == SYMBOL_TT)
- { put_token_back();
- n = parse_label();
- }
- else
- ebf_error("label name after '?' or '?~'", token_text);
- }
- AI.branch_label_number = n;
- continue;
- }
-
- if (AI.operand_count == 8)
- { error("No assembly instruction may have more than 8 operands");
- panic_mode_error_recovery(); break;
- }
-
- if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
- { if (!indirect_addressed)
- error("This opcode does not use indirect addressing");
- if (AI.operand_count > 0)
- error("Indirect addressing can only be used on the first operand");
- 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);
- put_token_back();
- }
- }
- else
- { put_token_back();
- AI.operand[AI.operand_count++] = parse_operand_z();
- if ((indirect_addressed) && (AI.operand_count == 1)
- && (AI.operand[AI.operand_count-1].type == VARIABLE_OT))
- { AI.operand[AI.operand_count-1].type = SHORT_CONSTANT_OT;
- AI.operand[AI.operand_count-1].marker = VARIABLE_MV;
- }
- }
-
- } while (TRUE);
-
- return_sp_as_variable = FALSE;
-
-
- if (O.version1 == 0)
- { error_named("Opcode unavailable in this Z-machine version:",
- opcode_names.keywords[AI.internal_number]);
- return;
- }
-
- if (((O.flags) & Br) != 0)
- { if (AI.branch_label_number == -1)
- { error_flag = TRUE;
- AI.branch_label_number = -2;
- }
- }
- else
- { if (AI.branch_label_number != -1)
- { error_flag = TRUE;
- AI.branch_label_number = -1;
- }
- }
- if (((O.flags) & St) != 0)
- { if (AI.store_variable_number == -1)
- { if (AI.operand_count == 0)
- { error_flag = TRUE;
- AI.store_variable_number = 255;
- }
- else
- { AI.store_variable_number
- = AI.operand[--AI.operand_count].value;
- if (AI.operand[AI.operand_count].type != VARIABLE_OT)
- error("Store destination (the last operand) is not a variable");
- }
- }
- }
- else
- { if (AI.store_variable_number != -1)
- { error_flag = TRUE;
- AI.store_variable_number = -1;
- }
- }
-
- min = 0; max = 0;
- switch(O.no)
- { case TWO: min = 2; max = 2;
- /* Exception for the V6 set_colour, which can take
- a third argument, thus forcing it into VAR form: */
- if ((version_number == 6) && (O.code == 0x1b)) max = 3;
- /* Also an exception for je, which can take from 1
- argument (useless) to 4 arguments */
- if (O.code == 0x01) { min = 1; max = 4; }
- break;
- case VAR: min = 0; max = 4; break;
- case VAR_LONG: min = 0; max = 8; break;
- case ONE: min = 1; max = 1; break;
- case ZERO: min = 0; max = 0; break;
- case EXT: min = 0; max = 4; break;
- case EXT_LONG: min = 0; max = 8; break;
- }
-
- if ((AI.operand_count >= min) && (AI.operand_count <= max))
- assemblez_instruction(&AI);
- else error_flag = TRUE;
-
- if (error_flag)
- { make_opcode_syntax_z(O);
- error_named("Assembly mistake: syntax is",
- opcode_syntax_string);
- }
-}
-
-static assembly_operand parse_operand_g(void)
-{ assembly_operand AO;
-
- AO = parse_expression(ASSEMBLY_CONTEXT);
- if (AO.type == EXPRESSION_OT)
- { ebf_error("variable or constant", "expression");
- AO.type = CONSTANT_OT;
- }
- return(AO);
-}
-
-static void parse_assembly_g(void)
-{
- opcodeg O;
- assembly_operand AO;
- int error_flag = FALSE, is_macro = FALSE;
-
- AI.operand_count = 0;
-
- 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) {
- 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++;
- }
-
- return_sp_as_variable = FALSE;
-
- 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) {
- make_opcode_syntax_g(O);
- error_named("Assembly mistake: syntax is",
- opcode_syntax_string);
- }
-}
-
-extern void parse_assembly(void)
-{
- if (!glulx_mode)
- parse_assembly_z();
- else
- parse_assembly_g();
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void asm_begin_pass(void)
-{ no_instructions = 0;
- zmachine_pc = 0;
- no_sequence_points = 0;
- next_label = 0;
- next_sequence_point = 0;
- zcode_ha_size = 0;
-}
-
-extern void init_asm_vars(void)
-{ int i;
-
- for (i=0;i<16;i++) flags2_requirements[i]=0;
-
- uses_unicode_features = FALSE;
- uses_memheap_features = FALSE;
- uses_acceleration_features = FALSE;
- uses_float_features = FALSE;
-
- sequence_point_follows = TRUE;
- label_moved_error_already_given = FALSE;
-
- initialise_memory_block(&zcode_area);
-}
-
-extern void asm_allocate_arrays(void)
-{ if ((debugfile_switch) && (MAX_LABELS < 2000)) MAX_LABELS = 2000;
-
- variable_tokens = my_calloc(sizeof(int32),
- MAX_LOCAL_VARIABLES+MAX_GLOBAL_VARIABLES, "variable tokens");
- variable_usage = my_calloc(sizeof(int),
- MAX_LOCAL_VARIABLES+MAX_GLOBAL_VARIABLES, "variable usage");
-
- label_offsets = my_calloc(sizeof(int32), MAX_LABELS, "label offsets");
- label_symbols = my_calloc(sizeof(int32), MAX_LABELS, "label symbols");
- label_next = my_calloc(sizeof(int), MAX_LABELS, "label dll 1");
- label_prev = my_calloc(sizeof(int), MAX_LABELS, "label dll 1");
- sequence_point_labels
- = my_calloc(sizeof(int), MAX_LABELS, "sequence point labels");
- sequence_point_locations
- = my_calloc(sizeof(debug_location),
- MAX_LABELS,
- "sequence point locations");
-
- zcode_holding_area = my_malloc(MAX_ZCODE_SIZE,"compiled routine code area");
- zcode_markers = my_malloc(MAX_ZCODE_SIZE, "compiled routine code area");
-
- named_routine_symbols
- = my_calloc(sizeof(int32), MAX_SYMBOLS, "named routine symbols");
-}
-
-extern void asm_free_arrays(void)
-{
- my_free(&variable_tokens, "variable tokens");
- my_free(&variable_usage, "variable usage");
-
- my_free(&label_offsets, "label offsets");
- my_free(&label_symbols, "label symbols");
- my_free(&label_next, "label dll 1");
- my_free(&label_prev, "label dll 2");
- my_free(&sequence_point_labels, "sequence point labels");
- my_free(&sequence_point_locations, "sequence point locations");
-
- my_free(&zcode_holding_area, "compiled routine code area");
- my_free(&zcode_markers, "compiled routine code markers");
-
- my_free(&named_routine_symbols, "named routine symbols");
- deallocate_memory_block(&zcode_area);
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "bpatch" : Keeps track of, and finally acts on, backpatch markers, */
-/* correcting symbol values not known at compilation time */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-memory_block zcode_backpatch_table, zmachine_backpatch_table;
-int32 zcode_backpatch_size, zmachine_backpatch_size;
-
-/* ------------------------------------------------------------------------- */
-/* The mending operation */
-/* ------------------------------------------------------------------------- */
-
-int backpatch_marker, backpatch_size, backpatch_error_flag;
-
-static int32 backpatch_value_z(int32 value)
-{ /* Corrects the quantity "value" according to backpatch_marker */
-
- ASSERT_ZCODE();
-
- if (asm_trace_level >= 4)
- printf("BP %s applied to %04x giving ",
- describe_mv(backpatch_marker), value);
-
- switch(backpatch_marker)
- { case STRING_MV:
- value += strings_offset/scale_factor; break;
- case ARRAY_MV:
- value += variables_offset; break;
- case IROUTINE_MV:
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset/scale_factor;
- break;
- case VROUTINE_MV:
- if ((value<0) || (value>=VENEER_ROUTINES))
- { if (no_link_errors > 0) break;
- if (compiler_error
- ("Backpatch veneer routine number out of range"))
- { printf("Illegal BP veneer routine number: %d\n", value);
- backpatch_error_flag = TRUE;
- }
- value = 0;
- break;
- }
- value = veneer_routine_address[value];
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset/scale_factor;
- break;
- case NO_OBJS_MV:
- value = no_objects; break;
- case INCON_MV:
- if ((value<0) || (value>=NO_SYSTEM_CONSTANTS))
- { if (no_link_errors > 0) break;
- if (compiler_error
- ("Backpatch system constant number out of range"))
- { printf("Illegal BP system constant number: %d\n", value);
- backpatch_error_flag = TRUE;
- }
- value = 0;
- break;
- }
- value = value_of_system_constant(value); break;
- case DWORD_MV:
- value = dictionary_offset + 7 +
- final_dict_order[value]*((version_number==3)?7:9);
- break;
- case ACTION_MV:
- break;
- case INHERIT_MV:
- value = 256*zmachine_paged_memory[value + prop_values_offset]
- + zmachine_paged_memory[value + prop_values_offset + 1];
- break;
- case INHERIT_INDIV_MV:
- value = 256*zmachine_paged_memory[value
- + individuals_offset]
- + zmachine_paged_memory[value
- + individuals_offset + 1];
- break;
- case INDIVPT_MV:
- value += individuals_offset;
- break;
- case MAIN_MV:
- value = symbol_index("Main", -1);
- if (stypes[value] != ROUTINE_T)
- error("No 'Main' routine has been defined");
- sflags[value] |= USED_SFLAG;
- value = svals[value];
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset/scale_factor;
- break;
- case SYMBOL_MV:
- if ((value<0) || (value>=no_symbols))
- { if (no_link_errors > 0) break;
- if (compiler_error("Backpatch symbol number out of range"))
- { printf("Illegal BP symbol number: %d\n", value);
- backpatch_error_flag = TRUE;
- }
- value = 0;
- break;
- }
- if (sflags[value] & UNKNOWN_SFLAG)
- { if (!(sflags[value] & UERROR_SFLAG))
- { sflags[value] |= UERROR_SFLAG;
- error_named_at("No such constant as",
- (char *) symbs[value], slines[value]);
- }
- }
- else
- if (sflags[value] & CHANGE_SFLAG)
- { sflags[value] &= (~(CHANGE_SFLAG));
- backpatch_marker = (svals[value]/0x10000);
- if ((backpatch_marker < 0)
- || (backpatch_marker > LARGEST_BPATCH_MV))
- {
- if (no_link_errors == 0)
- { compiler_error_named(
- "Illegal backpatch marker attached to symbol",
- (char *) symbs[value]);
- backpatch_error_flag = TRUE;
- }
- }
- else
- svals[value] = backpatch_value_z((svals[value]) % 0x10000);
- }
-
- sflags[value] |= USED_SFLAG;
- { int t = stypes[value];
- value = svals[value];
- switch(t)
- { case ROUTINE_T:
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset/scale_factor;
- break;
- case ARRAY_T: value += variables_offset; break;
- }
- }
- break;
- default:
- if (no_link_errors > 0) break;
- if (compiler_error("Illegal backpatch marker"))
- { printf("Illegal backpatch marker %d value %04x\n",
- backpatch_marker, value);
- backpatch_error_flag = TRUE;
- }
- break;
- }
-
- if (asm_trace_level >= 4) printf(" %04x\n", value);
-
- return(value);
-}
-
-static int32 backpatch_value_g(int32 value)
-{ /* Corrects the quantity "value" according to backpatch_marker */
- int32 valaddr;
-
- ASSERT_GLULX();
-
- if (asm_trace_level >= 4)
- printf("BP %s applied to %04x giving ",
- describe_mv(backpatch_marker), value);
-
- switch(backpatch_marker)
- {
- case STRING_MV:
- if (value <= 0 || value > no_strings)
- compiler_error("Illegal string marker.");
- value = strings_offset + compressed_offsets[value-1]; break;
- case IROUTINE_MV:
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset;
- break;
- case ARRAY_MV:
- value += arrays_offset; break;
- case VARIABLE_MV:
- value = variables_offset + (4*value); break;
- case OBJECT_MV:
- value = object_tree_offset + (OBJECT_BYTE_LENGTH*(value-1));
- break;
- case VROUTINE_MV:
- if ((value<0) || (value>=VENEER_ROUTINES))
- { if (no_link_errors > 0) break;
- if (compiler_error
- ("Backpatch veneer routine number out of range"))
- { printf("Illegal BP veneer routine number: %d\n", value);
- backpatch_error_flag = TRUE;
- }
- value = 0;
- break;
- }
- value = veneer_routine_address[value];
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset;
- break;
- case NO_OBJS_MV:
- value = no_objects; break;
- case INCON_MV:
- if ((value<0) || (value>=NO_SYSTEM_CONSTANTS))
- { if (no_link_errors > 0) break;
- if (compiler_error
- ("Backpatch system constant number out of range"))
- { printf("Illegal BP system constant number: %d\n", value);
- backpatch_error_flag = TRUE;
- }
- value = 0;
- break;
- }
- value = value_of_system_constant(value); break;
- case DWORD_MV:
- value = dictionary_offset + 4
- + final_dict_order[value]*DICT_ENTRY_BYTE_LENGTH;
- break;
- case ACTION_MV:
- break;
- case INHERIT_MV:
- valaddr = (prop_values_offset - Write_RAM_At) + value;
- value = ReadInt32(zmachine_paged_memory + valaddr);
- break;
- case INHERIT_INDIV_MV:
- error("*** No individual property storage in Glulx ***");
- break;
- case INDIVPT_MV:
- value += individuals_offset;
- break;
- case MAIN_MV:
- value = symbol_index("Main", -1);
- if (stypes[value] != ROUTINE_T)
- error("No 'Main' routine has been defined");
- sflags[value] |= USED_SFLAG;
- value = svals[value];
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset;
- break;
- case SYMBOL_MV:
- if ((value<0) || (value>=no_symbols))
- { if (no_link_errors > 0) break;
- if (compiler_error("Backpatch symbol number out of range"))
- { printf("Illegal BP symbol number: %d\n", value);
- backpatch_error_flag = TRUE;
- }
- value = 0;
- break;
- }
- if (sflags[value] & UNKNOWN_SFLAG)
- { if (!(sflags[value] & UERROR_SFLAG))
- { sflags[value] |= UERROR_SFLAG;
- error_named_at("No such constant as",
- (char *) symbs[value], slines[value]);
- }
- }
- else
- if (sflags[value] & CHANGE_SFLAG)
- { sflags[value] &= (~(CHANGE_SFLAG));
- backpatch_marker = smarks[value];
- if ((backpatch_marker < 0)
- || (backpatch_marker > LARGEST_BPATCH_MV))
- {
- if (no_link_errors == 0)
- { compiler_error_named(
- "Illegal backpatch marker attached to symbol",
- (char *) symbs[value]);
- backpatch_error_flag = TRUE;
- }
- }
- else
- svals[value] = backpatch_value_g(svals[value]);
- }
-
- sflags[value] |= USED_SFLAG;
- { int t = stypes[value];
- value = svals[value];
- switch(t)
- {
- case ROUTINE_T:
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset;
- break;
- case ARRAY_T: value += arrays_offset; break;
- case OBJECT_T:
- case CLASS_T:
- value = object_tree_offset +
- (OBJECT_BYTE_LENGTH*(value-1));
- break;
- case ATTRIBUTE_T:
- /* value is unchanged */
- break;
- case CONSTANT_T:
- case INDIVIDUAL_PROPERTY_T:
- /* value is unchanged */
- break;
- default:
- error("*** Illegal backpatch marker in forward-declared \
-symbol");
- break;
- }
- }
- break;
- default:
- if (no_link_errors > 0) break;
- if (compiler_error("Illegal backpatch marker"))
- { printf("Illegal backpatch marker %d value %04x\n",
- backpatch_marker, value);
- backpatch_error_flag = TRUE;
- }
- break;
- }
-
- if (asm_trace_level >= 4) printf(" %04x\n", value);
-
- return(value);
-}
-
-extern int32 backpatch_value(int32 value)
-{
- if (!glulx_mode)
- return backpatch_value_z(value);
- else
- return backpatch_value_g(value);
-}
-
-static void backpatch_zmachine_z(int mv, int zmachine_area, int32 offset)
-{ if (module_switch)
- { if (zmachine_area == PROP_DEFAULTS_ZA) return;
- }
- else
- { if (mv == OBJECT_MV) return;
- if (mv == IDENT_MV) return;
- if (mv == ACTION_MV) return;
- }
-
- /* printf("MV %d ZA %d Off %04x\n", mv, zmachine_area, offset); */
-
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, mv);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, zmachine_area);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, offset/256);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, offset%256);
-}
-
-static void backpatch_zmachine_g(int mv, int zmachine_area, int32 offset)
-{ if (module_switch)
- { if (zmachine_area == PROP_DEFAULTS_ZA) return;
- }
- else
- { if (mv == IDENT_MV) return;
- if (mv == ACTION_MV) return;
- }
-
-/* The backpatch table format for Glulx:
- First, the marker byte.
- Then, the zmachine area being patched.
- Then the four-byte address.
-*/
-
-/* printf("+MV %d ZA %d Off %06x\n", mv, zmachine_area, offset); */
-
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, mv);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, zmachine_area);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, (offset >> 24) & 0xFF);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, (offset >> 16) & 0xFF);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, (offset >> 8) & 0xFF);
- write_byte_to_memory_block(&zmachine_backpatch_table,
- zmachine_backpatch_size++, (offset) & 0xFF);
-}
-
-extern void backpatch_zmachine(int mv, int zmachine_area, int32 offset)
-{
- if (!glulx_mode)
- backpatch_zmachine_z(mv, zmachine_area, offset);
- else
- backpatch_zmachine_g(mv, zmachine_area, offset);
-}
-
-extern void backpatch_zmachine_image_z(void)
-{ int bm = 0, zmachine_area; int32 offset, value, addr = 0;
- ASSERT_ZCODE();
- backpatch_error_flag = FALSE;
- while (bm < zmachine_backpatch_size)
- { backpatch_marker
- = read_byte_from_memory_block(&zmachine_backpatch_table, bm);
- zmachine_area
- = read_byte_from_memory_block(&zmachine_backpatch_table, bm+1);
- offset
- = 256*read_byte_from_memory_block(&zmachine_backpatch_table,bm+2)
- + read_byte_from_memory_block(&zmachine_backpatch_table, bm+3);
- bm += 4;
-
- switch(zmachine_area)
- { case PROP_DEFAULTS_ZA: addr = prop_defaults_offset; break;
- case PROP_ZA: addr = prop_values_offset; break;
- case INDIVIDUAL_PROP_ZA: addr = individuals_offset; break;
- case DYNAMIC_ARRAY_ZA: addr = variables_offset; break;
- default:
- if (no_link_errors == 0)
- if (compiler_error("Illegal area to backpatch"))
- backpatch_error_flag = TRUE;
- }
- addr += offset;
-
- value = 256*zmachine_paged_memory[addr]
- + zmachine_paged_memory[addr+1];
- value = backpatch_value_z(value);
- zmachine_paged_memory[addr] = value/256;
- zmachine_paged_memory[addr+1] = value%256;
-
- if (backpatch_error_flag)
- { backpatch_error_flag = FALSE;
- if (no_link_errors == 0)
- printf("*** MV %d ZA %d Off %04x ***\n",
- backpatch_marker, zmachine_area, offset);
- }
- }
-}
-
-extern void backpatch_zmachine_image_g(void)
-{ int bm = 0, zmachine_area; int32 offset, value, addr = 0;
- ASSERT_GLULX();
- backpatch_error_flag = FALSE;
- while (bm < zmachine_backpatch_size)
- { backpatch_marker
- = read_byte_from_memory_block(&zmachine_backpatch_table, bm);
- zmachine_area
- = read_byte_from_memory_block(&zmachine_backpatch_table, bm+1);
- offset = read_byte_from_memory_block(&zmachine_backpatch_table, bm+2);
- offset = (offset << 8) |
- read_byte_from_memory_block(&zmachine_backpatch_table, bm+3);
- offset = (offset << 8) |
- read_byte_from_memory_block(&zmachine_backpatch_table, bm+4);
- offset = (offset << 8) |
- read_byte_from_memory_block(&zmachine_backpatch_table, bm+5);
- bm += 6;
-
- /* printf("-MV %d ZA %d Off %06x\n", backpatch_marker, zmachine_area, offset); */
-
- switch(zmachine_area) {
- case PROP_DEFAULTS_ZA: addr = prop_defaults_offset+4; break;
- case PROP_ZA: addr = prop_values_offset; break;
- case INDIVIDUAL_PROP_ZA: addr = individuals_offset; break;
- case ARRAY_ZA: addr = arrays_offset; break;
- case GLOBALVAR_ZA: addr = variables_offset; break;
- default:
- if (no_link_errors == 0)
- if (compiler_error("Illegal area to backpatch"))
- backpatch_error_flag = TRUE;
- }
- addr = addr + offset - Write_RAM_At;
-
- value = (zmachine_paged_memory[addr] << 24)
- | (zmachine_paged_memory[addr+1] << 16)
- | (zmachine_paged_memory[addr+2] << 8)
- | (zmachine_paged_memory[addr+3]);
- value = backpatch_value_g(value);
- zmachine_paged_memory[addr] = (value >> 24) & 0xFF;
- zmachine_paged_memory[addr+1] = (value >> 16) & 0xFF;
- zmachine_paged_memory[addr+2] = (value >> 8) & 0xFF;
- zmachine_paged_memory[addr+3] = (value) & 0xFF;
-
- if (backpatch_error_flag)
- { backpatch_error_flag = FALSE;
- if (no_link_errors == 0)
- printf("*** MV %d ZA %d Off %04x ***\n",
- backpatch_marker, zmachine_area, offset);
- }
- }
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_bpatch_vars(void)
-{ initialise_memory_block(&zcode_backpatch_table);
- initialise_memory_block(&zmachine_backpatch_table);
-}
-
-extern void bpatch_begin_pass(void)
-{ zcode_backpatch_size = 0;
- zmachine_backpatch_size = 0;
-}
-
-extern void bpatch_allocate_arrays(void)
-{
-}
-
-extern void bpatch_free_arrays(void)
-{ deallocate_memory_block(&zcode_backpatch_table);
- deallocate_memory_block(&zmachine_backpatch_table);
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "chars" : Character set mappings and the Z-machine alphabet table */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-/* Inform uses six different character representations: */
-/* */
-/* ASCII plain ASCII characters in range $20 to $7e */
-/* (unsigned 7-bit number) */
-/* Source raw bytes from source code */
-/* (unsigned 8-bit number) */
-/* ISO plain ASCII or ISO 8859-1 to -9, according to value */
-/* character_set_setting == 0 or 1 to 9 */
-/* in Unicode mode (character_set_unicode), individual */
-/* UTF-8 bytes */
-/* (unsigned 8-bit number) */
-/* ZSCII the Z-machine's character set */
-/* (unsigned 10-bit number) */
-/* textual such as the text @'e to mean e-acute */
-/* or @$03a3 to mean capital Greek sigma */
-/* in Unicode mode, the operations manipulating multibyte */
-/* UCS representations are included in text routines */
-/* (sequence of ASCII characters) */
-/* Unicode a unifying character set holding all possible characters */
-/* Inform can ever deal with */
-/* (unsigned 16-bit number) */
-/* */
-/* Conversion can always be made down this list, but generally not up. */
-/* Note that all ASCII values are the same in any version of ISO */
-/* and in Unicode. */
-/* */
-/* There is a seventh form: sequences of 5-bit "Z-chars" which encode */
-/* ZSCII into the story file in compressed form. Conversion of ZSCII to */
-/* and from Z-char sequences, although it uses the alphabet table, is done */
-/* in "text.c". */
-/* ------------------------------------------------------------------------- */
-/* The main data structures need to be modified in mid-compilation, but */
-/* several of them depend on each other, and must remain consistent; */
-/* and rebuilding one sometimes uses conversion routines depending on */
-/* information held in the others: */
-/* */
-/* Structure If changed, need to rebuild: */
-/* character_set_setting source_to_iso_grid[] */
-/* zscii_to_unicode_grid[] */
-/* zscii_to_iso_grid[] */
-/* iso_to_unicode_grid[] */
-/* alphabet[][] iso_to_alphabet_grid[] */
-/* zscii_to_alphabet_grid[] */
-/* zscii_to_unicode_grid[] iso_to_alphabet_grid[] */
-/* source_to_iso_grid[] <nothing> */
-/* iso_to_alphabet_grid[] <nothing> */
-/* zscii_to_alphabet_grid[] <nothing> */
-/* zscii_to_iso_grid[] <nothing> */
-/* */
-/* (zscii_to_iso_grid[] is made whenever iso_to_alphabet_grid[] is */
-/* made but does not depend on alphabet[].) */
-/* */
-/* Conversion routine Makes use of: */
-/* iso_to_unicode character_set_setting */
-/* unicode_to_zscii character_set_setting */
-/* zscii_to_unicode_grid[] */
-/* zscii_to_unicode character_set_setting */
-/* zscii_to_unicode_grid[] */
-/* text_to_unicode <nothing> */
-/* zscii_to_text character_set_setting */
-/* zscii_to_unicode_grid[] */
-/* zscii_to_iso_grid[] */
-/* */
-/* For example, if we want to change alphabet[][] then we can safely */
-/* use any of the conversion routines while working on the change, but */
-/* must rebuild the iso_to_alphabet_grid[] before allowing Inform to */
-/* continue compiling. */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-uchar source_to_iso_grid[0x100]; /* Filters source code into legal ISO */
-
-int32 iso_to_unicode_grid[0x100]; /* Filters ISO into Unicode */
-
-int character_digit_value[128]; /* Parsing of binary, decimal and hex */
-
-static char *accents = /* Standard 0.2 stock of accented... */
-
- ":a:o:u:A:O:Uss>><<:e:i:y:E:I'a'e'i'o'u'y'A'E'I'O'U'Y`a`e`i`o`u\
-`A`E`I`O`U^a^e^i^o^u^A^E^I^O^UoaoA/o/O~a~n~o~A~N~OaeAEcccCthetThEtLLoeOE!!??";
-
- /* ...characters, numbered upwards */
- /* from 155 */
-
-/* ------------------------------------------------------------------------- */
-
-uchar alphabet[3][27]; /* The alphabet table. */
-
-int alphabet_modified; /* Has the default been changed? */
-
-char alphabet_used[78]; /* Flags (holding 'N' or 'Y') for
- which of the Z-alphabet letters
- have actually been encrypted */
-
-/* ------------------------------------------------------------------------- */
-
-int iso_to_alphabet_grid[0x100];
-
-/* This array combines two conversion processes which have to run quickly:
- an ISO character n is being converted for text purposes into a stream
- of Z-chars (anything from 1 up to 8 of these). Unicode but non-ISO
- characters are also converted from text, but far less often, and
- different (and slower) methods are used to carry this out.
-
- iso_to_alphabet_grid[n]
- = i if the character exists in ZSCII and is located at
- position i in the Z-machine alphabet (where 0 to 25
- give positions in A0, 26 to 51 in A1 and 52 to 77 in A2);
-
- -z if the character exists in ZSCII as value z, but is not
- located anywhere in the Z-machine alphabet;
-
- -5 if the character does not exist in ZSCII. (It will still
- be printable using an 8-Z-char sequence to encode it in
- Unicode form, but there's no ZSCII form.)
-
- Note that ISO tilde ~ is interpreted as ZSCII double-quote ",
- and ISO circumflex ^ is interpreted as ZSCII new-line, in accordance
- with the Inform syntax for strings. This is automatic from the
- structure of alphabet[][]:
-
- alphabet[i][j] = the ZSCII code of letter j (0 to 25)
- in alphabet i (0 to 2)
-
- _except that_
-
- alphabet[2][0] is ignored by the Z-machine and Inform
- (char 0 in A2 is an escape)
- alphabet[2][1] is ignored by the Z-machine
- (char 1 in A2 means new-line)
- but used by Inform to hold ISO circumflex
- so that ^ is translated as new-line
- alphabet[2][19] is used by Inform to hold ISO tilde
- so that ~ is translated as ": after
- compilation, when the alphabet table is
- written into the Z-machine, this entry
- is changed back to ".
-
- Note that the alphabet can only hold ZSCII values between 0 and 255.
-
- The array is dimensioned as [3][27], not [3][26], to make it easier to
- initialise using strcpy (see below), but the zero entries [x][26] are
- not used */
-
-int zscii_to_alphabet_grid[0x100];
-
-/* The same, except that the index is a ZSCII character, not an ISO one. */
-
-int zscii_to_iso_grid[0x100]; /* Converts ZSCII between 0 and 255 to
- codes in current ISO set: or to 0 if
- code isn't in the current ISO set. */
-
-static void make_iso_to_alphabet_grid(void)
-{ int i, j, k; int z;
-
- for (j=0; j<0x100; j++)
- { zscii_to_iso_grid[j] = 0;
- zscii_to_alphabet_grid[j] = -j;
- }
-
- for (j=0; j<0x100; j++)
- { iso_to_alphabet_grid[j]=-5;
- if ((j >= 0x20) && (j <= 0x7e))
- { iso_to_alphabet_grid[j] = -j;
- zscii_to_iso_grid[j] = j;
- }
- if ((j >= 0xa1) && (j <= 0xff))
- { z = unicode_to_zscii(iso_to_unicode(j));
- if (character_set_setting != 0)
- zscii_to_iso_grid[z] = j;
- iso_to_alphabet_grid[j] = -z;
- }
- iso_to_unicode_grid[j] = iso_to_unicode(j);
- }
- for (j=0; j<3; j++)
- for (k=(j<2?0:1); k<26; k++)
- { i=(int) ((alphabet[j])[k]);
- zscii_to_alphabet_grid[i] = k + j*26;
- iso_to_alphabet_grid[zscii_to_iso_grid[i]] = k + j*26;
- }
-}
-
-extern void map_new_zchar(int32 unicode)
-{ /* Attempts to enter the given Unicode character into the "alphabet[]"
- array, in place of one which has not so far been used in the
- compilation of the current file. This may of course fail. */
-
- int i, j; int zscii;
-
- zscii = unicode_to_zscii(unicode);
-
- /* Out of ZSCII range? */
- if ((zscii == 5) || (zscii >= 0x100))
- { unicode_char_error(
- "Character must first be entered into Zcharacter table:", unicode);
- return;
- }
-
- /* Already there? */
- for (i=0;i<3;i++) for (j=0;j<26;j++)
- if (alphabet[i][j] == zscii) return;
-
- /* A0 and A1 are never changed. Try to find a place in alphabet A2:
-
- xx0123456789.,!?_#'~/\-:()
- ^^^^^^^^^^ ^^^^^ ^^^^^^
-
- The letters marked ^ are considered to be replaceable, as long as
- they haven't yet been used in any text already encoded, and haven't
- already been replaced. The routine works along from the left, since
- numerals are more of a luxury than punctuation. */
-
- for (i=2; i<26; i++)
- { if ((i == 12) || (i == 13) || (i == 19)) continue;
- if (alphabet_used[52+i] == 'N')
- { alphabet_used[52+i] = 'Y';
- alphabet[2][i] = zscii;
- alphabet_modified = TRUE;
- make_iso_to_alphabet_grid();
- return;
- }
- }
-}
-
-extern void new_alphabet(char *text, int which_alph)
-{
- /* Called three times in succession, with which_alph = 0, 1, 2 */
-
- int i, j, zscii; int32 unicode;
-
- alphabet_modified = TRUE;
-
- if (which_alph == 2)
- { i=3; alphabet[2][2] = '~';
- }
- else i=0;
-
- for (j=0; i<26; i++)
- { if (text[j] == 0) goto WrongSizeError;
-
- unicode = text_to_unicode(text+j);
- j += textual_form_length;
-
- zscii = unicode_to_zscii(unicode);
- if ((zscii == 5) || (zscii >= 0x100))
- unicode_char_error("Character can't be used in alphabets unless \
-entered into Zcharacter table", unicode);
- else alphabet[which_alph][i] = zscii;
- }
-
- if (text[j] != 0)
- { WrongSizeError:
- if (which_alph == 2)
- error("Alphabet string must give exactly 23 characters");
- else
- error("Alphabet string must give exactly 26 characters");
- }
-
- if (which_alph == 2)
- { int test_dups[0x100];
- for (i=0; i<0x100; i++) test_dups[i] = 0;
- for (i=0; i<3; i++) for (j=0; j<26; j++)
- { if (test_dups[alphabet[i][j]]++ == 1)
- unicode_char_error("Character duplicated in alphabet:",
- zscii_to_unicode(alphabet[i][j]));
- }
-
- make_iso_to_alphabet_grid();
- }
-}
-
-static void read_source_to_iso_file(uchar *uccg)
-{ FILE *charset_file;
- char cs_buff[256];
- char *p;
- int i=0;
-
- charset_file=fopen(Charset_Map, "r");
- if (charset_file==NULL)
- fatalerror_named("Couldn't open character set mapping", Charset_Map);
-
- while (feof(charset_file)==0)
- { if (fgets(cs_buff,256,charset_file)==0) break;
-
- switch (cs_buff[0])
- { case '!': /* Ignore comments in file */
- break;
- case 'C': /* Set character set */
- character_set_setting = cs_buff[1]-'0';
- if ((character_set_setting < 0) || (character_set_setting > 9))
- { fatalerror_named("Character set in mapping must be 0 to 9",
- Charset_Map);
- }
- break;
- default:
- p = cs_buff;
- while ((i<256) && (p!=NULL))
- {
- uccg[i++] = (uchar)atoi(p);
- p = strchr(p,',');
- if (p != NULL)
- p++;
- }
- break;
- }
- }
- fclose(charset_file);
-}
-
-/* ========================================================================= */
-/* Conversion functions (without side effects) */
-/* ------------------------------------------------------------------------- */
-/* (1) Source -> ISO */
-/* */
-/* 00 remains 0 (meaning "end of file") */
-/* TAB becomes SPACE */
-/* 0c ("form feed") becomes '\n' */
-/* 0d becomes '\n' */
-/* other control characters become '?' */
-/* 7f becomes '?' */
-/* 80 to 9f become '?' */
-/* a0 (ISO "non-breaking space") becomes SPACE */
-/* ad (ISO "soft hyphen") becomes '-' */
-/* any character undefined in ISO is mapped to '?' */
-/* In Unicode mode, characters 80 and upwards are preserved. */
-/* */
-/* ------------------------------------------------------------------------- */
-
-static void make_source_to_iso_grid(void)
-{ int n; uchar *uccg = (uchar *) source_to_iso_grid;
-
- for (n=0; n<0x100; n++) uccg[n] = (char) n;
-
- if (Charset_Map[0] != '\0')
- read_source_to_iso_file(uccg);
- else
- { source_to_iso_grid[0] = (char) 0;
- 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[127] = '?';
- source_to_iso_grid[TAB_CHARACTER] = ' ';
-
- if (character_set_unicode) /* No need to meddle with 8-bit for UTF-8 */
- return;
-
- for (n=0x80; n<0xa0; n++) source_to_iso_grid[n] = '?';
- source_to_iso_grid[0xa0] = ' ';
- source_to_iso_grid[0xad] = '-';
-
- switch(character_set_setting)
- { case 0:
- for (n=0xa0; n<0x100; n++)
- source_to_iso_grid[n] = '?';
- break;
- case 6: /* Arabic */
- for (n=0xa0; n<0xc1; n++)
- switch(n)
- { case 0xa0: case 0xa4: case 0xac: case 0xad:
- case 0xbb: case 0xbf: break;
- default: source_to_iso_grid[n] = '?';
- }
- for (n=0xdb; n<0xe0; n++)
- source_to_iso_grid[n] = '?';
- for (n=0xf3; n<0x100; n++)
- source_to_iso_grid[n] = '?';
- break;
- case 7: /* Greek */
- source_to_iso_grid[0xa4] = '?';
- source_to_iso_grid[0xa5] = '?';
- source_to_iso_grid[0xaa] = '?';
- source_to_iso_grid[0xae] = '?';
- source_to_iso_grid[0xd2] = '?';
- source_to_iso_grid[0xff] = '?';
- break;
- case 8: /* Hebrew */
- source_to_iso_grid[0xa1] = '?';
- for (n=0xbf; n<0xdf; n++)
- source_to_iso_grid[n] = '?';
- for (n=0xfb; n<0x100; n++)
- source_to_iso_grid[n] = '?';
- break;
- }
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* (2) ISO -> Unicode */
-/* */
-/* Need not be rapid, as the results are mostly cached. */
-/* Always succeeds. */
-/* ------------------------------------------------------------------------- */
-
-extern int iso_to_unicode(int iso)
-{ int u = iso;
- switch(character_set_setting)
- {
-
- case 0: /* Plain ASCII only */
- break;
-
- case 1: /* ISO 8859-1: Latin1: west European */
- break;
-
- case 2: /* ISO 8859-2: Latin2: central European */
-
-switch(iso)
-{ case 0xA1: u=0x0104; break; /* LATIN CAP A WITH OGONEK */
- case 0xA2: u=0x02D8; break; /* BREVE */
- case 0xA3: u=0x0141; break; /* LATIN CAP L WITH STROKE */
- case 0xA5: u=0x013D; break; /* LATIN CAP L WITH CARON */
- case 0xA6: u=0x015A; break; /* LATIN CAP S WITH ACUTE */
- case 0xA9: u=0x0160; break; /* LATIN CAP S WITH CARON */
- case 0xAA: u=0x015E; break; /* LATIN CAP S WITH CEDILLA */
- case 0xAB: u=0x0164; break; /* LATIN CAP T WITH CARON */
- case 0xAC: u=0x0179; break; /* LATIN CAP Z WITH ACUTE */
- case 0xAE: u=0x017D; break; /* LATIN CAP Z WITH CARON */
- case 0xAF: u=0x017B; break; /* LATIN CAP Z WITH DOT ABOVE */
- case 0xB1: u=0x0105; break; /* LATIN SMALL A WITH OGONEK */
- case 0xB2: u=0x02DB; break; /* OGONEK */
- case 0xB3: u=0x0142; break; /* LATIN SMALL L WITH STROKE */
- case 0xB5: u=0x013E; break; /* LATIN SMALL L WITH CARON */
- case 0xB6: u=0x015B; break; /* LATIN SMALL S WITH ACUTE */
- case 0xB7: u=0x02C7; break; /* CARON */
- case 0xB9: u=0x0161; break; /* LATIN SMALL S WITH CARON */
- case 0xBA: u=0x015F; break; /* LATIN SMALL S WITH CEDILLA */
- case 0xBB: u=0x0165; break; /* LATIN SMALL T WITH CARON */
- case 0xBC: u=0x017A; break; /* LATIN SMALL Z WITH ACUTE */
- case 0xBD: u=0x02DD; break; /* DOUBLE ACUTE ACCENT */
- case 0xBE: u=0x017E; break; /* LATIN SMALL Z WITH CARON */
- case 0xBF: u=0x017C; break; /* LATIN SMALL Z WITH DOT ABOVE */
- case 0xC0: u=0x0154; break; /* LATIN CAP R WITH ACUTE */
- case 0xC3: u=0x0102; break; /* LATIN CAP A WITH BREVE */
- case 0xC5: u=0x0139; break; /* LATIN CAP L WITH ACUTE */
- case 0xC6: u=0x0106; break; /* LATIN CAP C WITH ACUTE */
- case 0xC8: u=0x010C; break; /* LATIN CAP C WITH CARON */
- case 0xCA: u=0x0118; break; /* LATIN CAP E WITH OGONEK */
- case 0xCC: u=0x011A; break; /* LATIN CAP E WITH CARON */
- case 0xCF: u=0x010E; break; /* LATIN CAP D WITH CARON */
- case 0xD0: u=0x0110; break; /* LATIN CAP D WITH STROKE */
- case 0xD1: u=0x0143; break; /* LATIN CAP N WITH ACUTE */
- case 0xD2: u=0x0147; break; /* LATIN CAP N WITH CARON */
- case 0xD5: u=0x0150; break; /* LATIN CAP O WITH DOUBLE ACUTE */
- case 0xD8: u=0x0158; break; /* LATIN CAP R WITH CARON */
- case 0xD9: u=0x016E; break; /* LATIN CAP U WITH RING ABOVE */
- case 0xDB: u=0x0170; break; /* LATIN CAP U WITH DOUBLE ACUTE */
- case 0xDE: u=0x0162; break; /* LATIN CAP T WITH CEDILLA */
- case 0xE0: u=0x0155; break; /* LATIN SMALL R WITH ACUTE */
- case 0xE3: u=0x0103; break; /* LATIN SMALL A WITH BREVE */
- case 0xE5: u=0x013A; break; /* LATIN SMALL L WITH ACUTE */
- case 0xE6: u=0x0107; break; /* LATIN SMALL C WITH ACUTE */
- case 0xE8: u=0x010D; break; /* LATIN SMALL C WITH CARON */
- case 0xEA: u=0x0119; break; /* LATIN SMALL E WITH OGONEK */
- case 0xEC: u=0x011B; break; /* LATIN SMALL E WITH CARON */
- case 0xEF: u=0x010F; break; /* LATIN SMALL D WITH CARON */
- case 0xF0: u=0x0111; break; /* LATIN SMALL D WITH STROKE */
- case 0xF1: u=0x0144; break; /* LATIN SMALL N WITH ACUTE */
- case 0xF2: u=0x0148; break; /* LATIN SMALL N WITH CARON */
- case 0xF5: u=0x0151; break; /* LATIN SMALL O WITH DOUBLE ACUTE */
- case 0xF8: u=0x0159; break; /* LATIN SMALL R WITH CARON */
- case 0xF9: u=0x016F; break; /* LATIN SMALL U WITH RING ABOVE */
- case 0xFB: u=0x0171; break; /* LATIN SMALL U WITH DOUBLE ACUTE */
- case 0xFE: u=0x0163; break; /* LATIN SMALL T WITH CEDILLA */
- case 0xFF: u=0x02D9; break; /* DOT ABOVE */
-} break;
-
- case 3: /* ISO 8859-3: Latin3: central European */
-
-switch(iso)
-{ case 0xA1: u=0x0126; break; /* LATIN CAP H WITH STROKE */
- case 0xA2: u=0x02D8; break; /* BREVE */
- case 0xA6: u=0x0124; break; /* LATIN CAP H WITH CIRCUMFLEX */
- case 0xA9: u=0x0130; break; /* LATIN CAP I WITH DOT ABOVE */
- case 0xAA: u=0x015E; break; /* LATIN CAP S WITH CEDILLA */
- case 0xAB: u=0x011E; break; /* LATIN CAP G WITH BREVE */
- case 0xAC: u=0x0134; break; /* LATIN CAP J WITH CIRCUMFLEX */
- case 0xAF: u=0x017B; break; /* LATIN CAP Z WITH DOT ABOVE */
- case 0xB1: u=0x0127; break; /* LATIN SMALL H WITH STROKE */
- case 0xB6: u=0x0125; break; /* LATIN SMALL H WITH CIRCUMFLEX */
- case 0xB9: u=0x0131; break; /* LATIN SMALL DOTLESS I */
- case 0xBA: u=0x015F; break; /* LATIN SMALL S WITH CEDILLA */
- case 0xBB: u=0x011F; break; /* LATIN SMALL G WITH BREVE */
- case 0xBC: u=0x0135; break; /* LATIN SMALL J WITH CIRCUMFLEX */
- case 0xBF: u=0x017C; break; /* LATIN SMALL Z WITH DOT ABOVE */
- case 0xC5: u=0x010A; break; /* LATIN CAP C WITH DOT ABOVE */
- case 0xC6: u=0x0108; break; /* LATIN CAP C WITH CIRCUMFLEX */
- case 0xD5: u=0x0120; break; /* LATIN CAP G WITH DOT ABOVE */
- case 0xD8: u=0x011C; break; /* LATIN CAP G WITH CIRCUMFLEX */
- case 0xDD: u=0x016C; break; /* LATIN CAP U WITH BREVE */
- case 0xDE: u=0x015C; break; /* LATIN CAP S WITH CIRCUMFLEX */
- case 0xE5: u=0x010B; break; /* LATIN SMALL C WITH DOT ABOVE */
- case 0xE6: u=0x0109; break; /* LATIN SMALL C WITH CIRCUMFLEX */
- case 0xF5: u=0x0121; break; /* LATIN SMALL G WITH DOT ABOVE */
- case 0xF8: u=0x011D; break; /* LATIN SMALL G WITH CIRCUMFLEX */
- case 0xFD: u=0x016D; break; /* LATIN SMALL U WITH BREVE */
- case 0xFE: u=0x015D; break; /* LATIN SMALL S WITH CIRCUMFLEX */
- case 0xFF: u=0x02D9; break; /* DOT ABOVE */
-} break;
-
- case 4: /* ISO 8859-4: Latin4: central European */
-
-switch(iso)
-{ case 0xA1: u=0x0104; break; /* LATIN CAP A WITH OGONEK */
- case 0xA2: u=0x0138; break; /* LATIN SMALL KRA */
- case 0xA3: u=0x0156; break; /* LATIN CAP R WITH CEDILLA */
- case 0xA5: u=0x0128; break; /* LATIN CAP I WITH TILDE */
- case 0xA6: u=0x013B; break; /* LATIN CAP L WITH CEDILLA */
- case 0xA9: u=0x0160; break; /* LATIN CAP S WITH CARON */
- case 0xAA: u=0x0112; break; /* LATIN CAP E WITH MACRON */
- case 0xAB: u=0x0122; break; /* LATIN CAP G WITH CEDILLA */
- case 0xAC: u=0x0166; break; /* LATIN CAP T WITH STROKE */
- case 0xAE: u=0x017D; break; /* LATIN CAP Z WITH CARON */
- case 0xB1: u=0x0105; break; /* LATIN SMALL A WITH OGONEK */
- case 0xB2: u=0x02DB; break; /* OGONEK */
- case 0xB3: u=0x0157; break; /* LATIN SMALL R WITH CEDILLA */
- case 0xB5: u=0x0129; break; /* LATIN SMALL I WITH TILDE */
- case 0xB6: u=0x013C; break; /* LATIN SMALL L WITH CEDILLA */
- case 0xB7: u=0x02C7; break; /* CARON */
- case 0xB9: u=0x0161; break; /* LATIN SMALL S WITH CARON */
- case 0xBA: u=0x0113; break; /* LATIN SMALL E WITH MACRON */
- case 0xBB: u=0x0123; break; /* LATIN SMALL G WITH CEDILLA */
- case 0xBC: u=0x0167; break; /* LATIN SMALL T WITH STROKE */
- case 0xBD: u=0x014A; break; /* LATIN CAP ENG */
- case 0xBE: u=0x017E; break; /* LATIN SMALL Z WITH CARON */
- case 0xBF: u=0x014B; break; /* LATIN SMALL ENG */
- case 0xC0: u=0x0100; break; /* LATIN CAP A WITH MACRON */
- case 0xC7: u=0x012E; break; /* LATIN CAP I WITH OGONEK */
- case 0xC8: u=0x010C; break; /* LATIN CAP C WITH CARON */
- case 0xCA: u=0x0118; break; /* LATIN CAP E WITH OGONEK */
- case 0xCC: u=0x0116; break; /* LATIN CAP E WITH DOT ABOVE */
- case 0xCF: u=0x012A; break; /* LATIN CAP I WITH MACRON */
- case 0xD0: u=0x0110; break; /* LATIN CAP D WITH STROKE */
- case 0xD1: u=0x0145; break; /* LATIN CAP N WITH CEDILLA */
- case 0xD2: u=0x014C; break; /* LATIN CAP O WITH MACRON */
- case 0xD3: u=0x0136; break; /* LATIN CAP K WITH CEDILLA */
- case 0xD9: u=0x0172; break; /* LATIN CAP U WITH OGONEK */
- case 0xDD: u=0x0168; break; /* LATIN CAP U WITH TILDE */
- case 0xDE: u=0x016A; break; /* LATIN CAP U WITH MACRON */
- case 0xE0: u=0x0101; break; /* LATIN SMALL A WITH MACRON */
- case 0xE7: u=0x012F; break; /* LATIN SMALL I WITH OGONEK */
- case 0xE8: u=0x010D; break; /* LATIN SMALL C WITH CARON */
- case 0xEA: u=0x0119; break; /* LATIN SMALL E WITH OGONEK */
- case 0xEC: u=0x0117; break; /* LATIN SMALL E WITH DOT ABOVE */
- case 0xEF: u=0x012B; break; /* LATIN SMALL I WITH MACRON */
- case 0xF0: u=0x0111; break; /* LATIN SMALL D WITH STROKE */
- case 0xF1: u=0x0146; break; /* LATIN SMALL N WITH CEDILLA */
- case 0xF2: u=0x014D; break; /* LATIN SMALL O WITH MACRON */
- case 0xF3: u=0x0137; break; /* LATIN SMALL K WITH CEDILLA */
- case 0xF9: u=0x0173; break; /* LATIN SMALL U WITH OGONEK */
- case 0xFD: u=0x0169; break; /* LATIN SMALL U WITH TILDE */
- case 0xFE: u=0x016B; break; /* LATIN SMALL U WITH MACRON */
- case 0xFF: u=0x02D9; break; /* DOT ABOVE */
-} break;
-
- case 5: /* ISO 8859-5: Cyrillic */
-
-switch(iso)
-{ case 0xA1: u=0x0401; break; /* CYRILLIC CAP IO */
- case 0xA2: u=0x0402; break; /* CYRILLIC CAP DJE */
- case 0xA3: u=0x0403; break; /* CYRILLIC CAP GJE */
- case 0xA4: u=0x0404; break; /* CYRILLIC CAP UKRAINIAN IE */
- case 0xA5: u=0x0405; break; /* CYRILLIC CAP DZE */
- case 0xA6: u=0x0406; break; /* CYRILLIC CAP BYELORUSSIAN-UKRAINIAN I */
- case 0xA7: u=0x0407; break; /* CYRILLIC CAP YI */
- case 0xA8: u=0x0408; break; /* CYRILLIC CAP JE */
- case 0xA9: u=0x0409; break; /* CYRILLIC CAP LJE */
- case 0xAA: u=0x040A; break; /* CYRILLIC CAP NJE */
- case 0xAB: u=0x040B; break; /* CYRILLIC CAP TSHE */
- case 0xAC: u=0x040C; break; /* CYRILLIC CAP KJE */
- case 0xAE: u=0x040E; break; /* CYRILLIC CAP SHORT U */
- case 0xAF: u=0x040F; break; /* CYRILLIC CAP DZHE */
- case 0xB0: u=0x0410; break; /* CYRILLIC CAP A */
- case 0xB1: u=0x0411; break; /* CYRILLIC CAP BE */
- case 0xB2: u=0x0412; break; /* CYRILLIC CAP VE */
- case 0xB3: u=0x0413; break; /* CYRILLIC CAP GHE */
- case 0xB4: u=0x0414; break; /* CYRILLIC CAP DE */
- case 0xB5: u=0x0415; break; /* CYRILLIC CAP IE */
- case 0xB6: u=0x0416; break; /* CYRILLIC CAP ZHE */
- case 0xB7: u=0x0417; break; /* CYRILLIC CAP ZE */
- case 0xB8: u=0x0418; break; /* CYRILLIC CAP I */
- case 0xB9: u=0x0419; break; /* CYRILLIC CAP SHORT I */
- case 0xBA: u=0x041A; break; /* CYRILLIC CAP KA */
- case 0xBB: u=0x041B; break; /* CYRILLIC CAP EL */
- case 0xBC: u=0x041C; break; /* CYRILLIC CAP EM */
- case 0xBD: u=0x041D; break; /* CYRILLIC CAP EN */
- case 0xBE: u=0x041E; break; /* CYRILLIC CAP O */
- case 0xBF: u=0x041F; break; /* CYRILLIC CAP PE */
- case 0xC0: u=0x0420; break; /* CYRILLIC CAP ER */
- case 0xC1: u=0x0421; break; /* CYRILLIC CAP ES */
- case 0xC2: u=0x0422; break; /* CYRILLIC CAP TE */
- case 0xC3: u=0x0423; break; /* CYRILLIC CAP U */
- case 0xC4: u=0x0424; break; /* CYRILLIC CAP EF */
- case 0xC5: u=0x0425; break; /* CYRILLIC CAP HA */
- case 0xC6: u=0x0426; break; /* CYRILLIC CAP TSE */
- case 0xC7: u=0x0427; break; /* CYRILLIC CAP CHE */
- case 0xC8: u=0x0428; break; /* CYRILLIC CAP SHA */
- case 0xC9: u=0x0429; break; /* CYRILLIC CAP SHCHA */
- case 0xCA: u=0x042A; break; /* CYRILLIC CAP HARD SIGN */
- case 0xCB: u=0x042B; break; /* CYRILLIC CAP YERU */
- case 0xCC: u=0x042C; break; /* CYRILLIC CAP SOFT SIGN */
- case 0xCD: u=0x042D; break; /* CYRILLIC CAP E */
- case 0xCE: u=0x042E; break; /* CYRILLIC CAP YU */
- case 0xCF: u=0x042F; break; /* CYRILLIC CAP YA */
- case 0xD0: u=0x0430; break; /* CYRILLIC SMALL A */
- case 0xD1: u=0x0431; break; /* CYRILLIC SMALL BE */
- case 0xD2: u=0x0432; break; /* CYRILLIC SMALL VE */
- case 0xD3: u=0x0433; break; /* CYRILLIC SMALL GHE */
- case 0xD4: u=0x0434; break; /* CYRILLIC SMALL DE */
- case 0xD5: u=0x0435; break; /* CYRILLIC SMALL IE */
- case 0xD6: u=0x0436; break; /* CYRILLIC SMALL ZHE */
- case 0xD7: u=0x0437; break; /* CYRILLIC SMALL ZE */
- case 0xD8: u=0x0438; break; /* CYRILLIC SMALL I */
- case 0xD9: u=0x0439; break; /* CYRILLIC SMALL SHORT I */
- case 0xDA: u=0x043A; break; /* CYRILLIC SMALL KA */
- case 0xDB: u=0x043B; break; /* CYRILLIC SMALL EL */
- case 0xDC: u=0x043C; break; /* CYRILLIC SMALL EM */
- case 0xDD: u=0x043D; break; /* CYRILLIC SMALL EN */
- case 0xDE: u=0x043E; break; /* CYRILLIC SMALL O */
- case 0xDF: u=0x043F; break; /* CYRILLIC SMALL PE */
- case 0xE0: u=0x0440; break; /* CYRILLIC SMALL ER */
- case 0xE1: u=0x0441; break; /* CYRILLIC SMALL ES */
- case 0xE2: u=0x0442; break; /* CYRILLIC SMALL TE */
- case 0xE3: u=0x0443; break; /* CYRILLIC SMALL U */
- case 0xE4: u=0x0444; break; /* CYRILLIC SMALL EF */
- case 0xE5: u=0x0445; break; /* CYRILLIC SMALL HA */
- case 0xE6: u=0x0446; break; /* CYRILLIC SMALL TSE */
- case 0xE7: u=0x0447; break; /* CYRILLIC SMALL CHE */
- case 0xE8: u=0x0448; break; /* CYRILLIC SMALL SHA */
- case 0xE9: u=0x0449; break; /* CYRILLIC SMALL SHCHA */
- case 0xEA: u=0x044A; break; /* CYRILLIC SMALL HARD SIGN */
- case 0xEB: u=0x044B; break; /* CYRILLIC SMALL YERU */
- case 0xEC: u=0x044C; break; /* CYRILLIC SMALL SOFT SIGN */
- case 0xED: u=0x044D; break; /* CYRILLIC SMALL E */
- case 0xEE: u=0x044E; break; /* CYRILLIC SMALL YU */
- case 0xEF: u=0x044F; break; /* CYRILLIC SMALL YA */
- case 0xF0: u=0x2116; break; /* NUMERO SIGN */
- case 0xF1: u=0x0451; break; /* CYRILLIC SMALL IO */
- case 0xF2: u=0x0452; break; /* CYRILLIC SMALL DJE */
- case 0xF3: u=0x0453; break; /* CYRILLIC SMALL GJE */
- case 0xF4: u=0x0454; break; /* CYRILLIC SMALL UKRAINIAN IE */
- case 0xF5: u=0x0455; break; /* CYRILLIC SMALL DZE */
- case 0xF6: u=0x0456; break; /* CYRILLIC SMALL BYELORUSSIAN-UKRAINIAN I */
- case 0xF7: u=0x0457; break; /* CYRILLIC SMALL YI */
- case 0xF8: u=0x0458; break; /* CYRILLIC SMALL JE */
- case 0xF9: u=0x0459; break; /* CYRILLIC SMALL LJE */
- case 0xFA: u=0x045A; break; /* CYRILLIC SMALL NJE */
- case 0xFB: u=0x045B; break; /* CYRILLIC SMALL TSHE */
- case 0xFC: u=0x045C; break; /* CYRILLIC SMALL KJE */
- case 0xFD: u=0x00A7; break; /* SECTION SIGN */
- case 0xFE: u=0x045E; break; /* CYRILLIC SMALL SHORT U */
- case 0xFF: u=0x045F; break; /* CYRILLIC SMALL DZHE */
-} break;
-
- case 6: /* ISO 8859-6: Arabic */
-
-switch(iso)
-{ case 0xAC: u=0x060C; break; /* ARABIC COMMA */
- case 0xBB: u=0x061B; break; /* ARABIC SEMICOLON */
- case 0xBF: u=0x061F; break; /* ARABIC QUESTION MARK */
- case 0xC1: u=0x0621; break; /* ARABIC HAMZA */
- case 0xC2: u=0x0622; break; /* ARABIC ALEF WITH MADDA ABOVE */
- case 0xC3: u=0x0623; break; /* ARABIC ALEF WITH HAMZA ABOVE */
- case 0xC4: u=0x0624; break; /* ARABIC WAW WITH HAMZA ABOVE */
- case 0xC5: u=0x0625; break; /* ARABIC ALEF WITH HAMZA BELOW */
- case 0xC6: u=0x0626; break; /* ARABIC YEH WITH HAMZA ABOVE */
- case 0xC7: u=0x0627; break; /* ARABIC ALEF */
- case 0xC8: u=0x0628; break; /* ARABIC BEH */
- case 0xC9: u=0x0629; break; /* ARABIC TEH MARBUTA */
- case 0xCA: u=0x062A; break; /* ARABIC TEH */
- case 0xCB: u=0x062B; break; /* ARABIC THEH */
- case 0xCC: u=0x062C; break; /* ARABIC JEEM */
- case 0xCD: u=0x062D; break; /* ARABIC HAH */
- case 0xCE: u=0x062E; break; /* ARABIC KHAH */
- case 0xCF: u=0x062F; break; /* ARABIC DAL */
- case 0xD0: u=0x0630; break; /* ARABIC THAL */
- case 0xD1: u=0x0631; break; /* ARABIC REH */
- case 0xD2: u=0x0632; break; /* ARABIC ZAIN */
- case 0xD3: u=0x0633; break; /* ARABIC SEEN */
- case 0xD4: u=0x0634; break; /* ARABIC SHEEN */
- case 0xD5: u=0x0635; break; /* ARABIC SAD */
- case 0xD6: u=0x0636; break; /* ARABIC DAD */
- case 0xD7: u=0x0637; break; /* ARABIC TAH */
- case 0xD8: u=0x0638; break; /* ARABIC ZAH */
- case 0xD9: u=0x0639; break; /* ARABIC AIN */
- case 0xDA: u=0x063A; break; /* ARABIC GHAIN */
- case 0xE0: u=0x0640; break; /* ARABIC TATWEEL */
- case 0xE1: u=0x0641; break; /* ARABIC FEH */
- case 0xE2: u=0x0642; break; /* ARABIC QAF */
- case 0xE3: u=0x0643; break; /* ARABIC KAF */
- case 0xE4: u=0x0644; break; /* ARABIC LAM */
- case 0xE5: u=0x0645; break; /* ARABIC MEEM */
- case 0xE6: u=0x0646; break; /* ARABIC NOON */
- case 0xE7: u=0x0647; break; /* ARABIC HEH */
- case 0xE8: u=0x0648; break; /* ARABIC WAW */
- case 0xE9: u=0x0649; break; /* ARABIC ALEF MAKSURA */
- case 0xEA: u=0x064A; break; /* ARABIC YEH */
- case 0xEB: u=0x064B; break; /* ARABIC FATHATAN */
- case 0xEC: u=0x064C; break; /* ARABIC DAMMATAN */
- case 0xED: u=0x064D; break; /* ARABIC KASRATAN */
- case 0xEE: u=0x064E; break; /* ARABIC FATHA */
- case 0xEF: u=0x064F; break; /* ARABIC DAMMA */
- case 0xF0: u=0x0650; break; /* ARABIC KASRA */
- case 0xF1: u=0x0651; break; /* ARABIC SHADDA */
- case 0xF2: u=0x0652; break; /* ARABIC SUKUN */
-} break;
-
- case 7: /* ISO 8859-7: Greek */
-
-switch(iso)
-{ case 0xA1: u=0x02BD; break; /* MODIFIER REVERSED COMMA */
- case 0xA2: u=0x02BC; break; /* MODIFIER APOSTROPHE */
- case 0xAF: u=0x2015; break; /* HORIZONTAL BAR */
- case 0xB4: u=0x0384; break; /* GREEK TONOS */
- case 0xB5: u=0x0385; break; /* GREEK DIALYTIKA TONOS */
- case 0xB6: u=0x0386; break; /* GREEK CAP ALPHA WITH TONOS */
- case 0xB8: u=0x0388; break; /* GREEK CAP EPSILON WITH TONOS */
- case 0xB9: u=0x0389; break; /* GREEK CAP ETA WITH TONOS */
- case 0xBA: u=0x038A; break; /* GREEK CAP IOTA WITH TONOS */
- case 0xBC: u=0x038C; break; /* GREEK CAP OMICRON WITH TONOS */
- case 0xBE: u=0x038E; break; /* GREEK CAP UPSILON WITH TONOS */
- case 0xBF: u=0x038F; break; /* GREEK CAP OMEGA WITH TONOS */
- case 0xC0: u=0x0390; break; /* GREEK SMALL IOTA WITH DIALYTIKA AND TONOS */
- case 0xC1: u=0x0391; break; /* GREEK CAP ALPHA */
- case 0xC2: u=0x0392; break; /* GREEK CAP BETA */
- case 0xC3: u=0x0393; break; /* GREEK CAP GAMMA */
- case 0xC4: u=0x0394; break; /* GREEK CAP DELTA */
- case 0xC5: u=0x0395; break; /* GREEK CAP EPSILON */
- case 0xC6: u=0x0396; break; /* GREEK CAP ZETA */
- case 0xC7: u=0x0397; break; /* GREEK CAP ETA */
- case 0xC8: u=0x0398; break; /* GREEK CAP THETA */
- case 0xC9: u=0x0399; break; /* GREEK CAP IOTA */
- case 0xCA: u=0x039A; break; /* GREEK CAP KAPPA */
- case 0xCB: u=0x039B; break; /* GREEK CAP LAMDA */
- case 0xCC: u=0x039C; break; /* GREEK CAP MU */
- case 0xCD: u=0x039D; break; /* GREEK CAP NU */
- case 0xCE: u=0x039E; break; /* GREEK CAP XI */
- case 0xCF: u=0x039F; break; /* GREEK CAP OMICRON */
- case 0xD0: u=0x03A0; break; /* GREEK CAP PI */
- case 0xD1: u=0x03A1; break; /* GREEK CAP RHO */
- case 0xD3: u=0x03A3; break; /* GREEK CAP SIGMA */
- case 0xD4: u=0x03A4; break; /* GREEK CAP TAU */
- case 0xD5: u=0x03A5; break; /* GREEK CAP UPSILON */
- case 0xD6: u=0x03A6; break; /* GREEK CAP PHI */
- case 0xD7: u=0x03A7; break; /* GREEK CAP CHI */
- case 0xD8: u=0x03A8; break; /* GREEK CAP PSI */
- case 0xD9: u=0x03A9; break; /* GREEK CAP OMEGA */
- case 0xDA: u=0x03AA; break; /* GREEK CAP IOTA WITH DIALYTIKA */
- case 0xDB: u=0x03AB; break; /* GREEK CAP UPSILON WITH DIALYTIKA */
- case 0xDC: u=0x03AC; break; /* GREEK SMALL ALPHA WITH TONOS */
- case 0xDD: u=0x03AD; break; /* GREEK SMALL EPSILON WITH TONOS */
- case 0xDE: u=0x03AE; break; /* GREEK SMALL ETA WITH TONOS */
- case 0xDF: u=0x03AF; break; /* GREEK SMALL IOTA WITH TONOS */
- case 0xE0: u=0x03B0; break; /* GREEK SMALL UPSILON WITH DIALYTIKA AND TONOS */
- case 0xE1: u=0x03B1; break; /* GREEK SMALL ALPHA */
- case 0xE2: u=0x03B2; break; /* GREEK SMALL BETA */
- case 0xE3: u=0x03B3; break; /* GREEK SMALL GAMMA */
- case 0xE4: u=0x03B4; break; /* GREEK SMALL DELTA */
- case 0xE5: u=0x03B5; break; /* GREEK SMALL EPSILON */
- case 0xE6: u=0x03B6; break; /* GREEK SMALL ZETA */
- case 0xE7: u=0x03B7; break; /* GREEK SMALL ETA */
- case 0xE8: u=0x03B8; break; /* GREEK SMALL THETA */
- case 0xE9: u=0x03B9; break; /* GREEK SMALL IOTA */
- case 0xEA: u=0x03BA; break; /* GREEK SMALL KAPPA */
- case 0xEB: u=0x03BB; break; /* GREEK SMALL LAMDA */
- case 0xEC: u=0x03BC; break; /* GREEK SMALL MU */
- case 0xED: u=0x03BD; break; /* GREEK SMALL NU */
- case 0xEE: u=0x03BE; break; /* GREEK SMALL XI */
- case 0xEF: u=0x03BF; break; /* GREEK SMALL OMICRON */
- case 0xF0: u=0x03C0; break; /* GREEK SMALL PI */
- case 0xF1: u=0x03C1; break; /* GREEK SMALL RHO */
- case 0xF2: u=0x03C2; break; /* GREEK SMALL FINAL SIGMA */
- case 0xF3: u=0x03C3; break; /* GREEK SMALL SIGMA */
- case 0xF4: u=0x03C4; break; /* GREEK SMALL TAU */
- case 0xF5: u=0x03C5; break; /* GREEK SMALL UPSILON */
- case 0xF6: u=0x03C6; break; /* GREEK SMALL PHI */
- case 0xF7: u=0x03C7; break; /* GREEK SMALL CHI */
- case 0xF8: u=0x03C8; break; /* GREEK SMALL PSI */
- case 0xF9: u=0x03C9; break; /* GREEK SMALL OMEGA */
- case 0xFA: u=0x03CA; break; /* GREEK SMALL IOTA WITH DIALYTIKA */
- case 0xFB: u=0x03CB; break; /* GREEK SMALL UPSILON WITH DIALYTIKA */
- case 0xFC: u=0x03CC; break; /* GREEK SMALL OMICRON WITH TONOS */
- case 0xFD: u=0x03CD; break; /* GREEK SMALL UPSILON WITH TONOS */
- case 0xFE: u=0x03CE; break; /* GREEK SMALL OMEGA WITH TONOS */
-} break;
-
- case 8: /* ISO 8859-8: Hebrew */
-
-switch(iso)
-{ case 0xAA: u=0x00D7; break; /* MULTIPLICATION SIGN */
- case 0xAF: u=0x203E; break; /* OVERLINE */
- case 0xBA: u=0x00F7; break; /* DIVISION SIGN */
- case 0xDF: u=0x2017; break; /* DOUBLE LOW LINE */
- case 0xE0: u=0x05D0; break; /* HEBREW ALEF */
- case 0xE1: u=0x05D1; break; /* HEBREW BET */
- case 0xE2: u=0x05D2; break; /* HEBREW GIMEL */
- case 0xE3: u=0x05D3; break; /* HEBREW DALET */
- case 0xE4: u=0x05D4; break; /* HEBREW HE */
- case 0xE5: u=0x05D5; break; /* HEBREW VAV */
- case 0xE6: u=0x05D6; break; /* HEBREW ZAYIN */
- case 0xE7: u=0x05D7; break; /* HEBREW HET */
- case 0xE8: u=0x05D8; break; /* HEBREW TET */
- case 0xE9: u=0x05D9; break; /* HEBREW YOD */
- case 0xEA: u=0x05DA; break; /* HEBREW FINAL KAF */
- case 0xEB: u=0x05DB; break; /* HEBREW KAF */
- case 0xEC: u=0x05DC; break; /* HEBREW LAMED */
- case 0xED: u=0x05DD; break; /* HEBREW FINAL MEM */
- case 0xEE: u=0x05DE; break; /* HEBREW MEM */
- case 0xEF: u=0x05DF; break; /* HEBREW FINAL NUN */
- case 0xF0: u=0x05E0; break; /* HEBREW NUN */
- case 0xF1: u=0x05E1; break; /* HEBREW SAMEKH */
- case 0xF2: u=0x05E2; break; /* HEBREW AYIN */
- case 0xF3: u=0x05E3; break; /* HEBREW FINAL PE */
- case 0xF4: u=0x05E4; break; /* HEBREW PE */
- case 0xF5: u=0x05E5; break; /* HEBREW FINAL TSADI */
- case 0xF6: u=0x05E6; break; /* HEBREW TSADI */
- case 0xF7: u=0x05E7; break; /* HEBREW QOF */
- case 0xF8: u=0x05E8; break; /* HEBREW RESH */
- case 0xF9: u=0x05E9; break; /* HEBREW SHIN */
- case 0xFA: u=0x05EA; break; /* HEBREW TAV */
-} break;
-
- case 9: /* ISO 8859-9: Latin5: west European without Icelandic */
-
-switch(iso)
-{
- case 0xD0: u=0x011E; break; /* LATIN CAP G WITH BREVE */
- case 0xDD: u=0x0130; break; /* LATIN CAP I WITH DOT ABOVE */
- case 0xDE: u=0x015e; break; /* LATIN CAP S WITH CEDILLA */
- case 0xF0: u=0x011f; break; /* LATIN SMALL G WITH BREVE */
- case 0xFD: u=0x0131; break; /* LATIN SMALL DOTLESS I */
- case 0xFE: u=0x015f; break; /* LATIN SMALL S WITH CEDILLA */
-} break;
-
- }
- return u;
-}
-
-/* ------------------------------------------------------------------------- */
-/* (3) Unicode -> ZSCII and vice versa */
-/* */
-/* Need not be rapid, as the results are mostly cached. */
-/* Unicode chars which can't be fitted into ZSCII are converted to the */
-/* value 5 (the pad character used in the dictionary and elsewhere). */
-/* ------------------------------------------------------------------------- */
-
-int zscii_defn_modified, zscii_high_water_mark;
-
-int32 zscii_to_unicode_grid[0x61];
-
-static void zscii_unicode_map(int zscii, int32 unicode)
-{ if ((zscii < 155) || (zscii > 251))
- { compiler_error("Attempted to map a Unicode character into the ZSCII \
-set at an illegal position");
- return;
- }
- zscii_to_unicode_grid[zscii-155] = unicode;
- zscii_defn_modified = TRUE;
-}
-
-int default_zscii_highset_sizes[] = { 69, 69, 81, 71, 82, 92, 48, 71, 27, 62 };
-
-int32 default_zscii_to_unicode_c01[]
- = { /* (This ordering is important, unlike those for other char sets)
- The 69 characters making up the default Unicode translation
- table (see the Z-Machine Standard 1.0). */
-
- 0xe4, /* a-diaeresis */ 0xf6, /* o-diaeresis */ 0xfc, /* u-diaeresis */
- 0xc4, /* A-diaeresis */ 0xd6, /* O-diaeresis */ 0xdc, /* U-diaeresis */
- 0xdf, /* sz-ligature */ 0xbb, /* >> */ 0xab, /* << */
- 0xeb, /* e-diaeresis */ 0xef, /* i-diaeresis */ 0xff, /* y-diaeresis */
- 0xcb, /* E-diaeresis */ 0xcf, /* I-diaeresis */ 0xe1, /* a-acute */
- 0xe9, /* e-acute */ 0xed, /* i-acute */ 0xf3, /* o-acute */
- 0xfa, /* u-acute */ 0xfd, /* y-acute */ 0xc1, /* A-acute */
- 0xc9, /* E-acute */ 0xcd, /* I-acute */ 0xd3, /* O-acute */
- 0xda, /* U-acute */ 0xdd, /* Y-acute */ 0xe0, /* a-grave */
- 0xe8, /* e-grave */ 0xec, /* i-grave */ 0xf2, /* o-grave */
- 0xf9, /* u-grave */ 0xc0, /* A-grave */ 0xc8, /* E-grave */
- 0xcc, /* I-grave */ 0xd2, /* O-grave */ 0xd9, /* U-grave */
- 0xe2, /* a-circumflex */ 0xea, /* e-circumflex */
- 0xee, /* i-circumflex */ 0xf4, /* o-circumflex */
- 0xfb, /* u-circumflex */ 0xc2, /* A-circumflex */
- 0xca, /* E-circumflex */ 0xce, /* I-circumflex */
- 0xd4, /* O-circumflex */ 0xdb, /* U-circumflex */
- 0xe5, /* a-ring */ 0xc5, /* A-ring */
- 0xf8, /* o-slash */ 0xd8, /* O-slash */
- 0xe3, /* a-tilde */ 0xf1, /* n-tilde */ 0xf5, /* o-tilde */
- 0xc3, /* A-tilde */ 0xd1, /* N-tilde */ 0xd5, /* O-tilde */
- 0xe6, /* ae-ligature */ 0xc6, /* AE-ligature */
- 0xe7, /* c-cedilla */ 0xc7, /* C-cedilla */
- 0xfe, /* thorn */ 0xf0, /* eth */ 0xde, /* Thorn */ 0xd0, /* Eth */
- 0xa3, /* pound symbol */
- 0x0153, /* oe-ligature */ 0x0152, /* OE-ligature */
- 0xa1, /* inverted ! */ 0xbf /* inverted ? */ };
-
-int32 default_zscii_to_unicode_c2[]
- = { /* The 81 accented letters in Latin2 */
- 0x0104, 0x0141, 0x013D, 0x015A, 0x0160, 0x015E, 0x0164, 0x0179,
- 0x017D, 0x017B, 0x0154, 0x00C1, 0x00C2, 0x0102, 0x00C4, 0x0139,
- 0x0106, 0x00C7, 0x010C, 0x00C9, 0x0118, 0x00CB, 0x011A, 0x00CD,
- 0x00CE, 0x010E, 0x0110, 0x0143, 0x0147, 0x00D3, 0x00D4, 0x0150,
- 0x00D6, 0x0158, 0x016E, 0x00DA, 0x0170, 0x00DC, 0x00DD, 0x0162,
- 0x0105, 0x0142, 0x013E, 0x015B, 0x0161, 0x015F, 0x0165, 0x017A,
- 0x017E, 0x017C, 0x00DF, 0x0155, 0x00E1, 0x00E2, 0x0103, 0x00E4,
- 0x013A, 0x0107, 0x00E7, 0x010D, 0x00E9, 0x0119, 0x00EB, 0x011B,
- 0x00ED, 0x00EE, 0x010F, 0x0111, 0x0144, 0x0148, 0x00F3, 0x00F4,
- 0x0151, 0x00F6, 0x0159, 0x016F, 0x00FA, 0x0171, 0x00FC, 0x00FD,
- 0x0163 };
-
-int32 default_zscii_to_unicode_c3[]
- = { /* The 71 accented letters in Latin3 */
- 0x0126, 0x0124, 0x0130, 0x015E, 0x011E, 0x0134, 0x017B, 0x0127,
- 0x0125, 0x0131, 0x015F, 0x011F, 0x0135, 0x017C, 0x00C0, 0x00C1,
- 0x00C2, 0x00C4, 0x010A, 0x0108, 0x00C7, 0x00C8, 0x00C9, 0x00CA,
- 0x00CB, 0x00CC, 0x00CD, 0x00CE, 0x00CF, 0x00D1, 0x00D2, 0x00D3,
- 0x00D4, 0x0120, 0x00D6, 0x011C, 0x00D9, 0x00DA, 0x00DB, 0x00DC,
- 0x016C, 0x015C, 0x00DF, 0x00E0, 0x00E1, 0x00E2, 0x00E4, 0x010B,
- 0x0109, 0x00E7, 0x00E8, 0x00E9, 0x00EA, 0x00EB, 0x00EC, 0x00ED,
- 0x00EE, 0x00EF, 0x00F1, 0x00F2, 0x00F3, 0x00F4, 0x0121, 0x00F6,
- 0x011D, 0x00F9, 0x00FA, 0x00FB, 0x00FC, 0x016D, 0x015D };
-
-int32 default_zscii_to_unicode_c4[]
- = { /* The 82 accented letters in Latin4 */
- 0x0104, 0x0138, 0x0156, 0x0128, 0x013B, 0x0160, 0x0112, 0x0122,
- 0x0166, 0x017D, 0x0105, 0x0157, 0x0129, 0x013C, 0x0161, 0x0113,
- 0x0123, 0x0167, 0x014A, 0x017E, 0x014B, 0x0100, 0x00C1, 0x00C2,
- 0x00C3, 0x00C4, 0x00C5, 0x00C6, 0x012E, 0x010C, 0x00C9, 0x0118,
- 0x00CB, 0x0116, 0x00CD, 0x00CE, 0x012A, 0x0110, 0x0145, 0x014C,
- 0x0136, 0x00D4, 0x00D5, 0x00D6, 0x00D8, 0x0172, 0x00DA, 0x00DB,
- 0x00DC, 0x0168, 0x016A, 0x00DF, 0x0101, 0x00E1, 0x00E2, 0x00E3,
- 0x00E4, 0x00E5, 0x00E6, 0x012F, 0x010D, 0x00E9, 0x0119, 0x00EB,
- 0x0117, 0x00ED, 0x00EE, 0x012B, 0x0111, 0x0146, 0x014D, 0x0137,
- 0x00F4, 0x00F5, 0x00F6, 0x00F8, 0x0173, 0x00FA, 0x00FB, 0x00FC,
- 0x0169, 0x016B };
-
-int32 default_zscii_to_unicode_c5[]
- = { /* The 92 accented letters in Cyrillic */
- 0x0401, 0x0402, 0x0403, 0x0404, 0x0405, 0x0406, 0x0407, 0x0408,
- 0x0409, 0x040A, 0x040B, 0x040C, 0x040E, 0x040F, 0x0410, 0x0411,
- 0x0412, 0x0413, 0x0414, 0x0415, 0x0416, 0x0417, 0x0418, 0x0419,
- 0x041A, 0x041B, 0x041C, 0x041D, 0x041E, 0x041F, 0x0420, 0x0421,
- 0x0422, 0x0423, 0x0424, 0x0425, 0x0426, 0x0427, 0x0428, 0x0429,
- 0x042A, 0x042B, 0x042C, 0x042D, 0x042E, 0x042F, 0x0430, 0x0431,
- 0x0432, 0x0433, 0x0434, 0x0435, 0x0436, 0x0437, 0x0438, 0x0439,
- 0x043A, 0x043B, 0x043C, 0x043D, 0x043E, 0x043F, 0x0440, 0x0441,
- 0x0442, 0x0443, 0x0444, 0x0445, 0x0446, 0x0447, 0x0448, 0x0449,
- 0x044A, 0x044B, 0x044C, 0x044D, 0x044E, 0x044F, 0x0451, 0x0452,
- 0x0453, 0x0454, 0x0455, 0x0456, 0x0457, 0x0458, 0x0459, 0x045A,
- 0x045B, 0x045C, 0x045E, 0x045F };
-
-int32 default_zscii_to_unicode_c6[]
- = { /* The 48 accented letters in Arabic */
- 0x060C, 0x061B, 0x061F, 0x0621, 0x0622, 0x0623, 0x0624, 0x0625,
- 0x0626, 0x0627, 0x0628, 0x0629, 0x062A, 0x062B, 0x062C, 0x062D,
- 0x062E, 0x062F, 0x0630, 0x0631, 0x0632, 0x0633, 0x0634, 0x0635,
- 0x0636, 0x0637, 0x0638, 0x0639, 0x063A, 0x0640, 0x0641, 0x0642,
- 0x0643, 0x0644, 0x0645, 0x0646, 0x0647, 0x0648, 0x0649, 0x064A,
- 0x064B, 0x064C, 0x064D, 0x064E, 0x064F, 0x0650, 0x0651, 0x0652 };
-
-int32 default_zscii_to_unicode_c7[]
- = { /* The 71 accented letters in Greek */
- 0x0384, 0x0385, 0x0386, 0x0388, 0x0389, 0x038A, 0x038C, 0x038E,
- 0x038F, 0x0390, 0x0391, 0x0392, 0x0393, 0x0394, 0x0395, 0x0396,
- 0x0397, 0x0398, 0x0399, 0x039A, 0x039B, 0x039C, 0x039D, 0x039E,
- 0x039F, 0x03A0, 0x03A1, 0x03A3, 0x03A4, 0x03A5, 0x03A6, 0x03A7,
- 0x03A8, 0x03A9, 0x03AA, 0x03AB, 0x03AC, 0x03AD, 0x03AE, 0x03AF,
- 0x03B0, 0x03B1, 0x03B2, 0x03B3, 0x03B4, 0x03B5, 0x03B6, 0x03B7,
- 0x03B8, 0x03B9, 0x03BA, 0x03BB, 0x03BC, 0x03BD, 0x03BE, 0x03BF,
- 0x03C0, 0x03C1, 0x03C2, 0x03C3, 0x03C4, 0x03C5, 0x03C6, 0x03C7,
- 0x03C8, 0x03C9, 0x03CA, 0x03CB, 0x03CC, 0x03CD, 0x03CE };
-
-int32 default_zscii_to_unicode_c8[]
- = { /* The 27 accented letters in Hebrew */
- 0x05D0, 0x05D1, 0x05D2, 0x05D3, 0x05D4, 0x05D5, 0x05D6, 0x05D7,
- 0x05D8, 0x05D9, 0x05DA, 0x05DB, 0x05DC, 0x05DD, 0x05DE, 0x05DF,
- 0x05E0, 0x05E1, 0x05E2, 0x05E3, 0x05E4, 0x05E5, 0x05E6, 0x05E7,
- 0x05E8, 0x05E9, 0x05EA };
-
-int32 default_zscii_to_unicode_c9[]
- = { /* The 62 accented letters in Latin5 */
- 0x00C0, 0x00C1, 0x00C2, 0x00C3, 0x00C4, 0x00C5, 0x00C6, 0x00C7,
- 0x00C8, 0x00C9, 0x00CA, 0x00CB, 0x00CC, 0x00CD, 0x00CE, 0x00CF,
- 0x011E, 0x00D1, 0x00D2, 0x00D3, 0x00D4, 0x00D5, 0x00D6, 0x00D8,
- 0x00D9, 0x00DA, 0x00DB, 0x00DC, 0x0130, 0x015E, 0x00DF, 0x00E0,
- 0x00E1, 0x00E2, 0x00E3, 0x00E4, 0x00E5, 0x00E6, 0x00E7, 0x00E8,
- 0x00E9, 0x00EA, 0x00EB, 0x00EC, 0x00ED, 0x00EE, 0x00EF, 0x011F,
- 0x00F1, 0x00F2, 0x00F3, 0x00F4, 0x00F5, 0x00F6, 0x00F8, 0x00F9,
- 0x00FA, 0x00FB, 0x00FC, 0x0131, 0x015F, 0x00FF };
-
-static void make_unicode_zscii_map(void)
-{ int i;
-
- for (i=0; i<0x61; i++) zscii_to_unicode_grid[i] = '?';
-
- zscii_high_water_mark
- = default_zscii_highset_sizes[character_set_setting];
-
- for (i=0; i<zscii_high_water_mark; i++)
- { switch(character_set_setting)
- { case 0:
- case 1: zscii_unicode_map(i+155, default_zscii_to_unicode_c01[i]);
- break;
- case 2: zscii_unicode_map(i+155, default_zscii_to_unicode_c2[i]);
- break;
- case 3: zscii_unicode_map(i+155, default_zscii_to_unicode_c3[i]);
- break;
- case 4: zscii_unicode_map(i+155, default_zscii_to_unicode_c4[i]);
- break;
- case 5: zscii_unicode_map(i+155, default_zscii_to_unicode_c5[i]);
- break;
- case 6: zscii_unicode_map(i+155, default_zscii_to_unicode_c6[i]);
- break;
- case 7: zscii_unicode_map(i+155, default_zscii_to_unicode_c7[i]);
- break;
- case 8: zscii_unicode_map(i+155, default_zscii_to_unicode_c8[i]);
- break;
- case 9: zscii_unicode_map(i+155, default_zscii_to_unicode_c9[i]);
- break;
- }
- }
- if (character_set_setting < 2) zscii_defn_modified = FALSE;
- make_iso_to_alphabet_grid();
-}
-
-extern void new_zscii_character(int32 u, int plus_flag)
-{
- if (u < 0 || u > 0xFFFF)
- error("Zcharacter table cannot contain Unicode characters beyond $FFFF");
- if (plus_flag == FALSE)
- zscii_high_water_mark = 0;
- if (zscii_high_water_mark == 0x61)
- error("No more room in the Zcharacter table");
- else zscii_unicode_map(155 + zscii_high_water_mark++, u);
-}
-
-extern void new_zscii_finished(void)
-{ make_iso_to_alphabet_grid();
-}
-
-extern int unicode_to_zscii(int32 u)
-{ int i;
- if (u < 0x7f) return u;
- for (i=0; i<zscii_high_water_mark; i++)
- if (zscii_to_unicode_grid[i] == u) return i+155;
- return 5;
-}
-
-extern int32 zscii_to_unicode(int z)
-{ if (z < 0x80) return z;
- if ((z >= 155) && (z <= 251)) return zscii_to_unicode_grid[z-155];
- return '?';
-}
-
-/* ------------------------------------------------------------------------- */
-/* (4) Text -> Unicode */
-/* */
-/* This routine is not used for ordinary text compilation as it is too */
-/* slow, but it's useful for handling @ string escapes, or to avoid writing */
-/* special code when speed is not especially required. */
-/* Note that the two string escapes which can define Unicode are: */
-/* */
-/* @.. where .. is an accent */
-/* and @{...} where ... specifies a Unicode char in hexadecimal */
-/* (1 to 6 digits long) */
-/* */
-/* If either syntax is malformed, an error is generated */
-/* and the Unicode (= ISO = ASCII) character value of '?' is returned */
-/* */
-/* In Unicode mode (character_set_unicode is true), this handles UTF-8 */
-/* decoding as well as @-expansion. (So it's called when an '@' appears */
-/* *and* when a high-bit character appears.) */
-/* ------------------------------------------------------------------------- */
-
-int textual_form_length;
-
-extern int32 text_to_unicode(char *text)
-{ int i;
-
- if (text[0] != '@')
- { if (character_set_unicode)
- { if (text[0] & 0x80) /* 8-bit */
- { switch (text[0] & 0xF0)
- { case 0xf0: /* 4-byte UTF-8 string */
- textual_form_length = 4;
- if ((text[0] & 0xf8) != 0xf0)
- { error("Invalid 4-byte UTF-8 string.");
- return '?';
- }
- if ((text[1] & 0xc0) != 0x80 || (text[2] & 0xc0) != 0x80 || (text[3] & 0xc0) != 0x80)
- { error("Invalid 4-byte UTF-8 string.");
- return '?';
- }
- return (text[0] & 0x07) << 18
- | (text[1] & 0x3f) << 12
- | (text[2] & 0x3f) << 6
- | (text[3] & 0x3f);
- break;
- case 0xe0: /* 3-byte UTF-8 string */
- textual_form_length = 3;
- if ((text[1] & 0xc0) != 0x80 || (text[2] & 0xc0) != 0x80)
- { error("Invalid 3-byte UTF-8 string.");
- return '?';
- }
- return (text[0] & 0x0f) << 12
- | (text[1] & 0x3f) << 6
- | (text[2] & 0x3f);
- break;
- case 0xc0: /* 2-byte UTF-8 string */
- case 0xd0:
- textual_form_length = 2;
- if ((text[1] & 0xc0) != 0x80)
- { error("Invalid 2-byte UTF-8 string.");
- return '?';
- }
- return (text[0] & 0x1f) << 6
- | (text[1] & 0x3f);
- break;
- default: /* broken */
- error("Invalid UTF-8 string.");
- textual_form_length = 1;
- return '?';
- break;
- }
- }
- else /* nice 7-bit */
- { textual_form_length = 1;
- return (uchar) text[0];
- }
- }
- else
- {
- textual_form_length = 1;
- return iso_to_unicode((uchar) text[0]);
- }
- }
-
- if ((isdigit(text[1])) || (text[1] == '@'))
- { ebf_error("'@' plus an accent code or '@{...}'", text);
- textual_form_length = 1;
- return '?';
- }
-
- if (text[1] != '{')
- { for (i=0; accents[i] != 0; i+=2)
- if ((text[1] == accents[i]) && (text[2] == accents[i+1]))
- { textual_form_length = 3;
- return default_zscii_to_unicode_c01[i/2];
- }
-
- { char uac[4];
- uac[0]='@'; uac[1]=text[1]; uac[2]=text[2]; uac[3]=0;
- error_named("No such accented character as", uac);
- }
- }
- else
- { int32 total = 0;
- int d=0; i=1;
- while (text[++i] != '}')
- { if (text[i] == 0)
- { error("'@{' without matching '}'");
- total = '?'; break;
- }
- if (i == 8)
- { error("At most six hexadecimal digits allowed in '@{...}'");
- total = '?'; break;
- }
- d = character_digit_value[(uchar)text[i]];
- if (d == 127)
- { error("'@{...}' may only contain hexadecimal digits");
- total = '?'; break;
- }
- total = total*16 + d;
- }
- while ((text[i] != '}') && (text[i] != 0)) i++;
- if (text[i] == '}') i++;
- textual_form_length = i;
- return total;
- }
-
- textual_form_length = 1;
- return '?';
-}
-
-/* ------------------------------------------------------------------------- */
-/* (5) Zscii -> Text */
-/* */
-/* Used for printing out dictionary contents into the text transcript file */
-/* or on-screen (in response to the Trace dictionary directive). */
-/* In either case, output uses the same ISO set as the source code. */
-/* ------------------------------------------------------------------------- */
-
-extern void zscii_to_text(char *text, int zscii)
-{ int i;
- int32 unicode;
-
- if ((zscii < 0x100) && (zscii_to_iso_grid[zscii] != 0))
- { text[0] = zscii_to_iso_grid[zscii]; text[1] = 0; return;
- }
-
- unicode = zscii_to_unicode(zscii);
- for (i=0;i<69;i++)
- if (default_zscii_to_unicode_c01[i] == unicode)
- { text[0] = '@';
- text[1] = accents[2*i];
- text[2] = accents[2*i+1];
- text[3] = 0; return;
- }
- sprintf(text, "@{%x}", unicode);
-}
-
-/* ========================================================================= */
-
-extern char *name_of_iso_set(int s)
-{ switch(s)
- { case 1: return "Latin1";
- case 2: return "Latin2";
- case 3: return "Latin3";
- case 4: return "Latin4";
- case 5: return "Cyrillic";
- case 6: return "Arabic";
- case 7: return "Greek";
- case 8: return "Hebrew";
- case 9: return "Latin5";
- }
- return "Plain ASCII";
-}
-
-extern void change_character_set(void)
-{ make_source_to_iso_grid();
- make_unicode_zscii_map();
-}
-
-/* ------------------------------------------------------------------------- */
-/* Case translation of standard Roman letters within ISO */
-/* ------------------------------------------------------------------------- */
-
-extern void make_lower_case(char *str)
-{ int i;
- for (i=0; str[i]!=0; i++)
- if ((((uchar)str[i])<128) && (isupper(str[i]))) str[i]=tolower(str[i]);
-}
-
-extern void make_upper_case(char *str)
-{ int i;
- for (i=0; str[i]!=0; i++)
- if ((((uchar)str[i])<128) && (islower(str[i]))) str[i]=toupper(str[i]);
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_chars_vars(void)
-{ int n;
- for (n=0; n<128; n++) character_digit_value[n] = 127;
- character_digit_value['0'] = 0;
- character_digit_value['1'] = 1;
- character_digit_value['2'] = 2;
- character_digit_value['3'] = 3;
- character_digit_value['4'] = 4;
- character_digit_value['5'] = 5;
- character_digit_value['6'] = 6;
- character_digit_value['7'] = 7;
- character_digit_value['8'] = 8;
- character_digit_value['9'] = 9;
- character_digit_value['a'] = 10;
- character_digit_value['b'] = 11;
- character_digit_value['c'] = 12;
- character_digit_value['d'] = 13;
- character_digit_value['e'] = 14;
- character_digit_value['f'] = 15;
- character_digit_value['A'] = 10;
- character_digit_value['B'] = 11;
- character_digit_value['C'] = 12;
- character_digit_value['D'] = 13;
- character_digit_value['E'] = 14;
- character_digit_value['F'] = 15;
-
- strcpy((char *) alphabet[0], "abcdefghijklmnopqrstuvwxyz");
- strcpy((char *) alphabet[1], "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
- strcpy((char *) alphabet[2], " ^0123456789.,!?_#'~/\\-:()");
-
- alphabet_modified = FALSE;
-
- for (n=0; n<78; n++) alphabet_used[n] = 'N';
-
- change_character_set();
-}
-
-extern void chars_begin_pass(void)
-{
-}
-
-extern void chars_allocate_arrays(void)
-{
-}
-
-extern void chars_free_arrays(void)
-{
-}
-
-/* ========================================================================= */
--- /dev/null
+# Process this file with autoconf to produce a configure script.
+#
+# This file is part of Inform.
+#
+# Inform is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# theFree Software Foundation, either version 3 of the License, or
+#(at your option) any later version.
+#
+# Inform is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Inform. If not, see https://gnu.org/licenses/
+
+AC_INIT([inform], m4_esyscmd_s([./version.sh]), [j@jxself.org])
+AM_INIT_AUTOMAKE([foreign])
+AC_OUTPUT(Makefile src/Makefile)
+
+# Checks for programs.
+AC_PROG_CC
+
+# Checks for libraries.
+
+# Checks for header files.
+AC_CHECK_HEADERS([limits.h stdlib.h string.h unistd.h])
+
+# Checks for typedefs, structures, and compiler characteristics.
+AC_CHECK_HEADER_STDBOOL
+AC_TYPE_SIZE_T
+
+# Checks for library functions.
+AC_FUNC_ERROR_AT_LINE
+AC_FUNC_MALLOC
+AC_FUNC_REALLOC
+AC_CHECK_FUNCS([memmove memset realpath strchr strtol])
+
+AC_OUTPUT
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "directs" : Directives (# commands) */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int no_routines, /* Number of routines compiled so far */
- no_named_routines, /* Number not embedded in objects */
- no_locals, /* Number of locals in current routine */
- no_termcs; /* Number of terminating characters */
-int terminating_characters[32];
-
-brief_location routine_starts_line; /* Source code location where the current
- routine starts. (Useful for reporting
- "unused variable" warnings on the start
- line rather than the end line.) */
-
-static int constant_made_yet; /* Have any constants been defined yet? */
-
-static int ifdef_stack[32], ifdef_sp;
-
-/* ------------------------------------------------------------------------- */
-
-static int ebf_error_recover(char *s1, char *s2)
-{
- /* Display an "expected... but found..." error, then skim forward
- to the next semicolon and return FALSE. This is such a common
- case in parse_given_directive() that it's worth a utility
- function. You will see many error paths that look like:
- return ebf_error_recover(...);
- */
- ebf_error(s1, s2);
- panic_mode_error_recovery();
- return FALSE;
-}
-
-/* ------------------------------------------------------------------------- */
-
-extern int parse_given_directive(int internal_flag)
-{ /* Internal_flag is FALSE if the directive is encountered normally,
- TRUE if encountered with a # prefix inside a routine or object
- definition.
-
- Returns: FALSE if program continues, TRUE if end of file reached. */
-
- int *trace_level = NULL; int32 i, j, k, n, flag;
- const char *constant_name;
- debug_location_beginning beginning_debug_location;
-
- switch(token_value)
- {
-
- /* --------------------------------------------------------------------- */
- /* Abbreviate "string1" ["string2" ...] */
- /* --------------------------------------------------------------------- */
-
- case ABBREVIATE_CODE:
-
- do
- { get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- return FALSE;
-
- /* Z-code has a 64-abbrev limit; Glulx doesn't. */
- if (!glulx_mode && no_abbreviations==64)
- { error("All 64 abbreviations already declared");
- panic_mode_error_recovery(); return FALSE;
- }
- if (no_abbreviations==MAX_ABBREVS)
- memoryerror("MAX_ABBREVS", MAX_ABBREVS);
-
- if (abbrevs_lookup_table_made)
- { error("All abbreviations must be declared together");
- panic_mode_error_recovery(); return FALSE;
- }
- if (token_type != DQ_TT)
- return ebf_error_recover("abbreviation string", token_text);
- if (strlen(token_text)<2)
- { error_named("It's not worth abbreviating", token_text);
- continue;
- }
- /* Abbreviation string with null must fit in a MAX_ABBREV_LENGTH
- array. */
- if (strlen(token_text)>=MAX_ABBREV_LENGTH)
- { error_named("Abbreviation too long", token_text);
- continue;
- }
- make_abbreviation(token_text);
- } while (TRUE);
-
- /* --------------------------------------------------------------------- */
- /* Array arrayname array... */
- /* --------------------------------------------------------------------- */
-
- case ARRAY_CODE: make_global(TRUE, FALSE); break; /* See "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* Attribute newname [alias oldname] */
- /* --------------------------------------------------------------------- */
-
- case ATTRIBUTE_CODE:
- make_attribute(); break; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Class classname ... */
- /* --------------------------------------------------------------------- */
-
- case CLASS_CODE:
- if (internal_flag)
- { error("Cannot nest #Class inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
- make_class(NULL); /* See "objects.c" */
- return FALSE;
-
- /* --------------------------------------------------------------------- */
- /* Constant newname [[=] value] [, ...] */
- /* --------------------------------------------------------------------- */
-
- case CONSTANT_CODE:
- constant_made_yet=TRUE;
-
- ParseConstantSpec:
- get_next_token(); i = token_value;
- beginning_debug_location = get_token_location_beginning();
-
- if ((token_type != SYMBOL_TT)
- || (!(sflags[i] & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))))
- { discard_token_location(beginning_debug_location);
- return ebf_error_recover("new constant name", token_text);
- }
-
- assign_symbol(i, 0, CONSTANT_T);
- constant_name = token_text;
-
- get_next_token();
-
- if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
- { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
- { debug_file_printf("<constant>");
- debug_file_printf("<identifier>%s</identifier>", constant_name);
- write_debug_symbol_optional_backpatch(i);
- write_debug_locations(get_token_location_end(beginning_debug_location));
- debug_file_printf("</constant>");
- }
- goto ParseConstantSpec;
- }
-
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
- { debug_file_printf("<constant>");
- debug_file_printf("<identifier>%s</identifier>", constant_name);
- write_debug_symbol_optional_backpatch(i);
- write_debug_locations(get_token_location_end(beginning_debug_location));
- debug_file_printf("</constant>");
- }
- return FALSE;
- }
-
- if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
- put_token_back();
-
- { assembly_operand AO = parse_expression(CONSTANT_CONTEXT);
- if (AO.marker != 0)
- { assign_marked_symbol(i, AO.marker, AO.value,
- CONSTANT_T);
- sflags[i] |= CHANGE_SFLAG;
- if (i == grammar_version_symbol)
- error(
- "Grammar__Version must be given an explicit constant value");
- }
- else
- { assign_symbol(i, AO.value, CONSTANT_T);
- if (i == grammar_version_symbol)
- { if ((grammar_version_number != AO.value)
- && (no_fake_actions > 0))
- error(
- "Once a fake action has been defined it is too late to \
-change the grammar version. (If you are using the library, move any \
-Fake_Action directives to a point after the inclusion of \"Parser\".)");
- grammar_version_number = AO.value;
- }
- }
- }
-
- if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
- { debug_file_printf("<constant>");
- debug_file_printf("<identifier>%s</identifier>", constant_name);
- write_debug_symbol_optional_backpatch(i);
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</constant>");
- }
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
- goto ParseConstantSpec;
- put_token_back();
- break;
-
- /* --------------------------------------------------------------------- */
- /* Default constantname integer */
- /* --------------------------------------------------------------------- */
-
- case DEFAULT_CODE:
- if (module_switch)
- { error("'Default' cannot be used in -M (Module) mode");
- panic_mode_error_recovery(); return FALSE;
- }
-
- get_next_token();
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("name", token_text);
-
- i = -1;
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { i = token_value;
- sflags[i] |= DEFCON_SFLAG;
- }
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
- put_token_back();
-
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (i != -1)
- { if (AO.marker != 0)
- { assign_marked_symbol(i, AO.marker, AO.value,
- CONSTANT_T);
- sflags[i] |= CHANGE_SFLAG;
- }
- else assign_symbol(i, AO.value, CONSTANT_T);
- }
- }
-
- break;
-
- /* --------------------------------------------------------------------- */
- /* Dictionary 'word' */
- /* Dictionary 'word' val1 */
- /* Dictionary 'word' val1 val3 */
- /* --------------------------------------------------------------------- */
-
- case DICTIONARY_CODE:
- /* In Inform 5, this directive had the form
- Dictionary SYMBOL "word";
- This was deprecated as of I6 (if not earlier), and is no longer
- supported at all. The current form just creates a dictionary word,
- with the given values for dict_par1 and dict_par3. If the word
- already exists, the values are bit-or'd in with the existing
- values.
- (We don't offer a way to set dict_par2, because that is entirely
- reserved for the verb number. Or'ing values into it would create
- garbage.)
- */
- get_next_token();
- if (token_type != SQ_TT && token_type != DQ_TT)
- return ebf_error_recover("dictionary word", token_text);
-
- {
- char *wd = token_text;
- int val1 = 0;
- int val3 = 0;
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
- put_token_back();
- }
- else {
- assembly_operand AO;
- put_token_back();
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as a Dictionary flag");
- else
- val1 = AO.value;
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
- put_token_back();
- }
- else {
- assembly_operand AO;
- put_token_back();
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as a Dictionary flag");
- else
- val3 = AO.value;
- }
- }
-
- if (!glulx_mode) {
- if ((val1 & ~0xFF) || (val3 & ~0xFF)) {
- warning("Dictionary flag values cannot exceed $FF in Z-code");
- }
- }
- else {
- if ((val1 & ~0xFFFF) || (val3 & ~0xFFFF)) {
- warning("Dictionary flag values cannot exceed $FFFF in Glulx");
- }
- }
-
- dictionary_add(wd, val1, 0, val3);
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* End */
- /* --------------------------------------------------------------------- */
-
- case END_CODE: return(TRUE);
-
- case ENDIF_CODE:
- if (ifdef_sp == 0) error("'Endif' without matching 'If...'");
- else ifdef_sp--;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Extend ... */
- /* --------------------------------------------------------------------- */
-
- case EXTEND_CODE: extend_verb(); return FALSE; /* see "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* Fake_Action name */
- /* --------------------------------------------------------------------- */
-
- case FAKE_ACTION_CODE:
- make_fake_action(); break; /* see "verbs.c" */
-
- /* --------------------------------------------------------------------- */
- /* Global variable [= value / array...] */
- /* --------------------------------------------------------------------- */
-
- case GLOBAL_CODE: make_global(FALSE, FALSE); break; /* See "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* If... */
- /* */
- /* Note that each time Inform tests an If... condition, it stacks the */
- /* result (TRUE or FALSE) on ifdef_stack: thus, the top of this stack */
- /* reveals what clause of the current If... is being compiled: */
- /* */
- /* If...; ... Ifnot; ... Endif; */
- /* top of stack: TRUE FALSE */
- /* */
- /* This is used to detect "two Ifnots in same If" errors. */
- /* --------------------------------------------------------------------- */
-
- case IFDEF_CODE:
- flag = TRUE;
- goto DefCondition;
- case IFNDEF_CODE:
- flag = FALSE;
-
- DefCondition:
- get_next_token();
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("symbol name", token_text);
-
- if ((token_text[0] == 'V')
- && (token_text[1] == 'N')
- && (token_text[2] == '_')
- && (strlen(token_text)==7))
- { i = atoi(token_text+3);
- if (VNUMBER < i) flag = (flag)?FALSE:TRUE;
- goto HashIfCondition;
- }
-
- if (sflags[token_value] & UNKNOWN_SFLAG) flag = (flag)?FALSE:TRUE;
- else sflags[token_value] |= USED_SFLAG;
- goto HashIfCondition;
-
- case IFNOT_CODE:
- if (ifdef_sp == 0)
- error("'Ifnot' without matching 'If...'");
- else
- if (!(ifdef_stack[ifdef_sp-1]))
- error("Second 'Ifnot' for the same 'If...' condition");
- else
- { dont_enter_into_symbol_table = -2; n = 1;
- directives.enabled = TRUE;
- do
- { get_next_token();
- if (token_type == EOF_TT)
- { error("End of file reached in code 'If...'d out");
- directives.enabled = FALSE;
- return TRUE;
- }
- if (token_type == DIRECTIVE_TT)
- { switch(token_value)
- { case ENDIF_CODE:
- n--; break;
- case IFV3_CODE:
- case IFV5_CODE:
- case IFDEF_CODE:
- case IFNDEF_CODE:
- case IFTRUE_CODE:
- case IFFALSE_CODE:
- n++; break;
- case IFNOT_CODE:
- if (n == 1)
- { error(
- "Second 'Ifnot' for the same 'If...' condition");
- break;
- }
- }
- }
- } while (n > 0);
- ifdef_sp--;
- dont_enter_into_symbol_table = FALSE;
- directives.enabled = FALSE;
- }
- break;
-
- case IFV3_CODE:
- flag = FALSE; if (version_number == 3) flag = TRUE;
- goto HashIfCondition;
-
- case IFV5_CODE:
- flag = TRUE; if (version_number == 3) flag = FALSE;
- goto HashIfCondition;
-
- case IFTRUE_CODE:
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- { error("This condition can't be determined");
- flag = 0;
- }
- else flag = (AO.value != 0);
- }
- goto HashIfCondition;
-
- case IFFALSE_CODE:
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- { error("This condition can't be determined");
- flag = 1;
- }
- else flag = (AO.value == 0);
- }
- goto HashIfCondition;
-
- HashIfCondition:
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- return ebf_error_recover("semicolon after 'If...' condition", token_text);
-
- if (flag)
- { ifdef_stack[ifdef_sp++] = TRUE; return FALSE; }
- else
- { dont_enter_into_symbol_table = -2; n = 1;
- directives.enabled = TRUE;
- do
- { get_next_token();
- if (token_type == EOF_TT)
- { error("End of file reached in code 'If...'d out");
- directives.enabled = FALSE;
- return TRUE;
- }
- if (token_type == DIRECTIVE_TT)
- {
- switch(token_value)
- { case ENDIF_CODE:
- n--; break;
- case IFV3_CODE:
- case IFV5_CODE:
- case IFDEF_CODE:
- case IFNDEF_CODE:
- case IFTRUE_CODE:
- case IFFALSE_CODE:
- n++; break;
- case IFNOT_CODE:
- if (n == 1)
- { ifdef_stack[ifdef_sp++] = FALSE;
- n--; break;
- }
- }
- }
- } while (n > 0);
- directives.enabled = FALSE;
- dont_enter_into_symbol_table = FALSE;
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Import global <varname> [, ...] */
- /* */
- /* (Further imported goods may be allowed later.) */
- /* --------------------------------------------------------------------- */
-
- case IMPORT_CODE:
- if (!module_switch)
- { error("'Import' can only be used in -M (Module) mode");
- panic_mode_error_recovery(); return FALSE;
- }
- directives.enabled = TRUE;
- do
- { get_next_token();
- if ((token_type == DIRECTIVE_TT) && (token_value == GLOBAL_CODE))
- make_global(FALSE, TRUE);
- else error_named("'Import' cannot import things of this type:",
- token_text);
- get_next_token();
- } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
- put_token_back();
- directives.enabled = FALSE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Include "[>]filename" */
- /* */
- /* The ">" character means to load the file from the same directory as */
- /* the current file, instead of relying on the include path. */
- /* --------------------------------------------------------------------- */
-
- case INCLUDE_CODE:
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("filename in double-quotes", token_text);
-
- { char *name = token_text;
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- ebf_error("semicolon ';' after Include filename", token_text);
-
- if (strcmp(name, "language__") == 0)
- load_sourcefile(Language_Name, 0);
- else if (name[0] == '>')
- load_sourcefile(name+1, 1);
- else load_sourcefile(name, 0);
- return FALSE;
- }
-
- /* --------------------------------------------------------------------- */
- /* Link "filename" */
- /* --------------------------------------------------------------------- */
-
- case LINK_CODE:
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("filename in double-quotes", token_text);
- link_module(token_text); /* See "linker.c" */
- break;
-
- /* --------------------------------------------------------------------- */
- /* Lowstring constantname "text of string" */
- /* --------------------------------------------------------------------- */
- /* Unlike most constant creations, these do not require backpatching: */
- /* the low strings always occupy a table at a fixed offset in the */
- /* Z-machine (after the abbreviations table has finished, at 0x100). */
- /* --------------------------------------------------------------------- */
-
- case LOWSTRING_CODE:
- if (module_switch)
- { error("'LowString' cannot be used in -M (Module) mode");
- panic_mode_error_recovery(); return FALSE;
- }
- get_next_token(); i = token_value;
- if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
- return ebf_error_recover("new low string name", token_text);
-
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("literal string in double-quotes", token_text);
-
- assign_symbol(i, compile_string(token_text, TRUE, TRUE), CONSTANT_T);
- break;
-
- /* --------------------------------------------------------------------- */
- /* Message | "information" */
- /* | error "error message" */
- /* | fatalerror "fatal error message" */
- /* | warning "warning message" */
- /* --------------------------------------------------------------------- */
-
- case MESSAGE_CODE:
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
- if (token_type == DQ_TT)
- { int i;
- if (hash_printed_since_newline) printf("\n");
- for (i=0; token_text[i]!=0; i++)
- { if (token_text[i] == '^') printf("\n");
- else
- if (token_text[i] == '~') printf("\"");
- else printf("%c", token_text[i]);
- }
- printf("\n");
- break;
- }
- if ((token_type == DIR_KEYWORD_TT) && (token_value == ERROR_DK))
- { get_next_token();
- if (token_type != DQ_TT)
- { return ebf_error_recover("error message in double-quotes", token_text);
- }
- error(token_text); break;
- }
- if ((token_type == DIR_KEYWORD_TT) && (token_value == FATALERROR_DK))
- { get_next_token();
- if (token_type != DQ_TT)
- { return ebf_error_recover("fatal error message in double-quotes", token_text);
- }
- fatalerror(token_text); break;
- }
- if ((token_type == DIR_KEYWORD_TT) && (token_value == WARNING_DK))
- { get_next_token();
- if (token_type != DQ_TT)
- { return ebf_error_recover("warning message in double-quotes", token_text);
- }
- warning(token_text); break;
- }
- return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'",
- token_text);
- break;
-
- /* --------------------------------------------------------------------- */
- /* Nearby objname "short name" ... */
- /* --------------------------------------------------------------------- */
-
- case NEARBY_CODE:
- if (internal_flag)
- { error("Cannot nest #Nearby inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
- make_object(TRUE, NULL, -1, -1, -1);
- return FALSE; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Object objname "short name" ... */
- /* --------------------------------------------------------------------- */
-
- case OBJECT_CODE:
- if (internal_flag)
- { error("Cannot nest #Object inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
- make_object(FALSE, NULL, -1, -1, -1);
- return FALSE; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Origsource <file> */
- /* Origsource <file> <line> */
- /* Origsource <file> <line> <char> */
- /* Origsource */
- /* */
- /* The first three forms declare that all following lines are derived */
- /* from the named Inform 7 source file (with an optional line number */
- /* and character number). This will be reported in error messages and */
- /* in debug output. The declaration holds through the next Origsource */
- /* directive (but does not apply to included files). */
- /* */
- /* The fourth form, with no arguments, clears the declaration. */
- /* */
- /* Unlike the Include directive, Origsource does not open the named */
- /* file or even verify that it exists. The filename is treated as an */
- /* opaque string. */
- /* --------------------------------------------------------------------- */
-
- case ORIGSOURCE_CODE:
- {
- char *origsource_file = NULL;
- int32 origsource_line = 0;
- int32 origsource_char = 0;
-
- /* Parse some optional tokens followed by a mandatory semicolon. */
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
- if (token_type != DQ_TT) {
- return ebf_error_recover("a file name in double-quotes",
- token_text);
- }
- origsource_file = token_text;
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
- if (token_type != NUMBER_TT) {
- return ebf_error_recover("a file line number",
- token_text);
- }
- origsource_line = token_value;
- if (origsource_line < 0)
- origsource_line = 0;
-
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
- if (token_type != NUMBER_TT) {
- return ebf_error_recover("a file line number",
- token_text);
- }
- origsource_char = token_value;
- if (origsource_char < 0)
- origsource_char = 0;
-
- get_next_token();
- }
- }
- }
-
- put_token_back();
-
- set_origsource_location(origsource_file, origsource_line, origsource_char);
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Property [long] [additive] name [alias oldname] */
- /* --------------------------------------------------------------------- */
-
- case PROPERTY_CODE: make_property(); break; /* See "objects.c" */
-
- /* --------------------------------------------------------------------- */
- /* Release <number> */
- /* --------------------------------------------------------------------- */
-
- case RELEASE_CODE:
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as release number");
- else
- release_number = AO.value;
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Replace routine [routinename] */
- /* --------------------------------------------------------------------- */
-
- case REPLACE_CODE:
- /* You can also replace system functions normally implemented in */
- /* the "hardware" of the Z-machine, like "random()": */
-
- system_functions.enabled = TRUE;
- directives.enabled = FALSE;
- directive_keywords.enabled = FALSE;
-
- /* Don't count the upcoming symbol as a top-level reference
- *to* the function. */
- df_dont_note_global_symbols = TRUE;
- get_next_token();
- df_dont_note_global_symbols = FALSE;
- if (token_type == SYSFUN_TT)
- { if (system_function_usage[token_value] == 1)
- error("You can't 'Replace' a system function already used");
- else system_function_usage[token_value] = 2;
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- {
- error("You can't give a 'Replace'd system function a new name");
- panic_mode_error_recovery(); return FALSE;
- }
- return FALSE;
- }
-
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("name of routine to replace", token_text);
- if (!(sflags[token_value] & UNKNOWN_SFLAG))
- return ebf_error_recover("name of routine not yet defined", token_text);
-
- sflags[token_value] |= REPLACE_SFLAG;
-
- /* If a second symbol is provided, it will refer to the
- original (replaced) definition of the routine. */
- i = token_value;
-
- system_functions.enabled = FALSE;
- df_dont_note_global_symbols = TRUE;
- get_next_token();
- df_dont_note_global_symbols = FALSE;
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { return FALSE;
- }
-
- if (token_type != SYMBOL_TT || !(sflags[token_value] & UNKNOWN_SFLAG))
- return ebf_error_recover("semicolon ';' or new routine name", token_text);
-
- /* Define the original-form symbol as a zero constant. Its
- value will be overwritten later, when we define the
- replacement. */
- assign_symbol(token_value, 0, CONSTANT_T);
- add_symbol_replacement_mapping(i, token_value);
-
- break;
-
- /* --------------------------------------------------------------------- */
- /* Serial "yymmdd" */
- /* --------------------------------------------------------------------- */
-
- case SERIAL_CODE:
- get_next_token();
- if ((token_type != DQ_TT) || (strlen(token_text)!=6))
- { error("The serial number must be a 6-digit date in double-quotes");
- panic_mode_error_recovery(); return FALSE;
- }
- for (i=0; i<6; i++) if (isdigit(token_text[i])==0)
- { error("The serial number must be a 6-digit date in double-quotes");
- panic_mode_error_recovery(); return FALSE;
- }
- strcpy(serial_code_buffer, token_text);
- serial_code_given_in_program = TRUE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Statusline score/time */
- /* --------------------------------------------------------------------- */
-
- case STATUSLINE_CODE:
- if (module_switch)
- warning("This does not set the final game's statusline");
-
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
- if ((token_type != DIR_KEYWORD_TT)
- || ((token_value != SCORE_DK) && (token_value != TIME_DK)))
- return ebf_error_recover("'score' or 'time' after 'statusline'", token_text);
- if (token_value == SCORE_DK) statusline_flag = SCORE_STYLE;
- else statusline_flag = TIME_STYLE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Stub routinename number-of-locals */
- /* --------------------------------------------------------------------- */
-
- case STUB_CODE:
- if (internal_flag)
- { error("Cannot nest #Stub inside a routine or object");
- panic_mode_error_recovery(); return FALSE;
- }
-
- /* The upcoming symbol is a definition; don't count it as a
- top-level reference *to* the stub function. */
- df_dont_note_global_symbols = TRUE;
- get_next_token();
- df_dont_note_global_symbols = FALSE;
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("routine name to stub", token_text);
-
- i = token_value; flag = FALSE;
-
- if (sflags[i] & UNKNOWN_SFLAG)
- { sflags[i] |= STUB_SFLAG;
- flag = TRUE;
- }
-
- get_next_token(); k = token_value;
- if (token_type != NUMBER_TT)
- return ebf_error_recover("number of local variables", token_text);
- if ((k>4) || (k<0))
- { error("Must specify 0 to 4 local variables for 'Stub' routine");
- k = 0;
- }
-
- if (flag)
- {
- /* Give these parameter-receiving local variables names
- for the benefit of the debugging information file,
- and for assembly tracing to look sensible. */
-
- local_variable_texts[0] = "dummy1";
- local_variable_texts[1] = "dummy2";
- local_variable_texts[2] = "dummy3";
- local_variable_texts[3] = "dummy4";
-
- assign_symbol(i,
- assemble_routine_header(k, FALSE, (char *) symbs[i], FALSE, i),
- ROUTINE_T);
-
- /* Ensure the return value of a stubbed routine is false,
- since this is necessary to make the library work properly */
-
- if (!glulx_mode)
- assemblez_0(rfalse_zc);
- else
- assembleg_1(return_gc, zero_operand);
-
- /* Inhibit "local variable unused" warnings */
-
- for (i=1; i<=k; i++) variable_usage[i] = 1;
- sequence_point_follows = FALSE;
- assemble_routine_end(FALSE, get_token_locations());
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* Switches switchblock */
- /* (this directive is ignored if the -i switch was set at command line) */
- /* --------------------------------------------------------------------- */
-
- case SWITCHES_CODE:
- dont_enter_into_symbol_table = TRUE;
- get_next_token();
- dont_enter_into_symbol_table = FALSE;
- if (token_type != DQ_TT)
- return ebf_error_recover("string of switches", token_text);
- if (!ignore_switches_switch)
- { if (constant_made_yet)
- error("A 'Switches' directive must must come before \
-the first constant definition");
- switches(token_text, 0); /* see "inform.c" */
- }
- break;
-
- /* --------------------------------------------------------------------- */
- /* System_file */
- /* */
- /* Some files are declared as "system files": this information is used */
- /* by Inform only to skip the definition of a routine X if the designer */
- /* has indicated his intention to Replace X. */
- /* --------------------------------------------------------------------- */
-
- case SYSTEM_CODE:
- declare_systemfile(); break; /* see "files.c" */
-
- /* --------------------------------------------------------------------- */
- /* Trace dictionary */
- /* objects */
- /* symbols */
- /* verbs */
- /* [on/off] */
- /* assembly [on/off] */
- /* expressions [on/off] */
- /* lines [on/off] */
- /* --------------------------------------------------------------------- */
-
- case TRACE_CODE:
- directives.enabled = FALSE;
- trace_keywords.enabled = TRUE;
- get_next_token();
- trace_keywords.enabled = FALSE;
- directives.enabled = TRUE;
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { asm_trace_level = 1; return FALSE; }
-
- if (token_type != TRACE_KEYWORD_TT)
- return ebf_error_recover("debugging keyword", token_text);
-
- trace_keywords.enabled = TRUE;
-
- i = token_value; j = 0;
- switch(i)
- { case DICTIONARY_TK: break;
- case OBJECTS_TK: break;
- case VERBS_TK: break;
- default:
- switch(token_value)
- { case ASSEMBLY_TK:
- trace_level = &asm_trace_level; break;
- case EXPRESSIONS_TK:
- trace_level = &expr_trace_level; break;
- case LINES_TK:
- trace_level = &line_trace_level; break;
- case TOKENS_TK:
- trace_level = &tokens_trace_level; break;
- case LINKER_TK:
- trace_level = &linker_trace_level; break;
- case SYMBOLS_TK:
- trace_level = NULL; break;
- default:
- put_token_back();
- trace_level = &asm_trace_level; break;
- }
- j = 1;
- get_next_token();
- if ((token_type == SEP_TT) &&
- (token_value == SEMICOLON_SEP))
- { put_token_back(); break;
- }
- if (token_type == NUMBER_TT)
- { j = token_value; break; }
- if ((token_type == TRACE_KEYWORD_TT) && (token_value == ON_TK))
- { j = 1; break; }
- if ((token_type == TRACE_KEYWORD_TT) && (token_value == OFF_TK))
- { j = 0; break; }
- put_token_back(); break;
- }
-
- switch(i)
- { case DICTIONARY_TK: show_dictionary(); break;
- case OBJECTS_TK: list_object_tree(); break;
- case SYMBOLS_TK: list_symbols(j); break;
- case VERBS_TK: list_verb_table(); break;
- default:
- *trace_level = j;
- break;
- }
- trace_keywords.enabled = FALSE;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Undef symbol */
- /* --------------------------------------------------------------------- */
-
- case UNDEF_CODE:
- get_next_token();
- if (token_type != SYMBOL_TT)
- return ebf_error_recover("symbol name", token_text);
-
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { break; /* undef'ing an undefined constant is okay */
- }
-
- if (stypes[token_value] != CONSTANT_T)
- { error_named("Cannot Undef a symbol which is not a defined constant:", (char *)symbs[token_value]);
- break;
- }
-
- if (debugfile_switch)
- { write_debug_undef(token_value);
- }
- end_symbol_scope(token_value);
- sflags[token_value] |= USED_SFLAG;
- break;
-
- /* --------------------------------------------------------------------- */
- /* Verb ... */
- /* --------------------------------------------------------------------- */
-
- case VERB_CODE: make_verb(); return FALSE; /* see "tables.c" */
-
- /* --------------------------------------------------------------------- */
- /* Version <number> */
- /* --------------------------------------------------------------------- */
-
- case VERSION_CODE:
-
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- /* If a version has already been set on the command line,
- that overrides this. */
- if (version_set_switch)
- {
- warning("The Version directive was overridden by a command-line argument.");
- break;
- }
-
- if (module_switch && (AO.marker != 0))
- error("A definite value must be given as version number");
- else
- if (glulx_mode)
- {
- warning("The Version directive does not work in Glulx. Use \
--vX.Y.Z instead, as either a command-line argument or a header comment.");
- break;
- }
- else
- { i = AO.value;
- if ((i<3) || (i>8))
- { error("The version number must be in the range 3 to 8");
- break;
- }
- select_version(i);
- }
- }
- break; /* see "inform.c" */
-
- /* --------------------------------------------------------------------- */
- /* Zcharacter table <num> ... */
- /* Zcharacter table + <num> ... */
- /* Zcharacter <string> <string> <string> */
- /* Zcharacter <char> */
- /* --------------------------------------------------------------------- */
-
- case ZCHARACTER_CODE:
-
- if (glulx_mode) {
- error("The Zcharacter directive has no meaning in Glulx.");
- panic_mode_error_recovery(); return FALSE;
- }
-
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
-
- switch(token_type)
- { case DQ_TT:
- new_alphabet(token_text, 0);
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("double-quoted alphabet string", token_text);
- new_alphabet(token_text, 1);
- get_next_token();
- if (token_type != DQ_TT)
- return ebf_error_recover("double-quoted alphabet string", token_text);
- new_alphabet(token_text, 2);
- break;
-
- case SQ_TT:
- map_new_zchar(text_to_unicode(token_text));
- if (token_text[textual_form_length] != 0)
- return ebf_error_recover("single character value", token_text);
- break;
-
- case DIR_KEYWORD_TT:
- switch(token_value)
- { case TABLE_DK:
- { int plus_flag = FALSE;
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == PLUS_SEP))
- { plus_flag = TRUE;
- get_next_token();
- }
- while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
- { switch(token_type)
- { case NUMBER_TT:
- new_zscii_character(token_value, plus_flag);
- plus_flag = TRUE; break;
- case SQ_TT:
- new_zscii_character(text_to_unicode(token_text),
- plus_flag);
- if (token_text[textual_form_length] != 0)
- return ebf_error_recover("single character value",
- token_text);
- plus_flag = TRUE;
- break;
- default:
- return ebf_error_recover("character or Unicode number",
- token_text);
- }
- get_next_token();
- }
- if (plus_flag) new_zscii_finished();
- put_token_back();
- }
- break;
- case TERMINATING_DK:
- get_next_token();
- while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
- { switch(token_type)
- { case NUMBER_TT:
- terminating_characters[no_termcs++]
- = token_value;
- break;
- default:
- return ebf_error_recover("ZSCII number",
- token_text);
- }
- get_next_token();
- }
- put_token_back();
- break;
- default:
- return ebf_error_recover("'table', 'terminating', \
-a string or a constant",
- token_text);
- }
- break;
- default:
- return ebf_error_recover("three alphabet strings, \
-a 'table' or 'terminating' command or a single character", token_text);
- }
- break;
-
- /* ===================================================================== */
-
- }
-
- /* We are now at the end of a syntactically valid directive. It
- should be terminated by a semicolon. */
-
- get_next_token();
- if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- /* Put the non-semicolon back. We will continue parsing from
- that point, in hope that it's the start of a new directive.
- (This recovers cleanly from a missing semicolon at the end
- of a directive. It's not so clean if the directive *does*
- end with a semicolon, but there's extra garbage before it.) */
- put_token_back();
- }
- return FALSE;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_directs_vars(void)
-{
-}
-
-extern void directs_begin_pass(void)
-{ no_routines = 0;
- no_named_routines = 0;
- no_locals = 0;
- no_termcs = 0;
- constant_made_yet = FALSE;
- ifdef_sp = 0;
-}
-
-extern void directs_allocate_arrays(void)
-{
-}
-
-extern void directs_free_arrays(void)
-{
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "errors" : Warnings, errors and fatal errors */
-/* (with error throwback code for RISC OS machines) */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-#define ERROR_BUFLEN (256)
-static char error_message_buff[ERROR_BUFLEN+4]; /* room for ellipsis */
-
-/* ------------------------------------------------------------------------- */
-/* Error preamble printing. */
-/* ------------------------------------------------------------------------- */
-
-ErrorPosition ErrorReport; /* Maintained by "lexer.c" */
-
-static void print_preamble(void)
-{
- /* Only really prints the preamble to an error or warning message:
-
- e.g. "jigsaw.apollo", line 24:
-
- The format is controllable (from an ICL switch) since this assists
- the working of some development environments. */
-
- int j, with_extension_flag = FALSE; char *p;
-
- j = ErrorReport.file_number;
- if (j <= 0 || j > total_files) p = ErrorReport.source;
- else p = InputFiles[j-1].filename;
-
- if (!p) p = "";
-
- switch(error_format)
- {
- case 0: /* RISC OS error message format */
-
- if (!(ErrorReport.main_flag)) printf("\"%s\", ", p);
- printf("line %d: ", ErrorReport.line_number);
- if (ErrorReport.orig_file) {
- char *op;
- if (ErrorReport.orig_file <= 0 || ErrorReport.orig_file > total_files)
- op = ErrorReport.orig_source;
- else
- op = InputFiles[ErrorReport.orig_file-1].filename;
- printf("(\"%s\"", op);
- if (ErrorReport.orig_line) {
- printf(", %d", ErrorReport.orig_line);
- if (ErrorReport.orig_char) {
- printf(":%d", ErrorReport.orig_char);
- }
- }
- printf("): ");
- }
- break;
-
- case 1: /* Microsoft error message format */
-
- for (j=0; p[j]!=0; j++)
- { if (p[j] == FN_SEP) with_extension_flag = TRUE;
- if (p[j] == '.') with_extension_flag = FALSE;
- }
- printf("%s", p);
- if (with_extension_flag) printf("%s", Source_Extension);
- printf("(%d): ", ErrorReport.line_number);
- break;
-
- case 2: /* Macintosh Programmer's Workshop error message format */
-
- printf("File \"%s\"; Line %d\t# ", p, ErrorReport.line_number);
- break;
- }
-}
-
-static void ellipsize_error_message_buff(void)
-{
- /* If the error buffer was actually filled up by a message, it was
- probably truncated too. Add an ellipsis, for which we left
- extra room. (Yes, yes; errors that are *exactly* 255 characters
- long will suffer an unnecessary ellipsis.) */
- if (strlen(error_message_buff) == ERROR_BUFLEN-1)
- strcat(error_message_buff, "...");
-}
-
-/* ------------------------------------------------------------------------- */
-/* Fatal errors (which have style 0) */
-/* ------------------------------------------------------------------------- */
-
-extern void fatalerror(char *s)
-{ print_preamble();
-
- printf("Fatal error: %s\n",s);
- if (no_compiler_errors > 0) print_sorry_message();
-
-#ifdef ARC_THROWBACK
- throwback(0, s);
- throwback_end();
-#endif
-#ifdef MAC_FACE
- close_all_source();
- if (temporary_files_switch) remove_temp_files();
- abort_transcript_file();
- free_arrays();
- if (store_the_text)
- my_free(&all_text,"transcription text");
- longjmp(g_fallback, 1);
-#endif
- exit(1);
-}
-
-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)
-{ if (howmany == 1)
- snprintf(error_message_buff, ERROR_BUFLEN,
- "Run out of memory allocating %d bytes for %s", size, name);
- else
- snprintf(error_message_buff, ERROR_BUFLEN,
- "Run out of memory allocating array of %dx%d bytes for %s",
- howmany, size, name);
- ellipsize_error_message_buff();
- fatalerror(error_message_buff);
-}
-
-extern void memoryerror(char *s, int32 size)
-{
- snprintf(error_message_buff, ERROR_BUFLEN,
- "The memory setting %s (which is %ld at present) has been \
-exceeded. Try running Inform again with $%s=<some-larger-number> on the \
-command line.",s,(long int) size,s);
- ellipsize_error_message_buff();
- fatalerror(error_message_buff);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Survivable diagnostics: */
-/* compilation errors style 1 */
-/* warnings style 2 */
-/* linkage errors style 3 */
-/* compiler errors style 4 (these should never happen and */
-/* indicate a bug in Inform) */
-/* ------------------------------------------------------------------------- */
-
-static int errors[MAX_ERRORS];
-
-int no_errors, no_warnings, no_suppressed_warnings, no_link_errors,
- no_compiler_errors;
-
-char *forerrors_buff;
-int forerrors_pointer;
-
-static void message(int style, char *s)
-{ int throw_style = style;
- if (hash_printed_since_newline) printf("\n");
- hash_printed_since_newline = FALSE;
- print_preamble();
- switch(style)
- { case 1: printf("Error: "); no_errors++; break;
- case 2: printf("Warning: "); no_warnings++; break;
- case 3: printf("Error: [linking '%s'] ", current_module_filename);
- no_link_errors++; no_errors++; throw_style=1; break;
- case 4: printf("*** Compiler error: ");
- no_compiler_errors++; throw_style=1; break;
- }
- printf(" %s\n", s);
-#ifdef ARC_THROWBACK
- throwback(throw_style, s);
-#endif
-#ifdef MAC_FACE
- ProcessEvents (&g_proc);
- if (g_proc != true)
- { free_arrays();
- if (store_the_text)
- my_free(&all_text,"transcription text");
- close_all_source ();
- if (temporary_files_switch) remove_temp_files();
- abort_transcript_file();
- longjmp (g_fallback, 1);
- }
-#endif
- if ((!concise_switch) && (forerrors_pointer > 0) && (style <= 2))
- { forerrors_buff[forerrors_pointer] = 0;
- sprintf(forerrors_buff+68," ...etc");
- printf("> %s\n",forerrors_buff);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Style 1: Error message routines */
-/* ------------------------------------------------------------------------- */
-
-extern void error(char *s)
-{ if (no_errors == MAX_ERRORS)
- fatalerror("Too many errors: giving up");
- errors[no_errors] = no_syntax_lines;
- message(1,s);
-}
-
-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);
-}
-
-extern void error_numbered(char *s1, int val)
-{
- snprintf(error_message_buff, ERROR_BUFLEN,"%s %d.",s1,val);
- ellipsize_error_message_buff();
- error(error_message_buff);
-}
-
-extern void error_named_at(char *s1, char *s2, brief_location report_line)
-{ int i;
-
- ErrorPosition E = ErrorReport;
- export_brief_location(report_line, &ErrorReport);
-
- snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
- ellipsize_error_message_buff();
-
- i = concise_switch; concise_switch = TRUE;
- error(error_message_buff);
- ErrorReport = E; concise_switch = i;
-}
-
-extern void no_such_label(char *lname)
-{ error_named("No such label as",lname);
-}
-
-extern void ebf_error(char *s1, char *s2)
-{ snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found %s", s1, s2);
- ellipsize_error_message_buff();
- error(error_message_buff);
-}
-
-extern void char_error(char *s, int ch)
-{ int32 uni;
-
- uni = iso_to_unicode(ch);
-
- if (character_set_unicode)
- snprintf(error_message_buff, ERROR_BUFLEN, "%s (unicode) $%04x", s, uni);
- else if (uni >= 0x100)
- { snprintf(error_message_buff, ERROR_BUFLEN,
- "%s (unicode) $%04x = (ISO %s) $%02x", s, uni,
- name_of_iso_set(character_set_setting), ch);
- }
- else
- snprintf(error_message_buff, ERROR_BUFLEN, "%s (ISO Latin1) $%02x", s, uni);
-
- /* If the character set is set to Latin-1, and the char in question
- is a printable Latin-1 character, we print it in the error message.
- This conflates the source-text charset with the terminal charset,
- really, but it's not a big deal. */
-
- if (((uni>=32) && (uni<127))
- || (((uni >= 0xa1) && (uni <= 0xff))
- && (character_set_setting==1) && (!character_set_unicode)))
- { int curlen = strlen(error_message_buff);
- snprintf(error_message_buff+curlen, ERROR_BUFLEN-curlen,
- ", i.e., '%c'", uni);
- }
-
- ellipsize_error_message_buff();
- error(error_message_buff);
-}
-
-extern void unicode_char_error(char *s, int32 uni)
-{
- if (uni >= 0x100)
- snprintf(error_message_buff, ERROR_BUFLEN, "%s (unicode) $%04x", s, uni);
- else
- snprintf(error_message_buff, ERROR_BUFLEN, "%s (ISO Latin1) $%02x", s, uni);
-
- /* See comment above. */
-
- if (((uni>=32) && (uni<127))
- || (((uni >= 0xa1) && (uni <= 0xff))
- && (character_set_setting==1) && (!character_set_unicode)))
- { int curlen = strlen(error_message_buff);
- snprintf(error_message_buff+curlen, ERROR_BUFLEN-curlen,
- ", i.e., '%c'", uni);
- }
-
- ellipsize_error_message_buff();
- error(error_message_buff);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Style 2: Warning message routines */
-/* ------------------------------------------------------------------------- */
-
-extern void warning(char *s1)
-{ if (nowarnings_switch) { no_suppressed_warnings++; return; }
- 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);
- ellipsize_error_message_buff();
- message(2,error_message_buff);
-}
-
-extern void warning_named(char *s1, char *s2)
-{
- if (nowarnings_switch) { no_suppressed_warnings++; return; }
- snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"", s1, s2);
- ellipsize_error_message_buff();
- message(2,error_message_buff);
-}
-
-extern void dbnu_warning(char *type, 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 \"%s\" declared but not used", type, name);
- ellipsize_error_message_buff();
- i = concise_switch; concise_switch = TRUE;
- message(2,error_message_buff);
- concise_switch = i;
- ErrorReport = E;
-}
-
-extern void uncalled_routine_warning(char *type, char *name, brief_location report_line)
-{ int i;
- /* This is called for functions which have been detected by the
- track-unused-routines module. These will often (but not always)
- be also caught by dbnu_warning(), which tracks symbols rather
- than routine addresses. */
- ErrorPosition E = ErrorReport;
- if (nowarnings_switch) { no_suppressed_warnings++; return; }
- export_brief_location(report_line, &ErrorReport);
- if (OMIT_UNUSED_ROUTINES)
- snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\" unused and omitted", type, name);
- else
- snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\" unused (not omitted)", type, name);
- ellipsize_error_message_buff();
- i = concise_switch; concise_switch = TRUE;
- message(2,error_message_buff);
- concise_switch = i;
- ErrorReport = E;
-}
-
-extern void obsolete_warning(char *s1)
-{ if (is_systemfile()==1) return;
- if (obsolete_switch || nowarnings_switch)
- { no_suppressed_warnings++; return; }
- snprintf(error_message_buff, ERROR_BUFLEN, "Obsolete usage: %s",s1);
- ellipsize_error_message_buff();
- message(2,error_message_buff);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Style 3: Link error message routines */
-/* ------------------------------------------------------------------------- */
-
-extern void link_error(char *s)
-{ if (no_errors==MAX_ERRORS) fatalerror("Too many errors: giving up");
- errors[no_errors] = no_syntax_lines;
- message(3,s);
-}
-
-extern void link_error_named(char *s1, char *s2)
-{ snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
- ellipsize_error_message_buff();
- link_error(error_message_buff);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Style 4: Compiler error message routines */
-/* ------------------------------------------------------------------------- */
-
-extern void print_sorry_message(void)
-{ printf(
-"***********************************************************************\n\
-* 'Compiler errors' should never occur if Inform is working properly. *\n\
-* This is version %d.%02d of Inform, dated %20s: so *\n\
-* if that was more than six months ago, there may be a more recent *\n\
-* version available, from which the problem may have been removed. *\n\
-* If not, please report this fault to: graham@gnelson.demon.co.uk *\n\
-* and if at all possible, please include your source code, as faults *\n\
-* such as these are rare and often difficult to reproduce. Sorry. *\n\
-***********************************************************************\n",
- (RELEASE_NUMBER/100)%10, RELEASE_NUMBER%100, RELEASE_DATE);
-}
-
-extern int compiler_error(char *s)
-{ if (no_link_errors > 0) return FALSE;
- if (no_errors > 0) return FALSE;
- if (no_compiler_errors==MAX_ERRORS)
- fatalerror("Too many compiler errors: giving up");
- message(4,s);
- return TRUE;
-}
-
-extern int compiler_error_named(char *s1, char *s2)
-{ if (no_link_errors > 0) return FALSE;
- if (no_errors > 0) return FALSE;
- snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\"",s1,s2);
- ellipsize_error_message_buff();
- compiler_error(error_message_buff);
- return TRUE;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Code for the Acorn RISC OS operating system, donated by Robin Watts, */
-/* to provide error throwback under the DDE environment */
-/* ------------------------------------------------------------------------- */
-
-#ifdef ARC_THROWBACK
-
-#define DDEUtils_ThrowbackStart 0x42587
-#define DDEUtils_ThrowbackSend 0x42588
-#define DDEUtils_ThrowbackEnd 0x42589
-
-#include "kernel.h"
-
-extern void throwback_start(void)
-{ _kernel_swi_regs regs;
- if (throwback_switch)
- _kernel_swi(DDEUtils_ThrowbackStart, ®s, ®s);
-}
-
-extern void throwback_end(void)
-{ _kernel_swi_regs regs;
- if (throwback_switch)
- _kernel_swi(DDEUtils_ThrowbackEnd, ®s, ®s);
-}
-
-int throwback_started = FALSE;
-
-extern void throwback(int severity, char * error)
-{ _kernel_swi_regs regs;
- if (!throwback_started)
- { throwback_started = TRUE;
- throwback_start();
- }
- if (throwback_switch)
- { regs.r[0] = 1;
- if ((ErrorReport.file_number == -1)
- || (ErrorReport.file_number == 0))
- regs.r[2] = (int) (InputFiles[0].filename);
- else regs.r[2] = (int) (InputFiles[ErrorReport.file_number-1].filename);
- regs.r[3] = ErrorReport.line_number;
- regs.r[4] = (2-severity);
- regs.r[5] = (int) error;
- _kernel_swi(DDEUtils_ThrowbackSend, ®s, ®s);
- }
-}
-
-#endif
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_errors_vars(void)
-{ forerrors_buff = NULL;
- no_errors = 0; no_warnings = 0; no_suppressed_warnings = 0;
- no_compiler_errors = 0;
-}
-
-extern void errors_begin_pass(void)
-{ ErrorReport.line_number = 0;
- ErrorReport.file_number = -1;
- ErrorReport.source = "<no text read yet>";
- ErrorReport.main_flag = FALSE;
- ErrorReport.orig_source = NULL;
- ErrorReport.orig_file = 0;
- ErrorReport.orig_line = 0;
- ErrorReport.orig_char = 0;
-}
-
-extern void errors_allocate_arrays(void)
-{ forerrors_buff = my_malloc(512, "errors buffer");
-}
-
-extern void errors_free_arrays(void)
-{ my_free(&forerrors_buff, "errors buffer");
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "expressc" : The expression code generator */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int vivc_flag; /* TRUE if the last code-generated
- expression produced a "value in void
- context" error: used to help the syntax
- analyser recover from unknown-keyword
- errors, since unknown keywords are
- treated as yet-to-be-defined constants
- and thus as values in void context */
-
-/* These data structures are global, because they're too useful to be
- static. */
-assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
- temp_var4, zero_operand, one_operand, two_operand, three_operand,
- four_operand, valueless_operand;
-
-static void make_operands(void)
-{
- if (!glulx_mode) {
- INITAOTV(&stack_pointer, VARIABLE_OT, 0);
- INITAOTV(&temp_var1, VARIABLE_OT, 255);
- INITAOTV(&temp_var2, VARIABLE_OT, 254);
- INITAOTV(&temp_var3, VARIABLE_OT, 253);
- INITAOTV(&temp_var4, VARIABLE_OT, 252);
- INITAOTV(&zero_operand, SHORT_CONSTANT_OT, 0);
- INITAOTV(&one_operand, SHORT_CONSTANT_OT, 1);
- INITAOTV(&two_operand, SHORT_CONSTANT_OT, 2);
- INITAOTV(&three_operand, SHORT_CONSTANT_OT, 3);
- INITAOTV(&four_operand, SHORT_CONSTANT_OT, 4);
- INITAOTV(&valueless_operand, OMITTED_OT, 0);
- }
- else {
- INITAOTV(&stack_pointer, LOCALVAR_OT, 0);
- INITAOTV(&temp_var1, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+0);
- INITAOTV(&temp_var2, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+1);
- INITAOTV(&temp_var3, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+2);
- INITAOTV(&temp_var4, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+3);
- INITAOTV(&zero_operand, ZEROCONSTANT_OT, 0);
- INITAOTV(&one_operand, BYTECONSTANT_OT, 1);
- INITAOTV(&two_operand, BYTECONSTANT_OT, 2);
- INITAOTV(&three_operand, BYTECONSTANT_OT, 3);
- INITAOTV(&four_operand, BYTECONSTANT_OT, 4);
- INITAOTV(&valueless_operand, OMITTED_OT, 0);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* The table of conditionals. (Only used in Glulx) */
-
-#define ZERO_CC (500)
-#define EQUAL_CC (502)
-#define LT_CC (504)
-#define GT_CC (506)
-#define HAS_CC (508)
-#define IN_CC (510)
-#define OFCLASS_CC (512)
-#define PROVIDES_CC (514)
-
-#define FIRST_CC (500)
-#define LAST_CC (515)
-
-typedef struct condclass_s {
- int32 posform; /* Opcode for the conditional in its positive form. */
- int32 negform; /* Opcode for the conditional in its negated form. */
-} condclass;
-
-condclass condclasses[] = {
- { jz_gc, jnz_gc },
- { jeq_gc, jne_gc },
- { jlt_gc, jge_gc },
- { jgt_gc, jle_gc },
- { -1, -1 },
- { -1, -1 },
- { -1, -1 },
- { -1, -1 }
-};
-
-/* ------------------------------------------------------------------------- */
-/* The table of operators.
-
- The ordering in this table is not significant except that it must match
- the #define's in "header.h" */
-
-operator operators[NUM_OPERATORS] =
-{
- /* ------------------------ */
- /* Level 0: , */
- /* ------------------------ */
-
- { 0, SEP_TT, COMMA_SEP, IN_U, L_A, 0, -1, -1, 0, 0, "comma" },
-
- /* ------------------------ */
- /* Level 1: = */
- /* ------------------------ */
-
- { 1, SEP_TT, SETEQUALS_SEP, IN_U, R_A, 1, -1, -1, 1, 0,
- "assignment operator '='" },
-
- /* ------------------------ */
- /* Level 2: ~~ && || */
- /* ------------------------ */
-
- { 2, SEP_TT, LOGAND_SEP, IN_U, L_A, 0, -1, -1, 0, LOGOR_OP,
- "logical conjunction '&&'" },
- { 2, SEP_TT, LOGOR_SEP, IN_U, L_A, 0, -1, -1, 0, LOGAND_OP,
- "logical disjunction '||'" },
- { 2, SEP_TT, LOGNOT_SEP, PRE_U, R_A, 0, -1, -1, 0, LOGNOT_OP,
- "logical negation '~~'" },
-
- /* ------------------------ */
- /* Level 3: == ~= */
- /* > >= < <= */
- /* has hasnt */
- /* in notin */
- /* provides */
- /* ofclass */
- /* ------------------------ */
-
- { 3, -1, -1, -1, 0, 0, 400 + jz_zc, ZERO_CC+0, 0, NONZERO_OP,
- "expression used as condition then negated" },
- { 3, -1, -1, -1, 0, 0, 800 + jz_zc, ZERO_CC+1, 0, ZERO_OP,
- "expression used as condition" },
- { 3, SEP_TT, CONDEQUALS_SEP, IN_U, 0, 0, 400 + je_zc, EQUAL_CC+0, 0, NOTEQUAL_OP,
- "'==' condition" },
- { 3, SEP_TT, NOTEQUAL_SEP, IN_U, 0, 0, 800 + je_zc, EQUAL_CC+1, 0, CONDEQUALS_OP,
- "'~=' condition" },
- { 3, SEP_TT, GE_SEP, IN_U, 0, 0, 800 + jl_zc, LT_CC+1, 0, LESS_OP,
- "'>=' condition" },
- { 3, SEP_TT, GREATER_SEP, IN_U, 0, 0, 400 + jg_zc, GT_CC+0, 0, LE_OP,
- "'>' condition" },
- { 3, SEP_TT, LE_SEP, IN_U, 0, 0, 800 + jg_zc, GT_CC+1, 0, GREATER_OP,
- "'<=' condition" },
- { 3, SEP_TT, LESS_SEP, IN_U, 0, 0, 400 + jl_zc, LT_CC+0, 0, GE_OP,
- "'<' condition" },
- { 3, CND_TT, HAS_COND, IN_U, 0, 0, 400 + test_attr_zc, HAS_CC+0, 0, HASNT_OP,
- "'has' condition" },
- { 3, CND_TT, HASNT_COND, IN_U, 0, 0, 800 + test_attr_zc, HAS_CC+1, 0, HAS_OP,
- "'hasnt' condition" },
- { 3, CND_TT, IN_COND, IN_U, 0, 0, 400 + jin_zc, IN_CC+0, 0, NOTIN_OP,
- "'in' condition" },
- { 3, CND_TT, NOTIN_COND, IN_U, 0, 0, 800 + jin_zc, IN_CC+1, 0, IN_OP,
- "'notin' condition" },
- { 3, CND_TT, OFCLASS_COND, IN_U, 0, 0, 600, OFCLASS_CC+0, 0, NOTOFCLASS_OP,
- "'ofclass' condition" },
- { 3, CND_TT, PROVIDES_COND, IN_U, 0, 0, 601, PROVIDES_CC+0, 0, NOTPROVIDES_OP,
- "'provides' condition" },
- { 3, -1, -1, -1, 0, 0, 1000, OFCLASS_CC+1, 0, OFCLASS_OP,
- "negated 'ofclass' condition" },
- { 3, -1, -1, -1, 0, 0, 1001, PROVIDES_CC+1, 0, PROVIDES_OP,
- "negated 'provides' condition" },
-
- /* ------------------------ */
- /* Level 4: or */
- /* ------------------------ */
-
- { 4, CND_TT, OR_COND, IN_U, L_A, 0, -1, -1, 0, 0, "'or'" },
-
- /* ------------------------ */
- /* Level 5: + binary - */
- /* ------------------------ */
-
- { 5, SEP_TT, PLUS_SEP, IN_U, L_A, 0, add_zc, add_gc, 0, 0, "'+'" },
- { 5, SEP_TT, MINUS_SEP, IN_U, L_A, 0, sub_zc, sub_gc, 0, 0, "'-'" },
-
- /* ------------------------ */
- /* Level 6: * / % */
- /* & | ~ */
- /* ------------------------ */
-
- { 6, SEP_TT, TIMES_SEP, IN_U, L_A, 0, mul_zc, mul_gc, 0, 0, "'*'" },
- { 6, SEP_TT, DIVIDE_SEP, IN_U, L_A, 0, div_zc, div_gc, 0, 0, "'/'" },
- { 6, SEP_TT, REMAINDER_SEP, IN_U, L_A, 0, mod_zc, mod_gc, 0, 0,
- "remainder after division '%'" },
- { 6, SEP_TT, ARTAND_SEP, IN_U, L_A, 0, and_zc, bitand_gc, 0, 0,
- "bitwise AND '&'" },
- { 6, SEP_TT, ARTOR_SEP, IN_U, L_A, 0, or_zc, bitor_gc, 0, 0,
- "bitwise OR '|'" },
- { 6, SEP_TT, ARTNOT_SEP, PRE_U, R_A, 0, -1, bitnot_gc, 0, 0,
- "bitwise NOT '~'" },
-
- /* ------------------------ */
- /* Level 7: -> --> */
- /* ------------------------ */
-
- { 7, SEP_TT, ARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "byte array operator '->'" },
- { 7, SEP_TT, DARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "word array operator '-->'" },
-
- /* ------------------------ */
- /* Level 8: unary - */
- /* ------------------------ */
-
- { 8, SEP_TT, UNARY_MINUS_SEP, PRE_U, R_A, 0, -1, neg_gc, 0, 0,
- "unary minus" },
-
- /* ------------------------ */
- /* Level 9: ++ -- */
- /* (prefix or postfix) */
- /* ------------------------ */
-
- { 9, SEP_TT, INC_SEP, PRE_U, R_A, 2, -1, -1, 1, 0,
- "pre-increment operator '++'" },
- { 9, SEP_TT, POST_INC_SEP, POST_U, R_A, 3, -1, -1, 1, 0,
- "post-increment operator '++'" },
- { 9, SEP_TT, DEC_SEP, PRE_U, R_A, 4, -1, -1, 1, 0,
- "pre-decrement operator '--'" },
- { 9, SEP_TT, POST_DEC_SEP, POST_U, R_A, 5, -1, -1, 1, 0,
- "post-decrement operator '--'" },
-
- /* ------------------------ */
- /* Level 10: .& .# */
- /* ..& ..# */
- /* ------------------------ */
-
- {10, SEP_TT, PROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property address operator '.&'" },
- {10, SEP_TT, PROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property length operator '.#'" },
- {10, SEP_TT, MPROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property address operator '..&'" },
- {10, SEP_TT, MPROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property length operator '..#'" },
-
- /* ------------------------ */
- /* Level 11: function ( */
- /* ------------------------ */
-
- {11, SEP_TT, OPENB_SEP, IN_U, L_A, 0, -1, -1, 1, 0,
- "function call" },
-
- /* ------------------------ */
- /* Level 12: . .. */
- /* ------------------------ */
-
- {12, SEP_TT, MESSAGE_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property selector '..'" },
- {12, SEP_TT, PROPERTY_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property selector '.'" },
-
- /* ------------------------ */
- /* Level 13: :: */
- /* ------------------------ */
-
- {13, SEP_TT, SUPERCLASS_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "superclass operator '::'" },
-
- /* ------------------------ */
- /* Miscellaneous operators */
- /* generated at lvalue */
- /* checking time */
- /* ------------------------ */
-
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> = */
- "byte array entry assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> = */
- "word array entry assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. = */
- "individual property assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . = */
- "common property assignment" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ -> */
- "byte array entry preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ --> */
- "word array entry preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ .. */
- "individual property preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ . */
- "common property preincrement" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- -> */
- "byte array entry predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- --> */
- "word array entry predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- .. */
- "individual property predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- . */
- "common property predecrement" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> ++ */
- "byte array entry postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> ++ */
- "word array entry postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. ++ */
- "individual property postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . ++ */
- "common property postincrement" },
-
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> -- */
- "byte array entry postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> -- */
- "word array entry postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. -- */
- "individual property postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . -- */
- "common property postdecrement" },
-
- {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x.y(args) */
- "call to common property" },
- {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x..y(args) */
- "call to individual property" },
-
- /* ------------------------ */
- /* And one Glulx-only op */
- /* which just pushes its */
- /* argument on the stack, */
- /* unchanged. */
- /* ------------------------ */
-
- {14, -1, -1, -1, -1, 0, -1, -1, 1, 0,
- "push on stack" }
-};
-
-/* --- Condition annotater ------------------------------------------------- */
-
-static void annotate_for_conditions(int n, int a, int b)
-{ int i, opnum = ET[n].operator_number;
-
- ET[n].label_after = -1;
- ET[n].to_expression = FALSE;
- ET[n].true_label = a;
- ET[n].false_label = b;
-
- if (ET[n].down == -1) return;
-
- if ((operators[opnum].precedence == 2)
- || (operators[opnum].precedence == 3))
- { if ((a == -1) && (b == -1))
- { if (opnum == LOGAND_OP)
- { b = next_label++;
- ET[n].false_label = b;
- ET[n].to_expression = TRUE;
- }
- else
- { a = next_label++;
- ET[n].true_label = a;
- ET[n].to_expression = TRUE;
- }
- }
- }
-
- switch(opnum)
- { case LOGAND_OP:
- if (b == -1)
- { b = next_label++;
- ET[n].false_label = b;
- ET[n].label_after = b;
- }
- annotate_for_conditions(ET[n].down, -1, b);
- if (b == ET[n].label_after)
- annotate_for_conditions(ET[ET[n].down].right, a, -1);
- else annotate_for_conditions(ET[ET[n].down].right, a, b);
- return;
- case LOGOR_OP:
- if (a == -1)
- { a = next_label++;
- ET[n].true_label = a;
- ET[n].label_after = a;
- }
- annotate_for_conditions(ET[n].down, a, -1);
- if (a == ET[n].label_after)
- annotate_for_conditions(ET[ET[n].down].right, -1, b);
- else annotate_for_conditions(ET[ET[n].down].right, a, b);
- return;
- }
-
- i = ET[n].down;
- while (i != -1)
- { annotate_for_conditions(i, -1, -1); i = ET[i].right; }
-}
-
-/* --- Code generator ------------------------------------------------------ */
-
-static void value_in_void_context_z(assembly_operand AO)
-{ char *t;
-
- ASSERT_ZCODE();
-
- switch(AO.type)
- { case LONG_CONSTANT_OT:
- case SHORT_CONSTANT_OT:
- t = "<constant>";
- if (AO.marker == SYMBOL_MV)
- t = (char *) (symbs[AO.value]);
- break;
- case VARIABLE_OT:
- t = variable_name(AO.value);
- break;
- default:
- compiler_error("Unable to print value in void context");
- t = "<expression>";
- break;
- }
- vivc_flag = TRUE;
-
- if (strcmp(t, "print_paddr") == 0)
- obsolete_warning("ignoring 'print_paddr': use 'print (string)' instead");
- else
- if (strcmp(t, "print_addr") == 0)
- obsolete_warning("ignoring 'print_addr': use 'print (address)' instead");
- else
- if (strcmp(t, "print_char") == 0)
- obsolete_warning("ignoring 'print_char': use 'print (char)' instead");
- else
- ebf_error("expression with side-effects", t);
-}
-
-static void write_result_z(assembly_operand to, assembly_operand from)
-{ if (to.value == from.value) return;
- if (to.value == 0) assemblez_1(push_zc, from);
- else assemblez_store(to, from);
-}
-
-static void pop_zm_stack(void)
-{ assembly_operand st;
- if (version_number < 5) assemblez_0(pop_zc);
- else
- { INITAOTV(&st, VARIABLE_OT, 0);
- assemblez_1_branch(jz_zc, st, -2, TRUE);
- }
-}
-
-static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
- assembly_operand AO3)
-{ int vr = 0;
-
- assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
- index_ao;
- int x = 0, y = 0, byte_flag = FALSE, read_flag = FALSE, from_module = FALSE;
-
- if (AO1.marker == ARRAY_MV)
- {
- INITAO(&zero_ao);
-
- if ((oc == loadb_zc) || (oc == storeb_zc)) byte_flag=TRUE;
- else byte_flag = FALSE;
- if ((oc == loadb_zc) || (oc == loadw_zc)) read_flag=TRUE;
- else read_flag = FALSE;
-
- zero_ao.type = SHORT_CONSTANT_OT;
- zero_ao.value = 0;
-
- size_ao = zero_ao; size_ao.value = -1;
- for (x=0; x<no_arrays; x++)
- { if (AO1.value == svals[array_symbols[x]])
- { size_ao.value = array_sizes[x]; y=x;
- }
- }
- if (size_ao.value==-1)
- from_module=TRUE;
- else {
- from_module=FALSE;
- type_ao = zero_ao; type_ao.value = array_types[y];
-
- if ((!is_systemfile()))
- { if (byte_flag)
- {
- if ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- warning("Using '->' to access a --> or table array");
- }
- else
- {
- if ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY))
- warning("Using '-->' to access a -> or string array");
- }
- }
- }
- }
-
-
- if ((!runtime_error_checking_switch) || (veneer_mode))
- { if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_2_to(oc, AO1, AO2, AO3);
- else
- assemblez_3(oc, AO1, AO2, AO3);
- return;
- }
-
- /* If we recognise AO1 as arising textually from a declared
- array, we can check bounds explicitly. */
-
- if ((AO1.marker == ARRAY_MV) && (!from_module))
- {
- int passed_label = next_label++, failed_label = next_label++,
- final_label = next_label++;
- /* Calculate the largest permitted array entry + 1
- Here "size_ao.value" = largest permitted entry of its own kind */
- max_ao = size_ao;
-
- if (byte_flag
- && ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY)))
- { max_ao.value = size_ao.value*2 + 1;
- type_ao.value += 8;
- }
- if ((!byte_flag)
- && ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY)
- || (array_types[y] == BUFFER_ARRAY)))
- { if ((size_ao.value % 2) == 0)
- max_ao.value = size_ao.value/2 - 1;
- else max_ao.value = (size_ao.value-1)/2;
- type_ao.value += 16;
- }
- max_ao.value++;
-
- if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
- if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
-
- /* Can't write to the size entry in a string or table */
- if (((array_types[y] == STRING_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- && (!read_flag))
- { if ((array_types[y] == TABLE_ARRAY) && byte_flag)
- zero_ao.value = 2;
- else zero_ao.value = 1;
- }
-
- en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
- switch(oc) { case loadb_zc: en_ao.value = ABOUNDS_RTE; break;
- case loadw_zc: en_ao.value = ABOUNDS_RTE+1; break;
- case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
- case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
-
- index_ao = AO2;
- if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
- { assemblez_store(temp_var2, AO2);
- assemblez_store(AO2, temp_var2);
- index_ao = temp_var2;
- }
- assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
- assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
- assemble_label_no(failed_label);
- an_ao = zero_ao; an_ao.value = y;
- assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
- index_ao, size_ao, type_ao, an_ao);
-
- /* We have to clear any of AO1, AO2, AO3 off the stack if
- present, so that we can achieve the same effect on the stack
- that executing the opcode would have had */
-
- if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
- if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
- if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
- { if ((oc == loadb_zc) || (oc == loadw_zc))
- { assemblez_store(AO3, zero_ao);
- }
- else pop_zm_stack();
- }
- assemblez_jump(final_label);
-
- assemble_label_no(passed_label);
- if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_2_to(oc, AO1, AO2, AO3);
- else
- assemblez_3(oc, AO1, AO2, AO3);
- assemble_label_no(final_label);
- return;
- }
-
- /* Otherwise, compile a call to the veneer which verifies that
- the proposed read/write is within dynamic Z-machine memory. */
-
- switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
- case loadw_zc: vr = RT__ChLDW_VR; break;
- case storeb_zc: vr = RT__ChSTB_VR; break;
- case storew_zc: vr = RT__ChSTW_VR; break;
- default: compiler_error("unknown array opcode");
- }
-
- if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
- else
- assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
-}
-
-static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
- int error_label, int rte_number)
-{ assembly_operand AO2, AO3;
- int check_sp = FALSE, passed_label, failed_label, last_label;
- if (veneer_mode) return AO1;
-
- /* Assemble to code to check that the operand AO1 is ofclass Object:
- if it is, execution should continue and the stack should be
- unchanged. Otherwise, call the veneer's run-time-error routine
- with the given error number, and then: if the label isn't -1,
- switch execution to this label, with the value popped from
- the stack if it was on the stack in the first place;
- if the label is -1, either replace the top of the stack with
- the constant 2, or return the operand (short constant) 2.
-
- The point of 2 is that object 2 is the class-object Object
- and therefore has no parent, child or sibling, so that the
- built-in tree functions will safely return 0 on this object. */
-
- /* Sometimes we can already see that the object number is valid. */
- if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
- && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
- return AO1;
-
- passed_label = next_label++;
- failed_label = next_label++;
- INITAOTV(&AO2, LONG_CONSTANT_OT, actual_largest_object_SC);
- AO2.marker = INCON_MV;
- INITAOTV(&AO3, SHORT_CONSTANT_OT, 5);
-
- if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
- || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
- || (rte_number == PROP_ADD_RTE))
- { /* Allow classes */
- AO3.value = 1;
- if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
- { /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assemblez_store(temp_var2, AO1);
- assemblez_store(AO1, temp_var2);
- assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
- assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
- }
- else
- { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
- assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
- }
- }
- else
- { if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
- { /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assemblez_store(temp_var2, AO1);
- assemblez_store(AO1, temp_var2);
- assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
- assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
- AO3.value = 1;
- assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
- }
- else
- { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
- assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
- AO3.value = 1;
- assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
- }
- }
-
- assemble_label_no(failed_label);
- INITAOTV(&AO2, SHORT_CONSTANT_OT, rte_number);
- if (version_number >= 5)
- assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
- else
- assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
-
- if (error_label != -1)
- { /* Jump to the error label */
- if (error_label == -3) assemblez_0(rfalse_zc);
- else if (error_label == -4) assemblez_0(rtrue_zc);
- else assemblez_jump(error_label);
- }
- else
- { if (check_sp)
- { /* Push the short constant 2 */
- INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
- assemblez_store(AO1, AO2);
- }
- else
- { /* Store either short constant 2 or the operand's value in
- the temporary variable */
- INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
- AO3 = temp_var2; assemblez_store(AO3, AO2);
- last_label = next_label++;
- assemblez_jump(last_label);
- assemble_label_no(passed_label);
- assemblez_store(AO3, AO1);
- assemble_label_no(last_label);
- return AO3;
- }
- }
- assemble_label_no(passed_label);
- return AO1;
-}
-
-static void compile_conditional_z(int oc,
- assembly_operand AO1, assembly_operand AO2, int label, int flag)
-{ assembly_operand AO3; int the_zc, error_label = label,
- va_flag = FALSE, va_label = 0;
-
- ASSERT_ZCODE();
-
- if (oc<200)
- { if ((runtime_error_checking_switch) && (oc == jin_zc))
- { if (flag) error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
- }
- if ((runtime_error_checking_switch) && (oc == test_attr_zc))
- { if (flag) error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
- switch(AO2.type)
- { case SHORT_CONSTANT_OT:
- case LONG_CONSTANT_OT:
- if (AO2.marker == 0)
- { if ((AO2.value < 0) || (AO2.value > 47))
- error("'has'/'hasnt' applied to illegal attribute number");
- break;
- }
- case VARIABLE_OT:
- { int pa_label = next_label++, fa_label = next_label++;
- assembly_operand en_ao, zero_ao, max_ao;
- assemblez_store(temp_var1, AO1);
- if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
- assemblez_store(AO1, temp_var1);
- assemblez_store(temp_var2, AO2);
- if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
- assemblez_store(AO2, temp_var2);
- INITAOT(&zero_ao, SHORT_CONSTANT_OT);
- zero_ao.value = 0;
- max_ao = zero_ao; max_ao.value = 48;
- assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
- assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
- assemble_label_no(fa_label);
- en_ao = zero_ao; en_ao.value = 19;
- assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
- en_ao, temp_var1, temp_var2);
- va_flag = TRUE; va_label = next_label++;
- assemblez_jump(va_label);
- assemble_label_no(pa_label);
- }
- }
- }
- assemblez_2_branch(oc, AO1, AO2, label, flag);
- if (error_label != label) assemble_label_no(error_label);
- if (va_flag) assemble_label_no(va_label);
- return;
- }
-
- INITAOTV(&AO3, VARIABLE_OT, 0);
-
- the_zc = (version_number == 3)?call_zc:call_vs_zc;
- if (oc == 201)
- assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
- else
- assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
-
- assemblez_1_branch(jz_zc, AO3, label, !flag);
-}
-
-static void value_in_void_context_g(assembly_operand AO)
-{ char *t;
-
- ASSERT_GLULX();
-
- switch(AO.type)
- { case CONSTANT_OT:
- case HALFCONSTANT_OT:
- case BYTECONSTANT_OT:
- case ZEROCONSTANT_OT:
- t = "<constant>";
- if (AO.marker == SYMBOL_MV)
- t = (char *) (symbs[AO.value]);
- break;
- case GLOBALVAR_OT:
- case LOCALVAR_OT:
- t = variable_name(AO.value);
- break;
- default:
- compiler_error("Unable to print value in void context");
- t = "<expression>";
- break;
- }
- vivc_flag = TRUE;
-
- ebf_error("expression with side-effects", t);
-}
-
-static void write_result_g(assembly_operand to, assembly_operand from)
-{ if (to.value == from.value && to.type == from.type) return;
- assembleg_store(to, from);
-}
-
-static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
- assembly_operand AO3)
-{ int vr = 0;
- int data_len, read_flag;
- assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
- index_ao, five_ao;
- int passed_label, failed_label, final_label, x = 0, y = 0;
-
- if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
- else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
- else data_len = 4;
-
- if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
- read_flag = TRUE;
- else
- read_flag = FALSE;
-
- if (AO1.marker == ARRAY_MV)
- {
- INITAO(&zero_ao);
-
- size_ao = zero_ao; size_ao.value = -1;
- for (x=0; x<no_arrays; x++)
- { if (AO1.value == svals[array_symbols[x]])
- { size_ao.value = array_sizes[x]; y=x;
- }
- }
- if (size_ao.value==-1) compiler_error("Array size can't be found");
-
- type_ao = zero_ao; type_ao.value = array_types[y];
-
- if ((!is_systemfile()))
- { if (data_len == 1)
- {
- if ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- warning("Using '->' to access a --> or table array");
- }
- else
- {
- if ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY))
- warning("Using '-->' to access a -> or string array");
- }
- }
- }
-
-
- if ((!runtime_error_checking_switch) || (veneer_mode))
- {
- assembleg_3(oc, AO1, AO2, AO3);
- return;
- }
-
- /* If we recognise AO1 as arising textually from a declared
- array, we can check bounds explicitly. */
-
- if (AO1.marker == ARRAY_MV)
- {
- /* Calculate the largest permitted array entry + 1
- Here "size_ao.value" = largest permitted entry of its own kind */
- max_ao = size_ao;
- if (data_len == 1
- && ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY)))
- { max_ao.value = size_ao.value*4 + 3;
- type_ao.value += 8;
- }
- if (data_len == 4
- && ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY)
- || (array_types[y] == BUFFER_ARRAY)))
- { max_ao.value = (size_ao.value-3)/4;
- type_ao.value += 16;
- }
- max_ao.value++;
-
- /* Can't write to the size entry in a string or table */
- if (((array_types[y] == STRING_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- && (!read_flag))
- { if ((array_types[y] == TABLE_ARRAY) && data_len == 1)
- zero_ao.value = 4;
- else zero_ao.value = 1;
- }
-
- en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
-
- switch(oc) { case aloadb_gc: en_ao.value = ABOUNDS_RTE; break;
- case aload_gc: en_ao.value = ABOUNDS_RTE+1; break;
- case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
- case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
-
- set_constant_ot(&zero_ao);
- set_constant_ot(&size_ao);
- set_constant_ot(&max_ao);
- set_constant_ot(&type_ao);
- set_constant_ot(&en_ao);
-
- /* If we recognize A02 as a constant, we can do the test right
- now. */
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
- error("Array reference is out-of-bounds");
- }
- assembleg_3(oc, AO1, AO2, AO3);
- return;
- }
-
- passed_label = next_label++;
- failed_label = next_label++;
- final_label = next_label++;
-
- index_ao = AO2;
- if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
- { assembleg_store(temp_var2, AO2); /* ### could peek */
- assembleg_store(AO2, temp_var2);
- index_ao = temp_var2;
- }
- assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
- assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
- assemble_label_no(failed_label);
-
- an_ao = zero_ao; an_ao.value = y;
- set_constant_ot(&an_ao);
- five_ao = zero_ao; five_ao.value = 5;
- set_constant_ot(&five_ao);
-
- /* Call the error veneer routine. */
- assembleg_store(stack_pointer, an_ao);
- assembleg_store(stack_pointer, type_ao);
- assembleg_store(stack_pointer, size_ao);
- assembleg_store(stack_pointer, index_ao);
- assembleg_store(stack_pointer, en_ao);
- assembleg_3(call_gc, veneer_routine(RT__Err_VR),
- five_ao, zero_operand);
-
- /* We have to clear any of AO1, AO2, AO3 off the stack if
- present, so that we can achieve the same effect on the stack
- that executing the opcode would have had */
-
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
- assembleg_2(copy_gc, stack_pointer, zero_operand);
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
- assembleg_2(copy_gc, stack_pointer, zero_operand);
- if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
- { if ((oc == aloadb_gc) || (oc == aload_gc))
- { assembleg_store(AO3, zero_ao);
- }
- else assembleg_2(copy_gc, stack_pointer, zero_operand);
- }
- assembleg_jump(final_label);
-
- assemble_label_no(passed_label);
- assembleg_3(oc, AO1, AO2, AO3);
- assemble_label_no(final_label);
- return;
- }
-
- /* Otherwise, compile a call to the veneer which verifies that
- the proposed read/write is within dynamic Z-machine memory. */
-
- switch(oc) {
- case aloadb_gc: vr = RT__ChLDB_VR; break;
- case aload_gc: vr = RT__ChLDW_VR; break;
- case astoreb_gc: vr = RT__ChSTB_VR; break;
- case astore_gc: vr = RT__ChSTW_VR; break;
- default: compiler_error("unknown array opcode");
- }
-
- if ((oc == aloadb_gc) || (oc == aload_gc))
- assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
- else
- assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
-}
-
-static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
- int error_label, int rte_number)
-{
- assembly_operand AO, AO2, AO3;
- int ln;
- int check_sp = FALSE, passed_label, failed_label, last_label;
-
- if (veneer_mode)
- return AO1;
-
- /* Assemble to code to check that the operand AO1 is ofclass Object:
- if it is, execution should continue and the stack should be
- unchanged. Otherwise, call the veneer's run-time-error routine
- with the given error number, and then: if the label isn't -1,
- switch execution to this label, with the value popped from
- the stack if it was on the stack in the first place;
- if the label is -1, either replace the top of the stack with
- the constant symbol (class-object) Object.
-
- The Object has no parent, child or sibling, so that the
- built-in tree functions will safely return 0 on this object. */
-
- /* Sometimes we can already see that the object number is valid. */
- if (AO1.marker == OBJECT_MV &&
- ((AO1.value >= 1) && (AO1.value <= no_objects))) {
- return AO1;
- }
-
- passed_label = next_label++;
- failed_label = next_label++;
-
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
- /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assembleg_store(temp_var2, stack_pointer);
- assembleg_store(stack_pointer, temp_var2);
- AO = temp_var2;
- }
- else {
- AO = AO1;
- }
-
- if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
- || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
- || (rte_number == PROP_ADD_RTE)) {
- /* Allow classes */
- /* Test if zero... */
- assembleg_1_branch(jz_gc, AO, failed_label);
- /* Test if first byte is 0x70... */
- assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
- INITAO(&AO3);
- AO3.value = 0x70; /* type byte -- object */
- set_constant_ot(&AO3);
- assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
- }
- else {
- /* Test if zero... */
- assembleg_1_branch(jz_gc, AO, failed_label);
- /* Test if first byte is 0x70... */
- assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
- INITAO(&AO3);
- AO3.value = 0x70; /* type byte -- object */
- set_constant_ot(&AO3);
- assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
- /* 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 = svals[ln];
- AO3.marker = OBJECT_MV;
- AO3.type = CONSTANT_OT;
- assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
- }
-
- assemble_label_no(failed_label);
- INITAO(&AO2);
- AO2.value = rte_number;
- set_constant_ot(&AO2);
- assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
-
- if (error_label != -1) {
- /* Jump to the error label */
- if (error_label == -3) assembleg_1(return_gc, zero_operand);
- else if (error_label == -4) assembleg_1(return_gc, one_operand);
- else assembleg_jump(error_label);
- }
- else {
- /* Build the symbol for "Object" */
- ln = symbol_index("Object", -1);
- AO2.value = svals[ln];
- AO2.marker = OBJECT_MV;
- AO2.type = CONSTANT_OT;
- if (check_sp) {
- /* Push "Object" */
- assembleg_store(AO1, AO2);
- }
- else {
- /* Store either "Object" or the operand's value in the temporary
- variable. */
- assembleg_store(temp_var2, AO2);
- last_label = next_label++;
- assembleg_jump(last_label);
- assemble_label_no(passed_label);
- assembleg_store(temp_var2, AO1);
- assemble_label_no(last_label);
- return temp_var2;
- }
- }
-
- assemble_label_no(passed_label);
- return AO1;
-}
-
-static void compile_conditional_g(condclass *cc,
- assembly_operand AO1, assembly_operand AO2, int label, int flag)
-{ assembly_operand AO4;
- int the_zc, error_label = label,
- va_flag = FALSE, va_label = 0;
-
- ASSERT_GLULX();
-
- the_zc = (flag ? cc->posform : cc->negform);
-
- if (the_zc == -1) {
- switch ((cc-condclasses)*2 + 500) {
-
- case HAS_CC:
- if (runtime_error_checking_switch) {
- if (flag)
- error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
- error("'has'/'hasnt' applied to illegal attribute number");
- }
- }
- else {
- int pa_label = next_label++, fa_label = next_label++;
- assembly_operand en_ao, max_ao;
-
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
- assembleg_2(stkpeek_gc, zero_operand, temp_var1);
- assembleg_2(stkpeek_gc, one_operand, temp_var2);
- }
- else {
- assembleg_2(stkpeek_gc, zero_operand, temp_var1);
- assembleg_store(temp_var2, AO2);
- }
- }
- else {
- assembleg_store(temp_var1, AO1);
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
- assembleg_2(stkpeek_gc, zero_operand, temp_var2);
- }
- else {
- assembleg_store(temp_var2, AO2);
- }
- }
-
- INITAO(&max_ao);
- max_ao.value = NUM_ATTR_BYTES*8;
- set_constant_ot(&max_ao);
- assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
- assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
- assemble_label_no(fa_label);
- INITAO(&en_ao);
- en_ao.value = 19; /* INVALIDATTR_RTE */
- set_constant_ot(&en_ao);
- assembleg_store(stack_pointer, temp_var2);
- assembleg_store(stack_pointer, temp_var1);
- assembleg_store(stack_pointer, en_ao);
- assembleg_3(call_gc, veneer_routine(RT__Err_VR),
- three_operand, zero_operand);
- va_flag = TRUE;
- va_label = next_label++;
- assembleg_jump(va_label);
- assemble_label_no(pa_label);
- }
- }
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- AO2.value += 8;
- set_constant_ot(&AO2);
- }
- else {
- INITAO(&AO4);
- AO4.value = 8;
- AO4.type = BYTECONSTANT_OT;
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
- assembleg_0(stkswap_gc);
- assembleg_3(add_gc, AO2, AO4, stack_pointer);
- assembleg_0(stkswap_gc);
- }
- else {
- assembleg_3(add_gc, AO2, AO4, stack_pointer);
- }
- AO2 = stack_pointer;
- }
- assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
-
- case IN_CC:
- if (runtime_error_checking_switch) {
- if (flag)
- error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
- }
- INITAO(&AO4);
- AO4.value = GOBJFIELD_PARENT();
- AO4.type = BYTECONSTANT_OT;
- assembleg_3(aload_gc, AO1, AO4, stack_pointer);
- AO1 = stack_pointer;
- the_zc = (flag ? jeq_gc : jne_gc);
- break;
-
- case OFCLASS_CC:
- assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
-
- case PROVIDES_CC:
- assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
-
- default:
- error("condition not yet supported in Glulx");
- return;
- }
- }
-
- if (the_zc == jnz_gc || the_zc == jz_gc)
- assembleg_1_branch(the_zc, AO1, label);
- else
- assembleg_2_branch(the_zc, AO1, AO2, label);
- if (error_label != label) assemble_label_no(error_label);
- if (va_flag) assemble_label_no(va_label);
-}
-
-static void value_in_void_context(assembly_operand AO)
-{
- if (!glulx_mode)
- value_in_void_context_z(AO);
- else
- value_in_void_context_g(AO);
-}
-
-
-extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
- int error_label, int rte_number)
-{
- if (!glulx_mode)
- return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
- else
- return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
-}
-
-static void generate_code_from(int n, int void_flag)
-{
- /* When void, this must not leave anything on the stack. */
-
- int i, j, below, above, opnum, arity; assembly_operand Result;
-
- below = ET[n].down; above = ET[n].up;
- if (below == -1)
- { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
- value_in_void_context(ET[n].value);
- return;
- }
-
- opnum = ET[n].operator_number;
-
- if (opnum == COMMA_OP)
- { generate_code_from(below, TRUE);
- generate_code_from(ET[below].right, void_flag);
- ET[n].value = ET[ET[below].right].value;
- goto OperatorGenerated;
- }
-
- if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
- { generate_code_from(below, FALSE);
- generate_code_from(ET[below].right, FALSE);
- goto OperatorGenerated;
- }
-
- if (opnum == -1)
- {
- /* Signifies a SETEQUALS_OP which has already been done */
-
- ET[n].down = -1; return;
- }
-
- /* Note that (except in the cases of comma and logical and/or) it
- is essential to code generate the operands right to left, because
- of the peculiar way the Z-machine's stack works:
-
- @sub sp sp -> a;
-
- (for instance) pulls to the first operand, then the second. So
-
- @mul a 2 -> sp;
- @add b 7 -> sp;
- @sub sp sp -> a;
-
- calculates (b+7)-(a*2), not the other way around (as would be more
- usual in stack machines evaluating expressions written in reverse
- Polish notation). (Basically this is because the Z-machine was
- designed to implement a LISP-like language naturally expressed
- in forward Polish notation: (PLUS 3 4), for instance.) */
-
- /* And the Glulx machine follows the Z-machine in this respect. */
-
- i=below; arity = 0;
- while (i != -1)
- { i = ET[i].right; arity++;
- }
- for (j=arity;j>0;j--)
- { int k = 1;
- i = below;
- while (k<j)
- { k++; i = ET[i].right;
- }
- generate_code_from(i, FALSE);
- }
-
-
- /* Check this again, because code generation lower down may have
- stubbed it into -1 */
-
- if (ET[n].operator_number == -1)
- { ET[n].down = -1; return;
- }
-
- if (!glulx_mode) {
-
- if (operators[opnum].opcode_number_z >= 400)
- {
- /* Conditional terms such as '==': */
-
- int a = ET[n].true_label, b = ET[n].false_label,
- branch_away, branch_other,
- make_jump_away = FALSE, make_branch_label = FALSE;
- int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
-
- if (oc >= 400) { oc = oc - 400; flag = FALSE; }
-
- if ((oc == je_zc) && (arity == 2))
- { i = ET[ET[n].down].right;
- if ((ET[i].value.value == zero_operand.value)
- && (ET[i].value.type == zero_operand.type))
- oc = jz_zc;
- }
-
- /* If the condition has truth state flag, branch to
- label a, and if not, to label b. Possibly one of a, b
- equals -1, meaning "continue from this instruction".
-
- branch_away is the label which is a branch away (the one
- which isn't immediately after) and flag is the truth
- state to branch there.
-
- Note that when multiple instructions are needed (because
- of the use of the 'or' operator) the branch_other label
- is created if need be.
- */
-
- /* Reduce to the case where the branch_away label does exist: */
-
- if (a == -1) { a = b; b = -1; flag = !flag; }
-
- branch_away = a; branch_other = b;
- if (branch_other != -1) make_jump_away = TRUE;
-
- if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
- {
- /* In this case, we have an 'or' situation where multiple
- instructions are needed and where the overall condition
- is negated. That is, we have, e.g.
-
- if not (A cond B or C or D) then branch_away
-
- which we transform into
-
- if (A cond B) then branch_other
- if (A cond C) then branch_other
- if not (A cond D) then branch_away
- .branch_other */
-
- if (branch_other == -1)
- { branch_other = next_label++; make_branch_label = TRUE;
- }
- }
-
- if (oc == jz_zc)
- assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
- else
- { assembly_operand left_operand;
-
- if (arity == 2)
- compile_conditional_z(oc, ET[below].value,
- ET[ET[below].right].value, branch_away, flag);
- else
- { /* The case of a condition using "or".
- First: if the condition tests the stack pointer,
- and it can't always be done in a single test, move
- the value off the stack and into temporary variable
- storage. */
-
- if (((ET[below].value.type == VARIABLE_OT)
- && (ET[below].value.value == 0))
- && ((oc != je_zc) || (arity>4)) )
- { INITAOTV(&left_operand, VARIABLE_OT, 255);
- assemblez_store(left_operand, ET[below].value);
- }
- else left_operand = ET[below].value;
- i = ET[below].right; arity--;
-
- /* "left_operand" now holds the quantity to be tested;
- "i" holds the right operand reached so far;
- "arity" the number of right operands. */
-
- while (i != -1)
- { if ((oc == je_zc) && (arity>1))
- {
- /* je_zc is an especially good case since the
- Z-machine implements "or" for up to three
- right operands automatically, though it's an
- especially bad case to generate code for! */
-
- if (arity == 2)
- { assemblez_3_branch(je_zc,
- left_operand, ET[i].value,
- ET[ET[i].right].value, branch_away, flag);
- i = ET[i].right; arity--;
- }
- else
- { if ((arity == 3) || flag)
- assemblez_4_branch(je_zc, left_operand,
- ET[i].value,
- ET[ET[i].right].value,
- ET[ET[ET[i].right].right].value,
- branch_away, flag);
- else
- assemblez_4_branch(je_zc, left_operand,
- ET[i].value,
- ET[ET[i].right].value,
- ET[ET[ET[i].right].right].value,
- branch_other, !flag);
- i = ET[ET[i].right].right; arity -= 2;
- }
- }
- else
- { /* Otherwise we can compare the left_operand with
- only one right operand at the time. There are
- two cases: it's the last right operand, or it
- isn't. */
-
- if ((arity == 1) || flag)
- compile_conditional_z(oc, left_operand,
- ET[i].value, branch_away, flag);
- else
- compile_conditional_z(oc, left_operand,
- ET[i].value, branch_other, !flag);
- }
- i = ET[i].right; arity--;
- }
-
- }
- }
-
- /* NB: These two conditions cannot both occur, fortunately! */
-
- if (make_branch_label) assemble_label_no(branch_other);
- if (make_jump_away) assemblez_jump(branch_other);
-
- goto OperatorGenerated;
- }
-
- }
- else {
- if (operators[opnum].opcode_number_g >= FIRST_CC
- && operators[opnum].opcode_number_g <= LAST_CC) {
- /* Conditional terms such as '==': */
-
- int a = ET[n].true_label, b = ET[n].false_label;
- int branch_away, branch_other, flag,
- make_jump_away = FALSE, make_branch_label = FALSE;
- int ccode = operators[opnum].opcode_number_g;
- condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
- flag = (ccode & 1) ? 0 : 1;
-
- /* If the comparison is "equal to (constant) 0", change it
- to the simple "zero" test. Unfortunately, this doesn't
- work for the commutative form "(constant) 0 is equal to".
- At least I don't think it does. */
-
- if ((cc == &condclasses[1]) && (arity == 2)) {
- i = ET[ET[n].down].right;
- if ((ET[i].value.value == 0)
- && (ET[i].value.marker == 0)
- && is_constant_ot(ET[i].value.type)) {
- cc = &condclasses[0];
- }
- }
-
- /* If the condition has truth state flag, branch to
- label a, and if not, to label b. Possibly one of a, b
- equals -1, meaning "continue from this instruction".
-
- branch_away is the label which is a branch away (the one
- which isn't immediately after) and flag is the truth
- state to branch there.
-
- Note that when multiple instructions are needed (because
- of the use of the 'or' operator) the branch_other label
- is created if need be.
- */
-
- /* Reduce to the case where the branch_away label does exist: */
-
- if (a == -1) { a = b; b = -1; flag = !flag; }
-
- branch_away = a; branch_other = b;
- if (branch_other != -1) make_jump_away = TRUE;
-
- if ((arity > 2) && (flag == FALSE)) {
- /* In this case, we have an 'or' situation where multiple
- instructions are needed and where the overall condition
- is negated. That is, we have, e.g.
-
- if not (A cond B or C or D) then branch_away
-
- which we transform into
-
- if (A cond B) then branch_other
- if (A cond C) then branch_other
- if not (A cond D) then branch_away
- .branch_other */
-
- if (branch_other == -1) {
- branch_other = next_label++; make_branch_label = TRUE;
- }
- }
-
- if (cc == &condclasses[0]) {
- assembleg_1_branch((flag ? cc->posform : cc->negform),
- ET[below].value, branch_away);
- }
- else {
- if (arity == 2) {
- compile_conditional_g(cc, ET[below].value,
- ET[ET[below].right].value, branch_away, flag);
- }
- else {
- /* The case of a condition using "or".
- First: if the condition tests the stack pointer,
- and it can't always be done in a single test, move
- the value off the stack and into temporary variable
- storage. */
-
- assembly_operand left_operand;
- if (((ET[below].value.type == LOCALVAR_OT)
- && (ET[below].value.value == 0))) {
- assembleg_store(temp_var1, ET[below].value);
- left_operand = temp_var1;
- }
- else {
- left_operand = ET[below].value;
- }
- i = ET[below].right;
- arity--;
-
- /* "left_operand" now holds the quantity to be tested;
- "i" holds the right operand reached so far;
- "arity" the number of right operands. */
-
- while (i != -1) {
- /* We can compare the left_operand with
- only one right operand at the time. There are
- two cases: it's the last right operand, or it
- isn't. */
-
- if ((arity == 1) || flag)
- compile_conditional_g(cc, left_operand,
- ET[i].value, branch_away, flag);
- else
- compile_conditional_g(cc, left_operand,
- ET[i].value, branch_other, !flag);
-
- i = ET[i].right;
- arity--;
- }
- }
- }
-
- /* NB: These two conditions cannot both occur, fortunately! */
-
- if (make_branch_label) assemble_label_no(branch_other);
- if (make_jump_away) assembleg_jump(branch_other);
-
- goto OperatorGenerated;
- }
-
- }
-
- /* The operator is now definitely one which produces a value */
-
- if (void_flag && (!(operators[opnum].side_effect)))
- error_named("Evaluating this has no effect:",
- operators[opnum].description);
-
- /* Where shall we put the resulting value? (In Glulx, this could
- be smarter, and peg the result into ZEROCONSTANT.) */
-
- if (void_flag) Result = temp_var1; /* Throw it away */
- else
- { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
- {
- /* If the node above is "set variable equal to", then
- make that variable the place to put the result, and
- delete the SETEQUALS_OP node since its effect has already
- been accomplished. */
-
- ET[above].operator_number = -1;
- Result = ET[ET[above].down].value;
- ET[above].value = Result;
- }
- else Result = stack_pointer; /* Otherwise, put it on the stack */
- }
-
- if (!glulx_mode) {
-
- if (operators[opnum].opcode_number_z != -1)
- {
- /* Operators directly translatable into Z-code opcodes: infix ops
- take two operands whereas pre/postfix operators take only one */
-
- if (operators[opnum].usage == IN_U)
- { int o_n = operators[opnum].opcode_number_z;
- if (runtime_error_checking_switch && (!veneer_mode)
- && ((o_n == div_zc) || (o_n == mod_zc)))
- { assembly_operand by_ao, error_ao; int ln;
- by_ao = ET[ET[below].right].value;
- if ((by_ao.value != 0) && (by_ao.marker == 0)
- && ((by_ao.type == SHORT_CONSTANT_OT)
- || (by_ao.type == LONG_CONSTANT_OT)))
- assemblez_2_to(o_n, ET[below].value,
- by_ao, Result);
- else
- {
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, by_ao);
- ln = next_label++;
- assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
- INITAOT(&error_ao, SHORT_CONSTANT_OT);
- error_ao.value = DBYZERO_RTE;
- assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
- error_ao);
- assemblez_inc(temp_var2);
- assemble_label_no(ln);
- assemblez_2_to(o_n, temp_var1, temp_var2, Result);
- }
- }
- else {
- assemblez_2_to(o_n, ET[below].value,
- ET[ET[below].right].value, Result);
- }
- }
- else
- assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
- Result);
- }
- else
- switch(opnum)
- { case ARROW_OP:
- access_memory_z(loadb_zc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case DARROW_OP:
- access_memory_z(loadw_zc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case UNARY_MINUS_OP:
- assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
- break;
- case ARTNOT_OP:
- assemblez_1_to(not_zc, ET[below].value, Result);
- break;
-
- case PROP_ADD_OP:
- { assembly_operand AO = ET[below].value;
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
- assemblez_2_to(get_prop_addr_zc, AO,
- ET[ET[below].right].value, temp_var1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
-
- case PROP_NUM_OP:
- { assembly_operand AO = ET[below].value;
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
- assemblez_2_to(get_prop_addr_zc, AO,
- ET[ET[below].right].value, temp_var1);
- assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
- assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
- assemble_label_no(next_label-1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
-
- case PROPERTY_OP:
- { assembly_operand AO = ET[below].value;
-
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
- AO, ET[ET[below].right].value, temp_var1);
- else
- assemblez_2_to(get_prop_zc, AO,
- ET[ET[below].right].value, temp_var1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
-
- case MESSAGE_OP:
- j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
- goto GenFunctionCallZ;
- case MPROP_ADD_OP:
- j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
- goto GenFunctionCallZ;
- case MPROP_NUM_OP:
- j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_SETEQUALS_OP:
- j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_INC_OP:
- j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_DEC_OP:
- j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_POST_INC_OP:
- j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_POST_DEC_OP:
- j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
- goto GenFunctionCallZ;
- case SUPERCLASS_OP:
- j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
- goto GenFunctionCallZ;
- case PROP_CALL_OP:
- j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_CALL_OP:
- j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
- goto GenFunctionCallZ;
-
-
- case FCALL_OP:
- j = 0;
-
- if ((ET[below].value.type == VARIABLE_OT)
- && (ET[below].value.value >= 256))
- { int sf_number = ET[below].value.value - 256;
-
- i = ET[below].right;
- if (i == -1)
- { error("Argument to system function missing");
- AI.operand[0] = one_operand;
- AI.operand_count = 1;
- }
- else
- { j=0;
- while (i != -1) { j++; i = ET[i].right; }
-
- if (((sf_number != INDIRECT_SYSF) &&
- (sf_number != RANDOM_SYSF) && (j > 1))
- || ((sf_number == INDIRECT_SYSF) && (j>7)))
- { j=1;
- error("System function given with too many arguments");
- }
- if (sf_number != RANDOM_SYSF)
- { int jcount;
- i = ET[below].right;
- for (jcount = 0; jcount < j; jcount++)
- { AI.operand[jcount] = ET[i].value;
- i = ET[i].right;
- }
- AI.operand_count = j;
- }
- }
- AI.store_variable_number = Result.value;
- AI.branch_label_number = -1;
-
- switch(sf_number)
- { case RANDOM_SYSF:
- if (j>1)
- { assembly_operand AO, AO2; int arg_c, arg_et;
- INITAOTV(&AO, SHORT_CONSTANT_OT, j);
- INITAOT(&AO2, LONG_CONSTANT_OT);
- AO2.value = begin_word_array();
- AO2.marker = ARRAY_MV;
-
- for (arg_c=0, arg_et = ET[below].right;arg_c<j;
- arg_c++, arg_et = ET[arg_et].right)
- { if (ET[arg_et].value.type == VARIABLE_OT)
- error("Only constants can be used as possible 'random' results");
- array_entry(arg_c, ET[arg_et].value);
- }
- finish_array(arg_c);
-
- assemblez_1_to(random_zc, AO, temp_var1);
- assemblez_dec(temp_var1);
- assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
- }
- else
- assemblez_1_to(random_zc,
- ET[ET[below].right].value, Result);
- break;
-
- case PARENT_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- PARENT_RTE);
- assemblez_1_to(get_parent_zc, AO, Result);
- }
- break;
-
- case ELDEST_SYSF:
- case CHILD_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
- assemblez_objcode(get_child_zc,
- AO, Result, -2, TRUE);
- }
- break;
-
- case YOUNGER_SYSF:
- case SIBLING_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==SIBLING_SYSF)
- ?SIBLING_RTE:YOUNGER_RTE);
- assemblez_objcode(get_sibling_zc,
- AO, Result, -2, TRUE);
- }
- break;
-
- case INDIRECT_SYSF:
- j=0; i = ET[below].right;
- goto IndirectFunctionCallZ;
-
- case CHILDREN_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- CHILDREN_RTE);
- assemblez_store(temp_var1, zero_operand);
- assemblez_objcode(get_child_zc,
- AO, stack_pointer, next_label+1, FALSE);
- assemble_label_no(next_label);
- assemblez_inc(temp_var1);
- assemblez_objcode(get_sibling_zc,
- stack_pointer, stack_pointer,
- next_label, TRUE);
- assemble_label_no(next_label+1);
- assemblez_store(temp_var2, stack_pointer);
- if (!void_flag) write_result_z(Result, temp_var1);
- next_label += 2;
- }
- break;
-
- case YOUNGEST_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- assemblez_objcode(get_child_zc,
- AO, temp_var1, next_label+1, FALSE);
- assemblez_1(push_zc, temp_var1);
- assemble_label_no(next_label);
- assemblez_store(temp_var1, stack_pointer);
- assemblez_objcode(get_sibling_zc,
- temp_var1, stack_pointer, next_label, TRUE);
- assemble_label_no(next_label+1);
- if (!void_flag) write_result_z(Result, temp_var1);
- next_label += 2;
- }
- break;
-
- case ELDER_SYSF:
- assemblez_store(temp_var1, ET[ET[below].right].value);
- if (runtime_error_checking_switch)
- check_nonzero_at_runtime(temp_var1, -1,
- ELDER_RTE);
- assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
- assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
- assemblez_store(temp_var2, temp_var3);
- assemblez_store(temp_var3, zero_operand);
- assemblez_objcode(get_child_zc,
- temp_var2, temp_var2, next_label, TRUE);
- assemble_label_no(next_label++);
- assemblez_2_branch(je_zc, temp_var1, temp_var2,
- next_label, TRUE);
- assemblez_store(temp_var3, temp_var2);
- assemblez_objcode(get_sibling_zc,
- temp_var2, temp_var2, next_label - 1, TRUE);
- assemble_label_no(next_label++);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case METACLASS_SYSF:
- assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
- veneer_routine(Metaclass_VR),
- ET[ET[below].right].value, Result);
- break;
-
- case GLK_SYSF:
- error("The glk() system function does not exist in Z-code");
- break;
- }
- break;
- }
-
- GenFunctionCallZ:
-
- i = below;
-
- IndirectFunctionCallZ:
-
- while ((i != -1) && (j<8))
- { AI.operand[j++] = ET[i].value;
- i = ET[i].right;
- }
-
- if ((j > 4) && (version_number == 3))
- { error("A function may be called with at most 3 arguments");
- j = 4;
- }
- if ((j==8) && (i != -1))
- { error("A function may be called with at most 7 arguments");
- }
-
- AI.operand_count = j;
-
- if ((void_flag) && (version_number >= 5))
- { AI.store_variable_number = -1;
- switch(j)
- { case 1: AI.internal_number = call_1n_zc; break;
- case 2: AI.internal_number = call_2n_zc; break;
- case 3: case 4: AI.internal_number = call_vn_zc; break;
- case 5: case 6: case 7: case 8:
- AI.internal_number = call_vn2_zc; break;
- }
- }
- else
- { AI.store_variable_number = Result.value;
- if (version_number == 3)
- AI.internal_number = call_zc;
- else
- switch(j)
- { case 1: AI.internal_number = call_1s_zc; break;
- case 2: AI.internal_number = call_2s_zc; break;
- case 3: case 4: AI.internal_number = call_vs_zc; break;
- case 5: case 6: case 7: case 8:
- AI.internal_number = call_vs2_zc; break;
- }
- }
-
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
- break;
-
- case SETEQUALS_OP:
- assemblez_store(ET[below].value,
- ET[ET[below].right].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
-
- case PROPERTY_SETEQUALS_OP:
- if (!void_flag)
- { if (runtime_error_checking_switch)
- assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
- ET[below].value, ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value, Result);
- else
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- assemblez_3(put_prop_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- }
- else
- { if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- ET[below].value, ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- else assemblez_3(put_prop_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- }
- break;
- case ARROW_SETEQUALS_OP:
- if (!void_flag)
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_z(storeb_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- else access_memory_z(storeb_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case DARROW_SETEQUALS_OP:
- if (!void_flag)
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_z(storew_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- else
- access_memory_z(storew_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case INC_OP:
- assemblez_inc(ET[below].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
- case DEC_OP:
- assemblez_dec(ET[below].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
- case POST_INC_OP:
- if (!void_flag) write_result_z(Result, ET[below].value);
- assemblez_inc(ET[below].value);
- break;
- case POST_DEC_OP:
- if (!void_flag) write_result_z(Result, ET[below].value);
- assemblez_dec(ET[below].value);
- break;
-
- case ARROW_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case ARROW_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case ARROW_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case ARROW_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case DARROW_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case DARROW_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case PROPERTY_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case PROPERTY_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
-
- case PROPERTY_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- case PROPERTY_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- break;
-
- default:
- printf("** Trouble op = %d i.e. '%s' **\n",
- opnum, operators[opnum].description);
- compiler_error("Expr code gen: Can't generate yet");
- }
- }
- else {
- assembly_operand AO, AO2;
- if (operators[opnum].opcode_number_g != -1)
- {
- /* Operators directly translatable into opcodes: infix ops
- take two operands whereas pre/postfix operators take only one */
-
- if (operators[opnum].usage == IN_U)
- { int o_n = operators[opnum].opcode_number_g;
- if (runtime_error_checking_switch && (!veneer_mode)
- && ((o_n == div_gc) || (o_n == mod_gc)))
- { assembly_operand by_ao, error_ao; int ln;
- by_ao = ET[ET[below].right].value;
- if ((by_ao.value != 0) && (by_ao.marker == 0)
- && is_constant_ot(by_ao.type))
- assembleg_3(o_n, ET[below].value,
- by_ao, Result);
- else
- { assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, by_ao);
- ln = next_label++;
- assembleg_1_branch(jnz_gc, temp_var2, ln);
- INITAO(&error_ao);
- error_ao.value = DBYZERO_RTE;
- set_constant_ot(&error_ao);
- assembleg_call_1(veneer_routine(RT__Err_VR),
- error_ao, zero_operand);
- assembleg_store(temp_var2, one_operand);
- assemble_label_no(ln);
- assembleg_3(o_n, temp_var1, temp_var2, Result);
- }
- }
- else
- assembleg_3(o_n, ET[below].value,
- ET[ET[below].right].value, Result);
- }
- else
- assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
- Result);
- }
- else
- switch(opnum)
- {
-
- case PUSH_OP:
- if (ET[below].value.type == Result.type
- && ET[below].value.value == Result.value
- && ET[below].value.marker == Result.marker)
- break;
- assembleg_2(copy_gc, ET[below].value, Result);
- break;
-
- case UNARY_MINUS_OP:
- assembleg_2(neg_gc, ET[below].value, Result);
- break;
- case ARTNOT_OP:
- assembleg_2(bitnot_gc, ET[below].value, Result);
- break;
-
- case ARROW_OP:
- access_memory_g(aloadb_gc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case DARROW_OP:
- access_memory_g(aload_gc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
-
- case SETEQUALS_OP:
- assembleg_store(ET[below].value,
- ET[ET[below].right].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
-
- case ARROW_SETEQUALS_OP:
- if (!void_flag)
- { assembleg_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_g(astoreb_gc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_g(Result, temp_var1);
- }
- else access_memory_g(astoreb_gc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case DARROW_SETEQUALS_OP:
- if (!void_flag)
- { assembleg_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_g(astore_gc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_g(Result, temp_var1);
- }
- else
- access_memory_g(astore_gc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
-
- case INC_OP:
- assembleg_inc(ET[below].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
- case DEC_OP:
- assembleg_dec(ET[below].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
- case POST_INC_OP:
- if (!void_flag) write_result_g(Result, ET[below].value);
- assembleg_inc(ET[below].value);
- break;
- case POST_DEC_OP:
- if (!void_flag) write_result_g(Result, ET[below].value);
- assembleg_dec(ET[below].value);
- break;
-
- case ARROW_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case ARROW_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case ARROW_POST_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case ARROW_POST_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case DARROW_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
-
- case DARROW_POST_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case DARROW_POST_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- break;
-
- case PROPERTY_OP:
- case MESSAGE_OP:
- AO = veneer_routine(RV__Pr_VR);
- goto TwoArgFunctionCall;
- case MPROP_ADD_OP:
- case PROP_ADD_OP:
- AO = veneer_routine(RA__Pr_VR);
- goto TwoArgFunctionCall;
- case MPROP_NUM_OP:
- case PROP_NUM_OP:
- AO = veneer_routine(RL__Pr_VR);
- goto TwoArgFunctionCall;
-
- case PROP_CALL_OP:
- case MESSAGE_CALL_OP:
- AO2 = veneer_routine(CA__Pr_VR);
- i = below;
- goto DoFunctionCall;
-
- case MESSAGE_INC_OP:
- case PROPERTY_INC_OP:
- AO = veneer_routine(IB__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_DEC_OP:
- case PROPERTY_DEC_OP:
- AO = veneer_routine(DB__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_POST_INC_OP:
- case PROPERTY_POST_INC_OP:
- AO = veneer_routine(IA__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_POST_DEC_OP:
- case PROPERTY_POST_DEC_OP:
- AO = veneer_routine(DA__Pr_VR);
- goto TwoArgFunctionCall;
- case SUPERCLASS_OP:
- AO = veneer_routine(RA__Sc_VR);
- goto TwoArgFunctionCall;
-
- TwoArgFunctionCall:
- {
- assembly_operand AO2 = ET[below].value;
- assembly_operand AO3 = ET[ET[below].right].value;
- if (void_flag)
- assembleg_call_2(AO, AO2, AO3, zero_operand);
- else
- assembleg_call_2(AO, AO2, AO3, Result);
- }
- break;
-
- case PROPERTY_SETEQUALS_OP:
- case MESSAGE_SETEQUALS_OP:
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = veneer_routine(RT__ChPS_VR);
- else
- AO = veneer_routine(WV__Pr_VR);
-
- {
- assembly_operand AO2 = ET[below].value;
- assembly_operand AO3 = ET[ET[below].right].value;
- assembly_operand AO4 = ET[ET[ET[below].right].right].value;
- if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
- /* Rightmost is on the stack; reduce to previous case. */
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- /* both already on stack. */
- }
- else {
- assembleg_store(stack_pointer, AO3);
- assembleg_0(stkswap_gc);
- }
- }
- else {
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- assembleg_store(stack_pointer, AO2);
- }
- else {
- assembleg_store(stack_pointer, AO3);
- assembleg_store(stack_pointer, AO2);
- }
- }
- }
- else {
- /* We have to get the rightmost on the stack, below the
- others. */
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- assembleg_store(stack_pointer, AO4);
- assembleg_2(stkroll_gc, three_operand, one_operand);
- }
- else {
- assembleg_store(stack_pointer, AO4);
- assembleg_0(stkswap_gc);
- assembleg_store(stack_pointer, AO2);
- }
- }
- else {
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- assembleg_store(stack_pointer, AO4);
- assembleg_store(stack_pointer, AO3);
- assembleg_2(stkroll_gc, three_operand, two_operand);
- }
- else {
- assembleg_store(stack_pointer, AO4);
- assembleg_store(stack_pointer, AO3);
- assembleg_store(stack_pointer, AO2);
- }
- }
- }
- if (void_flag)
- assembleg_3(call_gc, AO, three_operand, zero_operand);
- else
- assembleg_3(call_gc, AO, three_operand, Result);
- }
- break;
-
- case FCALL_OP:
- j = 0;
-
- if (ET[below].value.type == SYSFUN_OT)
- { int sf_number = ET[below].value.value;
-
- i = ET[below].right;
- if (i == -1)
- { error("Argument to system function missing");
- AI.operand[0] = one_operand;
- AI.operand_count = 1;
- }
- else
- { j=0;
- while (i != -1) { j++; i = ET[i].right; }
-
- if (((sf_number != INDIRECT_SYSF) &&
- (sf_number != GLK_SYSF) &&
- (sf_number != RANDOM_SYSF) && (j > 1)))
- { j=1;
- error("System function given with too many arguments");
- }
- if (sf_number != RANDOM_SYSF)
- { int jcount;
- i = ET[below].right;
- for (jcount = 0; jcount < j; jcount++)
- { AI.operand[jcount] = ET[i].value;
- i = ET[i].right;
- }
- AI.operand_count = j;
- }
- }
-
- switch(sf_number)
- {
- case RANDOM_SYSF:
- if (j>1)
- { assembly_operand AO, AO2;
- int arg_c, arg_et;
- INITAO(&AO);
- AO.value = j;
- set_constant_ot(&AO);
- INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
- AO2.marker = ARRAY_MV;
-
- for (arg_c=0, arg_et = ET[below].right;arg_c<j;
- arg_c++, arg_et = ET[arg_et].right)
- { if (ET[arg_et].value.type == LOCALVAR_OT
- || ET[arg_et].value.type == GLOBALVAR_OT)
- error("Only constants can be used as possible 'random' results");
- array_entry(arg_c, ET[arg_et].value);
- }
- finish_array(arg_c);
-
- assembleg_2(random_gc, AO, stack_pointer);
- assembleg_3(aload_gc, AO2, stack_pointer, Result);
- }
- else {
- assembleg_2(random_gc,
- ET[ET[below].right].value, stack_pointer);
- assembleg_3(add_gc, stack_pointer, one_operand,
- Result);
- }
- break;
-
- case PARENT_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- PARENT_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
-
- case ELDEST_SYSF:
- case CHILD_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
-
- case YOUNGER_SYSF:
- case SIBLING_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==SIBLING_SYSF)
- ?SIBLING_RTE:YOUNGER_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
-
- case CHILDREN_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- CHILDREN_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_store(temp_var1, zero_operand);
- assembleg_3(aload_gc, AO, AO2, temp_var2);
- AO2.value = GOBJFIELD_SIBLING();
- assemble_label_no(next_label);
- assembleg_1_branch(jz_gc, temp_var2, next_label+1);
- assembleg_3(add_gc, temp_var1, one_operand,
- temp_var1);
- assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- next_label += 2;
- if (!void_flag)
- write_result_g(Result, temp_var1);
- }
- break;
-
- case INDIRECT_SYSF:
- i = ET[below].right;
- goto IndirectFunctionCallG;
-
- case GLK_SYSF:
- AO2 = veneer_routine(Glk__Wrap_VR);
- i = ET[below].right;
- goto DoFunctionCall;
-
- case METACLASS_SYSF:
- assembleg_call_1(veneer_routine(Metaclass_VR),
- ET[ET[below].right].value, Result);
- break;
-
- case YOUNGEST_SYSF:
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_3(aload_gc, AO, AO2, temp_var1);
- AO2.value = GOBJFIELD_SIBLING();
- assembleg_1_branch(jz_gc, temp_var1, next_label+1);
- assemble_label_no(next_label);
- assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
- assembleg_1_branch(jz_gc, temp_var2, next_label+1);
- assembleg_store(temp_var1, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- if (!void_flag)
- write_result_g(Result, temp_var1);
- next_label += 2;
- break;
-
- case ELDER_SYSF:
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- assembleg_store(temp_var3, AO);
- INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
- assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
- assembleg_1_branch(jz_gc, temp_var1, next_label+2);
- AO2.value = GOBJFIELD_CHILD();
- assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
- assembleg_1_branch(jz_gc, temp_var1, next_label+2);
- assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
- next_label+1);
- assemble_label_no(next_label);
- AO2.value = GOBJFIELD_SIBLING();
- assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
- assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
- next_label+2);
- assembleg_store(temp_var1, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- assembleg_store(temp_var1, zero_operand);
- assemble_label_no(next_label+2);
- if (!void_flag)
- write_result_g(Result, temp_var1);
- next_label += 3;
- break;
-
- default:
- error("*** system function not implemented ***");
- break;
-
- }
- break;
- }
-
- i = below;
-
- IndirectFunctionCallG:
-
- /* Get the function address. */
- AO2 = ET[i].value;
- i = ET[i].right;
-
- DoFunctionCall:
-
- {
- /* If all the function arguments are in local/global
- variables, we have to push them all on the stack.
- If all of them are on the stack, we have to do nothing.
- If some are and some aren't, we have a hopeless mess,
- and we should throw a compiler error.
- */
-
- int onstack = 0;
- int offstack = 0;
-
- /* begin part of patch G03701 */
- int nargs = 0;
- j = i;
- while (j != -1) {
- nargs++;
- j = ET[j].right;
- }
-
- if (nargs==0) {
- assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
- } else if (nargs==1) {
- assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
- } else if (nargs==2) {
- assembly_operand o1 = ET[i].value;
- assembly_operand o2 = ET[ET[i].right].value;
- assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
- } else if (nargs==3) {
- assembly_operand o1 = ET[i].value;
- assembly_operand o2 = ET[ET[i].right].value;
- assembly_operand o3 = ET[ET[ET[i].right].right].value;
- assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
- } else {
-
- j = 0;
- while (i != -1) {
- if (ET[i].value.type == LOCALVAR_OT
- && ET[i].value.value == 0) {
- onstack++;
- }
- else {
- assembleg_store(stack_pointer, ET[i].value);
- offstack++;
- }
- i = ET[i].right;
- j++;
- }
-
- if (onstack && offstack)
- error("*** Function call cannot be generated with mixed arguments ***");
- if (offstack > 1)
- error("*** Function call cannot be generated with more than one nonstack argument ***");
-
- INITAO(&AO);
- AO.value = j;
- set_constant_ot(&AO);
-
- if (void_flag)
- assembleg_3(call_gc, AO2, AO, zero_operand);
- else
- assembleg_3(call_gc, AO2, AO, Result);
-
- } /* else nargs>=4 */
- } /* DoFunctionCall: */
-
- break;
-
- default:
- printf("** Trouble op = %d i.e. '%s' **\n",
- opnum, operators[opnum].description);
- compiler_error("Expr code gen: Can't generate yet");
- }
- }
-
- ET[n].value = Result;
-
- OperatorGenerated:
-
- if (!glulx_mode) {
-
- if (ET[n].to_expression)
- {
- if (void_flag) {
- warning("Logical expression has no side-effects");
- if (ET[n].true_label != -1)
- assemble_label_no(ET[n].true_label);
- else
- assemble_label_no(ET[n].false_label);
- }
- else if (ET[n].true_label != -1)
- { assemblez_1(push_zc, zero_operand);
- assemblez_jump(next_label++);
- assemble_label_no(ET[n].true_label);
- assemblez_1(push_zc, one_operand);
- assemble_label_no(next_label-1);
- }
- else
- { assemblez_1(push_zc, one_operand);
- assemblez_jump(next_label++);
- assemble_label_no(ET[n].false_label);
- assemblez_1(push_zc, zero_operand);
- assemble_label_no(next_label-1);
- }
- ET[n].value = stack_pointer;
- }
- else
- if (ET[n].label_after != -1)
- assemble_label_no(ET[n].label_after);
-
- }
- else {
-
- if (ET[n].to_expression)
- {
- if (void_flag) {
- warning("Logical expression has no side-effects");
- if (ET[n].true_label != -1)
- assemble_label_no(ET[n].true_label);
- else
- assemble_label_no(ET[n].false_label);
- }
- else if (ET[n].true_label != -1)
- { assembleg_store(stack_pointer, zero_operand);
- assembleg_jump(next_label++);
- assemble_label_no(ET[n].true_label);
- assembleg_store(stack_pointer, one_operand);
- assemble_label_no(next_label-1);
- }
- else
- { assembleg_store(stack_pointer, one_operand);
- assembleg_jump(next_label++);
- assemble_label_no(ET[n].false_label);
- assembleg_store(stack_pointer, zero_operand);
- assemble_label_no(next_label-1);
- }
- ET[n].value = stack_pointer;
- }
- else
- if (ET[n].label_after != -1)
- assemble_label_no(ET[n].label_after);
-
- }
-
- ET[n].down = -1;
-}
-
-assembly_operand code_generate(assembly_operand AO, int context, int label)
-{
- /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
- QUANTITY_CONTEXT.
-
- If CONDITION_CONTEXT, then compile code branching to label number
- "label" if the condition is false: there's no return value.
- (Except that if label is -3 or -4 (internal codes for rfalse and
- rtrue rather than branch) then this is for branching when the
- condition is true. This is used for optimising code generation
- for "if" statements.)
-
- Otherwise return the assembly operand containing the result
- (probably the stack pointer variable but not necessarily:
- e.g. is would be short constant 2 from the expression "j++, 2") */
-
- vivc_flag = FALSE;
-
- if (AO.type != EXPRESSION_OT)
- { switch(context)
- { case VOID_CONTEXT:
- value_in_void_context(AO);
- AO.type = OMITTED_OT;
- AO.value = 0;
- break;
- case CONDITION_CONTEXT:
- if (!glulx_mode) {
- if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
- else assemblez_1_branch(jz_zc, AO, label, TRUE);
- }
- else {
- if (label < -2)
- assembleg_1_branch(jnz_gc, AO, label);
- else
- assembleg_1_branch(jz_gc, AO, label);
- }
- AO.type = OMITTED_OT;
- AO.value = 0;
- break;
- }
- return AO;
- }
-
- if (expr_trace_level >= 2)
- { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
- }
-
- if (context == CONDITION_CONTEXT)
- { if (label < -2) annotate_for_conditions(AO.value, label, -1);
- else annotate_for_conditions(AO.value, -1, label);
- }
- else annotate_for_conditions(AO.value, -1, -1);
-
- if (expr_trace_level >= 1)
- { printf("Code generation for expression in ");
- switch(context)
- { case VOID_CONTEXT: printf("void"); break;
- case CONDITION_CONTEXT: printf("condition"); break;
- case QUANTITY_CONTEXT: printf("quantity"); break;
- case ASSEMBLY_CONTEXT: printf("assembly"); break;
- case ARRAY_CONTEXT: printf("array initialisation"); break;
- default: printf("* ILLEGAL *"); break;
- }
- printf(" context with annotated tree:\n");
- show_tree(AO, TRUE);
- }
-
- generate_code_from(AO.value, (context==VOID_CONTEXT));
- return ET[AO.value].value;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_expressc_vars(void)
-{ make_operands();
-}
-
-extern void expressc_begin_pass(void)
-{
-}
-
-extern void expressc_allocate_arrays(void)
-{
-}
-
-extern void expressc_free_arrays(void)
-{
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "expressp" : The expression parser */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-/* --- Interface to lexer -------------------------------------------------- */
-
-static char separators_to_operators[103];
-static char conditionals_to_operators[7];
-static char token_type_allowable[301];
-
-#define NOT_AN_OPERATOR (char) 0x7e
-
-static void make_lexical_interface_tables(void)
-{ int i;
- for (i=0;i<103;i++)
- separators_to_operators[i] = NOT_AN_OPERATOR;
- for (i=0;i<NUM_OPERATORS;i++)
- if (operators[i].token_type == SEP_TT)
- separators_to_operators[operators[i].token_value] = i;
-
- for (i=0;i<7;i++) /* 7 being the size of keyword_group "conditions" */
- conditionals_to_operators[i] = NOT_AN_OPERATOR;
- for (i=0;i<NUM_OPERATORS;i++)
- if (operators[i].token_type == CND_TT)
- conditionals_to_operators[operators[i].token_value] = i;
-
- for (i=0;i<301;i++) token_type_allowable[i] = 0;
-
- token_type_allowable[VARIABLE_TT] = 1;
- token_type_allowable[SYSFUN_TT] = 1;
- token_type_allowable[DQ_TT] = 1;
- token_type_allowable[DICTWORD_TT] = 1;
- token_type_allowable[SUBOPEN_TT] = 1;
- token_type_allowable[SUBCLOSE_TT] = 1;
- token_type_allowable[SMALL_NUMBER_TT] = 1;
- token_type_allowable[LARGE_NUMBER_TT] = 1;
- token_type_allowable[ACTION_TT] = 1;
- token_type_allowable[SYSTEM_CONSTANT_TT] = 1;
- token_type_allowable[OP_TT] = 1;
-}
-
-static token_data current_token, previous_token, heldback_token;
-
-static int comma_allowed, arrow_allowed, superclass_allowed,
- bare_prop_allowed,
- array_init_ambiguity, action_ambiguity,
- etoken_count, inserting_token, bracket_level;
-
-extern int *variable_usage;
-
-int system_function_usage[32];
-
-static int get_next_etoken(void)
-{ int v, symbol = 0, mark_symbol_as_used = FALSE,
- initial_bracket_level = bracket_level;
-
- etoken_count++;
-
- if (inserting_token)
- { current_token = heldback_token;
- inserting_token = FALSE;
- }
- else
- { get_next_token();
- current_token.text = token_text;
- current_token.value = token_value;
- current_token.type = token_type;
- current_token.marker = 0;
- current_token.symtype = 0;
- current_token.symflags = -1;
- }
-
- switch(current_token.type)
- { case LOCAL_VARIABLE_TT:
- current_token.type = VARIABLE_TT;
- variable_usage[current_token.value] = TRUE;
- break;
-
- case DQ_TT:
- current_token.marker = STRING_MV;
- break;
-
- case SQ_TT:
- { int32 unicode = text_to_unicode(token_text);
- if (token_text[textual_form_length] == 0)
- {
- if (!glulx_mode) {
- current_token.value = unicode_to_zscii(unicode);
- if (current_token.value == 5)
- { unicode_char_error("Character can be printed \
-but not used as a value:", unicode);
- current_token.value = '?';
- }
- if (current_token.value >= 0x100)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- else {
- current_token.value = unicode;
- if (current_token.value >= 0x8000
- || current_token.value < -0x8000)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- }
- else
- { current_token.type = DICTWORD_TT;
- current_token.marker = DWORD_MV;
- }
- }
- break;
-
- case SYMBOL_TT:
- ReceiveSymbol:
- symbol = current_token.value;
-
- mark_symbol_as_used = TRUE;
-
- v = svals[symbol];
-
- current_token.symtype = stypes[symbol];
- current_token.symflags = sflags[symbol];
- switch(stypes[symbol])
- { case ROUTINE_T:
- /* Replaced functions must always be backpatched
- because there could be another definition coming. */
- if (sflags[symbol] & REPLACE_SFLAG)
- { current_token.marker = SYMBOL_MV;
- if (module_switch) import_symbol(symbol);
- v = symbol;
- break;
- }
- current_token.marker = IROUTINE_MV;
- break;
- case GLOBAL_VARIABLE_T:
- current_token.marker = VARIABLE_MV;
- break;
- case OBJECT_T:
- case CLASS_T:
- /* All objects must be backpatched in Glulx. */
- if (module_switch || glulx_mode)
- current_token.marker = OBJECT_MV;
- break;
- case ARRAY_T:
- current_token.marker = ARRAY_MV;
- break;
- case INDIVIDUAL_PROPERTY_T:
- if (module_switch) current_token.marker = IDENT_MV;
- break;
- case CONSTANT_T:
- if (sflags[symbol] & (UNKNOWN_SFLAG + CHANGE_SFLAG))
- { current_token.marker = SYMBOL_MV;
- if (module_switch) import_symbol(symbol);
- v = symbol;
- }
- else current_token.marker = 0;
- break;
- case LABEL_T:
- error_named("Label name used as value:", token_text);
- break;
- default:
- current_token.marker = 0;
- break;
- }
- if (sflags[symbol] & SYSTEM_SFLAG)
- current_token.marker = 0;
-
- current_token.value = v;
-
- if (!glulx_mode) {
- if (((current_token.marker != 0)
- && (current_token.marker != VARIABLE_MV))
- || (v < 0) || (v > 255))
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- else {
- if (((current_token.marker != 0)
- && (current_token.marker != VARIABLE_MV))
- || (v < -0x8000) || (v >= 0x8000))
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
-
- if (stypes[symbol] == GLOBAL_VARIABLE_T)
- { current_token.type = VARIABLE_TT;
- variable_usage[current_token.value] = TRUE;
- }
- break;
-
- case NUMBER_TT:
- if (!glulx_mode) {
- if (current_token.value >= 256)
- current_token.type = LARGE_NUMBER_TT;
- else
- current_token.type = SMALL_NUMBER_TT;
- }
- else {
- if (current_token.value < -0x8000
- || current_token.value >= 0x8000)
- current_token.type = LARGE_NUMBER_TT;
- else
- current_token.type = SMALL_NUMBER_TT;
- }
- break;
-
- case SEP_TT:
- switch(current_token.value)
- { case ARROW_SEP:
- if (!arrow_allowed)
- current_token.type = ENDEXP_TT;
- break;
-
- case COMMA_SEP:
- if ((bracket_level==0) && (!comma_allowed))
- current_token.type = ENDEXP_TT;
- break;
-
- case SUPERCLASS_SEP:
- if ((bracket_level==0) && (!superclass_allowed))
- current_token.type = ENDEXP_TT;
- break;
-
- case GREATER_SEP:
- get_next_token();
- if ((token_type == SEP_TT)
- &&((token_value == SEMICOLON_SEP)
- || (token_value == GREATER_SEP)))
- current_token.type = ENDEXP_TT;
- put_token_back();
- break;
-
- case OPENB_SEP:
- bracket_level++;
- if (expr_trace_level>=3)
- { printf("Previous token type = %d\n",previous_token.type);
- printf("Previous token val = %d\n",previous_token.value);
- }
- if ((previous_token.type == OP_TT)
- || (previous_token.type == SUBOPEN_TT)
- || (previous_token.type == ENDEXP_TT)
- || (array_init_ambiguity)
- || ((bracket_level == 1) && (action_ambiguity)))
- current_token.type = SUBOPEN_TT;
- else
- { inserting_token = TRUE;
- heldback_token = current_token;
- current_token.text = "<call>";
- bracket_level--;
- }
- break;
-
- case CLOSEB_SEP:
- bracket_level--;
- if (bracket_level < 0)
- current_token.type = ENDEXP_TT;
- else current_token.type = SUBCLOSE_TT;
- break;
-
- case SEMICOLON_SEP:
- current_token.type = ENDEXP_TT; break;
-
- case MINUS_SEP:
- if ((previous_token.type == OP_TT)
- || (previous_token.type == SUBOPEN_TT)
- || (previous_token.type == ENDEXP_TT))
- current_token.value = UNARY_MINUS_SEP; break;
-
- case INC_SEP:
- if ((previous_token.type == VARIABLE_TT)
- || (previous_token.type == SUBCLOSE_TT)
- || (previous_token.type == LARGE_NUMBER_TT)
- || (previous_token.type == SMALL_NUMBER_TT))
- current_token.value = POST_INC_SEP; break;
-
- case DEC_SEP:
- if ((previous_token.type == VARIABLE_TT)
- || (previous_token.type == SUBCLOSE_TT)
- || (previous_token.type == LARGE_NUMBER_TT)
- || (previous_token.type == SMALL_NUMBER_TT))
- current_token.value = POST_DEC_SEP; break;
-
- case HASHHASH_SEP:
- token_text = current_token.text + 2;
-
- ActionUsedAsConstant:
-
- current_token.type = ACTION_TT;
- current_token.text = token_text;
- current_token.value = 0;
- current_token.marker = ACTION_MV;
-
- break;
-
- case HASHADOLLAR_SEP:
- obsolete_warning("'#a$Act' is now superseded by '##Act'");
- token_text = current_token.text + 3;
- goto ActionUsedAsConstant;
-
- case HASHGDOLLAR_SEP:
-
- /* This form generates the position of a global variable
- in the global variables array. So Glob is the same as
- #globals_array --> #g$Glob */
-
- current_token.text += 3;
- current_token.type = SYMBOL_TT;
- symbol = symbol_index(current_token.text, -1);
- if (stypes[symbol] != GLOBAL_VARIABLE_T) {
- ebf_error(
- "global variable name after '#g$'",
- current_token.text);
- current_token.value = 0;
- current_token.type = SMALL_NUMBER_TT;
- current_token.marker = 0;
- break;
- }
- mark_symbol_as_used = TRUE;
- current_token.value = svals[symbol] - MAX_LOCAL_VARIABLES;
- current_token.marker = 0;
- if (!glulx_mode) {
- if (current_token.value >= 0x100)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- else {
- if (current_token.value >= 0x8000
- || current_token.value < -0x8000)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- break;
-
- case HASHNDOLLAR_SEP:
-
- /* This form is still needed for constants like #n$a (the
- dictionary address of the word "a"), since 'a' means
- the ASCII value of 'a' */
-
- if (strlen(token_text) > 4)
- obsolete_warning(
- "'#n$word' is now superseded by ''word''");
- current_token.type = DICTWORD_TT;
- current_token.value = 0;
- current_token.text = token_text + 3;
- current_token.marker = DWORD_MV;
- break;
-
- case HASHRDOLLAR_SEP:
-
- /* This form -- #r$Routinename, to return the routine's */
- /* packed address -- is needed far less often in Inform 6, */
- /* where just giving the name Routine returns the packed */
- /* address. But it's used in a lot of Inform 5 code. */
-
- obsolete_warning(
- "'#r$Routine' can now be written just 'Routine'");
- current_token.text += 3;
- current_token.type = SYMBOL_TT;
- current_token.value = symbol_index(current_token.text, -1);
- goto ReceiveSymbol;
-
- case HASHWDOLLAR_SEP:
- error("The obsolete '#w$word' construct has been removed");
- break;
-
- case HASH_SEP:
- system_constants.enabled = TRUE;
- get_next_token();
- system_constants.enabled = FALSE;
- if (token_type != SYSTEM_CONSTANT_TT)
- { ebf_error(
- "'r$', 'n$', 'g$' or internal Inform constant name after '#'",
- token_text);
- break;
- }
- else
- { current_token.type = token_type;
- current_token.value = token_value;
- current_token.text = token_text;
- current_token.marker = INCON_MV;
- }
- break;
- }
- break;
-
- case CND_TT:
- v = conditionals_to_operators[current_token.value];
- if (v != NOT_AN_OPERATOR)
- { current_token.type = OP_TT; current_token.value = v;
- }
- break;
- }
-
- if (current_token.type == SEP_TT)
- { v = separators_to_operators[current_token.value];
- if (v != NOT_AN_OPERATOR)
- { if ((veneer_mode)
- || ((v!=MESSAGE_OP) && (v!=MPROP_NUM_OP) && (v!=MPROP_NUM_OP)))
- { current_token.type = OP_TT; current_token.value = v;
- if (array_init_ambiguity &&
- ((v==MINUS_OP) || (v==UNARY_MINUS_OP)) &&
- (initial_bracket_level == 0) &&
- (etoken_count != 1))
- warning("Without bracketing, the minus sign '-' is ambiguous");
- }
- }
- }
-
- /* A feature of Inform making it annoyingly hard to parse left-to-right
- is that there is no clear delimiter for expressions; that is, the
- legal syntax often includes sequences of expressions with no
- intervening markers such as commas. We therefore need to use some
- internal context to determine whether an end is in sight... */
-
- if (token_type_allowable[current_token.type]==0)
- { if (expr_trace_level >= 3)
- { printf("Discarding as not allowable: '%s' ", current_token.text);
- describe_token(current_token);
- printf("\n");
- }
- current_token.type = ENDEXP_TT;
- }
- else
- if ((!((initial_bracket_level > 0)
- || (previous_token.type == ENDEXP_TT)
- || ((previous_token.type == OP_TT)
- && (operators[previous_token.value].usage != POST_U))
- || (previous_token.type == SYSFUN_TT)))
- && ((current_token.type != OP_TT)
- || (operators[current_token.value].usage == PRE_U)))
- { if (expr_trace_level >= 3)
- { printf("Discarding as no longer part: '%s' ", current_token.text);
- describe_token(current_token);
- printf("\n");
- }
- current_token.type = ENDEXP_TT;
- }
- else
- { if (mark_symbol_as_used) sflags[symbol] |= USED_SFLAG;
- if (expr_trace_level >= 3)
- { printf("Expr token = '%s' ", current_token.text);
- describe_token(current_token);
- printf("\n");
- }
- }
-
- if ((previous_token.type == ENDEXP_TT)
- && (current_token.type == ENDEXP_TT)) return FALSE;
-
- previous_token = current_token;
-
- return TRUE;
-}
-
-/* --- Operator precedences ------------------------------------------------ */
-
-#define LOWER_P 101
-#define EQUAL_P 102
-#define GREATER_P 103
-
-#define e1 1 /* Missing operand error */
-#define e2 2 /* Unexpected close bracket */
-#define e3 3 /* Missing operator error */
-#define e4 4 /* Expression ends with an open bracket */
-#define e5 5 /* Associativity illegal error */
-
-const int prec_table[] = {
-
-/* a .......... ( ) end op term */
-
-/* b ( */ LOWER_P, e3, LOWER_P, LOWER_P, e3,
-/* . ) */ EQUAL_P, GREATER_P, e2, GREATER_P, GREATER_P,
-/* . end */ e4, GREATER_P, e1, GREATER_P, GREATER_P,
-/* . op */ LOWER_P, GREATER_P, LOWER_P, -1, GREATER_P,
-/* . term */ LOWER_P, e3, LOWER_P, LOWER_P, e3
-
-};
-
-static int find_prec(token_data a, token_data b)
-{
- /* We are comparing the precedence of tokens a and b
- (where a occurs to the left of b). If the expression is correct,
- the only possible values are GREATER_P, LOWER_P or EQUAL_P;
- if it is malformed then one of e1 to e5 results.
-
- Note that this routine is not symmetrical and that the relation
- is not trichotomous.
-
- If a and b are equal (and aren't brackets), then
-
- a LOWER_P a if a right-associative
- a GREATER_P a if a left-associative
- */
-
- int i, j, l1, l2;
-
- switch(a.type)
- { case SUBOPEN_TT: i=0; break;
- case SUBCLOSE_TT: i=1; break;
- case ENDEXP_TT: i=2; break;
- case OP_TT: i=3; break;
- default: i=4; break;
- }
- switch(b.type)
- { case SUBOPEN_TT: i+=0; break;
- case SUBCLOSE_TT: i+=5; break;
- case ENDEXP_TT: i+=10; break;
- case OP_TT: i+=15; break;
- default: i+=20; break;
- }
-
- j = prec_table[i]; if (j != -1) return j;
-
- l1 = operators[a.value].precedence;
- l2 = operators[b.value].precedence;
- if (operators[b.value].usage == PRE_U) return LOWER_P;
- if (operators[a.value].usage == POST_U) return GREATER_P;
-
- /* Anomalous rule to resolve the function call precedence, which is
- different on the right from on the left, e.g., in:
-
- alpha.beta(gamma)
- beta(gamma).alpha
- */
-
- if ((l1 == 11) && (l2 > 11)) return GREATER_P;
-
- if (l1 < l2) return LOWER_P;
- if (l1 > l2) return GREATER_P;
- switch(operators[a.value].associativity)
- { case L_A: return GREATER_P;
- case R_A: return LOWER_P;
- case 0: return e5;
- }
- return GREATER_P;
-}
-
-/* --- Converting token to operand ----------------------------------------- */
-
-/* Must match the switch statement below */
-int z_system_constant_list[] =
- { adjectives_table_SC,
- actions_table_SC,
- classes_table_SC,
- identifiers_table_SC,
- preactions_table_SC,
- largest_object_SC,
- strings_offset_SC,
- code_offset_SC,
- actual_largest_object_SC,
- static_memory_offset_SC,
- array_names_offset_SC,
- readable_memory_offset_SC,
- cpv__start_SC,
- cpv__end_SC,
- ipv__start_SC,
- ipv__end_SC,
- array__start_SC,
- array__end_SC,
- highest_attribute_number_SC,
- attribute_names_array_SC,
- highest_property_number_SC,
- property_names_array_SC,
- highest_action_number_SC,
- action_names_array_SC,
- highest_fake_action_number_SC,
- fake_action_names_array_SC,
- highest_routine_number_SC,
- routine_names_array_SC,
- routines_array_SC,
- routine_flags_array_SC,
- highest_global_number_SC,
- global_names_array_SC,
- globals_array_SC,
- global_flags_array_SC,
- highest_array_number_SC,
- array_names_array_SC,
- array_flags_array_SC,
- highest_constant_number_SC,
- constant_names_array_SC,
- highest_class_number_SC,
- class_objects_array_SC,
- highest_object_number_SC,
- -1 };
-
-static int32 value_of_system_constant_z(int t)
-{ switch(t)
- { case adjectives_table_SC:
- return adjectives_offset;
- case actions_table_SC:
- return actions_offset;
- case classes_table_SC:
- return class_numbers_offset;
- case identifiers_table_SC:
- return identifier_names_offset;
- case preactions_table_SC:
- return preactions_offset;
- case largest_object_SC:
- return 256 + no_objects - 1;
- case strings_offset_SC:
- return strings_offset/scale_factor;
- case code_offset_SC:
- return code_offset/scale_factor;
- case actual_largest_object_SC:
- return no_objects;
- case static_memory_offset_SC:
- return static_memory_offset;
- case array_names_offset_SC:
- return array_names_offset;
- case readable_memory_offset_SC:
- return Write_Code_At;
- case cpv__start_SC:
- return prop_values_offset;
- case cpv__end_SC:
- return class_numbers_offset;
- case ipv__start_SC:
- return individuals_offset;
- case ipv__end_SC:
- return variables_offset;
- case array__start_SC:
- return variables_offset + (MAX_GLOBAL_VARIABLES*WORDSIZE);
- case array__end_SC:
- return static_memory_offset;
-
- case highest_attribute_number_SC:
- return no_attributes-1;
- case attribute_names_array_SC:
- return attribute_names_offset;
-
- case highest_property_number_SC:
- return no_individual_properties-1;
- case property_names_array_SC:
- return identifier_names_offset + 2;
-
- case highest_action_number_SC:
- return no_actions-1;
- case action_names_array_SC:
- return action_names_offset;
-
- case highest_fake_action_number_SC:
- return ((grammar_version_number==1)?256:4096) + no_fake_actions-1;
- case fake_action_names_array_SC:
- return fake_action_names_offset;
-
- case highest_routine_number_SC:
- return no_named_routines-1;
- case routine_names_array_SC:
- return routine_names_offset;
- case routines_array_SC:
- return routines_array_offset;
- case routine_flags_array_SC:
- return routine_flags_array_offset;
- case highest_global_number_SC:
- return 16 + no_globals-1;
- case global_names_array_SC:
- return global_names_offset;
- case globals_array_SC:
- return variables_offset;
- case global_flags_array_SC:
- return global_flags_array_offset;
- case highest_array_number_SC:
- return no_arrays-1;
- case array_names_array_SC:
- return array_names_offset;
- case array_flags_array_SC:
- return array_flags_array_offset;
- case highest_constant_number_SC:
- return no_named_constants-1;
- case constant_names_array_SC:
- return constant_names_offset;
- case highest_class_number_SC:
- return no_classes-1;
- case class_objects_array_SC:
- return class_numbers_offset;
- case highest_object_number_SC:
- return no_objects-1;
- }
-
- error_named("System constant not implemented in Z-code",
- system_constants.keywords[t]);
-
- return(0);
-}
-
-/* Must match the switch statement below */
-int glulx_system_constant_list[] =
- { classes_table_SC,
- identifiers_table_SC,
- array_names_offset_SC,
- cpv__start_SC,
- cpv__end_SC,
- dictionary_table_SC,
- dynam_string_table_SC,
- grammar_table_SC,
- actions_table_SC,
- globals_array_SC,
- highest_class_number_SC,
- highest_object_number_SC,
- -1 };
-
-static int32 value_of_system_constant_g(int t)
-{
- switch (t) {
- case classes_table_SC:
- return Write_RAM_At + class_numbers_offset;
- case identifiers_table_SC:
- return Write_RAM_At + identifier_names_offset;
- case array_names_offset_SC:
- return Write_RAM_At + array_names_offset;
- case cpv__start_SC:
- return prop_defaults_offset;
- case cpv__end_SC:
- return Write_RAM_At + class_numbers_offset;
- case dictionary_table_SC:
- return dictionary_offset;
- case dynam_string_table_SC:
- return abbreviations_offset;
- case grammar_table_SC:
- return grammar_table_offset;
- case actions_table_SC:
- return actions_offset;
- case globals_array_SC:
- return variables_offset;
- case highest_class_number_SC:
- return no_classes-1;
- case highest_object_number_SC:
- return no_objects-1;
- }
-
- error_named("System constant not implemented in Glulx",
- system_constants.keywords[t]);
-
- return 0;
-}
-
-extern int32 value_of_system_constant(int t)
-{
- if (!glulx_mode)
- return value_of_system_constant_z(t);
- else
- return value_of_system_constant_g(t);
-}
-
-static int evaluate_term(token_data t, assembly_operand *o)
-{
- /* If the given token is a constant, evaluate it into the operand.
- For now, the identifiers are considered variables.
-
- Returns FALSE if it fails to understand type. */
-
- int32 v;
-
- o->marker = t.marker;
- o->symtype = t.symtype;
- o->symflags = t.symflags;
-
- switch(t.type)
- { case LARGE_NUMBER_TT:
- v = t.value;
- if (!glulx_mode) {
- if (v < 0) v = v + 0x10000;
- o->type = LONG_CONSTANT_OT;
- o->value = v;
- }
- else {
- o->value = v;
- o->type = CONSTANT_OT;
- }
- return(TRUE);
- case SMALL_NUMBER_TT:
- v = t.value;
- if (!glulx_mode) {
- if (v < 0) v = v + 0x10000;
- o->type = SHORT_CONSTANT_OT;
- o->value = v;
- }
- else {
- o->value = v;
- set_constant_ot(o);
- }
- return(TRUE);
- case DICTWORD_TT:
- /* Find the dictionary address, adding to dictionary if absent */
- if (!glulx_mode)
- o->type = LONG_CONSTANT_OT;
- else
- o->type = CONSTANT_OT;
- o->value = dictionary_add(t.text, 0x80, 0, 0);
- return(TRUE);
- case DQ_TT:
- /* Create as a static string */
- if (!glulx_mode)
- o->type = LONG_CONSTANT_OT;
- else
- o->type = CONSTANT_OT;
- o->value = compile_string(t.text, FALSE, FALSE);
- return(TRUE);
- case VARIABLE_TT:
- if (!glulx_mode) {
- o->type = VARIABLE_OT;
- }
- else {
- if (t.value >= MAX_LOCAL_VARIABLES) {
- o->type = GLOBALVAR_OT;
- }
- else {
- /* This includes "local variable zero", which is really
- the stack-pointer magic variable. */
- o->type = LOCALVAR_OT;
- }
- }
- o->value = t.value;
- return(TRUE);
- case SYSFUN_TT:
- if (!glulx_mode) {
- o->type = VARIABLE_OT;
- o->value = t.value + 256;
- }
- else {
- o->type = SYSFUN_OT;
- o->value = t.value;
- }
- system_function_usage[t.value] = 1;
- return(TRUE);
- case ACTION_TT:
- *o = action_of_name(t.text);
- return(TRUE);
- case SYSTEM_CONSTANT_TT:
- /* Certain system constants depend only on the
- version number and need no backpatching, as they
- are known in advance. We can therefore evaluate
- them immediately. */
- if (!glulx_mode) {
- o->type = LONG_CONSTANT_OT;
- switch(t.value)
- {
- case version_number_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = version_number; break;
- case dict_par1_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = (version_number==3)?4:6; break;
- case dict_par2_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = (version_number==3)?5:7; break;
- case dict_par3_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = (version_number==3)?6:8; break;
- case lowest_attribute_number_SC:
- case lowest_action_number_SC:
- case lowest_routine_number_SC:
- case lowest_array_number_SC:
- case lowest_constant_number_SC:
- case lowest_class_number_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 0; break;
- case lowest_object_number_SC:
- case lowest_property_number_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 1; break;
- case lowest_global_number_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 16; break;
- case lowest_fake_action_number_SC:
- o->type = LONG_CONSTANT_OT; o->marker = 0;
- v = ((grammar_version_number==1)?256:4096); break;
- case oddeven_packing_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0;
- v = oddeven_packing_switch; break;
- default:
- v = t.value;
- o->marker = INCON_MV;
- break;
- }
- o->value = v;
- }
- else {
- o->type = CONSTANT_OT;
- switch(t.value)
- {
- /* The three dict_par flags point at the lower byte
- of the flag field, because the library is written
- to expect one-byte fields, even though the compiler
- generates a dictionary with room for two. */
- case dict_par1_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = DICT_ENTRY_FLAG_POS+1;
- break;
- case dict_par2_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = DICT_ENTRY_FLAG_POS+3;
- break;
- case dict_par3_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = DICT_ENTRY_FLAG_POS+5;
- break;
-
- case lowest_attribute_number_SC:
- case lowest_action_number_SC:
- case lowest_routine_number_SC:
- case lowest_array_number_SC:
- case lowest_constant_number_SC:
- case lowest_class_number_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = 0;
- break;
- case lowest_object_number_SC:
- case lowest_property_number_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = 1;
- break;
-
- /* ###fix: need to fill more of these in! */
-
- default:
- v = t.value;
- o->marker = INCON_MV;
- break;
- }
- o->value = v;
- }
- return(TRUE);
- default:
- return(FALSE);
- }
-}
-
-/* --- Emitter ------------------------------------------------------------- */
-
-expression_tree_node *ET;
-static int ET_used;
-
-extern void clear_expression_space(void)
-{ ET_used = 0;
-}
-
-static assembly_operand *emitter_stack;
-static int *emitter_markers;
-static int *emitter_bracket_counts;
-
-#define FUNCTION_VALUE_MARKER 1
-#define ARGUMENT_VALUE_MARKER 2
-#define OR_VALUE_MARKER 3
-
-static int emitter_sp;
-
-static int is_property_t(int symbol_type)
-{ return ((symbol_type == PROPERTY_T) || (symbol_type == INDIVIDUAL_PROPERTY_T));
-}
-
-static void mark_top_of_emitter_stack(int marker, token_data t)
-{ if (emitter_sp < 1)
- { compiler_error("SR error: Attempt to add a marker to the top of an empty emitter stack");
- return;
- }
- if (expr_trace_level >= 2)
- { printf("Marking top of emitter stack (which is ");
- print_operand(emitter_stack[emitter_sp-1]);
- printf(") as ");
- switch(marker)
- {
- case FUNCTION_VALUE_MARKER:
- printf("FUNCTION");
- break;
- case ARGUMENT_VALUE_MARKER:
- printf("ARGUMENT");
- break;
- case OR_VALUE_MARKER:
- printf("OR_VALUE");
- break;
- default:
- printf("UNKNOWN");
- break;
- }
- printf("\n");
- }
- if (emitter_markers[emitter_sp-1])
- { if (marker == ARGUMENT_VALUE_MARKER)
- {
- warning("Ignoring spurious leading comma");
- return;
- }
- error_named("Missing operand for", t.text);
- if (emitter_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
- emitter_stack[emitter_sp] = zero_operand;
- emitter_sp++;
- }
- emitter_markers[emitter_sp-1] = marker;
-}
-
-static void add_bracket_layer_to_emitter_stack(int depth)
-{ /* There's no point in tracking bracket layers that don't fence off any values. */
- if (emitter_sp < depth + 1) return;
- if (expr_trace_level >= 2)
- printf("Adding bracket layer\n");
- ++emitter_bracket_counts[emitter_sp-depth-1];
-}
-
-static void remove_bracket_layer_from_emitter_stack()
-{ /* Bracket layers that don't fence off any values will not have been tracked. */
- if (emitter_sp < 2) return;
- if (expr_trace_level >= 2)
- printf("Removing bracket layer\n");
- if (emitter_bracket_counts[emitter_sp-2] <= 0)
- { compiler_error("SR error: Attempt to remove a nonexistent bracket layer from the emitter stack");
- return;
- }
- --emitter_bracket_counts[emitter_sp-2];
-}
-
-static void emit_token(token_data t)
-{ assembly_operand o1, o2; int arity, stack_size, i;
- int op_node_number, operand_node_number, previous_node_number;
- int32 x = 0;
-
- if (expr_trace_level >= 2)
- { printf("Output: %-19s%21s ", t.text, "");
- for (i=0; i<emitter_sp; i++)
- { print_operand(emitter_stack[i]); printf(" ");
- if (emitter_markers[i] == FUNCTION_VALUE_MARKER) printf(":FUNCTION ");
- if (emitter_markers[i] == ARGUMENT_VALUE_MARKER) printf(":ARGUMENT ");
- if (emitter_markers[i] == OR_VALUE_MARKER) printf(":OR ");
- if (emitter_bracket_counts[i]) printf(":BRACKETS(%d) ", emitter_bracket_counts[i]);
- }
- printf("\n");
- }
-
- if (t.type == SUBOPEN_TT) return;
-
- stack_size = 0;
- while ((stack_size < emitter_sp) &&
- !emitter_markers[emitter_sp-stack_size-1] &&
- !emitter_bracket_counts[emitter_sp-stack_size-1])
- stack_size++;
-
- if (t.type == SUBCLOSE_TT)
- { if (stack_size < emitter_sp && emitter_bracket_counts[emitter_sp-stack_size-1])
- { if (stack_size == 0)
- { error("No expression between brackets '(' and ')'");
- emitter_stack[emitter_sp] = zero_operand;
- emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
- ++emitter_sp;
- }
- else if (stack_size < 1)
- compiler_error("SR error: emitter stack empty in subexpression");
- else if (stack_size > 1)
- compiler_error("SR error: emitter stack overfull in subexpression");
- remove_bracket_layer_from_emitter_stack();
- }
- return;
- }
-
- if (t.type != OP_TT)
- { emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
-
- if (emitter_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- if (!evaluate_term(t, &(emitter_stack[emitter_sp++])))
- compiler_error_named("Emit token error:", t.text);
- return;
- }
-
- /* A comma is argument-separating if it follows an argument (or a function
- call, since we ignore spurious leading commas in function argument lists)
- with no intervening brackets. Function calls are variadic, so we don't
- apply argument-separating commas. */
- if (t.value == COMMA_OP &&
- stack_size < emitter_sp &&
- (emitter_markers[emitter_sp-stack_size-1] == ARGUMENT_VALUE_MARKER ||
- emitter_markers[emitter_sp-stack_size-1] == FUNCTION_VALUE_MARKER) &&
- !emitter_bracket_counts[emitter_sp-stack_size-1])
- { if (expr_trace_level >= 2)
- printf("Treating comma as argument-separating\n");
- return;
- }
-
- if (t.value == OR_OP)
- return;
-
- arity = 1;
- if (t.value == FCALL_OP)
- { if (expr_trace_level >= 3)
- { printf("FCALL_OP finds marker stack: ");
- for (x=0; x<emitter_sp; x++) printf("%d ", emitter_markers[x]);
- printf("\n");
- }
- if (emitter_markers[emitter_sp-1] == ARGUMENT_VALUE_MARKER)
- warning("Ignoring spurious trailing comma");
- while (emitter_markers[emitter_sp-arity] != FUNCTION_VALUE_MARKER)
- {
- if ((glulx_mode &&
- emitter_stack[emitter_sp-arity].type == SYSFUN_OT) ||
- (!glulx_mode &&
- emitter_stack[emitter_sp-arity].type == VARIABLE_OT &&
- emitter_stack[emitter_sp-arity].value >= 256 &&
- emitter_stack[emitter_sp-arity].value < 288))
- { int index = emitter_stack[emitter_sp-arity].value;
- if(!glulx_mode)
- index -= 256;
- if(index >= 0 && index < NUMBER_SYSTEM_FUNCTIONS)
- error_named("System function name used as a value:", system_functions.keywords[index]);
- else
- compiler_error("Found unnamed system function used as a value");
- emitter_stack[emitter_sp-arity] = zero_operand;
- }
- ++arity;
- }
- }
- else
- { arity = 1;
- if (operators[t.value].usage == IN_U) arity = 2;
-
- if (operators[t.value].precedence == 3)
- { arity = 2;
- x = emitter_sp-1;
- if(!emitter_markers[x] && !emitter_bracket_counts[x])
- { for (--x; emitter_markers[x] == OR_VALUE_MARKER && !emitter_bracket_counts[x]; --x)
- { ++arity;
- ++stack_size;
- }
- for (;x >= 0 && !emitter_markers[x] && !emitter_bracket_counts[x]; --x)
- ++stack_size;
- }
- }
-
- if (arity > stack_size)
- { error_named("Missing operand for", t.text);
- while (arity > stack_size)
- { if (emitter_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
- emitter_stack[emitter_sp] = zero_operand;
- emitter_sp++;
- stack_size++;
- }
- }
- }
-
- /* pseudo-typecheck in 6.30 */
- for (i = 1; i <= arity; i++)
- {
- o1 = emitter_stack[emitter_sp - i];
- if (is_property_t(o1.symtype) ) {
- switch(t.value)
- {
- case FCALL_OP:
- case SETEQUALS_OP: case NOTEQUAL_OP:
- case CONDEQUALS_OP:
- case PROVIDES_OP: case NOTPROVIDES_OP:
- case PROP_ADD_OP: case PROP_NUM_OP:
- case SUPERCLASS_OP:
- case MPROP_ADD_OP: case MESSAGE_OP:
- case PROPERTY_OP:
- if (i < arity) break;
- case GE_OP: case LE_OP:
- if ((i < arity) && (o1.symflags & STAR_SFLAG)) break;
- default:
- warning("Property name in expression is not qualified by object");
- }
- } /* if (is_property_t */
- }
-
- switch(arity)
- { case 1:
- o1 = emitter_stack[emitter_sp - 1];
- if ((o1.marker == 0) && is_constant_ot(o1.type))
- { switch(t.value)
- { case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
- case ARTNOT_OP:
- if (!glulx_mode)
- x = (~o1.value) & 0xffff;
- else
- x = (~o1.value) & 0xffffffff;
- goto FoldConstant;
- case LOGNOT_OP:
- if (o1.value != 0) x=0; else x=1;
- goto FoldConstant;
- }
- }
- break;
-
- case 2:
- o1 = emitter_stack[emitter_sp - 2];
- o2 = emitter_stack[emitter_sp - 1];
-
- if ((o1.marker == 0) && (o2.marker == 0)
- && is_constant_ot(o1.type) && is_constant_ot(o2.type))
- {
- int32 ov1, ov2;
- if (glulx_mode)
- { ov1 = o1.value;
- ov2 = o2.value;
- }
- else
- { ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
- ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
- }
-
- switch(t.value)
- {
- case PLUS_OP: x = ov1 + ov2; goto FoldConstantC;
- case MINUS_OP: x = ov1 - ov2; goto FoldConstantC;
- case TIMES_OP: x = ov1 * ov2; goto FoldConstantC;
- case DIVIDE_OP:
- case REMAINDER_OP:
- if (ov2 == 0)
- error("Division of constant by zero");
- else
- if (t.value == DIVIDE_OP) {
- if (ov2 < 0) {
- ov1 = -ov1;
- ov2 = -ov2;
- }
- if (ov1 >= 0)
- x = ov1 / ov2;
- else
- x = -((-ov1) / ov2);
- }
- else {
- if (ov2 < 0) {
- ov2 = -ov2;
- }
- if (ov1 >= 0)
- x = ov1 % ov2;
- else
- x = -((-ov1) % ov2);
- }
- goto FoldConstant;
- case ARTAND_OP: x = o1.value & o2.value; goto FoldConstant;
- case ARTOR_OP: x = o1.value | o2.value; goto FoldConstant;
- case CONDEQUALS_OP:
- if (o1.value == o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case NOTEQUAL_OP:
- if (o1.value != o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case GE_OP:
- if (o1.value >= o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case GREATER_OP:
- if (o1.value > o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case LE_OP:
- if (o1.value <= o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case LESS_OP:
- if (o1.value < o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case LOGAND_OP:
- if ((o1.value != 0) && (o2.value != 0)) x=1; else x=0;
- goto FoldConstant;
- case LOGOR_OP:
- if ((o1.value != 0) || (o2.value != 0)) x=1; else x=0;
- goto FoldConstant;
- }
-
- }
- }
-
- op_node_number = ET_used++;
- if (op_node_number == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
-
- ET[op_node_number].operator_number = t.value;
- ET[op_node_number].up = -1;
- ET[op_node_number].down = -1;
- ET[op_node_number].right = -1;
-
- /* This statement is redundant, but prevents compilers from wrongly
- issuing a "used before it was assigned a value" error: */
- previous_node_number = 0;
-
- for (i = emitter_sp-arity; i != emitter_sp; i++)
- {
- if (expr_trace_level >= 3)
- printf("i=%d, emitter_sp=%d, arity=%d, ETU=%d\n",
- i, emitter_sp, arity, ET_used);
- if (emitter_stack[i].type == EXPRESSION_OT)
- operand_node_number = emitter_stack[i].value;
- else
- { operand_node_number = ET_used++;
- if (operand_node_number == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[operand_node_number].down = -1;
- ET[operand_node_number].value = emitter_stack[i];
- }
- ET[operand_node_number].up = op_node_number;
- ET[operand_node_number].right = -1;
- if (i == emitter_sp - arity)
- { ET[op_node_number].down = operand_node_number;
- }
- else
- { ET[previous_node_number].right = operand_node_number;
- }
- previous_node_number = operand_node_number;
- }
-
- emitter_sp = emitter_sp - arity + 1;
-
- emitter_stack[emitter_sp - 1].type = EXPRESSION_OT;
- emitter_stack[emitter_sp - 1].value = op_node_number;
- emitter_stack[emitter_sp - 1].marker = 0;
- emitter_markers[emitter_sp - 1] = 0;
- emitter_bracket_counts[emitter_sp - 1] = 0;
- /* Remove the marker for the brackets implied by operator precedence */
- remove_bracket_layer_from_emitter_stack();
-
- return;
-
- FoldConstantC:
-
- /* In Glulx, skip this test; we can't check out-of-range errors
- for 32-bit arithmetic. */
-
- if (!glulx_mode && ((x<-32768) || (x > 32767)))
- { char folding_error[40];
- int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
- int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
- switch(t.value)
- {
- case PLUS_OP:
- sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
- break;
- case MINUS_OP:
- sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
- break;
- case TIMES_OP:
- sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
- break;
- }
- error_named("Signed arithmetic on compile-time constants overflowed \
-the range -32768 to +32767:", folding_error);
- }
-
- FoldConstant:
-
- if (!glulx_mode) {
- while (x < 0) x = x + 0x10000;
- x = x & 0xffff;
- }
- else {
- x = x & 0xffffffff;
- }
-
- emitter_sp = emitter_sp - arity + 1;
-
- if (!glulx_mode) {
- if (x<256)
- emitter_stack[emitter_sp - 1].type = SHORT_CONSTANT_OT;
- else emitter_stack[emitter_sp - 1].type = LONG_CONSTANT_OT;
- }
- else {
- if (x == 0)
- emitter_stack[emitter_sp - 1].type = ZEROCONSTANT_OT;
- else if (x >= -128 && x <= 127)
- emitter_stack[emitter_sp - 1].type = BYTECONSTANT_OT;
- else if (x >= -32768 && x <= 32767)
- emitter_stack[emitter_sp - 1].type = HALFCONSTANT_OT;
- else
- emitter_stack[emitter_sp - 1].type = CONSTANT_OT;
- }
-
- emitter_stack[emitter_sp - 1].value = x;
- emitter_stack[emitter_sp - 1].marker = 0;
- emitter_markers[emitter_sp - 1] = 0;
- emitter_bracket_counts[emitter_sp - 1] = 0;
-
- if (expr_trace_level >= 2)
- { printf("Folding constant to: ");
- print_operand(emitter_stack[emitter_sp - 1]);
- printf("\n");
- }
-
- /* Remove the marker for the brackets implied by operator precedence */
- remove_bracket_layer_from_emitter_stack();
- return;
-}
-
-/* --- Pretty printing ----------------------------------------------------- */
-
-static void show_node(int n, int depth, int annotate)
-{ int j;
- for (j=0; j<2*depth+2; j++) printf(" ");
-
- if (ET[n].down == -1)
- { print_operand(ET[n].value);
- if (annotate && (ET[n].value.marker != 0))
- printf(" [%s]", describe_mv(ET[n].value.marker));
- printf("\n");
- }
- else
- { printf("%s ", operators[ET[n].operator_number].description);
- j = operators[ET[n].operator_number].precedence;
- if ((annotate) && ((j==2) || (j==3)))
- { printf(" %d|%d ", ET[n].true_label, ET[n].false_label);
- if (ET[n].label_after != -1) printf(" def %d after ",
- ET[n].label_after);
- if (ET[n].to_expression) printf(" con to expr ");
- }
- printf("\n");
- show_node(ET[n].down, depth+1, annotate);
- }
-
- if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
-}
-
-extern void show_tree(assembly_operand AO, int annotate)
-{ if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
- else
- { printf("Constant: "); print_operand(AO);
- if (annotate && (AO.marker != 0))
- printf(" [%s]", describe_mv(AO.marker));
- printf("\n");
- }
-}
-
-/* --- Lvalue transformations ---------------------------------------------- */
-
-/* This only gets called in Z-code, since Glulx doesn't distinguish
- individual property operators from general ones. */
-static void check_property_operator(int from_node)
-{ int below = ET[from_node].down;
- int opnum = ET[from_node].operator_number;
-
- ASSERT_ZCODE();
-
- if (veneer_mode) return;
-
- if ((below != -1) && (ET[below].right != -1))
- { int n = ET[below].right, flag = FALSE;
-
- if ((ET[n].down == -1)
- && ((ET[n].value.type == LONG_CONSTANT_OT)
- || (ET[n].value.type == SHORT_CONSTANT_OT))
- && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
- && ((!module_switch) || (ET[n].value.marker == 0)))
- flag = TRUE;
-
- if (!flag)
- { switch(opnum)
- { case PROPERTY_OP: opnum = MESSAGE_OP; break;
- case PROP_ADD_OP: opnum = MPROP_ADD_OP; break;
- case PROP_NUM_OP: opnum = MPROP_NUM_OP; break;
- }
- }
-
- ET[from_node].operator_number = opnum;
- }
-
- if (below != -1)
- check_property_operator(below);
- if (ET[from_node].right != -1)
- check_property_operator(ET[from_node].right);
-}
-
-static void check_lvalues(int from_node)
-{ int below = ET[from_node].down;
- int opnum = ET[from_node].operator_number, opnum_below;
- int lvalue_form, i, j = 0;
-
- if (below != -1)
- {
- if ((opnum == FCALL_OP) && (ET[below].down != -1))
- { opnum_below = ET[below].operator_number;
- if ((opnum_below == PROPERTY_OP) || (opnum_below == MESSAGE_OP))
- { i = ET[ET[from_node].down].right;
- ET[from_node].down = ET[below].down;
- ET[ET[below].down].up = from_node;
- ET[ET[ET[below].down].right].up = from_node;
- ET[ET[ET[below].down].right].right = i;
- opnum = PROP_CALL_OP;
- ET[from_node].operator_number = opnum;
- }
- }
-
- if (operators[opnum].requires_lvalue)
- { opnum_below = ET[below].operator_number;
-
- if (ET[below].down == -1)
- { if (!is_variable_ot(ET[below].value.type))
- { error("'=' applied to undeclared variable");
- goto LvalueError;
- }
- }
- else
- { lvalue_form=0;
- switch(opnum)
- { case SETEQUALS_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_SETEQUALS_OP; break;
- case DARROW_OP: lvalue_form = DARROW_SETEQUALS_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_SETEQUALS_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_SETEQUALS_OP; break;
- }
- break;
- case INC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_INC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_INC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_INC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_INC_OP; break;
- }
- break;
- case POST_INC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_POST_INC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_POST_INC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_POST_INC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_POST_INC_OP; break;
- }
- break;
- case DEC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_DEC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_DEC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_DEC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_DEC_OP; break;
- }
- break;
- case POST_DEC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_POST_DEC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_POST_DEC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_POST_DEC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_POST_DEC_OP; break;
- }
- break;
- }
- if (lvalue_form == 0)
- { error_named("'=' applied to",
- (char *) operators[opnum_below].description);
- goto LvalueError;
- }
-
- /* Transform from_node from_node
- | \ | \\\ \
- below value to value
- | \\\
- */
-
- ET[from_node].operator_number = lvalue_form;
- i = ET[below].down;
- ET[from_node].down = i;
- while (i != -1)
- { ET[i].up = from_node;
- j = i;
- i = ET[i].right;
- }
- ET[j].right = ET[below].right;
- }
- }
- check_lvalues(below);
- }
- if (ET[from_node].right != -1)
- check_lvalues(ET[from_node].right);
- return;
-
- LvalueError:
- ET[from_node].down = -1;
- ET[from_node].value = zero_operand;
- if (ET[from_node].right != -1)
- check_lvalues(ET[from_node].right);
-}
-
-/* --- Tree surgery for conditionals --------------------------------------- */
-
-static void negate_condition(int n)
-{ int i;
-
- if (ET[n].right != -1) negate_condition(ET[n].right);
- if (ET[n].down == -1) return;
- i = operators[ET[n].operator_number].negation;
- if (i!=0) ET[n].operator_number = i;
- if (operators[i].precedence==2) negate_condition(ET[n].down);
-}
-
-static void delete_negations(int n, int context)
-{
- /* Recursively apply
-
- ~~(x && y) = ~~x || ~~y
- ~~(x || y) = ~~x && ~~y
- ~~(x == y) = x ~= y
-
- (etc) to delete the ~~ operator from the tree. Since this is
- depth first, the ~~ being deleted has no ~~s beneath it, which
- is important to make "negate_condition" work. */
-
- int i;
-
- if (ET[n].right != -1) delete_negations(ET[n].right, context);
- if (ET[n].down == -1) return;
- delete_negations(ET[n].down, context);
-
- if (ET[n].operator_number == LOGNOT_OP)
- { negate_condition(ET[n].down);
- ET[n].operator_number
- = ET[ET[n].down].operator_number;
- ET[n].down = ET[ET[n].down].down;
- i = ET[n].down;
- while(i != -1) { ET[i].up = n; i = ET[i].right; }
- }
-}
-
-static void insert_exp_to_cond(int n, int context)
-{
- /* Insert a ~= test when an expression is used as a condition.
-
- Check for possible confusion over = and ==, e.g. "if (a = 1) ..." */
-
- int new, i;
-
- if (ET[n].right != -1) insert_exp_to_cond(ET[n].right, context);
-
- if (ET[n].down == -1)
- { if (context==CONDITION_CONTEXT)
- { new = ET_used++;
- if (new == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[new] = ET[n];
- ET[n].down = new; ET[n].operator_number = NONZERO_OP;
- ET[new].up = n; ET[new].right = -1;
- }
- return;
- }
-
- switch(operators[ET[n].operator_number].precedence)
- { case 3: /* Conditionals have level 3 */
- context = QUANTITY_CONTEXT;
- break;
- case 2: /* Logical operators level 2 */
- context = CONDITION_CONTEXT;
- break;
- case 1: /* Forms of '=' have level 1 */
- if (context == CONDITION_CONTEXT)
- warning("'=' used as condition: '==' intended?");
- default:
- if (context != CONDITION_CONTEXT) break;
-
- new = ET_used++;
- if (new == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[new] = ET[n];
- ET[n].down = new; ET[n].operator_number = NONZERO_OP;
- ET[new].up = n; ET[new].right = -1;
-
- i = ET[new].down;
- while (i!= -1) { ET[i].up = new; i = ET[i].right; }
- context = QUANTITY_CONTEXT; n = new;
- }
-
- insert_exp_to_cond(ET[n].down, context);
-}
-
-static unsigned int etoken_num_children(int n)
-{
- int count = 0;
- int i;
- i = ET[n].down;
- if (i == -1) { return 0; }
- do {
- count++;
- i = ET[i].right;
- } while (i!=-1);
- return count;
-}
-
-static void func_args_on_stack(int n, int context)
-{
- /* Make sure that the arguments of every function-call expression
- are stored to the stack. If any aren't (ie, if any arguments are
- constants or variables), cover them with push operators.
- (The very first argument does not need to be so treated, because
- it's the function address, not a function argument. We also
- skip the treatment for most system functions.) */
-
- int new, pn, fnaddr, opnum;
-
- ASSERT_GLULX();
-
- if (ET[n].right != -1)
- func_args_on_stack(ET[n].right, context);
- if (ET[n].down == -1) {
- pn = ET[n].up;
- if (pn != -1) {
- opnum = ET[pn].operator_number;
- if (opnum == FCALL_OP
- || opnum == MESSAGE_CALL_OP
- || opnum == PROP_CALL_OP) {
- /* If it's an FCALL, get the operand which contains the function
- address (or system-function number) */
- if (opnum == MESSAGE_CALL_OP
- || opnum == PROP_CALL_OP
- || ((fnaddr=ET[pn].down) != n
- && (ET[fnaddr].value.type != SYSFUN_OT
- || ET[fnaddr].value.value == INDIRECT_SYSF
- || ET[fnaddr].value.value == GLK_SYSF))) {
- if (etoken_num_children(pn) > (unsigned int)(opnum == FCALL_OP ? 4:3)) {
- new = ET_used++;
- if (new == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[new] = ET[n];
- ET[n].down = new;
- ET[n].operator_number = PUSH_OP;
- ET[new].up = n;
- ET[new].right = -1;
- }
- }
- }
- }
- return;
- }
-
- func_args_on_stack(ET[n].down, context);
-}
-
-static assembly_operand check_conditions(assembly_operand AO, int context)
-{ int n;
-
- if (AO.type != EXPRESSION_OT)
- { if (context != CONDITION_CONTEXT) return AO;
- n = ET_used++;
- if (n == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[n].down = -1;
- ET[n].up = -1;
- ET[n].right = -1;
- ET[n].value = AO;
- INITAOT(&AO, EXPRESSION_OT);
- AO.value = n;
- }
-
- insert_exp_to_cond(AO.value, context);
- delete_negations(AO.value, context);
-
- if (glulx_mode)
- func_args_on_stack(AO.value, context);
-
- return AO;
-}
-
-/* --- Shift-reduce parser ------------------------------------------------- */
-
-static int sr_sp;
-static token_data *sr_stack;
-
-extern assembly_operand parse_expression(int context)
-{
- /* Parses an expression, evaluating it as a constant if possible.
-
- Possible contexts are:
-
- VOID_CONTEXT the expression is used as a statement, so that
- its value will be thrown away and it only
- needs to exist for any resulting side-effects
- (function calls and assignments)
-
- CONDITION_CONTEXT the result must be a condition
-
- CONSTANT_CONTEXT there is required to be a constant result
- (so that, for instance, comma becomes illegal)
-
- QUANTITY_CONTEXT the default: a quantity is to be specified
-
- ACTION_Q_CONTEXT like QUANTITY_CONTEXT, but postfixed brackets
- at the top level do not indicate function call:
- used for e.g.
- <Insert button (random(pocket1, pocket2))>
-
- RETURN_Q_CONTEXT like QUANTITY_CONTEXT, but a single property
- name does not generate a warning
-
- ASSEMBLY_CONTEXT a quantity which cannot use the '->' operator
- (needed for assembly language to indicate
- store destinations)
-
- FORINIT_CONTEXT a quantity which cannot use an (unbracketed)
- '::' operator
-
- ARRAY_CONTEXT like CONSTANT_CONTEXT, but where an unbracketed
- minus sign is ambiguous, and brackets always
- indicate subexpressions, not function calls
-
- Return value: an assembly operand.
-
- If the type is OMITTED_OT, then the expression has no resulting value.
-
- If the type is EXPRESSION_OT, then the value will need to be
- calculated at run-time by code compiled from the expression tree
- whose root node-number is the operand value.
-
- Otherwise the assembly operand is the value of the expression, which
- is constant and thus known at compile time.
-
- If an error has occurred in the expression, which recovery from was
- not possible, then the return is (short constant) 0. This should
- minimise the chance of a cascade of further error messages.
- */
-
- token_data a, b, pop; int i;
- assembly_operand AO;
-
- superclass_allowed = (context != FORINIT_CONTEXT);
- if (context == FORINIT_CONTEXT) context = VOID_CONTEXT;
-
- comma_allowed = (context == VOID_CONTEXT);
- arrow_allowed = (context != ASSEMBLY_CONTEXT);
- bare_prop_allowed = (context == RETURN_Q_CONTEXT);
- array_init_ambiguity = ((context == ARRAY_CONTEXT) ||
- (context == ASSEMBLY_CONTEXT));
-
- action_ambiguity = (context == ACTION_Q_CONTEXT);
-
- if (context == ASSEMBLY_CONTEXT) context = QUANTITY_CONTEXT;
- if (context == ACTION_Q_CONTEXT) context = QUANTITY_CONTEXT;
- if (context == RETURN_Q_CONTEXT) context = QUANTITY_CONTEXT;
- if (context == ARRAY_CONTEXT) context = CONSTANT_CONTEXT;
-
- etoken_count = 0;
- inserting_token = FALSE;
-
- emitter_sp = 0;
- bracket_level = 0;
-
- previous_token.text = "$";
- previous_token.type = ENDEXP_TT;
- previous_token.value = 0;
-
- sr_sp = 1;
- sr_stack[0] = previous_token;
-
- AO = zero_operand;
-
- statements.enabled = FALSE;
- directives.enabled = FALSE;
-
- if (get_next_etoken() == FALSE)
- { ebf_error("expression", token_text);
- return AO;
- }
-
- do
- { if (expr_trace_level >= 2)
- { printf("Input: %-20s", current_token.text);
- for (i=0; i<sr_sp; i++) printf("%s ", sr_stack[i].text);
- printf("\n");
- }
- if (expr_trace_level >= 3) printf("ET_used = %d\n", ET_used);
-
- if (sr_sp == 0)
- { compiler_error("SR error: stack empty");
- return(AO);
- }
-
- a = sr_stack[sr_sp-1]; b = current_token;
-
- if ((a.type == ENDEXP_TT) && (b.type == ENDEXP_TT))
- { if (emitter_sp == 0)
- { error("No expression between brackets '(' and ')'");
- put_token_back();
- return AO;
- }
- if (emitter_sp > 1)
- { compiler_error("SR error: emitter stack overfull");
- return AO;
- }
-
- AO = emitter_stack[0];
- if (AO.type == EXPRESSION_OT)
- { if (expr_trace_level >= 3)
- { printf("Tree before lvalue checking:\n");
- show_tree(AO, FALSE);
- }
- if (!glulx_mode)
- check_property_operator(AO.value);
- check_lvalues(AO.value);
- ET[AO.value].up = -1;
- }
- else {
- if ((context != CONSTANT_CONTEXT) && is_property_t(AO.symtype)
- && (arrow_allowed) && (!bare_prop_allowed))
- warning("Bare property name found. \"self.prop\" intended?");
- }
-
- check_conditions(AO, context);
-
- if (context == CONSTANT_CONTEXT)
- if (!is_constant_ot(AO.type))
- { AO = zero_operand;
- ebf_error("constant", "<expression>");
- }
- put_token_back();
-
- return(AO);
- }
-
- switch(find_prec(a,b))
- {
- case e5: /* Associativity error */
- error_named("Brackets mandatory to clarify order of:",
- a.text);
-
- case LOWER_P:
- case EQUAL_P:
- if (sr_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- sr_stack[sr_sp++] = b;
- switch(b.type)
- {
- case SUBOPEN_TT:
- if (sr_sp >= 2 && sr_stack[sr_sp-2].type == OP_TT && sr_stack[sr_sp-2].value == FCALL_OP)
- mark_top_of_emitter_stack(FUNCTION_VALUE_MARKER, b);
- else
- add_bracket_layer_to_emitter_stack(0);
- break;
- case OP_TT:
- switch(b.value){
- case OR_OP:
- if (sr_stack[sr_sp-2].type == OP_TT &&
- operators[sr_stack[sr_sp-2].value].precedence == 3)
- mark_top_of_emitter_stack(OR_VALUE_MARKER, b);
- else
- { error("'or' not between values to the right of a condition");
- /* Convert to + for error recovery purposes */
- sr_stack[sr_sp-1].value = PLUS_OP;
- }
- break;
- case COMMA_OP:
- {
- /* A comma separates arguments only if the shallowest open bracket belongs to a function call. */
- int shallowest_open_bracket_index = sr_sp - 2;
- while (shallowest_open_bracket_index > 0 && sr_stack[shallowest_open_bracket_index].type != SUBOPEN_TT)
- --shallowest_open_bracket_index;
- if (shallowest_open_bracket_index > 0 &&
- sr_stack[shallowest_open_bracket_index-1].type == OP_TT &&
- sr_stack[shallowest_open_bracket_index-1].value == FCALL_OP)
- { mark_top_of_emitter_stack(ARGUMENT_VALUE_MARKER, b);
- break;
- }
- /* Non-argument-separating commas get treated like any other operator; we fall through to the default case. */
- }
- default:
- {
- /* Add a marker for the brackets implied by operator precedence */
- int operands_on_left = (operators[b.value].usage == PRE_U) ? 0 : 1;
- add_bracket_layer_to_emitter_stack(operands_on_left);
- }
- }
- }
- get_next_etoken();
- break;
- case GREATER_P:
- do
- { pop = sr_stack[sr_sp - 1];
- emit_token(pop);
- sr_sp--;
- } while (find_prec(sr_stack[sr_sp-1], pop) != LOWER_P);
- break;
-
- case e1: /* Missing operand error */
- error_named("Missing operand after", a.text);
- put_token_back();
- current_token.type = NUMBER_TT;
- current_token.value = 0;
- current_token.marker = 0;
- current_token.text = "0";
- break;
-
- case e2: /* Unexpected close bracket */
- error("Found '(' without matching ')'");
- get_next_etoken();
- break;
-
- case e3: /* Missing operator error */
- error("Missing operator: inserting '+'");
- put_token_back();
- current_token.type = OP_TT;
- current_token.value = PLUS_OP;
- current_token.marker = 0;
- current_token.text = "+";
- break;
-
- case e4: /* Expression ends with an open bracket */
- error("Found '(' without matching ')'");
- sr_sp--;
- break;
-
- }
- }
- while (TRUE);
-}
-
-/* --- Test for simple ++ or -- usage: used to optimise "for" loop code ---- */
-
-extern int test_for_incdec(assembly_operand AO)
-{ int s = 0;
- if (AO.type != EXPRESSION_OT) return 0;
- if (ET[AO.value].down == -1) return 0;
- switch(ET[AO.value].operator_number)
- { case INC_OP: s = 1; break;
- case POST_INC_OP: s = 1; break;
- case DEC_OP: s = -1; break;
- case POST_DEC_OP: s = -1; break;
- }
- if (s==0) return 0;
- if (ET[ET[AO.value].down].down != -1) return 0;
- if (!is_variable_ot(ET[ET[AO.value].down].value.type)) return 0;
- return s*(ET[ET[AO.value].down].value.value);
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_expressp_vars(void)
-{ int i;
- /* make_operands(); */
- make_lexical_interface_tables();
- for (i=0;i<32;i++) system_function_usage[i] = 0;
-}
-
-extern void expressp_begin_pass(void)
-{
-}
-
-extern void expressp_allocate_arrays(void)
-{ ET = my_calloc(sizeof(expression_tree_node), MAX_EXPRESSION_NODES,
- "expression parse trees");
- emitter_markers = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
- "emitter markers");
- emitter_bracket_counts = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
- "emitter bracket layer counts");
- emitter_stack = my_calloc(sizeof(assembly_operand), MAX_EXPRESSION_NODES,
- "emitter stack");
- sr_stack = my_calloc(sizeof(token_data), MAX_EXPRESSION_NODES,
- "shift-reduce parser stack");
-}
-
-extern void expressp_free_arrays(void)
-{ my_free(&ET, "expression parse trees");
- my_free(&emitter_markers, "emitter markers");
- my_free(&emitter_bracket_counts, "emitter bracket layer counts");
- my_free(&emitter_stack, "emitter stack");
- my_free(&sr_stack, "shift-reduce parser stack");
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "files" : File handling for source code, the transcript file and the */
-/* debugging information file; file handling and splicing of */
-/* the output file. */
-/* */
-/* Note that filenaming conventions are left to the top-level */
-/* routines in "inform.c", since they are tied up with ICL */
-/* settings and are very host OS-dependent. */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int total_files; /* Number of files so far, including
- #include and #origsource files */
-int total_input_files; /* Number of source files so far
- (excludes #origsource) */
-int current_input_file; /* Most recently-opened source file */
-static int current_origsource_file; /* Most recently-used #origsource */
-
-int32 total_chars_read; /* Characters read in (from all
- source files put together) */
-
-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 int checksum_count; /* similarly */
-
-/* ------------------------------------------------------------------------- */
-/* Most of the information about source files is kept by "lexer.c"; this */
-/* level is only concerned with file names and handles. */
-/* ------------------------------------------------------------------------- */
-
-FileId *InputFiles=NULL; /* Ids for all the source files */
-static char *filename_storage, /* Translated filenames */
- *filename_storage_p;
-static int filename_storage_left;
-
-/* ------------------------------------------------------------------------- */
-/* When emitting debug information, we won't have addresses of routines, */
-/* sequence points, Glulx objects (addresses of Z-machine objects aren't */
-/* needed), globals, arrays, or grammar lines. We only have their */
-/* offsets from base addresses, which won't be known until the end of */
-/* compilation. Since everything else in the relevant debug records is */
-/* known much earlier and is less convenient to store up, we emit the */
-/* debug records with a placeholder value and then backpatch these */
-/* placeholders. The following structs each store either an offset or a */
-/* symbol index and the point in the debug information file where the */
-/* corresponding address should be written once the base address is known. */
-/* ------------------------------------------------------------------------- */
-
-#define INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION 65536
-
-typedef struct value_and_backpatch_position_struct
-{ int32 value;
- fpos_t backpatch_position;
-} value_and_backpatch_position;
-
-typedef struct debug_backpatch_accumulator_struct
-{ int32 number_of_values_to_backpatch;
- int32 number_of_available_backpatches;
- value_and_backpatch_position *values_and_backpatch_positions;
- int32 (* backpatching_function)(int32);
-} debug_backpatch_accumulator;
-
-static debug_backpatch_accumulator object_backpatch_accumulator;
-static debug_backpatch_accumulator packed_code_backpatch_accumulator;
-static debug_backpatch_accumulator code_backpatch_accumulator;
-static debug_backpatch_accumulator global_backpatch_accumulator;
-static debug_backpatch_accumulator array_backpatch_accumulator;
-static debug_backpatch_accumulator grammar_backpatch_accumulator;
-
-/* ------------------------------------------------------------------------- */
-/* File handles and names for temporary files. */
-/* ------------------------------------------------------------------------- */
-
-FILE *Temp1_fp=NULL, *Temp2_fp=NULL, *Temp3_fp=NULL;
-char Temp1_Name[PATHLEN], Temp2_Name[PATHLEN], Temp3_Name[PATHLEN];
-
-/* ------------------------------------------------------------------------- */
-/* Opening and closing source code files */
-/* ------------------------------------------------------------------------- */
-
-#if defined(PC_WIN32) && defined(HAS_REALPATH)
-#include <windows.h>
-char *realpath(const char *path, char *resolved_path)
-{
- return GetFullPathNameA(path,PATHLEN,resolved_path,NULL) != 0 ? resolved_path : 0;
-}
-#endif
-
-extern void load_sourcefile(char *filename_given, int same_directory_flag)
-{
- /* Meaning: open a new file of Inform source. (The lexer picks up on
- this by noticing that input_file has increased.) */
-
- char name[PATHLEN];
-#ifdef HAS_REALPATH
- char absolute_name[PATHLEN];
-#endif
- int x = 0;
- FILE *handle;
-
- if (total_files == MAX_SOURCE_FILES)
- memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
-
- do
- { x = translate_in_filename(x, name, filename_given, same_directory_flag,
- (total_files==0)?1:0);
- handle = fopen(name,"r");
- } while ((handle == NULL) && (x != 0));
-
- if (filename_storage_left <= (int)strlen(name))
- memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
-
- filename_storage_left -= strlen(name)+1;
- strcpy(filename_storage_p, name);
- InputFiles[total_files].filename = filename_storage_p;
-
- filename_storage_p += strlen(name)+1;
-
- if (debugfile_switch)
- { debug_file_printf("<source index=\"%d\">", total_files);
- debug_file_printf("<given-path>");
- debug_file_print_with_entities(filename_given);
- debug_file_printf("</given-path>");
-#ifdef HAS_REALPATH
- if (realpath(name, absolute_name))
- { debug_file_printf("<resolved-path>");
- debug_file_print_with_entities(absolute_name);
- debug_file_printf("</resolved-path>");
- }
-#endif
- debug_file_printf("<language>Inform 6</language>");
- debug_file_printf("</source>");
- }
-
- InputFiles[total_files].handle = handle;
- if (InputFiles[total_files].handle==NULL)
- fatalerror_named("Couldn't open source file", name);
-
- InputFiles[total_files].is_input = TRUE;
-
- if (line_trace_level > 0) printf("\nOpening file \"%s\"\n",name);
-
- total_files++;
- total_input_files++;
- current_input_file = total_files;
-}
-
-static void close_sourcefile(int file_number)
-{
- if (InputFiles[file_number-1].handle == NULL) return;
-
- /* Close this file. */
-
- if (ferror(InputFiles[file_number-1].handle))
- fatalerror_named("I/O failure: couldn't read from source file",
- InputFiles[file_number-1].filename);
-
- fclose(InputFiles[file_number-1].handle);
-
- InputFiles[file_number-1].handle = NULL;
-
- if (line_trace_level > 0) printf("\nClosing file\n");
-}
-
-extern void close_all_source(void)
-{ int i;
- for (i=0; i<total_files; i++) close_sourcefile(i+1);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Register an #origsource filename. This goes in the InputFiles table, */
-/* but we do not open the file or advance current_input_file. */
-/* ------------------------------------------------------------------------- */
-
-extern int register_orig_sourcefile(char *filename)
-{
- int ix;
-
- /* If the filename has already been used as an origsource filename,
- return that entry. We check the most-recently-used file first, and
- then search the list. */
- if (current_origsource_file > 0 && current_origsource_file <= total_files) {
- if (!strcmp(filename, InputFiles[current_origsource_file-1].filename))
- return current_origsource_file;
- }
-
- for (ix=0; ix<total_files; ix++) {
- if (InputFiles[ix].is_input)
- continue;
- if (!strcmp(filename, InputFiles[ix].filename)) {
- current_origsource_file = ix+1;
- return current_origsource_file;
- }
- }
-
- /* This filename has never been used before. Allocate a new InputFiles
- entry. */
-
- char *name = filename; /* no translation */
-
- if (total_files == MAX_SOURCE_FILES)
- memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
-
- if (filename_storage_left <= (int)strlen(name))
- memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
-
- filename_storage_left -= strlen(name)+1;
- strcpy(filename_storage_p, name);
- InputFiles[total_files].filename = filename_storage_p;
-
- filename_storage_p += strlen(name)+1;
-
- if (debugfile_switch)
- { debug_file_printf("<source index=\"%d\">", total_files);
- debug_file_printf("<given-path>");
- debug_file_print_with_entities(filename);
- debug_file_printf("</given-path>");
- debug_file_printf("<language>Inform 7</language>");
- debug_file_printf("</source>");
- }
-
- InputFiles[total_files].handle = NULL;
- InputFiles[total_files].is_input = FALSE;
-
- total_files++;
- current_origsource_file = total_files;
- return current_origsource_file;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Feeding source code up into the lexical analyser's buffer */
-/* (see "lexer.c" for its specification) */
-/* ------------------------------------------------------------------------- */
-
-extern int file_load_chars(int file_number, char *buffer, int length)
-{
- int read_in; FILE *handle;
-
- if (file_number-1 > total_files)
- { buffer[0] = 0; return 1; }
-
- handle = InputFiles[file_number-1].handle;
- if (handle == NULL)
- { buffer[0] = 0; return 1; }
-
- read_in = fread(buffer, 1, length, handle);
- total_chars_read += read_in;
-
- if (read_in == length) return length;
-
- close_sourcefile(file_number);
-
- if (file_number == 1)
- { buffer[read_in] = 0;
- buffer[read_in+1] = 0;
- buffer[read_in+2] = 0;
- buffer[read_in+3] = 0;
- }
- else
- { buffer[read_in] = '\n';
- buffer[read_in+1] = ' ';
- buffer[read_in+2] = ' ';
- buffer[read_in+3] = ' ';
- }
-
- return(-(read_in+4));
-}
-
-/* ------------------------------------------------------------------------- */
-/* Final assembly and output of the story file/module. */
-/* ------------------------------------------------------------------------- */
-
-FILE *sf_handle;
-
-static void sf_put(int c)
-{
- if (!glulx_mode) {
-
- /* The checksum is the unsigned sum mod 65536 of the bytes in the
- story file from 0x0040 (first byte after header) to the end.
-
- The link data does not contribute to the checksum of a module. */
-
- checksum_low_byte += c;
- if (checksum_low_byte>=256)
- { checksum_low_byte-=256;
- if (++checksum_high_byte==256) checksum_high_byte=0;
- }
-
- }
- else {
-
- /* The checksum is the unsigned 32-bit sum of the entire story file,
- considered as a list of 32-bit words, with the checksum field
- being zero. */
-
- switch (checksum_count) {
- case 0:
- checksum_long += (((int32)(c & 0xFF)) << 24);
- break;
- case 1:
- checksum_long += (((int32)(c & 0xFF)) << 16);
- break;
- case 2:
- checksum_long += (((int32)(c & 0xFF)) << 8);
- break;
- case 3:
- checksum_long += ((int32)(c & 0xFF));
- break;
- }
-
- checksum_count = (checksum_count+1) & 3;
-
- }
-
- fputc(c, sf_handle);
-}
-
-/* Recursive procedure to generate the Glulx compression table. */
-
-static void output_compression(int entnum, int32 *size, int *count)
-{
- huffentity_t *ent = &(huff_entities[entnum]);
- int32 val;
- char *cx;
-
- sf_put(ent->type);
- (*size)++;
- (*count)++;
-
- switch (ent->type) {
- case 0:
- val = Write_Strings_At + huff_entities[ent->u.branch[0]].addr;
- sf_put((val >> 24) & 0xFF);
- sf_put((val >> 16) & 0xFF);
- sf_put((val >> 8) & 0xFF);
- sf_put((val) & 0xFF);
- (*size) += 4;
- val = Write_Strings_At + huff_entities[ent->u.branch[1]].addr;
- sf_put((val >> 24) & 0xFF);
- sf_put((val >> 16) & 0xFF);
- sf_put((val >> 8) & 0xFF);
- sf_put((val) & 0xFF);
- (*size) += 4;
- output_compression(ent->u.branch[0], size, count);
- output_compression(ent->u.branch[1], size, count);
- break;
- case 1:
- /* no data */
- break;
- case 2:
- sf_put(ent->u.ch);
- (*size) += 1;
- break;
- case 3:
- cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
- while (*cx) {
- sf_put(*cx);
- cx++;
- (*size) += 1;
- }
- sf_put('\0');
- (*size) += 1;
- break;
- case 4:
- val = unicode_usage_entries[ent->u.val].ch;
- sf_put((val >> 24) & 0xFF);
- sf_put((val >> 16) & 0xFF);
- sf_put((val >> 8) & 0xFF);
- sf_put((val) & 0xFF);
- (*size) += 4;
- break;
- case 9:
- val = abbreviations_offset + 4 + ent->u.val*4;
- sf_put((val >> 24) & 0xFF);
- sf_put((val >> 16) & 0xFF);
- sf_put((val >> 8) & 0xFF);
- sf_put((val) & 0xFF);
- (*size) += 4;
- break;
- }
-}
-
-static void output_file_z(void)
-{ FILE *fin=NULL; char new_name[PATHLEN];
- int32 length, blanks=0, size, i, j, offset;
- uint32 code_length, size_before_code, next_cons_check;
- int use_function;
-
- ASSERT_ZCODE();
-
- /* At this point, construct_storyfile() has just been called. */
-
- /* Enter the length information into the header. */
-
- length=((int32) Write_Strings_At) + static_strings_extent;
- if (module_switch) length += link_data_size +
- zcode_backpatch_size +
- zmachine_backpatch_size;
-
- while ((length%length_scale_factor)!=0) { length++; blanks++; }
- length=length/length_scale_factor;
- zmachine_paged_memory[26]=(length & 0xff00)/0x100;
- zmachine_paged_memory[27]=(length & 0xff);
-
- /* To assist interpreters running a paged virtual memory system, Inform
- writes files which are padded with zeros to the next multiple of
- 0.5K. This calculates the number of bytes of padding needed: */
-
- while (((length_scale_factor*length)+blanks-1)%512 != 511) blanks++;
-
- translate_out_filename(new_name, Code_Name);
-
- sf_handle = fopen(new_name,"wb");
- if (sf_handle == NULL)
- fatalerror_named("Couldn't open output file", new_name);
-
-#ifdef MAC_MPW
- /* Set the type and creator to Andrew Plotkin's MaxZip, a popular
- Z-code interpreter on the Macintosh */
-
- if (!module_switch) fsetfileinfo(new_name, 'mxZR', 'ZCOD');
-#endif
-
- /* (1) Output the paged memory. */
-
- for (i=0;i<64;i++)
- fputc(zmachine_paged_memory[i], sf_handle);
- size = 64;
- checksum_low_byte = 0;
- checksum_high_byte = 0;
-
- for (i=64; i<Write_Code_At; i++)
- { sf_put(zmachine_paged_memory[i]); size++;
- }
-
- /* (2) Output the compiled code area. */
-
- if (temporary_files_switch)
- { fclose(Temp2_fp);
- Temp2_fp = NULL;
- fin=fopen(Temp2_Name,"rb");
- if (fin==NULL)
- fatalerror("I/O failure: couldn't reopen temporary file 2");
- }
-
- if (!OMIT_UNUSED_ROUTINES) {
- /* This is the old-fashioned case, which is easy. All of zcode_area
- (zmachine_pc bytes) will be output. next_cons_check will be
- ignored, because j will never reach it. */
- code_length = zmachine_pc;
- use_function = TRUE;
- next_cons_check = code_length+1;
- }
- else {
- /* With dead function stripping, life is more complicated.
- j will run from 0 to zmachine_pc, but only code_length of
- those should be output. next_cons_check is the location of
- the next function break; that's where we check whether
- we're in a live function or a dead one.
- (This logic is simplified by the assumption that a backpatch
- marker will never straddle a function break.) */
- if (zmachine_pc != df_total_size_before_stripping)
- compiler_error("Code size does not match (zmachine_pc and df_total_size).");
- code_length = df_total_size_after_stripping;
- use_function = TRUE;
- next_cons_check = 0;
- df_prepare_function_iterate();
- }
- size_before_code = size;
-
- j=0;
- if (!module_switch)
- for (i=0; i<zcode_backpatch_size; i=i+3)
- { int long_flag = TRUE;
- offset
- = 256*read_byte_from_memory_block(&zcode_backpatch_table, i+1)
- + read_byte_from_memory_block(&zcode_backpatch_table, i+2);
- backpatch_error_flag = FALSE;
- backpatch_marker
- = read_byte_from_memory_block(&zcode_backpatch_table, i);
- if (backpatch_marker >= 0x80) long_flag = FALSE;
- backpatch_marker &= 0x7f;
- offset = offset + (backpatch_marker/32)*0x10000;
- while (offset+0x30000 < j) {
- offset += 0x40000;
- long_flag = !long_flag;
- }
- backpatch_marker &= 0x1f;
-
- /* All code up until the next backpatch marker gets flushed out
- as-is. (Unless we're in a stripped-out function.) */
- while (j<offset) {
- if (!use_function) {
- while (j<offset && j<next_cons_check) {
- /* get dummy value */
- ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- else {
- while (j<offset && j<next_cons_check) {
- size++;
- sf_put((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- if (j == next_cons_check)
- next_cons_check = df_next_function_iterate(&use_function);
- }
-
- if (long_flag)
- { int32 v = (temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j);
- v = 256*v + ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j+1));
- j += 2;
- if (use_function) {
- v = backpatch_value(v);
- sf_put(v/256); sf_put(v%256);
- size += 2;
- }
- }
- else
- { int32 v = (temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j);
- j++;
- if (use_function) {
- v = backpatch_value(v);
- sf_put(v);
- size++;
- }
- }
-
- if (j > next_cons_check)
- compiler_error("Backpatch appears to straddle function break");
-
- if (backpatch_error_flag)
- { printf("*** %s zcode offset=%08lx backpatch offset=%08lx ***\n",
- (long_flag)?"long":"short", (long int) j, (long int) i);
- }
- }
-
- /* Flush out the last bit of zcode_area, after the last backpatch
- marker. */
- offset = zmachine_pc;
- while (j<offset) {
- if (!use_function) {
- while (j<offset && j<next_cons_check) {
- /* get dummy value */
- ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- else {
- while (j<offset && j<next_cons_check) {
- size++;
- sf_put((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- if (j == next_cons_check)
- next_cons_check = df_next_function_iterate(&use_function);
- }
-
- if (temporary_files_switch)
- { if (ferror(fin))
- fatalerror("I/O failure: couldn't read from temporary file 2");
- fclose(fin);
- fin = NULL;
- }
-
- if (size_before_code + code_length != size)
- compiler_error("Code output length did not match");
-
- /* (3) Output any null bytes (required to reach a packed address)
- before the strings area. */
-
- while (size<Write_Strings_At) { sf_put(0); size++; }
-
- /* (4) Output the static strings area. */
-
- if (temporary_files_switch)
- { fclose(Temp1_fp);
- Temp1_fp = NULL;
- fin=fopen(Temp1_Name,"rb");
- if (fin==NULL)
- fatalerror("I/O failure: couldn't reopen temporary file 1");
- for (i=0; i<static_strings_extent; i++) sf_put(fgetc(fin));
- if (ferror(fin))
- fatalerror("I/O failure: couldn't read from temporary file 1");
- fclose(fin);
- fin = NULL;
- remove(Temp1_Name); remove(Temp2_Name);
- }
- else
- for (i=0; i<static_strings_extent; i++) {
- sf_put(read_byte_from_memory_block(&static_strings_area,i));
- size++;
- }
-
- /* (5) Output the linking data table (in the case of a module). */
-
- if (temporary_files_switch)
- { if (module_switch)
- { fclose(Temp3_fp);
- Temp3_fp = NULL;
- fin=fopen(Temp3_Name,"rb");
- if (fin==NULL)
- fatalerror("I/O failure: couldn't reopen temporary file 3");
- for (j=0; j<link_data_size; j++) sf_put(fgetc(fin));
- if (ferror(fin))
- fatalerror("I/O failure: couldn't read from temporary file 3");
- fclose(fin);
- fin = NULL;
- remove(Temp3_Name);
- }
- }
- else
- if (module_switch)
- for (i=0; i<link_data_size; i++)
- sf_put(read_byte_from_memory_block(&link_data_area,i));
-
- if (module_switch)
- { for (i=0; i<zcode_backpatch_size; i++)
- sf_put(read_byte_from_memory_block(&zcode_backpatch_table, i));
- for (i=0; i<zmachine_backpatch_size; i++)
- sf_put(read_byte_from_memory_block(&zmachine_backpatch_table, i));
- }
-
- /* (6) Output null bytes to reach a multiple of 0.5K. */
-
- while (blanks>0) { sf_put(0); blanks--; }
-
- if (ferror(sf_handle))
- fatalerror("I/O failure: couldn't write to story file");
-
- fseek(sf_handle, 28, SEEK_SET);
- fputc(checksum_high_byte, sf_handle);
- fputc(checksum_low_byte, sf_handle);
-
- if (ferror(sf_handle))
- fatalerror("I/O failure: couldn't backtrack on story file for checksum");
-
- fclose(sf_handle);
-
- /* Write a copy of the header into the debugging information file
- (mainly so that it can be used to identify which story file matches
- with which debugging info file). */
-
- if (debugfile_switch)
- { debug_file_printf("<story-file-prefix>");
- for (i = 0; i < 63; i += 3)
- { if (i == 27)
- { debug_file_print_base_64_triple
- (zmachine_paged_memory[27],
- checksum_high_byte,
- checksum_low_byte);
- } else
- { debug_file_print_base_64_triple
- (zmachine_paged_memory[i],
- zmachine_paged_memory[i + 1],
- zmachine_paged_memory[i + 2]);
- }
- }
- debug_file_print_base_64_single(zmachine_paged_memory[63]);
- debug_file_printf("</story-file-prefix>");
- }
-
-#ifdef ARCHIMEDES
- { char settype_command[PATHLEN];
- sprintf(settype_command, "settype %s %s",
- new_name, riscos_file_type());
- system(settype_command);
- }
-#endif
-#ifdef MAC_FACE
- if (module_switch)
- InformFiletypes (new_name, INF_MODULE_TYPE);
- else
- InformFiletypes (new_name, INF_ZCODE_TYPE);
-#endif
-}
-
-static void output_file_g(void)
-{ FILE *fin=NULL; 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;
-
- ASSERT_GLULX();
-
- /* At this point, construct_storyfile() has just been called. */
-
- translate_out_filename(new_name, Code_Name);
-
- sf_handle = fopen(new_name,"wb+");
- if (sf_handle == NULL)
- fatalerror_named("Couldn't open output file", new_name);
-
-#ifdef MAC_MPW
- /* Set the type and creator to Andrew Plotkin's MaxZip, a popular
- Z-code interpreter on the Macintosh */
-
- if (!module_switch) fsetfileinfo(new_name, 'mxZR', 'ZCOD');
-#endif
-
- checksum_long = 0;
- checksum_count = 0;
-
- /* Determine the version number. */
-
- VersionNum = 0x00020000;
-
- /* Increase for various features the game may have used. */
- if (no_unicode_chars != 0 || (uses_unicode_features)) {
- VersionNum = 0x00030000;
- }
- if (uses_memheap_features) {
- VersionNum = 0x00030100;
- }
- if (uses_acceleration_features) {
- VersionNum = 0x00030101;
- }
- if (uses_float_features) {
- VersionNum = 0x00030102;
- }
-
- /* 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);
- }
- else {
- VersionNum = requested_glulx_version;
- }
- }
-
- /* (1) Output the header. We use sf_put here, instead of fputc,
- because the header is included in the checksum. */
-
- /* Magic number */
- sf_put('G');
- sf_put('l');
- sf_put('u');
- sf_put('l');
- /* Version number. */
- sf_put((VersionNum >> 24));
- sf_put((VersionNum >> 16));
- sf_put((VersionNum >> 8));
- sf_put((VersionNum));
- /* RAMSTART */
- sf_put((Write_RAM_At >> 24));
- sf_put((Write_RAM_At >> 16));
- sf_put((Write_RAM_At >> 8));
- sf_put((Write_RAM_At));
- /* EXTSTART, or game file size */
- sf_put((Out_Size >> 24));
- sf_put((Out_Size >> 16));
- sf_put((Out_Size >> 8));
- sf_put((Out_Size));
- /* ENDMEM, which the game file size plus MEMORY_MAP_EXTENSION */
- i = Out_Size + MEMORY_MAP_EXTENSION;
- sf_put((i >> 24));
- sf_put((i >> 16));
- sf_put((i >> 8));
- sf_put((i));
- /* STACKSIZE */
- sf_put((MAX_STACK_SIZE >> 24));
- sf_put((MAX_STACK_SIZE >> 16));
- sf_put((MAX_STACK_SIZE >> 8));
- sf_put((MAX_STACK_SIZE));
- /* Initial function to call. Inform sets things up so that this
- is the start of the executable-code area. */
- sf_put((Write_Code_At >> 24));
- sf_put((Write_Code_At >> 16));
- sf_put((Write_Code_At >> 8));
- sf_put((Write_Code_At));
- /* String-encoding table. */
- sf_put((Write_Strings_At >> 24));
- sf_put((Write_Strings_At >> 16));
- sf_put((Write_Strings_At >> 8));
- sf_put((Write_Strings_At));
- /* Checksum -- zero for the moment. */
- sf_put(0x00);
- sf_put(0x00);
- sf_put(0x00);
- sf_put(0x00);
-
- size = GLULX_HEADER_SIZE;
-
- /* (1a) Output the eight-byte memory layout identifier. */
-
- sf_put('I'); sf_put('n'); sf_put('f'); sf_put('o');
- sf_put(0); sf_put(1); sf_put(0); sf_put(0);
-
- /* (1b) Output the rest of the Inform-specific data. */
-
- /* Inform version number */
- sf_put('0' + ((RELEASE_NUMBER/100)%10));
- sf_put('.');
- sf_put('0' + ((RELEASE_NUMBER/10)%10));
- sf_put('0' + RELEASE_NUMBER%10);
- /* Glulx back-end version number */
- sf_put('0' + ((GLULX_RELEASE_NUMBER/100)%10));
- sf_put('.');
- sf_put('0' + ((GLULX_RELEASE_NUMBER/10)%10));
- sf_put('0' + GLULX_RELEASE_NUMBER%10);
- /* Game release number */
- sf_put((release_number>>8) & 0xFF);
- sf_put(release_number & 0xFF);
- /* Game serial number */
- {
- char serialnum[8];
- write_serial_number(serialnum);
- for (i=0; i<6; i++)
- sf_put(serialnum[i]);
- }
- size += GLULX_STATIC_ROM_SIZE;
-
- /* (2) Output the compiled code area. */
-
- if (temporary_files_switch)
- { fclose(Temp2_fp);
- Temp2_fp = NULL;
- fin=fopen(Temp2_Name,"rb");
- if (fin==NULL)
- fatalerror("I/O failure: couldn't reopen temporary file 2");
- }
-
- if (!OMIT_UNUSED_ROUTINES) {
- /* This is the old-fashioned case, which is easy. All of zcode_area
- (zmachine_pc bytes) will be output. next_cons_check will be
- ignored, because j will never reach it. */
- code_length = zmachine_pc;
- use_function = TRUE;
- next_cons_check = code_length+1;
- }
- else {
- /* With dead function stripping, life is more complicated.
- j will run from 0 to zmachine_pc, but only code_length of
- those should be output. next_cons_check is the location of
- the next function break; that's where we check whether
- we're in a live function or a dead one.
- (This logic is simplified by the assumption that a backpatch
- marker will never straddle a function break.) */
- if (zmachine_pc != df_total_size_before_stripping)
- compiler_error("Code size does not match (zmachine_pc and df_total_size).");
- code_length = df_total_size_after_stripping;
- use_function = TRUE;
- next_cons_check = 0;
- df_prepare_function_iterate();
- }
- size_before_code = size;
-
- j=0;
- if (!module_switch)
- for (i=0; i<zcode_backpatch_size; i=i+6) {
- int data_len;
- int32 v;
- offset =
- (read_byte_from_memory_block(&zcode_backpatch_table, i+2) << 24)
- | (read_byte_from_memory_block(&zcode_backpatch_table, i+3) << 16)
- | (read_byte_from_memory_block(&zcode_backpatch_table, i+4) << 8)
- | (read_byte_from_memory_block(&zcode_backpatch_table, i+5));
- backpatch_error_flag = FALSE;
- backpatch_marker =
- read_byte_from_memory_block(&zcode_backpatch_table, i);
- data_len =
- read_byte_from_memory_block(&zcode_backpatch_table, i+1);
-
- /* All code up until the next backpatch marker gets flushed out
- as-is. (Unless we're in a stripped-out function.) */
- while (j<offset) {
- if (!use_function) {
- while (j<offset && j<next_cons_check) {
- /* get dummy value */
- ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- else {
- while (j<offset && j<next_cons_check) {
- size++;
- sf_put((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- if (j == next_cons_check)
- next_cons_check = df_next_function_iterate(&use_function);
- }
-
- /* Write out the converted value of the backpatch marker.
- (Unless we're in a stripped-out function.) */
- switch (data_len) {
-
- case 4:
- v = ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j+1));
- v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j+2));
- v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j+3));
- j += 4;
- if (!use_function)
- break;
- v = backpatch_value(v);
- sf_put((v >> 24) & 0xFF);
- sf_put((v >> 16) & 0xFF);
- sf_put((v >> 8) & 0xFF);
- sf_put((v) & 0xFF);
- size += 4;
- break;
-
- case 2:
- v = ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j+1));
- j += 2;
- if (!use_function)
- break;
- v = backpatch_value(v);
- if (v >= 0x10000) {
- printf("*** backpatch value does not fit ***\n");
- backpatch_error_flag = TRUE;
- }
- sf_put((v >> 8) & 0xFF);
- sf_put((v) & 0xFF);
- size += 2;
- break;
-
- case 1:
- v = ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j += 1;
- if (!use_function)
- break;
- v = backpatch_value(v);
- if (v >= 0x100) {
- printf("*** backpatch value does not fit ***\n");
- backpatch_error_flag = TRUE;
- }
- sf_put((v) & 0xFF);
- size += 1;
- break;
-
- default:
- printf("*** unknown backpatch data len = %d ***\n",
- data_len);
- backpatch_error_flag = TRUE;
- }
-
- if (j > next_cons_check)
- compiler_error("Backpatch appears to straddle function break");
-
- if (backpatch_error_flag) {
- printf("*** %d bytes zcode offset=%08lx backpatch offset=%08lx ***\n",
- data_len, (long int) j, (long int) i);
- }
- }
-
- /* Flush out the last bit of zcode_area, after the last backpatch
- marker. */
- offset = zmachine_pc;
- while (j<offset) {
- if (!use_function) {
- while (j<offset && j<next_cons_check) {
- /* get dummy value */
- ((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- else {
- while (j<offset && j<next_cons_check) {
- size++;
- sf_put((temporary_files_switch)?fgetc(fin):
- read_byte_from_memory_block(&zcode_area, j));
- j++;
- }
- }
- if (j == next_cons_check)
- next_cons_check = df_next_function_iterate(&use_function);
- }
-
- if (temporary_files_switch)
- { if (ferror(fin))
- fatalerror("I/O failure: couldn't read from temporary file 2");
- fclose(fin);
- fin = NULL;
- }
-
- if (size_before_code + code_length != size)
- compiler_error("Code output length did not match");
-
- /* (4) Output the static strings area. */
-
- if (temporary_files_switch) {
- fseek(Temp1_fp, 0, SEEK_SET);
- }
- {
- int32 ix, lx;
- int ch, jx, curbyte, bx;
- int depth, checkcount;
- huffbitlist_t *bits;
- int32 origsize;
-
- origsize = size;
-
- if (compression_switch) {
-
- /* The 12-byte table header. */
- lx = compression_table_size;
- sf_put((lx >> 24) & 0xFF);
- sf_put((lx >> 16) & 0xFF);
- sf_put((lx >> 8) & 0xFF);
- sf_put((lx) & 0xFF);
- size += 4;
- sf_put((no_huff_entities >> 24) & 0xFF);
- sf_put((no_huff_entities >> 16) & 0xFF);
- sf_put((no_huff_entities >> 8) & 0xFF);
- sf_put((no_huff_entities) & 0xFF);
- size += 4;
- lx = Write_Strings_At + 12;
- sf_put((lx >> 24) & 0xFF);
- sf_put((lx >> 16) & 0xFF);
- sf_put((lx >> 8) & 0xFF);
- sf_put((lx) & 0xFF);
- size += 4;
-
- checkcount = 0;
- output_compression(huff_entity_root, &size, &checkcount);
- if (checkcount != no_huff_entities)
- compiler_error("Compression table count mismatch.");
- }
-
- if (size - origsize != compression_table_size)
- compiler_error("Compression table size mismatch.");
-
- origsize = size;
-
- for (lx=0, ix=0; lx<no_strings; lx++) {
- int escapelen=0, escapetype=0;
- int done=FALSE;
- int32 escapeval=0;
- if (compression_switch)
- sf_put(0xE1); /* type byte -- compressed string */
- else
- sf_put(0xE0); /* type byte -- non-compressed string */
- size++;
- jx = 0;
- curbyte = 0;
- while (!done) {
- if (temporary_files_switch)
- ch = fgetc(Temp1_fp);
- else
- ch = read_byte_from_memory_block(&static_strings_area, ix);
- ix++;
- if (ix > static_strings_extent || ch < 0)
- compiler_error("Read too much not-yet-compressed text.");
-
- if (escapelen == -1) {
- escapelen = 0;
- if (ch == '@') {
- ch = '@';
- }
- else if (ch == '0') {
- ch = '\0';
- }
- else if (ch == 'A' || ch == 'D' || ch == 'U') {
- escapelen = 4;
- escapetype = ch;
- escapeval = 0;
- continue;
- }
- else {
- compiler_error("Strange @ escape in processed text.");
- }
- }
- else if (escapelen) {
- escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
- escapelen--;
- if (escapelen == 0) {
- if (escapetype == 'A') {
- ch = huff_abbrev_start+escapeval;
- }
- else if (escapetype == 'D') {
- ch = huff_dynam_start+escapeval;
- }
- else if (escapetype == 'U') {
- ch = huff_unicode_start+escapeval;
- }
- else {
- compiler_error("Strange @ escape in processed text.");
- }
- }
- else
- continue;
- }
- else {
- if (ch == '@') {
- escapelen = -1;
- continue;
- }
- if (ch == 0) {
- ch = 256;
- done = TRUE;
- }
- }
-
- if (compression_switch) {
- bits = &(huff_entities[ch].bits);
- depth = huff_entities[ch].depth;
- for (bx=0; bx<depth; bx++) {
- if (bits->b[bx / 8] & (1 << (bx % 8)))
- curbyte |= (1 << jx);
- jx++;
- if (jx == 8) {
- sf_put(curbyte);
- size++;
- curbyte = 0;
- jx = 0;
- }
- }
- }
- else {
- if (ch >= huff_dynam_start) {
- sf_put(' '); sf_put(' '); sf_put(' ');
- size += 3;
- }
- else if (ch >= huff_abbrev_start) {
- /* nothing */
- }
- else {
- /* 256, the string terminator, comes out as zero */
- sf_put(ch & 0xFF);
- size++;
- }
- }
- }
- if (compression_switch && jx) {
- sf_put(curbyte);
- size++;
- }
- }
-
- if (size - origsize != compression_string_size)
- compiler_error("Compression string size mismatch.");
-
- }
-
- /* (4.5) Output any null bytes (required to reach a GPAGESIZE address)
- before RAMSTART. */
-
- while (size % GPAGESIZE) { sf_put(0); size++; }
-
- /* (5) Output RAM. */
-
- for (i=0; i<RAM_Size; i++)
- { sf_put(zmachine_paged_memory[i]); size++;
- }
-
- if (ferror(sf_handle))
- fatalerror("I/O failure: couldn't write to story file");
-
- fseek(sf_handle, 32, SEEK_SET);
- fputc((checksum_long >> 24) & 0xFF, sf_handle);
- fputc((checksum_long >> 16) & 0xFF, sf_handle);
- fputc((checksum_long >> 8) & 0xFF, sf_handle);
- fputc((checksum_long) & 0xFF, sf_handle);
-
- if (ferror(sf_handle))
- fatalerror("I/O failure: couldn't backtrack on story file for checksum");
-
- /* Write a copy of the first 64 bytes into the debugging information file
- (mainly so that it can be used to identify which story file matches with
- which debugging info file). */
-
- if (debugfile_switch)
- { fseek(sf_handle, 0L, SEEK_SET);
- debug_file_printf("<story-file-prefix>");
- for (i = 0; i < 63; i += 3)
- { first_byte_of_triple = fgetc(sf_handle);
- second_byte_of_triple = fgetc(sf_handle);
- third_byte_of_triple = fgetc(sf_handle);
- debug_file_print_base_64_triple
- (first_byte_of_triple,
- second_byte_of_triple,
- third_byte_of_triple);
- }
- debug_file_print_base_64_single(fgetc(sf_handle));
- debug_file_printf("</story-file-prefix>");
- }
-
- fclose(sf_handle);
-
-#ifdef ARCHIMEDES
- { char settype_command[PATHLEN];
- sprintf(settype_command, "settype %s %s",
- new_name, riscos_file_type());
- system(settype_command);
- }
-#endif
-#ifdef MAC_FACE
- if (module_switch)
- InformFiletypes (new_name, INF_MODULE_TYPE);
- else
- InformFiletypes (new_name, INF_ZCODE_TYPE);
-#endif
-}
-
-extern void output_file(void)
-{
- if (!glulx_mode)
- output_file_z();
- else
- output_file_g();
-}
-
-/* ------------------------------------------------------------------------- */
-/* Output the text transcript file (only called if there is to be one). */
-/* ------------------------------------------------------------------------- */
-
-FILE *transcript_file_handle; int transcript_open;
-
-extern void write_to_transcript_file(char *text)
-{ fputs(text, transcript_file_handle);
- fputc('\n', transcript_file_handle);
-}
-
-extern void open_transcript_file(char *what_of)
-{ char topline_buffer[256];
-
- transcript_file_handle = fopen(Transcript_Name,"w");
- if (transcript_file_handle==NULL)
- fatalerror_named("Couldn't open transcript file",
- Transcript_Name);
-
- transcript_open = TRUE;
-
- sprintf(topline_buffer, "Transcript of the text of \"%s\"\n\
-[From %s]\n", what_of, banner_line);
- write_to_transcript_file(topline_buffer);
-}
-
-extern void abort_transcript_file(void)
-{ if (transcript_switch && transcript_open)
- fclose(transcript_file_handle);
- transcript_open = FALSE;
-}
-
-extern void close_transcript_file(void)
-{ char botline_buffer[256];
- char sn_buffer[7];
-
- write_serial_number(sn_buffer);
- sprintf(botline_buffer, "\n[End of transcript: release %d.%s]\n",
- release_number, sn_buffer);
- write_to_transcript_file(botline_buffer);
-
- if (ferror(transcript_file_handle))
- fatalerror("I/O failure: couldn't write to transcript file");
- fclose(transcript_file_handle);
- transcript_open = FALSE;
-
-#ifdef ARCHIMEDES
- { char settype_command[PATHLEN];
- sprintf(settype_command, "settype %s text",
- Transcript_Name);
- system(settype_command);
- }
-#endif
-#ifdef MAC_FACE
- InformFiletypes (Transcript_Name, INF_TEXT_TYPE);
-#endif
-}
-
-/* ------------------------------------------------------------------------- */
-/* Access to the debugging information file. */
-/* ------------------------------------------------------------------------- */
-
-static FILE *Debug_fp; /* Handle of debugging info file */
-
-static void open_debug_file(void)
-{ Debug_fp=fopen(Debugging_Name,"wb");
- if (Debug_fp==NULL)
- fatalerror_named("Couldn't open debugging information file",
- Debugging_Name);
-}
-
-extern void nullify_debug_file_position(maybe_file_position *position) {
- position->valid = 0;
-}
-
-static void close_debug_file(void)
-{ fclose(Debug_fp);
-#ifdef MAC_FACE
- InformFiletypes (Debugging_Name, INF_DEBUG_TYPE);
-#endif
-}
-
-extern void begin_debug_file(void)
-{ open_debug_file();
-
- debug_file_printf("<?xml version=\"1.0\" encoding=\"UTF-8\"?>");
- debug_file_printf("<inform-story-file version=\"1.0\" ");
- debug_file_printf("content-creator=\"Inform\" ");
- debug_file_printf
- ("content-creator-version=\"%d.%d%d\">",
- (VNUMBER / 100) % 10,
- (VNUMBER / 10) % 10,
- VNUMBER % 10);
-}
-
-extern void debug_file_printf(const char*format, ...)
-{ va_list argument_pointer;
- va_start(argument_pointer, format);
- vfprintf(Debug_fp, format, argument_pointer);
- va_end(argument_pointer);
- if (ferror(Debug_fp))
- { fatalerror("I/O failure: can't write to debugging information file");
- }
-}
-
-extern void debug_file_print_with_entities(const char*string)
-{ int index = 0;
- char character;
- for (character = string[index]; character; character = string[++index])
- { switch(character)
- { case '"':
- debug_file_printf(""");
- break;
- case '&':
- debug_file_printf("&");
- break;
- case '\'':
- debug_file_printf("'");
- break;
- case '<':
- debug_file_printf("<");
- break;
- case '>':
- debug_file_printf(">");
- break;
- default:
- debug_file_printf("%c", character);
- break;
- }
- }
-}
-
-static char base_64_digits[] =
- { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
- 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd',
- 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
- 't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', '+', '/' };
-
-extern void debug_file_print_base_64_triple
- (uchar first, uchar second, uchar third)
-{ debug_file_printf
- ("%c%c%c%c",
- base_64_digits[first >> 2],
- base_64_digits[((first & 3) << 4) | (second >> 4)],
- base_64_digits[((second & 15) << 2) | (third >> 6)],
- base_64_digits[third & 63]);
-}
-
-extern void debug_file_print_base_64_pair(uchar first, uchar second)
-{ debug_file_printf
- ("%c%c%c=",
- base_64_digits[first >> 2],
- base_64_digits[((first & 3) << 4) | (second >> 4)],
- base_64_digits[(second & 15) << 2]);
-}
-
-extern void debug_file_print_base_64_single(uchar first)
-{ debug_file_printf
- ("%c%c==",
- base_64_digits[first >> 2],
- base_64_digits[(first & 3) << 4]);
-}
-
-static void write_debug_location_internals(debug_location location)
-{ debug_file_printf("<file-index>%d</file-index>", location.file_index - 1);
- debug_file_printf
- ("<file-position>%d</file-position>", location.beginning_byte_index);
- debug_file_printf
- ("<line>%d</line>", location.beginning_line_number);
- debug_file_printf
- ("<character>%d</character>", location.beginning_character_number);
- if (location.beginning_byte_index != location.end_byte_index ||
- location.beginning_line_number != location.end_line_number ||
- location.beginning_character_number != location.end_character_number)
- { debug_file_printf
- ("<end-file-position>%d</end-file-position>",
- location.end_byte_index);
- debug_file_printf
- ("<end-line>%d</end-line>", location.end_line_number);
- debug_file_printf
- ("<end-character>%d</end-character>",
- location.end_character_number);
- }
-}
-
-static void write_debug_location_origsource_internals(debug_location location)
-{ debug_file_printf
- ("<file-index>%d</file-index>", location.orig_file_index - 1);
- if (location.orig_beg_line_number)
- debug_file_printf
- ("<line>%d</line>", location.orig_beg_line_number);
- if (location.orig_beg_char_number)
- debug_file_printf
- ("<character>%d</character>", location.orig_beg_char_number);
-}
-
-extern void write_debug_location(debug_location location)
-{ if (location.file_index && location.file_index != 255)
- { debug_file_printf("<source-code-location>");
- write_debug_location_internals(location);
- debug_file_printf("</source-code-location>");
- }
- if (location.orig_file_index)
- { debug_file_printf("<source-code-location>");
- write_debug_location_origsource_internals(location);
- debug_file_printf("</source-code-location>");
- }
-}
-
-extern void write_debug_locations(debug_locations locations)
-{ if (locations.next)
- { const debug_locations*current = &locations;
- unsigned int index = 0;
- for (; current; current = current->next, ++index)
- { debug_file_printf("<source-code-location index=\"%d\">", index);
- write_debug_location_internals(current->location);
- debug_file_printf("</source-code-location>");
- }
- if (locations.location.orig_file_index)
- { debug_file_printf("<source-code-location>");
- write_debug_location_origsource_internals(locations.location);
- debug_file_printf("</source-code-location>");
- }
- }
- else
- { write_debug_location(locations.location);
- }
-}
-
-extern void write_debug_optional_identifier(int32 symbol_index)
-{ if (stypes[symbol_index] != ROUTINE_T)
- { compiler_error
- ("Attempt to write a replaceable identifier for a non-routine");
- }
- if (replacement_debug_backpatch_positions[symbol_index].valid)
- { if (fsetpos
- (Debug_fp,
- &replacement_debug_backpatch_positions[symbol_index].position))
- { fatalerror("I/O failure: can't seek in debugging information file");
- }
- debug_file_printf
- ("<identifier artificial=\"true\">%s "
- "(superseded replacement)</identifier>",
- symbs[symbol_index]);
- if (fseek(Debug_fp, 0L, SEEK_END))
- { fatalerror("I/O failure: can't seek in debugging information file");
- }
- }
- fgetpos
- (Debug_fp, &replacement_debug_backpatch_positions[symbol_index].position);
- replacement_debug_backpatch_positions[symbol_index].valid = TRUE;
- debug_file_printf("<identifier>%s</identifier>", symbs[symbol_index]);
- /* Space for: artificial="true" (superseded replacement) */
- debug_file_printf(" ");
-}
-
-extern void write_debug_symbol_backpatch(int32 symbol_index)
-{ if (symbol_debug_backpatch_positions[symbol_index].valid) {
- compiler_error("Symbol entry incorrectly reused in debug information "
- "file backpatching");
- }
- fgetpos(Debug_fp, &symbol_debug_backpatch_positions[symbol_index].position);
- symbol_debug_backpatch_positions[symbol_index].valid = TRUE;
- /* Reserve space for up to 10 digits plus a negative sign. */
- debug_file_printf("*BACKPATCH*");
-}
-
-extern void write_debug_symbol_optional_backpatch(int32 symbol_index)
-{ if (symbol_debug_backpatch_positions[symbol_index].valid) {
- compiler_error("Symbol entry incorrectly reused in debug information "
- "file backpatching");
- }
- /* Reserve space for open and close value tags and up to 10 digits plus a
- negative sign, but take the backpatch position just inside the element,
- so that we'll be in the same case as above if the symbol is eventually
- defined. */
- debug_file_printf("<value>");
- fgetpos(Debug_fp, &symbol_debug_backpatch_positions[symbol_index].position);
- symbol_debug_backpatch_positions[symbol_index].valid = TRUE;
- debug_file_printf("*BACKPATCH*</value>");
-}
-
-static void write_debug_backpatch
- (debug_backpatch_accumulator *accumulator, int32 value)
-{ if (accumulator->number_of_values_to_backpatch ==
- accumulator->number_of_available_backpatches)
- { my_realloc(&accumulator->values_and_backpatch_positions,
- sizeof(value_and_backpatch_position) *
- accumulator->number_of_available_backpatches,
- 2 * sizeof(value_and_backpatch_position) *
- accumulator->number_of_available_backpatches,
- "values and debug information backpatch positions");
- accumulator->number_of_available_backpatches *= 2;
- }
- accumulator->values_and_backpatch_positions
- [accumulator->number_of_values_to_backpatch].value = value;
- fgetpos
- (Debug_fp,
- &accumulator->values_and_backpatch_positions
- [accumulator->number_of_values_to_backpatch].backpatch_position);
- ++(accumulator->number_of_values_to_backpatch);
- /* Reserve space for up to 10 digits plus a negative sign. */
- debug_file_printf("*BACKPATCH*");
-}
-
-extern void write_debug_object_backpatch(int32 object_number)
-{ if (glulx_mode)
- { write_debug_backpatch(&object_backpatch_accumulator, object_number - 1);
- }
- else
- { debug_file_printf("%d", object_number);
- }
-}
-
-static int32 backpatch_object_address(int32 index)
-{ return object_tree_offset + OBJECT_BYTE_LENGTH * index;
-}
-
-extern void write_debug_packed_code_backpatch(int32 offset)
-{ write_debug_backpatch(&packed_code_backpatch_accumulator, offset);
-}
-
-static int32 backpatch_packed_code_address(int32 offset)
-{
- if (OMIT_UNUSED_ROUTINES) {
- int stripped;
- offset = df_stripped_offset_for_code_offset(offset, &stripped);
- if (stripped)
- return 0;
- }
- return (code_offset + offset) / scale_factor;
-}
-
-extern void write_debug_code_backpatch(int32 offset)
-{ write_debug_backpatch(&code_backpatch_accumulator, offset);
-}
-
-static int32 backpatch_code_address(int32 offset)
-{
- if (OMIT_UNUSED_ROUTINES) {
- int stripped;
- offset = df_stripped_offset_for_code_offset(offset, &stripped);
- if (stripped)
- return 0;
- }
- return code_offset + offset;
-}
-
-extern void write_debug_global_backpatch(int32 offset)
-{ write_debug_backpatch(&global_backpatch_accumulator, offset);
-}
-
-static int32 backpatch_global_address(int32 offset)
-{ return variables_offset + WORDSIZE * (offset - MAX_LOCAL_VARIABLES);
-}
-
-extern void write_debug_array_backpatch(int32 offset)
-{ write_debug_backpatch(&array_backpatch_accumulator, offset);
-}
-
-static int32 backpatch_array_address(int32 offset)
-{ return (glulx_mode ? arrays_offset : variables_offset) + offset;
-}
-
-extern void write_debug_grammar_backpatch(int32 offset)
-{ write_debug_backpatch(&grammar_backpatch_accumulator, offset);
-}
-
-static int32 backpatch_grammar_address(int32 offset)
-{ return grammar_table_offset + offset;
-}
-
-extern void begin_writing_debug_sections()
-{ debug_file_printf("<story-file-section>");
- debug_file_printf("<type>header</type>");
- debug_file_printf("<address>0</address>");
-}
-
-extern void write_debug_section(const char*name, int32 beginning_address)
-{ debug_file_printf("<end-address>%d</end-address>", beginning_address);
- debug_file_printf("</story-file-section>");
- debug_file_printf("<story-file-section>");
- debug_file_printf("<type>");
- debug_file_print_with_entities(name);
- debug_file_printf("</type>");
- debug_file_printf("<address>%d</address>", beginning_address);
-}
-
-extern void end_writing_debug_sections(int32 end_address)
-{ debug_file_printf("<end-address>%d</end-address>", end_address);
- debug_file_printf("</story-file-section>");
-}
-
-extern void write_debug_undef(int32 symbol_index)
-{ if (!symbol_debug_backpatch_positions[symbol_index].valid)
- { compiler_error
- ("Attempt to erase debugging information never written or since "
- "erased");
- }
- if (stypes[symbol_index] != CONSTANT_T)
- { compiler_error
- ("Attempt to erase debugging information for a non-constant "
- "because of an #undef");
- }
- if (fsetpos
- (Debug_fp, &symbol_debug_backpatch_positions[symbol_index].position))
- { fatalerror("I/O failure: can't seek in debugging information file");
- }
- /* There are 7 characters in ``<value>''. */
- if (fseek(Debug_fp, -7L, SEEK_CUR))
- { fatalerror("I/O failure: can't seek in debugging information file");
- }
- /* Overwrite: <value>*BACKPATCH*</value> */
- debug_file_printf(" ");
- nullify_debug_file_position
- (&symbol_debug_backpatch_positions[symbol_index]);
- if (fseek(Debug_fp, 0L, SEEK_END))
- { fatalerror("I/O failure: can't seek in debugging information file");
- }
-}
-
-static void apply_debug_information_backpatches
- (debug_backpatch_accumulator *accumulator)
-{ int32 backpatch_index, backpatch_value;
- for (backpatch_index = accumulator->number_of_values_to_backpatch;
- backpatch_index--;)
- { if (fsetpos
- (Debug_fp,
- &accumulator->values_and_backpatch_positions
- [backpatch_index].backpatch_position))
- { fatalerror
- ("I/O failure: can't seek in debugging information file");
- }
- backpatch_value =
- (*accumulator->backpatching_function)
- (accumulator->values_and_backpatch_positions
- [backpatch_index].value);
- debug_file_printf
- ("%11d", /* Space for up to 10 digits plus a negative sign. */
- backpatch_value);
- }
-}
-
-static void apply_debug_information_symbol_backpatches()
-{ int backpatch_symbol;
- for (backpatch_symbol = no_symbols; backpatch_symbol--;)
- { if (symbol_debug_backpatch_positions[backpatch_symbol].valid)
- { if (fsetpos(Debug_fp,
- &symbol_debug_backpatch_positions
- [backpatch_symbol].position))
- { fatalerror
- ("I/O failure: can't seek in debugging information file");
- }
- debug_file_printf("%11d", svals[backpatch_symbol]);
- }
- }
-}
-
-static void write_debug_system_constants()
-{ int *system_constant_list =
- glulx_mode ? glulx_system_constant_list : z_system_constant_list;
- int system_constant_index = 0;
-
- /* Store system constants. */
- for (; system_constant_list[system_constant_index] != -1;
- ++system_constant_index)
- { int system_constant = system_constant_list[system_constant_index];
- debug_file_printf("<constant>");
- debug_file_printf
- ("<identifier>#%s</identifier>",
- system_constants.keywords[system_constant]);
- debug_file_printf
- ("<value>%d</value>",
- value_of_system_constant(system_constant));
- debug_file_printf("</constant>");
- }
-}
-
-extern void end_debug_file()
-{ write_debug_system_constants();
- debug_file_printf("</inform-story-file>\n");
-
- if (glulx_mode)
- { apply_debug_information_backpatches(&object_backpatch_accumulator);
- } else
- { apply_debug_information_backpatches(&packed_code_backpatch_accumulator);
- }
- apply_debug_information_backpatches(&code_backpatch_accumulator);
- apply_debug_information_backpatches(&global_backpatch_accumulator);
- apply_debug_information_backpatches(&array_backpatch_accumulator);
- apply_debug_information_backpatches(&grammar_backpatch_accumulator);
-
- apply_debug_information_symbol_backpatches();
-
- close_debug_file();
-}
-
-/* ------------------------------------------------------------------------- */
-/* Temporary storage files: */
-/* */
-/* Temp file 1 is used to hold the static strings area, as compiled */
-/* 2 to hold compiled routines of Z-code */
-/* 3 to hold the link data table (but only for modules) */
-/* */
-/* (Though annoying, this procedure typically saves about 200K of memory, */
-/* an important point for Amiga and sub-386 PC users of Inform) */
-/* ------------------------------------------------------------------------- */
-
-extern void open_temporary_files(void)
-{ translate_temp_filename(1);
- Temp1_fp=fopen(Temp1_Name,"wb");
- if (Temp1_fp==NULL) fatalerror_named("Couldn't open temporary file 1",
- Temp1_Name);
- translate_temp_filename(2);
- Temp2_fp=fopen(Temp2_Name,"wb");
- if (Temp2_fp==NULL) fatalerror_named("Couldn't open temporary file 2",
- Temp2_Name);
-
- if (!module_switch) return;
- translate_temp_filename(3);
- Temp3_fp=fopen(Temp3_Name,"wb");
- if (Temp3_fp==NULL) fatalerror_named("Couldn't open temporary file 3",
- Temp3_Name);
-}
-
-extern void check_temp_files(void)
-{
- if (ferror(Temp1_fp))
- fatalerror("I/O failure: couldn't write to temporary file 1");
- if (ferror(Temp2_fp))
- fatalerror("I/O failure: couldn't write to temporary file 2");
- if (module_switch && ferror(Temp3_fp))
- fatalerror("I/O failure: couldn't write to temporary file 3");
-}
-
-extern void remove_temp_files(void)
-{ if (Temp1_fp != NULL) fclose(Temp1_fp);
- Temp1_fp = NULL;
- if (Temp2_fp != NULL) fclose(Temp2_fp);
- Temp2_fp = NULL;
- remove(Temp1_Name); remove(Temp2_Name);
- if (module_switch)
- { if (Temp3_fp != NULL) fclose(Temp3_fp);
- Temp3_fp = NULL;
- remove(Temp3_Name);
- }
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_files_vars(void)
-{ malloced_bytes = 0;
- checksum_low_byte = 0; /* Z-code */
- checksum_high_byte = 0;
- checksum_long = 0; /* Glulx */
- checksum_count = 0;
- transcript_open = FALSE;
-}
-
-extern void files_begin_prepass(void)
-{
- total_files = 0;
- total_input_files = 0;
- current_input_file = 0;
- current_origsource_file = 0;
-}
-
-extern void files_begin_pass(void)
-{ total_chars_read=0;
- if (temporary_files_switch)
- open_temporary_files();
-}
-
-static void initialise_accumulator
- (debug_backpatch_accumulator *accumulator,
- int32 (* backpatching_function)(int32))
-{ accumulator->number_of_values_to_backpatch = 0;
- accumulator->number_of_available_backpatches =
- INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION;
- accumulator->values_and_backpatch_positions =
- my_malloc
- (sizeof(value_and_backpatch_position) *
- accumulator->number_of_available_backpatches,
- "values and debug information backpatch positions");
- accumulator->backpatching_function = backpatching_function;
-}
-
-extern void files_allocate_arrays(void)
-{ filename_storage = my_malloc(MAX_SOURCE_FILES*64, "filename storage");
- filename_storage_p = filename_storage;
- filename_storage_left = MAX_SOURCE_FILES*64;
- InputFiles = my_malloc(MAX_SOURCE_FILES*sizeof(FileId),
- "input file storage");
- if (debugfile_switch)
- { if (glulx_mode)
- { initialise_accumulator
- (&object_backpatch_accumulator, &backpatch_object_address);
- } else
- { initialise_accumulator
- (&packed_code_backpatch_accumulator,
- &backpatch_packed_code_address);
- }
- initialise_accumulator
- (&code_backpatch_accumulator, &backpatch_code_address);
- initialise_accumulator
- (&global_backpatch_accumulator, &backpatch_global_address);
- initialise_accumulator
- (&array_backpatch_accumulator, &backpatch_array_address);
- initialise_accumulator
- (&grammar_backpatch_accumulator, &backpatch_grammar_address);
- }
-}
-
-static void tear_down_accumulator(debug_backpatch_accumulator *accumulator)
-{ my_free
- (&(accumulator->values_and_backpatch_positions),
- "values and debug information backpatch positions");
-}
-
-extern void files_free_arrays(void)
-{ my_free(&filename_storage, "filename storage");
- my_free(&InputFiles, "input file storage");
- if (debugfile_switch)
- { if (!glulx_mode)
- { tear_down_accumulator(&object_backpatch_accumulator);
- } else
- { tear_down_accumulator(&packed_code_backpatch_accumulator);
- }
- tear_down_accumulator(&code_backpatch_accumulator);
- tear_down_accumulator(&global_backpatch_accumulator);
- tear_down_accumulator(&array_backpatch_accumulator);
- tear_down_accumulator(&grammar_backpatch_accumulator);
- }
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* Header file for Inform: Z-machine ("Infocom" format) compiler */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* *** To compile this program in one of the existing ports, you must */
-/* at least change the machine definition (on the next page). */
-/* In most cases no other work will be needed. *** */
-/* */
-/* Contents: */
-/* */
-/* Machine/host OS definitions (in alphabetical order) */
-/* Default definitions */
-/* Standard ANSI inclusions, macro definitions, structures */
-/* Definitions of internal code numbers */
-/* Extern declarations for linkage (in alphabetical order of file) */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#define RELEASE_DATE "28th June 2018"
-#define RELEASE_NUMBER 1634
-#define GLULX_RELEASE_NUMBER 38
-#define MODULE_VERSION_NUMBER 1
-#define VNUMBER RELEASE_NUMBER
-
-/* N indicates an intermediate release for Inform 7 */
-/*#define RELEASE_SUFFIX "N"*/
-
-/* ------------------------------------------------------------------------- */
-/* Our host machine or OS for today is... */
-/* */
-/* [ Inform should compile (possibly with warnings) and work safely */
-/* if you just: */
-/* */
-/* #define AMIGA - for the Commodore Amiga under SAS/C */
-/* #define ARCHIMEDES - for Acorn RISC OS machines under Norcroft C */
-/* #define ATARIST - for the Atari ST */
-/* #define BEOS - for the BeBox */
-/* #define LINUX - for Linux under gcc (essentially as Unix) */
-/* #define MACOS - for the Apple Mac with OS X (another Unix) */
-/* #define MAC_CLASSIC - for the Apple Mac under Think C or Codewarrior */
-/* #define MAC_MPW - for MPW under Codewarrior (and maybe Think C) */
-/* #define OS2 - for OS/2 32-bit mode under IBM's C Set++ */
-/* #define PC - for 386+ IBM PCs, eg. Microsoft Visual C/C++ */
-/* #define PC_QUICKC - for small IBM PCs under QuickC */
-/* #define PC_WIN32 - for Borland C++ or Microsoft Visual C++ */
-/* #define UNIX - for Unix under gcc (or big IBM PC under djgpp) */
-/* #define VMS - for VAX or ALPHA under DEC C, but not VAX C */
-/* */
-/* In most cases executables are already available at */
-/* http://www.ifarchive.org/, and these are sometimes enhanced with */
-/* e.g. windowed interfaces whose source is not archived with the */
-/* main Inform source.] */
-/* */
-/* (If no machine is defined, then cautious #defines will be made. In */
-/* most cases, porting to a new machine is a matter of carefully filling */
-/* out a block of definitions like those below.) */
-/* ------------------------------------------------------------------------- */
-
-/* #define UNIX */
-
-/* ------------------------------------------------------------------------- */
-/* The first task is to include the ANSI header files, and typedef */
-/* suitable 32-bit integer types. */
-/* ------------------------------------------------------------------------- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdarg.h>
-#include <ctype.h>
-#include <string.h>
-#include <time.h>
-#include <limits.h>
-#include <math.h>
-
-#ifndef VAX
-#if SCHAR_MAX >= 0x7FFFFFFFL && SCHAR_MIN <= -0x7FFFFFFFL
- typedef signed char int32;
- typedef unsigned char uint32;
-#elif SHRT_MAX >= 0x7FFFFFFFL && SHRT_MIN <= -0x7FFFFFFFL
- typedef signed short int int32;
- typedef unsigned short int uint32;
-#elif INT_MAX >= 0x7FFFFFFFL && INT_MIN <= -0x7FFFFFFFL
- typedef signed int int32;
- typedef unsigned int uint32;
-#elif LONG_MAX >= 0x7FFFFFFFL && LONG_MIN <= -0x7FFFFFFFL
- typedef signed long int int32;
- typedef unsigned long int uint32;
-#else
-#error No type large enough to support 32-bit integers.
-#endif
-#else
- /* VAX C does not provide these limit constants, contrary to ANSI */
- typedef int int32;
- typedef unsigned int uint32;
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* The next part of this file contains blocks of definitions, one for */
-/* each port, of machine or OS-dependent constants needed by Inform. */
-/* */
-/* 1. MACHINE_STRING should be set to the name of the machine or OS. */
-/* */
-/* 2. Some miscellaneous #define options (set if the constant is */
-/* defined, otherwise not set): */
-/* */
-/* USE_TEMPORARY_FILES - use scratch files for workspace, not memory, */
-/* by default */
-/* PROMPT_INPUT - prompt input (don't use Unix-style command line) */
-/* TIME_UNAVAILABLE - don't use ANSI time routines to work out today's */
-/* date */
-/* CHAR_IS_UNSIGNED - if on your compiler the type "char" is unsigned */
-/* by default, you should define this */
-/* HAS_REALPATH - the POSIX realpath() function is available to */
-/* find the absolute path to a file */
-/* */
-/* 3. An estimate of the typical amount of memory likely to be free */
-/* should be given in DEFAULT_MEMORY_SIZE. */
-/* For most modern machines, HUGE_SIZE is the appropriate setting, but */
-/* some older micros may benefit from SMALL_SIZE. */
-/* ------------------------------------------------------------------------- */
-
-#define LARGE_SIZE 1
-#define SMALL_SIZE 2
-#define HUGE_SIZE 3
-
-/* ------------------------------------------------------------------------- */
-/* 4. Filenaming definitions: */
-/* */
-/* It's assumed that the host OS has the concept of subdirectories and */
-/* has "pathnames", that is, filenames giving a chain of subdirectories */
-/* divided by the FN_SEP (filename separator) character: e.g. for Unix */
-/* FN_SEP is defined below as '/' and a typical name is */
-/* "users/graham/jigsaw.z5". */
-/* White space is not allowed in filenames, and nor is the special */
-/* character FN_ALT, which unless defined here will be a comma and will */
-/* be used to separate alternative locations in a path variable. */
-/* */
-/* If NO_FILE_EXTENSIONS is undefined then the OS allows "file extensions" */
-/* of 1 to 3 alphanumeric characters like ".txt" (for text files), ".z5" */
-/* (for game files), etc., to indicate the file's type (and, crucially, */
-/* regards the same filename but with different extensions -- e.g., */
-/* "frog.amp" and "frog.lil" -- as being different names). */
-/* (The file extensions defined below are widely accepted, so please use */
-/* them unless there's a good reason why not.) */
-/* */
-/* You should then define STANDARD_DIRECTORIES (you can define it anyway) */
-/* in which case Inform will expect by default that files are sorted out */
-/* by being put into suitable directories (e.g., a "games" directory for */
-/* story files). */
-/* */
-/* If it's convenient for your port you can alter the detailed definitions */
-/* which these broad settings make. Be careful if NO_FILE_EXTENSIONS */
-/* is set without STANDARD_DIRECTORIES, as then Inform may */
-/* overwrite its source with object code. */
-/* */
-/* 5. Filenames (or code related to filenames) for the three temporary */
-/* files. These only exist during compilation (and only if -F1 is set). */
-/* Temporary_Name is the body of a filename to use */
-/* (if you don't set this, it becomes "Inftemp") and Temporary_Directory */
-/* is the directory path for the files to go in (which can be altered on */
-/* the command line). On some multi-tasking OSs these filenames ought to */
-/* include a number uniquely identifying the process: to indicate this, */
-/* define INCLUDE_TASK_ID and provide some code... */
-/* */
-/* #define INCLUDE_TASK_ID */
-/* #ifdef INFORM_FILE */
-/* static int32 unique_task_id(void) */
-/* { ...some code returning your task ID... */
-/* } */
-/* #endif */
-/* */
-/* 6. Any other definitions specific to the OS or machine. */
-/* (In particular DEFAULT_ERROR_FORMAT is 0 on most machines and 1 on PCs; */
-/* it controls the style of error messages, which is important for some */
-/* error-throwback debugging tools.) */
-/* ------------------------------------------------------------------------- */
-
-/* ========================================================================= */
-/* The blocks now follow in alphabetical order. */
-/* ------------------------------------------------------------------------- */
-/* AMIGA block */
-/* ------------------------------------------------------------------------- */
-#ifdef AMIGA
-/* 1 */
-#define MACHINE_STRING "Amiga"
-/* 3 */
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-/* 5 */
-#define __USE_SYSBASE
-#include <proto/exec.h>
-#define INCLUDE_TASK_ID
-#define Temporary_Directory "T:"
-#ifdef MAIN_INFORM_FILE
-static int32 unique_task_id(void)
-{ return (int32)FindTask(NULL);
-}
-#endif
-#endif
-/* ------------------------------------------------------------------------- */
-/* ARCHIMEDES block: Acorn/RISC OS settings */
-/* ------------------------------------------------------------------------- */
-#ifdef ARCHIMEDES
-/* 1 */
-#define MACHINE_STRING "RISC OS"
-/* 2 */
-#define CHAR_IS_UNSIGNED
-/* 3 */
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-/* 4 */
-#define FN_SEP '.'
-#define STANDARD_DIRECTORIES
-#define NO_FILE_EXTENSIONS
-#define Source_Directory "inform"
-#define ICL_Directory "ICL"
-/* 5 */
-#define ENABLE_TEMPORARY_PATH
-#define Temporary_Directory "ram:"
-/* 6 */
-#define ARC_THROWBACK
-#endif
-/* ------------------------------------------------------------------------- */
-/* Atari ST block */
-/* ------------------------------------------------------------------------- */
-#ifdef ATARIST
-/* 1 */
-#define MACHINE_STRING "Atari ST"
-/* 3 */
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-/* 5 */
-#ifndef TOSFS
-#define Temporary_Directory "/tmp"
-#define INCLUDE_TASK_ID
-#ifdef MAIN_INFORM_FILE
-static int32 unique_task_id(void)
-{ return (int32)getpid();
-}
-#endif
-#endif
-#endif
-/* ------------------------------------------------------------------------- */
-/* BEOS block */
-/* ------------------------------------------------------------------------- */
-#ifdef BEOS
-/* 1 */
-#define MACHINE_STRING "BeOS"
-/* 3 */
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-#define FILE_EXTENSIONS
-/* 5 */
-#define Temporary_Directory "/tmp"
-#endif
-/* ------------------------------------------------------------------------- */
-/* LINUX block */
-/* ------------------------------------------------------------------------- */
-#ifdef LINUX
-/* 1 */
-#define MACHINE_STRING "Linux"
-/* 2 */
-#define HAS_REALPATH
-/* 3 */
-#define DEFAULT_MEMORY_SIZE HUGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-/* 5 */
-#define Temporary_Directory "/tmp"
-/* 6 */
-#define PATHLEN 8192
-#endif
-/* ------------------------------------------------------------------------- */
-/* Macintosh block */
-/* ------------------------------------------------------------------------- */
-#ifdef MAC_MPW
-#define MAC_CLASSIC
-#endif
-
-#ifdef MAC_CLASSIC
-/* 1 */
-#ifdef MAC_MPW
-#define MACHINE_STRING "Macintosh Programmer's Workshop"
-#else
-#define MACHINE_STRING "Macintosh"
-#endif
-/* 2 */
-#ifdef MAC_FACE
-#define EXTERNAL_SHELL
-#endif
-#ifndef MAC_FACE
-#ifndef MAC_MPW
-#define PROMPT_INPUT
-#endif
-#endif
-/* 3 */
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-/* 4 */
-#define FN_SEP ':'
-#ifdef MAC_MPW
-#define Include_Extension ".h"
-#endif
-/* 6 */
-#ifdef MAC_FACE
-#include "TB Inform.h"
-#endif
-#ifdef MAC_MPW
-#include <CursorCtl.h>
-#define DEFAULT_ERROR_FORMAT 2
-#endif
-#endif
-/* ------------------------------------------------------------------------- */
-/* OS/2 block */
-/* ------------------------------------------------------------------------- */
-#ifdef OS2
-/* 1 */
-#define MACHINE_STRING "OS/2"
-/* 2 */
-#define CHAR_IS_UNSIGNED
-/* 3 */
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-#endif
-/* ------------------------------------------------------------------------- */
-/* MACOS block */
-/* ------------------------------------------------------------------------- */
-#ifdef MACOS
-/* 1 */
-#define MACHINE_STRING "MacOS"
-/* 2 */
-#define HAS_REALPATH
-/* 3 */
-#define DEFAULT_MEMORY_SIZE HUGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-/* 5 */
-#define Temporary_Directory "/tmp"
-#define INCLUDE_TASK_ID
-#define _POSIX_C_SOURCE 199506L
-#define _XOPEN_SOURCE 500
-#ifdef MAIN_INFORM_FILE
-#include <sys/types.h>
-#include <unistd.h>
-static int32 unique_task_id(void)
-{ return (int32)getpid();
-}
-#endif
-/* 6 */
-#define PATHLEN 8192
-#endif
-/* ------------------------------------------------------------------------- */
-/* PC and PC_QUICKC block */
-/* ------------------------------------------------------------------------- */
-#ifdef PC_QUICKC
-#define PC
-#endif
-
-#ifdef PC
-/* 1 */
-#define MACHINE_STRING "PC"
-/* 2 */
-#define USE_TEMPORARY_FILES
-/* 3 */
-#ifdef PC_QUICKC
-#define DEFAULT_MEMORY_SIZE SMALL_SIZE
-#else
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-#endif
-/* 4 */
-#define FN_SEP '\\'
-/* 6 */
-#define DEFAULT_ERROR_FORMAT 1
-#endif
-/* ------------------------------------------------------------------------- */
-/* PC_WIN32 block */
-/* ------------------------------------------------------------------------- */
-#ifdef PC_WIN32
-/* 1 */
-#define MACHINE_STRING "Win32"
-/* 2 */
-#define HAS_REALPATH
-/* 3 */
-#define DEFAULT_MEMORY_SIZE HUGE_SIZE
-/* 4 */
-#define FN_SEP '\\'
-/* 6 */
-#define DEFAULT_ERROR_FORMAT 1
-#define PATHLEN 512
-#ifdef _MSC_VER /* Microsoft Visual C++ */
-#define snprintf _snprintf
-#define isnan _isnan
-#define isinf(x) (!_isnan(x) && !_finite(x))
-#endif
-#endif
-/* ------------------------------------------------------------------------- */
-/* UNIX block */
-/* ------------------------------------------------------------------------- */
-#ifdef UNIX
-/* 1 */
-#ifndef MACHINE_STRING
-#define MACHINE_STRING "Unix"
-#endif
-/* 2 */
-#define HAS_REALPATH
-/* 3 */
-#define DEFAULT_MEMORY_SIZE HUGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-/* 5 */
-#define PATHLEN 512
-#define Temporary_Directory "/tmp"
-#define INCLUDE_TASK_ID
-#ifdef MAIN_INFORM_FILE
-#include <unistd.h>
-static int32 unique_task_id(void)
-{ return (int32)getpid();
-}
-#endif
-#endif
-/* ------------------------------------------------------------------------- */
-/* VMS (Dec VAX and Alpha) block */
-/* ------------------------------------------------------------------------- */
-#ifdef __VMS
-#define VMS
-#endif
-
-#ifdef VMS
-/* 1 */
-#ifdef __ALPHA
-#define MACHINE_STRING "Alpha/VMS"
-#else
-#define MACHINE_STRING "VAX/VMS"
-#endif
-/* 2 */
-#define CHAR_IS_UNSIGNED
-/* 3 */
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-/* 4 */
-#define FN_SEP '/'
-#define Code_Extension ".zip"
-#define V4Code_Extension ".zip"
-#define V5Code_Extension ".zip"
-#define V6Code_Extension ".zip"
-#define V7Code_Extension ".zip"
-#define V8Code_Extension ".zip"
-#endif
-/* ========================================================================= */
-/* Default settings: */
-/* ------------------------------------------------------------------------- */
-
-#ifndef NO_FILE_EXTENSIONS
-#define FILE_EXTENSIONS
-#endif
-
-#ifndef Transcript_File
-#ifdef FILE_EXTENSIONS
-#define Transcript_File "gametext.txt"
-#else
-#define Transcript_File "gametext"
-#endif
-#endif
-#ifndef Debugging_File
-#ifdef FILE_EXTENSIONS
-#define Debugging_File "gameinfo.dbg"
-#else
-#define Debugging_File "gamedebug"
-#endif
-#endif
-
-#ifdef FILE_EXTENSIONS
-#ifndef Source_Extension
-#define Source_Extension ".inf"
-#endif
-#ifndef Include_Extension
-#define Include_Extension ".h"
-#endif
-#ifndef Code_Extension
-#define Code_Extension ".z3"
-#endif
-#ifndef V4Code_Extension
-#define V4Code_Extension ".z4"
-#endif
-#ifndef V5Code_Extension
-#define V5Code_Extension ".z5"
-#endif
-#ifndef V6Code_Extension
-#define V6Code_Extension ".z6"
-#endif
-#ifndef V7Code_Extension
-#define V7Code_Extension ".z7"
-#endif
-#ifndef V8Code_Extension
-#define V8Code_Extension ".z8"
-#endif
-#ifndef GlulxCode_Extension
-#define GlulxCode_Extension ".ulx"
-#endif
-#ifndef Module_Extension
-#define Module_Extension ".m5"
-#endif
-#ifndef ICL_Extension
-#define ICL_Extension ".icl"
-#endif
-
-#else
-
-#define Source_Extension ""
-#define Include_Extension ""
-#define Code_Extension ""
-#define V4Code_Extension ""
-#define V5Code_Extension ""
-#define V6Code_Extension ""
-#define V7Code_Extension ""
-#define V8Code_Extension ""
-#define GlulxCode_Extension ""
-#define Module_Extension ""
-#define ICL_Extension ""
-#endif
-
-#ifdef STANDARD_DIRECTORIES
-#ifndef Source_Directory
-#define Source_Directory "source"
-#endif
-#ifndef Include_Directory
-#define Include_Directory "library"
-#endif
-#ifndef Code_Directory
-#define Code_Directory "games"
-#endif
-#ifndef Module_Directory
-#define Module_Directory "modules"
-#endif
-#ifndef Temporary_Directory
-#define Temporary_Directory ""
-#endif
-#ifndef ICL_Directory
-#define ICL_Directory ""
-#endif
-
-#else
-
-#ifndef Source_Directory
-#define Source_Directory ""
-#endif
-#ifndef Include_Directory
-#define Include_Directory ""
-#endif
-#ifndef Code_Directory
-#define Code_Directory ""
-#endif
-#ifndef Module_Directory
-#define Module_Directory ""
-#endif
-#ifndef Temporary_Directory
-#define Temporary_Directory ""
-#endif
-#ifndef ICL_Directory
-#define ICL_Directory ""
-#endif
-#endif
-
-#ifndef FN_SEP
-#define FN_SEP '/'
-#endif
-
-#ifndef FN_ALT
-#define FN_ALT ','
-#endif
-
-#ifndef PATHLEN
-#define PATHLEN 128
-#endif
-
-#ifndef Temporary_File
-#define Temporary_File "Inftemp"
-#endif
-
-#ifndef DEFAULT_ERROR_FORMAT
-#define DEFAULT_ERROR_FORMAT 0
-#endif
-
-#ifndef DEFAULT_MEMORY_SIZE
-#define DEFAULT_MEMORY_SIZE LARGE_SIZE
-#endif
-
-#ifndef CHAR_IS_UNSIGNED
- typedef unsigned char uchar;
-#else
- typedef char uchar;
-#endif
-
-#if defined(__GNUC__) || defined(__clang__)
-#define NORETURN __attribute__((__noreturn__))
-#endif /* defined(__GNUC__) || defined(__clang__) */
-
-#ifndef NORETURN
-#define NORETURN
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* A macro (rather than constant) definition: */
-/* ------------------------------------------------------------------------- */
-
-#ifdef PC_QUICKC
- void _huge * halloc(long, size_t);
- void hfree(void *);
-#define subtract_pointers(p1,p2) (long)((char _huge *)p1-(char _huge *)p2)
-#else
-#define subtract_pointers(p1,p2) (((char *) p1)-((char *) p2))
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* SEEK_SET is a constant which should be defined in the ANSI header files */
-/* but which is not present in some implementations: it's used as a */
-/* parameter for "fseek", defined in "stdio". In pre-ANSI C, the value */
-/* 0 was used as a parameter instead, hence the definition below. */
-/* ------------------------------------------------------------------------- */
-
-#ifndef SEEK_SET
-#define SEEK_SET 0
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* A large block of #define'd constant values follows. */
-/* ------------------------------------------------------------------------- */
-
-#define TRUE -1
-#define FALSE 0
-
-/* These checked the glulx_mode global during development, but are no
- longer needed. */
-#define ASSERT_ZCODE() (0)
-#define ASSERT_GLULX() (0)
-
-
-#define ReadInt32(ptr) \
- ( (((int32)(((uchar *)(ptr))[0])) << 24) \
- | (((int32)(((uchar *)(ptr))[1])) << 16) \
- | (((int32)(((uchar *)(ptr))[2])) << 8) \
- | (((int32)(((uchar *)(ptr))[3])) ) )
-
-#define ReadInt16(ptr) \
- ( (((int32)(((uchar *)(ptr))[0])) << 8) \
- | (((int32)(((uchar *)(ptr))[1])) ) )
-
-#define WriteInt32(ptr, val) \
- ((ptr)[0] = (uchar)(((int32)(val)) >> 24), \
- (ptr)[1] = (uchar)(((int32)(val)) >> 16), \
- (ptr)[2] = (uchar)(((int32)(val)) >> 8), \
- (ptr)[3] = (uchar)(((int32)(val)) ) )
-
-#define WriteInt16(ptr, val) \
- ((ptr)[0] = (uchar)(((int32)(val)) >> 8), \
- (ptr)[1] = (uchar)(((int32)(val)) ) )
-
-/* ------------------------------------------------------------------------- */
-/* If your compiler doesn't recognise \t, and you use ASCII, you could */
-/* define T_C as (char) 9; failing that, it _must_ be defined as ' ' */
-/* (space) and is _not_ allowed to be 0 or any recognisable character. */
-/* ------------------------------------------------------------------------- */
-
-#define TAB_CHARACTER '\t'
-
-/* ------------------------------------------------------------------------- */
-/* Maxima. */
-/* ------------------------------------------------------------------------- */
-
-#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
-
-#define VENEER_CONSTRAINT_ON_CLASSES_Z 256
-#define VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_Z 128
-#define VENEER_CONSTRAINT_ON_CLASSES_G 32768
-#define VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_G 32768
-#define VENEER_CONSTRAINT_ON_CLASSES \
- (glulx_mode ? VENEER_CONSTRAINT_ON_CLASSES_G \
- : VENEER_CONSTRAINT_ON_CLASSES_Z)
-#define VENEER_CONSTRAINT_ON_IP_TABLE_SIZE \
- (glulx_mode ? VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_G \
- : VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_Z)
-
-#define GLULX_HEADER_SIZE 36
-/* Number of bytes in the header. */
-#define GLULX_STATIC_ROM_SIZE 24
-/* Number of bytes in the Inform-specific block right after the header. */
-#define GPAGESIZE 256
-/* All Glulx memory boundaries must be multiples of GPAGESIZE. */
-
-/* ------------------------------------------------------------------------- */
-/* Structure definitions (there are a few others local to files) */
-/* ------------------------------------------------------------------------- */
-
-typedef struct assembly_operand_t
-{ int type;
- int32 value;
- int symtype; /* 6.30 */
- int symflags; /* 6.30 */
- int marker;
-} assembly_operand;
-
-#define INITAOTV(aop, typ, val) ((aop)->type=(typ), (aop)->value=(val), (aop)->marker=0, (aop)->symtype=0, (aop)->symflags=0)
-#define INITAOT(aop, typ) INITAOTV(aop, typ, 0)
-#define INITAO(aop) INITAOTV(aop, 0, 0)
-
-#define MAX_LINES_PER_VERB 32
-typedef struct verbt {
- int lines;
- int l[MAX_LINES_PER_VERB];
-} verbt;
-
-typedef struct prop {
- uchar l, num;
- assembly_operand ao[32];
-} prop;
-
-/* Only one of this object. */
-typedef struct fpropt {
- uchar atts[6];
- int l;
- prop pp[64];
-} fpropt;
-
-typedef struct objecttz {
- uchar atts[6];
- int parent, next, child;
- int propsize;
-} objecttz;
-
-typedef struct propg {
- int num;
- int continuation;
- int flags;
- int32 datastart;
- int32 datalen;
-} propg;
-
-/* Only one of this object. */
-typedef struct fproptg {
- uchar atts[MAX_NUM_ATTR_BYTES];
- int numprops;
- propg *props;
- int propdatasize;
- assembly_operand *propdata;
- int32 finalpropaddr;
-} fproptg;
-
-typedef struct objecttg {
- /* attributes are stored in a separate array */
- int32 shortname;
- int32 parent, next, child;
- int32 propaddr;
- int32 propsize;
-} objecttg;
-
-typedef struct maybe_file_position_S
-{ int valid;
- fpos_t position;
-} maybe_file_position;
-
-typedef struct debug_location_s
-{ int32 file_index;
- int32 beginning_byte_index;
- int32 end_byte_index;
- int32 beginning_line_number;
- int32 end_line_number;
- int32 beginning_character_number;
- int32 end_character_number;
- int32 orig_file_index;
- int32 orig_beg_line_number;
- int32 orig_beg_char_number;
- /* We only track the beginning #origsource location, not the end. */
-} debug_location;
-
-typedef struct debug_locations_s
-{ debug_location location;
- struct debug_locations_s *next;
- 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;
- int32 beginning_line_number;
- int32 beginning_character_number;
- int32 orig_file_index;
- int32 orig_beg_line_number;
- int32 orig_beg_char_number;
-} debug_location_beginning;
-
-typedef struct keyword_group_s
-{ char *keywords[120];
- int change_token_type;
- int enabled;
- int case_sensitive;
-} keyword_group;
-
-typedef struct token_data_s
-{ char *text;
- int32 value; /* ###-long */
- int type;
- int symtype; /* 6.30 */
- int symflags; /* 6.30 */
- int marker;
- debug_location location;
-} token_data;
-
-typedef struct FileId_s /* Source code file identifier: */
-{ char *filename; /* The filename (after translation) */
- FILE *handle; /* Handle of file (when open), or
- NULL when closed */
- int is_input; /* Is this a source file that we are
- parsing? If not, this is an
- origsource filename (and handle
- is NULL). */
-} FileId;
-
-typedef struct ErrorPosition_s
-{ int file_number;
- char *source;
- int line_number;
- int main_flag;
- int orig_file;
- char *orig_source;
- int32 orig_line;
- int32 orig_char;
-} ErrorPosition;
-
-/* A memory block can hold at most ALLOC_CHUNK_SIZE * 72: */
-
-extern int ALLOC_CHUNK_SIZE;
-
-typedef struct memory_block_s
-{ int chunks;
- int extent_of_last;
- uchar *chunk[72];
- int write_pos;
-} memory_block;
-
-/* This serves for both Z-code and Glulx instructions. Glulx doesn't use
- the text, store_variable_number, branch_label_number, or branch_flag
- fields. */
-typedef struct assembly_instruction_t
-{ int internal_number;
- int store_variable_number;
- int32 branch_label_number;
- int branch_flag;
- char *text;
- int operand_count;
- assembly_operand operand[8];
-} assembly_instruction;
-
-typedef struct expression_tree_node_s
-{
- /* Data used in tree construction */
-
- int up, down, right;
- int operator_number; /* Only meaningful for non-leaves */
- assembly_operand value; /* Only meaningful for leaves */
-
- /* Attributes synthesised during code generation */
-
- int must_produce_value; /* e.g. FALSE in a void context */
-
- int label_after; /* -1, or "put this label after code" */
- int to_expression; /* TRUE if a condition used as numeric val */
- int true_label; /* On condition "true", jump to this (or keep
- going if -1) */
- int false_label; /* Likewise if the condition is "false". */
-
-} expression_tree_node;
-
-typedef struct operator_s
-{ int precedence; /* Level 0 to 13 (13 is highest) */
- int token_type; /* Lexical token type */
- int token_value; /* Lexical token value */
- int usage; /* Infix (IN_U), prefix or postfix */
- int associativity; /* Left (L_A), right (R_A)
- or 0 for "it is an error to
- implicitly associate this" */
- int requires_lvalue; /* TRUE if the first operand must
- be an "lvalue" (the name of some
- storage object, such as a variable
- or an array entry) */
- int opcode_number_z; /* Translation number (see below) */
- int opcode_number_g; /* Translation number (see below) */
- int side_effect; /* TRUE if evaluating the operator
- has potential side-effects in
- terms of changing the Z-machine */
- int negation; /* 0 for an unconditional operator,
- otherwise the negation operator */
- char *description; /* Text describing the operator
- for error messages and tracing */
-} operator;
-
-/* The translation number of an operator is as follows:
-
- Z-code:
- an internal opcode number if the operator can be translated
- directly to a single Z-machine opcode;
- 400+n if it can be translated to branch opcode n;
- 800+n if to the negated form of branch opcode n;
- (using n = 200, 201 for two conditions requiring special
- translation)
- -1 otherwise
- Glulx:
- an internal opcode number if the operator can be translated
- directly to a single Glulx opcode;
- FIRST_CC to LAST_CC if it is a condition;
- -1 otherwise */
-
-/* ------------------------------------------------------------------------- */
-/* Assembly operand types. */
-/* ------------------------------------------------------------------------- */
-
-/* For Z-machine... */
-
-#define LONG_CONSTANT_OT 0 /* General constant */
-#define SHORT_CONSTANT_OT 1 /* Constant in range 0 to 255 */
-#define VARIABLE_OT 2 /* Variable (global, local or sp) */
-#define OMITTED_OT 3 /* Value used in type field to indicate
- that no operand is supplied */
-#define EXPRESSION_OT 4 /* Meaning: to determine this value, run code
- equivalent to the expression tree whose
- root node-number is the value given */
-
-/* For Glulx... */
-
-/* #define OMITTED_OT 3 */ /* Same as above */
-/* #define EXPRESSION_OT 4 */ /* Same as above */
-#define CONSTANT_OT 5 /* Four-byte constant */
-#define HALFCONSTANT_OT 6 /* Two-byte constant */
-#define BYTECONSTANT_OT 7 /* One-byte constant */
-#define ZEROCONSTANT_OT 8 /* Constant zero (no bytes of data) */
-#define SYSFUN_OT 9 /* System function value */
-#define DEREFERENCE_OT 10 /* Value at this address */
-#define GLOBALVAR_OT 11 /* Global variable */
-#define LOCALVAR_OT 12 /* Local variable or sp */
-
-/* ------------------------------------------------------------------------- */
-/* Internal numbers representing assemble-able Z-opcodes */
-/* ------------------------------------------------------------------------- */
-
-#define je_zc 0
-#define jl_zc 1
-#define jg_zc 2
-#define dec_chk_zc 3
-#define inc_chk_zc 4
-#define jin_zc 5
-#define test_zc 6
-#define or_zc 7
-#define and_zc 8
-#define test_attr_zc 9
-#define set_attr_zc 10
-#define clear_attr_zc 11
-#define store_zc 12
-#define insert_obj_zc 13
-#define loadw_zc 14
-#define loadb_zc 15
-#define get_prop_zc 16
-#define get_prop_addr_zc 17
-#define get_next_prop_zc 18
-#define add_zc 19
-#define sub_zc 20
-#define mul_zc 21
-#define div_zc 22
-#define mod_zc 23
-#define call_zc 24
-#define storew_zc 25
-#define storeb_zc 26
-#define put_prop_zc 27
-#define sread_zc 28
-#define print_char_zc 29
-#define print_num_zc 30
-#define random_zc 31
-#define push_zc 32
-#define pull_zc 33
-#define split_window_zc 34
-#define set_window_zc 35
-#define output_stream_zc 36
-#define input_stream_zc 37
-#define sound_effect_zc 38
-#define jz_zc 39
-#define get_sibling_zc 40
-#define get_child_zc 41
-#define get_parent_zc 42
-#define get_prop_len_zc 43
-#define inc_zc 44
-#define dec_zc 45
-#define print_addr_zc 46
-#define remove_obj_zc 47
-#define print_obj_zc 48
-#define ret_zc 49
-#define jump_zc 50
-#define print_paddr_zc 51
-#define load_zc 52
-#define not_zc 53
-#define rtrue_zc 54
-#define rfalse_zc 55
-#define print_zc 56
-#define print_ret_zc 57
-#define nop_zc 58
-#define save_zc 59
-#define restore_zc 60
-#define restart_zc 61
-#define ret_popped_zc 62
-#define pop_zc 63
-#define quit_zc 64
-#define new_line_zc 65
-#define show_status_zc 66
-#define verify_zc 67
-#define call_2s_zc 68
-#define call_vs_zc 69
-#define aread_zc 70
-#define call_vs2_zc 71
-#define erase_window_zc 72
-#define erase_line_zc 73
-#define set_cursor_zc 74
-#define get_cursor_zc 75
-#define set_text_style_zc 76
-#define buffer_mode_zc 77
-#define read_char_zc 78
-#define scan_table_zc 79
-#define call_1s_zc 80
-#define call_2n_zc 81
-#define set_colour_zc 82
-#define throw_zc 83
-#define call_vn_zc 84
-#define call_vn2_zc 85
-#define tokenise_zc 86
-#define encode_text_zc 87
-#define copy_table_zc 88
-#define print_table_zc 89
-#define check_arg_count_zc 90
-#define call_1n_zc 91
-#define catch_zc 92
-#define piracy_zc 93
-#define log_shift_zc 94
-#define art_shift_zc 95
-#define set_font_zc 96
-#define save_undo_zc 97
-#define restore_undo_zc 98
-#define draw_picture_zc 99
-#define picture_data_zc 100
-#define erase_picture_zc 101
-#define set_margins_zc 102
-#define move_window_zc 103
-#define window_size_zc 104
-#define window_style_zc 105
-#define get_wind_prop_zc 106
-#define scroll_window_zc 107
-#define pop_stack_zc 108
-#define read_mouse_zc 109
-#define mouse_window_zc 110
-#define push_stack_zc 111
-#define put_wind_prop_zc 112
-#define print_form_zc 113
-#define make_menu_zc 114
-#define picture_table_zc 115
-#define print_unicode_zc 116
-#define check_unicode_zc 117
-
-
-/* ------------------------------------------------------------------------- */
-/* Internal numbers representing assemble-able Glulx opcodes */
-/* ------------------------------------------------------------------------- */
-
-#define nop_gc 0
-#define add_gc 1
-#define sub_gc 2
-#define mul_gc 3
-#define div_gc 4
-#define mod_gc 5
-#define neg_gc 6
-#define bitand_gc 7
-#define bitor_gc 8
-#define bitxor_gc 9
-#define bitnot_gc 10
-#define shiftl_gc 11
-#define sshiftr_gc 12
-#define ushiftr_gc 13
-#define jump_gc 14
-#define jz_gc 15
-#define jnz_gc 16
-#define jeq_gc 17
-#define jne_gc 18
-#define jlt_gc 19
-#define jge_gc 20
-#define jgt_gc 21
-#define jle_gc 22
-#define jltu_gc 23
-#define jgeu_gc 24
-#define jgtu_gc 25
-#define jleu_gc 26
-#define call_gc 27
-#define return_gc 28
-#define catch_gc 29
-#define throw_gc 30
-#define tailcall_gc 31
-#define copy_gc 32
-#define copys_gc 33
-#define copyb_gc 34
-#define sexs_gc 35
-#define sexb_gc 36
-#define aload_gc 37
-#define aloads_gc 38
-#define aloadb_gc 39
-#define aloadbit_gc 40
-#define astore_gc 41
-#define astores_gc 42
-#define astoreb_gc 43
-#define astorebit_gc 44
-#define stkcount_gc 45
-#define stkpeek_gc 46
-#define stkswap_gc 47
-#define stkroll_gc 48
-#define stkcopy_gc 49
-#define streamchar_gc 50
-#define streamnum_gc 51
-#define streamstr_gc 52
-#define gestalt_gc 53
-#define debugtrap_gc 54
-#define getmemsize_gc 55
-#define setmemsize_gc 56
-#define jumpabs_gc 57
-#define random_gc 58
-#define setrandom_gc 59
-#define quit_gc 60
-#define verify_gc 61
-#define restart_gc 62
-#define save_gc 63
-#define restore_gc 64
-#define saveundo_gc 65
-#define restoreundo_gc 66
-#define protect_gc 67
-#define glk_gc 68
-#define getstringtbl_gc 69
-#define setstringtbl_gc 70
-#define getiosys_gc 71
-#define setiosys_gc 72
-#define linearsearch_gc 73
-#define binarysearch_gc 74
-#define linkedsearch_gc 75
-#define callf_gc 76
-#define callfi_gc 77
-#define callfii_gc 78
-#define callfiii_gc 79
-#define streamunichar_gc 80
-#define mzero_gc 81
-#define mcopy_gc 82
-#define malloc_gc 83
-#define mfree_gc 84
-#define accelfunc_gc 85
-#define accelparam_gc 86
-#define numtof_gc 87
-#define ftonumz_gc 88
-#define ftonumn_gc 89
-#define ceil_gc 90
-#define floor_gc 91
-#define fadd_gc 92
-#define fsub_gc 93
-#define fmul_gc 94
-#define fdiv_gc 95
-#define fmod_gc 96
-#define sqrt_gc 97
-#define exp_gc 98
-#define log_gc 99
-#define pow_gc 100
-#define sin_gc 101
-#define cos_gc 102
-#define tan_gc 103
-#define asin_gc 104
-#define acos_gc 105
-#define atan_gc 106
-#define atan2_gc 107
-#define jfeq_gc 108
-#define jfne_gc 109
-#define jflt_gc 110
-#define jfle_gc 111
-#define jfgt_gc 112
-#define jfge_gc 113
-#define jisnan_gc 114
-#define jisinf_gc 115
-
-/* ------------------------------------------------------------------------- */
-/* Index numbers into the keyword group "opcode_macros_g" (see "lexer.c") */
-/* ------------------------------------------------------------------------- */
-
-#define pull_gm 0
-#define push_gm 1
-
-
-#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 STATEMENT_TT 100 /* a statement keyword */
-#define SEGMENT_MARKER_TT 101 /* with/has/class etc. */
-#define DIRECTIVE_TT 102 /* a directive keyword */
-#define CND_TT 103 /* in/has/etc. */
-#define SYSFUN_TT 105 /* built-in function */
-#define LOCAL_VARIABLE_TT 106 /* local variable */
-#define OPCODE_NAME_TT 107 /* opcode name */
-#define MISC_KEYWORD_TT 108 /* keyword like "char" used in
- syntax for a statement */
-#define DIR_KEYWORD_TT 109 /* keyword like "meta" used in
- syntax for a directive */
-#define TRACE_KEYWORD_TT 110 /* keyword used in debugging */
-#define SYSTEM_CONSTANT_TT 111 /* such as "code_offset" */
-#define OPCODE_MACRO_TT 112 /* fake opcode for compatibility */
-
-#define OP_TT 200 /* value = operator no */
-#define ENDEXP_TT 201 /* no value */
-#define SUBOPEN_TT 202 /* ( used for subexpr */
-#define SUBCLOSE_TT 203 /* ) used to close subexp */
-#define LARGE_NUMBER_TT 204 /* constant not in range 0-255 */
-#define SMALL_NUMBER_TT 205 /* constant in range 0-255 */
-/* In Glulx, that's the range -0x8000 to 0x7fff instead. */
-#define VARIABLE_TT 206 /* variable name */
-#define DICTWORD_TT 207 /* literal 'word' */
-#define ACTION_TT 208 /* action name */
-
-#define VOID_CONTEXT 1
-#define CONDITION_CONTEXT 2
-#define CONSTANT_CONTEXT 3
-#define QUANTITY_CONTEXT 4
-#define ACTION_Q_CONTEXT 5
-#define ASSEMBLY_CONTEXT 6
-#define ARRAY_CONTEXT 7
-#define FORINIT_CONTEXT 8
-#define RETURN_Q_CONTEXT 9
-
-#define LOWEST_SYSTEM_VAR_NUMBER 249 /* globals 249 to 255 are used
- in compiled code (Z-code
- only; in Glulx, the range can
- change) */
-
-/* ------------------------------------------------------------------------- */
-/* 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 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
-
-/* ------------------------------------------------------------------------- */
-/* Symbol type definitions */
-/* ------------------------------------------------------------------------- */
-
-#define ROUTINE_T 1
-#define LABEL_T 2
-#define GLOBAL_VARIABLE_T 3
-#define ARRAY_T 4
-#define CONSTANT_T 5
-#define ATTRIBUTE_T 6
-#define PROPERTY_T 7
-#define INDIVIDUAL_PROPERTY_T 8
-#define OBJECT_T 9
-#define CLASS_T 10
-#define FAKE_ACTION_T 11
-
-/* ------------------------------------------------------------------------- */
-/* Statusline_flag values */
-/* ------------------------------------------------------------------------- */
-
-#define SCORE_STYLE 0
-#define TIME_STYLE 1
-
-/* ------------------------------------------------------------------------- */
-/* Inform keyword definitions */
-/* ------------------------------------------------------------------------- */
-
-/* Index numbers into the keyword group "directives" (see "lexer.c") */
-
-#define ABBREVIATE_CODE 0
-#define ARRAY_CODE 1
-#define ATTRIBUTE_CODE 2
-#define CLASS_CODE 3
-#define CONSTANT_CODE 4
-#define DEFAULT_CODE 5
-#define DICTIONARY_CODE 6
-#define END_CODE 7
-#define ENDIF_CODE 8
-#define EXTEND_CODE 9
-#define FAKE_ACTION_CODE 10
-#define GLOBAL_CODE 11
-#define IFDEF_CODE 12
-#define IFNDEF_CODE 13
-#define IFNOT_CODE 14
-#define IFV3_CODE 15
-#define IFV5_CODE 16
-#define IFTRUE_CODE 17
-#define IFFALSE_CODE 18
-#define IMPORT_CODE 19
-#define INCLUDE_CODE 20
-#define LINK_CODE 21
-#define LOWSTRING_CODE 22
-#define MESSAGE_CODE 23
-#define NEARBY_CODE 24
-#define OBJECT_CODE 25
-#define ORIGSOURCE_CODE 26
-#define PROPERTY_CODE 27
-#define RELEASE_CODE 28
-#define REPLACE_CODE 29
-#define SERIAL_CODE 30
-#define SWITCHES_CODE 31
-#define STATUSLINE_CODE 32
-#define STUB_CODE 33
-#define SYSTEM_CODE 34
-#define TRACE_CODE 35
-#define UNDEF_CODE 36
-#define VERB_CODE 37
-#define VERSION_CODE 38
-#define ZCHARACTER_CODE 39
-
-#define OPENBLOCK_CODE 100
-#define CLOSEBLOCK_CODE 101
-
-/* Index numbers into the keyword group "statements" (see "lexer.c") */
-
-#define BOX_CODE 0
-#define BREAK_CODE 1
-#define CONTINUE_CODE 2
-#define SDEFAULT_CODE 3
-#define DO_CODE 4
-#define ELSE_CODE 5
-#define FONT_CODE 6
-#define FOR_CODE 7
-#define GIVE_CODE 8
-#define IF_CODE 9
-#define INVERSION_CODE 10
-#define JUMP_CODE 11
-#define MOVE_CODE 12
-#define NEW_LINE_CODE 13
-#define OBJECTLOOP_CODE 14
-#define PRINT_CODE 15
-#define PRINT_RET_CODE 16
-#define QUIT_CODE 17
-#define READ_CODE 18
-#define REMOVE_CODE 19
-#define RESTORE_CODE 20
-#define RETURN_CODE 21
-#define RFALSE_CODE 22
-#define RTRUE_CODE 23
-#define SAVE_CODE 24
-#define SPACES_CODE 25
-#define STRING_CODE 26
-#define STYLE_CODE 27
-#define SWITCH_CODE 28
-#define UNTIL_CODE 29
-#define WHILE_CODE 30
-
-#define ASSIGNMENT_CODE 100
-#define FUNCTION_CODE 101
-
-/* Index numbers into the keyword group "conditions" (see "lexer.c") */
-
-#define HAS_COND 0
-#define HASNT_COND 1
-#define IN_COND 2
-#define NOTIN_COND 3
-#define OFCLASS_COND 4
-#define OR_COND 5
-#define PROVIDES_COND 6
-
-/* Index numbers into the keyword group "segment_markers" (see "lexer.c") */
-
-#define CLASS_SEGMENT 0
-#define HAS_SEGMENT 1
-#define PRIVATE_SEGMENT 2
-#define WITH_SEGMENT 3
-
-/* Index numbers into the keyword group "misc_keywords" (see "lexer.c") */
-
-#define CHAR_MK 0
-#define NAME_MK 1
-#define THE_MK 2
-#define A_MK 3
-#define AN_MK 4
-#define CAP_THE_MK 5
-#define NUMBER_MK 6
-#define ROMAN_MK 7
-#define REVERSE_MK 8
-#define BOLD_MK 9
-#define UNDERLINE_MK 10
-#define FIXED_MK 11
-#define ON_MK 12
-#define OFF_MK 13
-#define TO_MK 14
-#define ADDRESS_MK 15
-#define STRING_MK 16
-#define OBJECT_MK 17
-#define NEAR_MK 18
-#define FROM_MK 19
-#define PROPERTY_MK 20
-#define CAP_A_MK 21
-
-/* Index numbers into the keyword group "directive_keywords" (see "lexer.c") */
-
-#define ALIAS_DK 0
-#define LONG_DK 1
-#define ADDITIVE_DK 2
-#define SCORE_DK 3
-#define TIME_DK 4
-#define NOUN_DK 5
-#define HELD_DK 6
-#define MULTI_DK 7
-#define MULTIHELD_DK 8
-#define MULTIEXCEPT_DK 9
-#define MULTIINSIDE_DK 10
-#define CREATURE_DK 11
-#define SPECIAL_DK 12
-#define NUMBER_DK 13
-#define SCOPE_DK 14
-#define TOPIC_DK 15
-#define REVERSE_DK 16
-#define META_DK 17
-#define ONLY_DK 18
-#define REPLACE_DK 19
-#define FIRST_DK 20
-#define LAST_DK 21
-#define STRING_DK 22
-#define TABLE_DK 23
-#define BUFFER_DK 24
-#define DATA_DK 25
-#define INITIAL_DK 26
-#define INITSTR_DK 27
-#define WITH_DK 28
-#define PRIVATE_DK 29
-#define HAS_DK 30
-#define CLASS_DK 31
-#define ERROR_DK 32
-#define FATALERROR_DK 33
-#define WARNING_DK 34
-#define TERMINATING_DK 35
-
-/* Index numbers into the keyword group "trace_keywords" (see "lexer.c") */
-
-#define DICTIONARY_TK 0
-#define SYMBOLS_TK 1
-#define OBJECTS_TK 2
-#define VERBS_TK 3
-#define ASSEMBLY_TK 4
-#define EXPRESSIONS_TK 5
-#define LINES_TK 6
-#define TOKENS_TK 7
-#define LINKER_TK 8
-#define ON_TK 9
-#define OFF_TK 10
-
-/* Index numbers into the keyword group "system_constants" (see "lexer.c") */
-
-#define NO_SYSTEM_CONSTANTS 62
-
-#define adjectives_table_SC 0
-#define actions_table_SC 1
-#define classes_table_SC 2
-#define identifiers_table_SC 3
-#define preactions_table_SC 4
-#define version_number_SC 5
-#define largest_object_SC 6
-#define strings_offset_SC 7
-#define code_offset_SC 8
-#define dict_par1_SC 9
-#define dict_par2_SC 10
-#define dict_par3_SC 11
-#define actual_largest_object_SC 12
-#define static_memory_offset_SC 13
-#define array_names_offset_SC 14
-#define readable_memory_offset_SC 15
-#define cpv__start_SC 16
-#define cpv__end_SC 17
-#define ipv__start_SC 18
-#define ipv__end_SC 19
-#define array__start_SC 20
-#define array__end_SC 21
-
-#define lowest_attribute_number_SC 22
-#define highest_attribute_number_SC 23
-#define attribute_names_array_SC 24
-
-#define lowest_property_number_SC 25
-#define highest_property_number_SC 26
-#define property_names_array_SC 27
-
-#define lowest_action_number_SC 28
-#define highest_action_number_SC 29
-#define action_names_array_SC 30
-
-#define lowest_fake_action_number_SC 31
-#define highest_fake_action_number_SC 32
-#define fake_action_names_array_SC 33
-
-#define lowest_routine_number_SC 34
-#define highest_routine_number_SC 35
-#define routines_array_SC 36
-#define routine_names_array_SC 37
-#define routine_flags_array_SC 38
-
-#define lowest_global_number_SC 39
-#define highest_global_number_SC 40
-#define globals_array_SC 41
-#define global_names_array_SC 42
-#define global_flags_array_SC 43
-
-#define lowest_array_number_SC 44
-#define highest_array_number_SC 45
-#define arrays_array_SC 46
-#define array_names_array_SC 47
-#define array_flags_array_SC 48
-
-#define lowest_constant_number_SC 49
-#define highest_constant_number_SC 50
-#define constants_array_SC 51
-#define constant_names_array_SC 52
-
-#define lowest_class_number_SC 53
-#define highest_class_number_SC 54
-#define class_objects_array_SC 55
-
-#define lowest_object_number_SC 56
-#define highest_object_number_SC 57
-
-#define oddeven_packing_SC 58
-
-#define grammar_table_SC 59 /* Glulx-only */
-#define dictionary_table_SC 60 /* Glulx-only */
-#define dynam_string_table_SC 61 /* Glulx-only */
-
-
-/* Index numbers into the keyword group "system_functions" (see "lexer.c") */
-
-#define NUMBER_SYSTEM_FUNCTIONS 12
-
-#define CHILD_SYSF 0
-#define CHILDREN_SYSF 1
-#define ELDER_SYSF 2
-#define ELDEST_SYSF 3
-#define INDIRECT_SYSF 4
-#define PARENT_SYSF 5
-#define RANDOM_SYSF 6
-#define SIBLING_SYSF 7
-#define YOUNGER_SYSF 8
-#define YOUNGEST_SYSF 9
-#define METACLASS_SYSF 10
-#define GLK_SYSF 11 /* Glulx-only */
-
-/* Index numbers into the operators group "separators" (see "lexer.c") */
-
-#define NUMBER_SEPARATORS 49
-
-#define ARROW_SEP 0
-#define DARROW_SEP 1
-#define DEC_SEP 2
-#define MINUS_SEP 3
-#define INC_SEP 4
-#define PLUS_SEP 5
-#define TIMES_SEP 6
-#define DIVIDE_SEP 7
-#define REMAINDER_SEP 8
-#define LOGOR_SEP 9
-#define ARTOR_SEP 10
-#define LOGAND_SEP 11
-#define ARTAND_SEP 12
-#define LOGNOT_SEP 13
-#define NOTEQUAL_SEP 14
-#define ARTNOT_SEP 15
-#define CONDEQUALS_SEP 16
-#define SETEQUALS_SEP 17
-#define GE_SEP 18
-#define GREATER_SEP 19
-#define LE_SEP 20
-#define LESS_SEP 21
-#define OPENB_SEP 22
-#define CLOSEB_SEP 23
-#define COMMA_SEP 24
-#define PROPADD_SEP 25
-#define PROPNUM_SEP 26
-#define MPROPADD_SEP 27
-#define MPROPNUM_SEP 28
-#define MESSAGE_SEP 29
-#define PROPERTY_SEP 30
-#define SUPERCLASS_SEP 31
-#define COLON_SEP 32
-#define AT_SEP 33
-#define SEMICOLON_SEP 34
-#define OPEN_SQUARE_SEP 35
-#define CLOSE_SQUARE_SEP 36
-#define OPEN_BRACE_SEP 37
-#define CLOSE_BRACE_SEP 38
-#define DOLLAR_SEP 39
-#define NBRANCH_SEP 40
-#define BRANCH_SEP 41
-#define HASHADOLLAR_SEP 42
-#define HASHGDOLLAR_SEP 43
-#define HASHNDOLLAR_SEP 44
-#define HASHRDOLLAR_SEP 45
-#define HASHWDOLLAR_SEP 46
-#define HASHHASH_SEP 47
-#define HASH_SEP 48
-
-#define UNARY_MINUS_SEP 100
-#define POST_INC_SEP 101
-#define POST_DEC_SEP 102
-
-/* ------------------------------------------------------------------------- */
-/* Internal numbers used to refer to operators (in expressions) */
-/* (must correspond to entries in the operators table in "express.c") */
-/* ------------------------------------------------------------------------- */
-
-#define NUM_OPERATORS 68
-
-#define PRE_U 1
-#define IN_U 2
-#define POST_U 3
-
-#define R_A 1
-#define L_A 2
-
-#define COMMA_OP 0
-#define SETEQUALS_OP 1
-#define LOGAND_OP 2
-#define LOGOR_OP 3
-#define LOGNOT_OP 4
-
-#define ZERO_OP 5
-#define NONZERO_OP 6
-#define CONDEQUALS_OP 7
-#define NOTEQUAL_OP 8
-#define GE_OP 9
-#define GREATER_OP 10
-#define LE_OP 11
-#define LESS_OP 12
-#define HAS_OP 13
-#define HASNT_OP 14
-#define IN_OP 15
-#define NOTIN_OP 16
-#define OFCLASS_OP 17
-#define PROVIDES_OP 18
-#define NOTOFCLASS_OP 19
-#define NOTPROVIDES_OP 20
-#define OR_OP 21
-
-#define PLUS_OP 22
-#define MINUS_OP 23
-#define TIMES_OP 24
-#define DIVIDE_OP 25
-#define REMAINDER_OP 26
-#define ARTAND_OP 27
-#define ARTOR_OP 28
-#define ARTNOT_OP 29
-#define ARROW_OP 30
-#define DARROW_OP 31
-#define UNARY_MINUS_OP 32
-#define INC_OP 33
-#define POST_INC_OP 34
-#define DEC_OP 35
-#define POST_DEC_OP 36
-#define PROP_ADD_OP 37
-#define PROP_NUM_OP 38
-#define MPROP_ADD_OP 39
-#define MPROP_NUM_OP 40
-#define FCALL_OP 41
-#define MESSAGE_OP 42
-#define PROPERTY_OP 43
-#define SUPERCLASS_OP 44
-
-#define ARROW_SETEQUALS_OP 45
-#define DARROW_SETEQUALS_OP 46
-#define MESSAGE_SETEQUALS_OP 47
-#define PROPERTY_SETEQUALS_OP 48
-
-#define ARROW_INC_OP 49
-#define DARROW_INC_OP 50
-#define MESSAGE_INC_OP 51
-#define PROPERTY_INC_OP 52
-
-#define ARROW_DEC_OP 53
-#define DARROW_DEC_OP 54
-#define MESSAGE_DEC_OP 55
-#define PROPERTY_DEC_OP 56
-
-#define ARROW_POST_INC_OP 57
-#define DARROW_POST_INC_OP 58
-#define MESSAGE_POST_INC_OP 59
-#define PROPERTY_POST_INC_OP 60
-
-#define ARROW_POST_DEC_OP 61
-#define DARROW_POST_DEC_OP 62
-#define MESSAGE_POST_DEC_OP 63
-#define PROPERTY_POST_DEC_OP 64
-
-#define PROP_CALL_OP 65
-#define MESSAGE_CALL_OP 66
-
-#define PUSH_OP 67 /* Glulx only */
-
-/* ------------------------------------------------------------------------- */
-/* The five types of compiled array */
-/* ------------------------------------------------------------------------- */
-
-#define BYTE_ARRAY 0
-#define WORD_ARRAY 1
-#define STRING_ARRAY 2
-#define TABLE_ARRAY 3
-#define BUFFER_ARRAY 4
-
-/* ------------------------------------------------------------------------- */
-/* Internal numbers used to refer to veneer routines */
-/* (must correspond to entries in the table in "veneer.c") */
-/* ------------------------------------------------------------------------- */
-
-#define VENEER_ROUTINES 48
-
-#define Box__Routine_VR 0
-
-#define R_Process_VR 1
-#define DefArt_VR 2
-#define InDefArt_VR 3
-#define CDefArt_VR 4
-#define CInDefArt_VR 5
-#define PrintShortName_VR 6
-#define EnglishNumber_VR 7
-#define Print__Pname_VR 8
-
-#define WV__Pr_VR 9
-#define RV__Pr_VR 10
-#define CA__Pr_VR 11
-#define IB__Pr_VR 12
-#define IA__Pr_VR 13
-#define DB__Pr_VR 14
-#define DA__Pr_VR 15
-#define RA__Pr_VR 16
-#define RL__Pr_VR 17
-#define RA__Sc_VR 18
-#define OP__Pr_VR 19
-#define OC__Cl_VR 20
-
-#define Copy__Primitive_VR 21
-#define RT__Err_VR 22
-#define Z__Region_VR 23
-#define Unsigned__Compare_VR 24
-#define Metaclass_VR 25
-#define CP__Tab_VR 26
-#define Cl__Ms_VR 27
-#define RT__ChT_VR 28
-#define RT__ChR_VR 29
-#define RT__ChG_VR 30
-#define RT__ChGt_VR 31
-#define RT__ChPS_VR 32
-#define RT__ChPR_VR 33
-#define RT__TrPS_VR 34
-#define RT__ChLDB_VR 35
-#define RT__ChLDW_VR 36
-#define RT__ChSTB_VR 37
-#define RT__ChSTW_VR 38
-#define RT__ChPrintC_VR 39
-#define RT__ChPrintA_VR 40
-#define RT__ChPrintS_VR 41
-#define RT__ChPrintO_VR 42
-
-/* Glulx-only veneer routines */
-#define OB__Move_VR 43
-#define OB__Remove_VR 44
-#define Print__Addr_VR 45
-#define Glk__Wrap_VR 46
-#define Dynam__String_VR 47
-
-/* ------------------------------------------------------------------------- */
-/* Run-time-error numbers (must correspond with RT__Err code in veneer) */
-/* ------------------------------------------------------------------------- */
-
-#define IN_RTE 2
-#define HAS_RTE 3
-#define PARENT_RTE 4
-#define ELDEST_RTE 5
-#define CHILD_RTE 6
-#define YOUNGER_RTE 7
-#define SIBLING_RTE 8
-#define CHILDREN_RTE 9
-#define YOUNGEST_RTE 10
-#define ELDER_RTE 11
-#define OBJECTLOOP_RTE 12
-#define OBJECTLOOP2_RTE 13
-#define GIVE_RTE 14
-#define REMOVE_RTE 15
-#define MOVE1_RTE 16
-#define MOVE2_RTE 17
-/* 18 = creating a loop in object tree */
-/* 19 = giving a non-existent attribute */
-#define DBYZERO_RTE 20
-#define PROP_ADD_RTE 21
-#define PROP_NUM_RTE 22
-#define PROPERTY_RTE 23
-/* 24 = reading with -> out of range */
-/* 25 = reading with --> out of range */
-/* 26 = writing with -> out of range */
-/* 27 = writing with --> out of range */
-#define ABOUNDS_RTE 28
-/* similarly 29, 30, 31 */
-#define OBJECTLOOP_BROKEN_RTE 32
-/* 33 = print (char) out of range */
-/* 34 = print (address) out of range */
-/* 35 = print (string) out of range */
-/* 36 = print (object) out of range */
-
-/* ------------------------------------------------------------------------- */
-/* Z-region areas (used to refer to module positions in markers) */
-/* ------------------------------------------------------------------------- */
-
-#define LOW_STRINGS_ZA 1
-#define PROP_DEFAULTS_ZA 2
-#define OBJECT_TREE_ZA 3
-#define PROP_ZA 4
-#define CLASS_NUMBERS_ZA 5
-#define INDIVIDUAL_PROP_ZA 6
-#define DYNAMIC_ARRAY_ZA 7 /* Z-code only */
-#define GRAMMAR_ZA 8
-#define ACTIONS_ZA 9
-#define PREACTIONS_ZA 10
-#define ADJECTIVES_ZA 11
-#define DICTIONARY_ZA 12
-#define ZCODE_ZA 13
-#define STATIC_STRINGS_ZA 14
-#define LINK_DATA_ZA 15
-
-#define SYMBOLS_ZA 16
-
-#define ARRAY_ZA 17 /* Glulx only */
-#define GLOBALVAR_ZA 18 /* Glulx only */
-
-/* ------------------------------------------------------------------------- */
-/* "Marker values", used for backpatching and linkage */
-/* ------------------------------------------------------------------------- */
-
-#define NULL_MV 0 /* Null */
-
-/* Marker values used in backpatch areas: */
-
-#define DWORD_MV 1 /* Dictionary word address */
-#define STRING_MV 2 /* Static string */
-#define INCON_MV 3 /* "Hardware" constant (table address) */
-#define IROUTINE_MV 4 /* Call to internal routine */
-#define VROUTINE_MV 5 /* Call to veneer routine */
-#define ARRAY_MV 6 /* Ref to internal array address */
-#define NO_OBJS_MV 7 /* Ref to number of game objects */
-#define INHERIT_MV 8 /* Inherited property value */
-#define INHERIT_INDIV_MV 9 /* Inherited indiv property value */
-#define MAIN_MV 10 /* "Main" routine */
-#define SYMBOL_MV 11 /* Forward ref to unassigned symbol */
-
-/* Additional marker values used in module backpatch areas: */
-/* (In Glulx, OBJECT_MV and VARIABLE_MV are used in backpatching, even
- without modules.) */
-
-#define VARIABLE_MV 12 /* Global variable */
-#define IDENT_MV 13 /* Property identifier number */
-#define INDIVPT_MV 14 /* Individual prop table address */
-#define ACTION_MV 15 /* Action number */
-#define OBJECT_MV 16 /* Ref to internal object number */
-
-#define LARGEST_BPATCH_MV 16 /* Larger marker values are never written
- to backpatch tables */
-
-/* Value indicating an imported symbol record: */
-
-#define IMPORT_MV 32
-
-/* Values indicating an exported symbol record: */
-
-#define EXPORT_MV 33 /* Defined ordinarily */
-#define EXPORTSF_MV 34 /* Defined in a system file */
-#define EXPORTAC_MV 35 /* Action name */
-
-/* Values used only in branch backpatching: */
-/* ###-I've rearranged these, so that BRANCH_MV can be last; Glulx uses the
- whole range from BRANCH_MV to BRANCHMAX_MV. */
-
-#define LABEL_MV 36 /* Ditto: marks "jump" operands */
-#define DELETED_MV 37 /* Ditto: marks bytes deleted from code */
-#define BRANCH_MV 38 /* Used in "asm.c" for routine coding */
-#define BRANCHMAX_MV 58 /* In fact, the range BRANCH_MV to
- BRANCHMAX_MV all means the same thing.
- The position within the range means
- how far back from the label to go
- to find the opmode byte to modify. */
-
-/* ========================================================================= */
-/* Initialisation extern definitions */
-/* */
-/* Note that each subsystem in Inform provides four routines to keep */
-/* track of variables and data structures: */
-/* */
-/* init_*_vars should set variables to initial values (they must */
-/* not be initialised directly in their declarations */
-/* as Inform may need to compile several times in a */
-/* row) */
-/* */
-/* *_begin_pass any variable/array initialisation that needs to */
-/* happen at the start of the pass through the source */
-/* */
-/* *_allocate_arrays should use my_malloc/my_calloc (see memory.c) */
-/* to allocate any arrays or workspace needed */
-/* */
-/* *_free_arrays should use my_free to free all memory allocated */
-/* (with one exception in "text.c") */
-/* */
-/* ========================================================================= */
-
- /* > READ INFORM SOURCE */
-
- /* My Source Book */
-
-extern void init_arrays_vars(void); /* arrays: construct tableaux */
-extern void init_asm_vars(void); /* asm: assemble even rare or v6 codes */
-extern void init_bpatch_vars(void); /* bpatch: backpatches code */
-extern void init_chars_vars(void); /* chars: translate character sets */
-extern void init_directs_vars(void); /* directs: ponder directives */
-extern void init_errors_vars(void); /* errors: issue diagnostics */
-extern void init_expressc_vars(void); /* expressc: compile expressions */
-extern void init_expressp_vars(void); /* expressp: parse expressions */
-extern void init_files_vars(void); /* files: handle files */
- /* void init_vars(void); inform: decide what to do */
-extern void init_lexer_vars(void); /* lexer: lexically analyse source */
-extern void init_linker_vars(void); /* linker: link in pre-compiled module */
-extern void init_memory_vars(void); /* memory: manage memory settings */
-extern void init_objects_vars(void); /* objects: cultivate object tree */
-extern void init_states_vars(void); /* states: translate statements to code*/
-extern void init_symbols_vars(void); /* symbols: construct symbols table */
-extern void init_syntax_vars(void); /* syntax: parse the program */
-extern void init_tables_vars(void); /* tables: glue tables into the output */
-extern void init_text_vars(void); /* text: encode text and dictionary */
-extern void init_veneer_vars(void); /* veneer: compile a layer of code */
-extern void init_verbs_vars(void); /* verbs: lay out grammar */
-
-extern void files_begin_prepass(void); /* These routines initialise just */
-extern void lexer_begin_prepass(void); /* enough to begin loading source */
-
-extern void arrays_begin_pass(void);
-extern void asm_begin_pass(void);
-extern void bpatch_begin_pass(void);
-extern void chars_begin_pass(void);
-extern void directs_begin_pass(void);
-extern void errors_begin_pass(void);
-extern void expressc_begin_pass(void);
-extern void expressp_begin_pass(void);
-extern void files_begin_pass(void);
- /* void begin_pass(void); */
-extern void lexer_begin_pass(void);
-extern void linker_begin_pass(void);
-extern void memory_begin_pass(void);
-extern void objects_begin_pass(void);
-extern void states_begin_pass(void);
-extern void symbols_begin_pass(void);
-extern void syntax_begin_pass(void);
-extern void tables_begin_pass(void);
-extern void text_begin_pass(void);
-extern void veneer_begin_pass(void);
-extern void verbs_begin_pass(void);
-
-extern void lexer_endpass(void);
-extern void linker_endpass(void);
-
-extern void arrays_allocate_arrays(void);
-extern void asm_allocate_arrays(void);
-extern void bpatch_allocate_arrays(void);
-extern void chars_allocate_arrays(void);
-extern void directs_allocate_arrays(void);
-extern void errors_allocate_arrays(void);
-extern void expressc_allocate_arrays(void);
-extern void expressp_allocate_arrays(void);
-extern void files_allocate_arrays(void);
- /* void allocate_arrays(void); */
-extern void lexer_allocate_arrays(void);
-extern void linker_allocate_arrays(void);
-extern void memory_allocate_arrays(void);
-extern void objects_allocate_arrays(void);
-extern void states_allocate_arrays(void);
-extern void symbols_allocate_arrays(void);
-extern void syntax_allocate_arrays(void);
-extern void tables_allocate_arrays(void);
-extern void text_allocate_arrays(void);
-extern void veneer_allocate_arrays(void);
-extern void verbs_allocate_arrays(void);
-
-extern void arrays_free_arrays(void);
-extern void asm_free_arrays(void);
-extern void bpatch_free_arrays(void);
-extern void chars_free_arrays(void);
-extern void directs_free_arrays(void);
-extern void errors_free_arrays(void);
-extern void expressc_free_arrays(void);
-extern void expressp_free_arrays(void);
-extern void files_free_arrays(void);
- /* void free_arrays(void); */
-extern void lexer_free_arrays(void);
-extern void linker_free_arrays(void);
-extern void memory_free_arrays(void);
-extern void objects_free_arrays(void);
-extern void states_free_arrays(void);
-extern void symbols_free_arrays(void);
-extern void syntax_free_arrays(void);
-extern void tables_free_arrays(void);
-extern void text_free_arrays(void);
-extern void veneer_free_arrays(void);
-extern void verbs_free_arrays(void);
-
-/* ========================================================================= */
-/* Remaining extern definitions are given by file in alphabetical order */
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "arrays" */
-/* ------------------------------------------------------------------------- */
-
-extern int no_globals, no_arrays;
-extern int dynamic_array_area_size;
-extern int *dynamic_array_area;
-extern int32 *global_initial_value;
-extern int32 *array_symbols;
-extern int *array_sizes, *array_types;
-
-extern void make_global(int array_flag, int name_only);
-extern void set_variable_value(int i, int32 v);
-extern void check_globals(void);
-extern int32 begin_table_array(void);
-extern int32 begin_word_array(void);
-extern void array_entry(int32 i, assembly_operand VAL);
-extern void finish_array(int32 i);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "asm" */
-/* ------------------------------------------------------------------------- */
-
-extern memory_block zcode_area;
-extern int32 zmachine_pc;
-
-extern int32 no_instructions;
-extern int sequence_point_follows;
-extern int uses_unicode_features, uses_memheap_features,
- uses_acceleration_features, uses_float_features;
-extern debug_location statement_debug_location;
-extern int execution_never_reaches_here;
-extern int *variable_usage;
-extern int next_label, no_sequence_points;
-extern int32 *variable_tokens;
-extern assembly_instruction AI;
-extern int32 *named_routine_symbols;
-
-extern void print_operand(assembly_operand o);
-extern char *variable_name(int32 i);
-extern void set_constant_ot(assembly_operand *AO);
-extern int is_constant_ot(int otval);
-extern int is_variable_ot(int otval);
-extern void assemblez_instruction(assembly_instruction *a);
-extern void assembleg_instruction(assembly_instruction *a);
-extern void assemble_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,
- char *name, int embedded_flag, int the_symbol);
-extern void assemble_routine_end(int embedded_flag, debug_locations locations);
-
-extern void assemblez_0(int internal_number);
-extern void assemblez_0_to(int internal_number, assembly_operand o1);
-extern void assemblez_0_branch(int internal_number, int label, int flag);
-extern void assemblez_1(int internal_number, assembly_operand o1);
-extern void assemblez_1_to(int internal_number,
- assembly_operand o1, assembly_operand st);
-extern void assemblez_1_branch(int internal_number,
- assembly_operand o1, int label, int flag);
-extern void assemblez_objcode(int internal_number,
- assembly_operand o1, assembly_operand st,
- int label, int flag);
-extern void assemblez_2(int internal_number,
- assembly_operand o1, assembly_operand o2);
-extern void assemblez_2_to(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand st);
-extern void assemblez_2_branch(int internal_number,
- assembly_operand o1, assembly_operand o2,
- int label, int flag);
-extern void assemblez_3(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3);
-extern void assemblez_3_branch(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, int label, int flag);
-extern void assemblez_3_to(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, assembly_operand st);
-extern void assemblez_4(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, assembly_operand o4);
-extern void assemblez_5(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, assembly_operand o4,
- assembly_operand o5);
-extern void assemblez_6(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, assembly_operand o4,
- assembly_operand o5, assembly_operand o6);
-extern void assemblez_4_branch(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, assembly_operand o4,
- int label, int flag);
-extern void assemblez_4_to(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, assembly_operand o4,
- assembly_operand st);
-extern void assemblez_5_to(int internal_number,
- assembly_operand o1, assembly_operand o2,
- assembly_operand o3, assembly_operand o4,
- assembly_operand o5, assembly_operand st);
-
-extern void assemblez_inc(assembly_operand o1);
-extern void assemblez_dec(assembly_operand o1);
-extern void assemblez_store(assembly_operand o1, assembly_operand o2);
-extern void assemblez_jump(int n);
-
-extern void assembleg_0(int internal_number);
-extern void assembleg_1(int internal_number, assembly_operand o1);
-extern void assembleg_2(int internal_number, assembly_operand o1,
- assembly_operand o2);
-extern void assembleg_3(int internal_number, assembly_operand o1,
- assembly_operand o2, assembly_operand o3);
-extern void assembleg_4(int internal_number, assembly_operand o1,
- assembly_operand o2, assembly_operand o3, assembly_operand o4);
-extern void assembleg_5(int internal_number, assembly_operand o1,
- assembly_operand o2, assembly_operand o3, assembly_operand o4,
- assembly_operand o5);
-extern void assembleg_0_branch(int internal_number,
- int label);
-extern void assembleg_1_branch(int internal_number,
- assembly_operand o1, int label);
-extern void assembleg_2_branch(int internal_number,
- assembly_operand o1, assembly_operand o2, int label);
-extern void assembleg_call_1(assembly_operand oaddr, assembly_operand o1,
- assembly_operand odest);
-extern void assembleg_call_2(assembly_operand oaddr, assembly_operand o1,
- assembly_operand o2, assembly_operand odest);
-extern void assembleg_call_3(assembly_operand oaddr, assembly_operand o1,
- assembly_operand o2, assembly_operand o3, assembly_operand odest);
-extern void assembleg_inc(assembly_operand o1);
-extern void assembleg_dec(assembly_operand o1);
-extern void assembleg_store(assembly_operand o1, assembly_operand o2);
-extern void assembleg_jump(int n);
-
-extern void parse_assembly(void);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "bpatch" */
-/* ------------------------------------------------------------------------- */
-
-extern memory_block zcode_backpatch_table, zmachine_backpatch_table;
-extern int32 zcode_backpatch_size, zmachine_backpatch_size;
-extern int backpatch_marker, backpatch_error_flag;
-
-extern int32 backpatch_value(int32 value);
-extern void backpatch_zmachine_image_z(void);
-extern void backpatch_zmachine_image_g(void);
-extern void backpatch_zmachine(int mv, int zmachine_area, int32 offset);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "chars" */
-/* ------------------------------------------------------------------------- */
-
-extern uchar source_to_iso_grid[];
-extern int32 iso_to_unicode_grid[];
-extern int character_digit_value[];
-extern uchar alphabet[3][27];
-extern int alphabet_modified;
-extern int zscii_defn_modified;
-extern int zscii_high_water_mark;
-extern char alphabet_used[];
-extern int iso_to_alphabet_grid[];
-extern int zscii_to_alphabet_grid[];
-extern int textual_form_length;
-
-extern int iso_to_unicode(int iso);
-extern int unicode_to_zscii(int32 u);
-extern int32 zscii_to_unicode(int z);
-extern int32 text_to_unicode(char *text);
-extern void zscii_to_text(char *text, int zscii);
-extern char *name_of_iso_set(int s);
-extern void change_character_set(void);
-extern void new_alphabet(char *text, int alphabet);
-extern void new_zscii_character(int32 unicode, int plus_flag);
-extern void new_zscii_finished(void);
-extern void map_new_zchar(int32 unicode);
-extern void make_lower_case(char *str);
-extern void make_upper_case(char *str);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "directs" */
-/* ------------------------------------------------------------------------- */
-
-extern brief_location routine_starts_line;
-
-extern int no_routines, no_named_routines, no_locals, no_termcs;
-extern int terminating_characters[];
-
-extern int parse_given_directive(int internal_flag);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "errors" */
-/* ------------------------------------------------------------------------- */
-
-extern char *forerrors_buff;
-extern int forerrors_pointer;
-extern int no_errors, no_warnings, no_suppressed_warnings,
- no_link_errors, no_compiler_errors;
-
-extern ErrorPosition ErrorReport;
-
-extern void fatalerror(char *s) NORETURN;
-extern void fatalerror_named(char *s1, char *s2) NORETURN;
-extern void memory_out_error(int32 size, int32 howmany, char *name) NORETURN;
-extern void memoryerror(char *s, int32 size) NORETURN;
-extern void error(char *s);
-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 char_error(char *s, int ch);
-extern void unicode_char_error(char *s, int32 uni);
-extern void no_such_label(char *lname);
-extern void warning(char *s);
-extern void warning_numbered(char *s1, int val);
-extern void warning_named(char *s1, char *s2);
-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 void link_error(char *s);
-extern void link_error_named(char *s1, char *s2);
-extern int compiler_error(char *s);
-extern int compiler_error_named(char *s1, char *s2);
-extern void print_sorry_message(void);
-
-#ifdef ARC_THROWBACK
-extern int throwback_switch;
-
-extern void throwback(int severity, char * error);
-extern void throwback_start(void);
-extern void throwback_end(void);
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "expressc" */
-/* ------------------------------------------------------------------------- */
-
-extern int vivc_flag;
-extern operator operators[];
-
-extern assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
- temp_var4, zero_operand, one_operand, two_operand, three_operand,
- four_operand, valueless_operand;
-
-assembly_operand code_generate(assembly_operand AO, int context, int label);
-assembly_operand check_nonzero_at_runtime(assembly_operand AO1, int label,
- int rte_number);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "expressp" */
-/* ------------------------------------------------------------------------- */
-
-extern int system_function_usage[];
-extern expression_tree_node *ET;
-
-extern int z_system_constant_list[];
-extern int glulx_system_constant_list[];
-
-extern int32 value_of_system_constant(int t);
-extern void clear_expression_space(void);
-extern void show_tree(assembly_operand AO, int annotate);
-extern assembly_operand parse_expression(int context);
-extern int test_for_incdec(assembly_operand AO);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "files" */
-/* ------------------------------------------------------------------------- */
-
-extern int total_files;
-extern int current_input_file;
-extern int total_input_files;
-extern FileId *InputFiles;
-
-extern FILE *Temp1_fp, *Temp2_fp, *Temp3_fp;
-extern char Temp1_Name[], Temp2_Name[], Temp3_Name[];
-extern int32 total_chars_read;
-
-extern void open_temporary_files(void);
-extern void check_temp_files(void);
-extern void remove_temp_files(void);
-
-extern void open_transcript_file(char *what_of);
-extern void write_to_transcript_file(char *text);
-extern void close_transcript_file(void);
-extern void abort_transcript_file(void);
-
-extern void nullify_debug_file_position(maybe_file_position *position);
-
-extern void begin_debug_file(void);
-
-extern void debug_file_printf(const char*format, ...);
-extern void debug_file_print_with_entities(const char*string);
-extern void debug_file_print_base_64_triple
- (uchar first, uchar second, uchar third);
-extern void debug_file_print_base_64_pair(uchar first, uchar second);
-extern void debug_file_print_base_64_single(uchar first);
-
-extern void write_debug_location(debug_location location);
-extern void write_debug_locations(debug_locations locations);
-extern void write_debug_optional_identifier(int32 symbol_index);
-extern void write_debug_symbol_backpatch(int32 symbol_index);
-extern void write_debug_symbol_optional_backpatch(int32 symbol_index);
-extern void write_debug_object_backpatch(int32 object_number);
-extern void write_debug_packed_code_backpatch(int32 offset);
-extern void write_debug_code_backpatch(int32 offset);
-extern void write_debug_global_backpatch(int32 offset);
-extern void write_debug_array_backpatch(int32 offset);
-extern void write_debug_grammar_backpatch(int32 offset);
-
-extern void begin_writing_debug_sections(void);
-extern void write_debug_section(const char*name, int32 beginning_address);
-extern void end_writing_debug_sections(int32 end_address);
-
-extern void write_debug_undef(int32 symbol_index);
-
-extern void end_debug_file(void);
-
-extern void add_to_checksum(void *address);
-
-extern void load_sourcefile(char *story_name, int style);
-extern int file_load_chars(int file_number, char *buffer, int length);
-extern void close_all_source(void);
-extern int register_orig_sourcefile(char *filename);
-
-extern void output_file(void);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "inform" */
-/* ------------------------------------------------------------------------- */
-
-extern char Code_Name[];
-extern int endofpass_flag;
-
-extern int version_number, instruction_set_number, extend_memory_map;
-extern int32 scale_factor, length_scale_factor;
-
-extern int WORDSIZE, INDIV_PROP_START,
- OBJECT_BYTE_LENGTH, DICT_ENTRY_BYTE_LENGTH, DICT_ENTRY_FLAG_POS;
-extern int32 MAXINTWORD;
-
-extern int asm_trace_level, line_trace_level, expr_trace_level,
- linker_trace_level, tokens_trace_level;
-
-extern int
- bothpasses_switch, concise_switch,
- economy_switch, frequencies_switch,
- ignore_switches_switch, listobjects_switch, debugfile_switch,
- listing_switch, memout_switch, printprops_switch,
- offsets_switch, percentages_switch, obsolete_switch,
- transcript_switch, statistics_switch, optimise_switch,
- version_set_switch, nowarnings_switch, hash_switch,
- memory_map_switch, module_switch, temporary_files_switch,
- define_DEBUG_switch, define_USE_MODULES_switch, define_INFIX_switch,
- runtime_error_checking_switch;
-
-extern int oddeven_packing_switch;
-
-extern int glulx_mode, compression_switch;
-extern int32 requested_glulx_version;
-
-extern int error_format, store_the_text, asm_trace_setting,
- double_space_setting, trace_fns_setting, character_set_setting,
- character_set_unicode;
-
-extern char Debugging_Name[];
-extern char Transcript_Name[];
-extern char Language_Name[];
-extern char Charset_Map[];
-
-extern char banner_line[];
-
-extern void select_version(int vn);
-extern void switches(char *, int);
-extern int translate_in_filename(int last_value, char *new_name, char *old_name,
- int same_directory_flag, int command_line_flag);
-extern void translate_out_filename(char *new_name, char *old_name);
-extern int translate_link_filename(int last_value,
- char *new_name, char *old_name);
-extern void translate_temp_filename(int i);
-
-#ifdef ARCHIMEDES
-extern char *riscos_file_type(void);
-#endif
-
-/* For the benefit of the MAC_FACE port these are declared extern, though
- unused outside "inform" in the compiler itself */
-
-extern void allocate_arrays(void);
-extern void free_arrays(void);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "lexer" */
-/* ------------------------------------------------------------------------- */
-
-extern int hash_printed_since_newline;
-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 char **local_variable_texts;
-
-extern int32 token_value;
-extern int token_type;
-extern char *token_text;
-
-extern debug_location get_token_location(void);
-extern debug_locations get_token_locations(void);
-extern debug_location_beginning get_token_location_beginning(void);
-extern void discard_token_location(debug_location_beginning beginning);
-extern debug_locations get_token_location_end(debug_location_beginning beginning);
-
-extern void describe_token(token_data t);
-
-extern void construct_local_variable_tables(void);
-extern void declare_systemfile(void);
-extern int is_systemfile(void);
-extern void report_errors_at_current_line(void);
-extern debug_location get_current_debug_location(void);
-extern debug_location get_error_report_debug_location(void);
-extern int32 get_current_line_start(void);
-extern void set_origsource_location(char *source, int32 line, int32 charnum);
-extern brief_location get_brief_location(ErrorPosition *errpos);
-extern void export_brief_location(brief_location loc, ErrorPosition *errpos);
-extern brief_location blank_brief_location;
-
-extern void put_token_back(void);
-extern void get_next_token(void);
-extern void restart_lexer(char *lexical_source, char *name);
-
-extern keyword_group directives, statements, segment_markers,
- conditions, system_functions, local_variables, opcode_names,
- misc_keywords, directive_keywords, trace_keywords, system_constants,
- opcode_macros;
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "linker" */
-/* ------------------------------------------------------------------------- */
-
-extern memory_block link_data_area;
-extern int32 link_data_size;
-extern char current_module_filename[];
-
-extern char *describe_mv(int mval);
-extern void write_link_marker(int zmachine_area, int32 offset,
- assembly_operand op);
-extern void flush_link_data(void);
-extern void import_symbol(int32 symbol_number);
-extern void export_symbol(int32 symbol_number);
-extern void export_symbol_name(int32 i);
-extern void link_module(char *filename);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "memory" */
-/* ------------------------------------------------------------------------- */
-
-extern int32 malloced_bytes;
-
-extern int MAX_QTEXT_SIZE, MAX_SYMBOLS, HASH_TAB_SIZE, MAX_DICT_ENTRIES,
- MAX_OBJECTS, MAX_ACTIONS, MAX_ADJECTIVES, MAX_ABBREVS,
- MAX_STATIC_DATA, MAX_PROP_TABLE_SIZE, SYMBOLS_CHUNK_SIZE,
- MAX_EXPRESSION_NODES, MAX_LABELS, MAX_LINESPACE,
- MAX_LOW_STRINGS, MAX_CLASSES, MAX_VERBS,
- MAX_VERBSPACE, MAX_ARRAYS, MAX_INCLUSION_DEPTH,
- MAX_SOURCE_FILES;
-
-extern int32 MAX_STATIC_STRINGS, MAX_ZCODE_SIZE, MAX_LINK_DATA_SIZE,
- MAX_TRANSCRIPT_SIZE, MAX_INDIV_PROP_TABLE_SIZE,
- MAX_NUM_STATIC_STRINGS, MAX_UNICODE_CHARS,
- MAX_STACK_SIZE, MEMORY_MAP_EXTENSION;
-
-extern int32 MAX_OBJ_PROP_COUNT, MAX_OBJ_PROP_TABLE_SIZE;
-extern int MAX_LOCAL_VARIABLES, MAX_GLOBAL_VARIABLES;
-extern int DICT_WORD_SIZE, DICT_CHAR_SIZE, DICT_WORD_BYTES;
-extern int ZCODE_HEADER_EXT_WORDS, ZCODE_HEADER_FLAGS_3;
-extern int NUM_ATTR_BYTES, GLULX_OBJECT_EXT_BYTES;
-extern int WARN_UNUSED_ROUTINES, OMIT_UNUSED_ROUTINES;
-
-/* These macros define offsets that depend on the value of NUM_ATTR_BYTES.
- (Meaningful only for Glulx.) */
-/* GOBJFIELD: word offsets of various elements in the object structure. */
-#define GOBJFIELD_CHAIN() (1+((NUM_ATTR_BYTES)/4))
-#define GOBJFIELD_NAME() (2+((NUM_ATTR_BYTES)/4))
-#define GOBJFIELD_PROPTAB() (3+((NUM_ATTR_BYTES)/4))
-#define GOBJFIELD_PARENT() (4+((NUM_ATTR_BYTES)/4))
-#define GOBJFIELD_SIBLING() (5+((NUM_ATTR_BYTES)/4))
-#define GOBJFIELD_CHILD() (6+((NUM_ATTR_BYTES)/4))
-
-extern void *my_malloc(int32 size, char *whatfor);
-extern void my_realloc(void *pointer, int32 oldsize, int32 size,
- char *whatfor);
-extern void *my_calloc(int32 size, int32 howmany, char *whatfor);
-extern void my_recalloc(void *pointer, int32 size, int32 oldhowmany,
- int32 howmany, char *whatfor);
-extern void my_free(void *pointer, char *whatitwas);
-
-extern void set_memory_sizes(int size_flag);
-extern void adjust_memory_sizes(void);
-extern void memory_command(char *command);
-extern void print_memory_usage(void);
-
-extern void initialise_memory_block(memory_block *MB);
-extern void deallocate_memory_block(memory_block *MB);
-extern int read_byte_from_memory_block(memory_block *MB, int32 index);
-extern void write_byte_to_memory_block(memory_block *MB,
- int32 index, int value);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "objects" */
-/* ------------------------------------------------------------------------- */
-
-extern int no_attributes, no_properties;
-extern int no_individual_properties;
-extern int individuals_length;
-extern uchar *individuals_table;
-extern int no_classes, no_objects;
-extern objecttz *objectsz;
-extern objecttg *objectsg;
-extern uchar *objectatts;
-extern int *class_object_numbers;
-extern int32 *class_begins_at;
-
-extern int32 *prop_default_value;
-extern int *prop_is_long;
-extern int *prop_is_additive;
-extern char *properties_table;
-extern int properties_table_size;
-
-extern void make_attribute(void);
-extern void make_property(void);
-extern void make_object(int nearby_flag,
- char *textual_name, int specified_parent, int specified_class,
- int instance_of);
-extern void make_class(char *metaclass_name);
-extern int object_provides(int obj, int id);
-extern void list_object_tree(void);
-extern void write_the_identifier_names(void);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "symbols" */
-/* ------------------------------------------------------------------------- */
-
-extern int no_named_constants;
-extern int no_symbols;
-extern int32 **symbs;
-extern int32 *svals;
-extern int *smarks;
-extern brief_location *slines;
-extern int *sflags;
-#ifdef VAX
- extern char *stypes;
-#else
- extern signed char *stypes;
-#endif
-extern maybe_file_position *symbol_debug_backpatch_positions;
-extern maybe_file_position *replacement_debug_backpatch_positions;
-extern int32 *individual_name_strings;
-extern int32 *attribute_name_strings;
-extern int32 *action_name_strings;
-extern int32 *array_name_strings;
-extern int track_unused_routines;
-extern int df_dont_note_global_symbols;
-extern uint32 df_total_size_before_stripping;
-extern uint32 df_total_size_after_stripping;
-
-extern char *typename(int type);
-extern int hash_code_from_string(char *p);
-extern int strcmpcis(char *p, char *q);
-extern int symbol_index(char *lexeme_text, int hashcode);
-extern void end_symbol_scope(int k);
-extern void describe_symbol(int k);
-extern void list_symbols(int level);
-extern void assign_marked_symbol(int index, int marker, int32 value, int type);
-extern void assign_symbol(int index, int32 value, int type);
-extern void issue_unused_warnings(void);
-extern void add_symbol_replacement_mapping(int original, int renamed);
-extern int find_symbol_replacement(int *value);
-extern void df_note_function_start(char *name, uint32 address,
- int embedded_flag, brief_location source_line);
-extern void df_note_function_end(uint32 endaddress);
-extern void df_note_function_symbol(int symbol);
-extern void locate_dead_functions(void);
-extern uint32 df_stripped_address_for_address(uint32);
-extern uint32 df_stripped_offset_for_code_offset(uint32, int *);
-extern void df_prepare_function_iterate(void);
-extern uint32 df_next_function_iterate(int *);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "syntax" */
-/* ------------------------------------------------------------------------- */
-
-extern int no_syntax_lines;
-
-extern void panic_mode_error_recovery(void);
-extern void get_next_token_with_directives(void);
-extern int parse_directive(int internal_flag);
-extern void parse_program(char *source);
-extern int32 parse_routine(char *source, int embedded_flag, char *name,
- int veneer_flag, int r_symbol);
-extern void parse_code_block(int break_label, int continue_label,
- int switch_rule);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "states" */
-/* ------------------------------------------------------------------------- */
-
-extern void match_close_bracket(void);
-extern void parse_statement(int break_label, int continue_label);
-extern int parse_label(void);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "tables" */
-/* ------------------------------------------------------------------------- */
-
-extern uchar *zmachine_paged_memory;
-extern int32
- code_offset, actions_offset, preactions_offset,
- dictionary_offset, strings_offset, adjectives_offset,
- variables_offset, class_numbers_offset, individuals_offset,
- identifier_names_offset, prop_defaults_offset, prop_values_offset,
- static_memory_offset, array_names_offset, attribute_names_offset,
- action_names_offset, fake_action_names_offset,
- routine_names_offset, routines_array_offset, routine_flags_array_offset,
- global_names_offset, global_flags_array_offset,
- array_flags_array_offset, constant_names_offset, constants_array_offset;
-extern int32
- arrays_offset, object_tree_offset, grammar_table_offset,
- abbreviations_offset; /* For Glulx */
-
-extern int32 Out_Size, Write_Code_At, Write_Strings_At;
-extern int32 RAM_Size, Write_RAM_At; /* For Glulx */
-
-extern int release_number, statusline_flag;
-extern int flags2_requirements[];
-extern int serial_code_given_in_program;
-extern char serial_code_buffer[];
-
-extern void construct_storyfile(void);
-extern void write_serial_number(char *buffer);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "text" */
-/* ------------------------------------------------------------------------- */
-
-extern uchar *low_strings, *low_strings_top;
-extern char *all_text, *all_text_top;
-
-extern int no_abbreviations;
-extern int abbrevs_lookup_table_made, is_abbreviation;
-extern uchar *abbreviations_at;
-extern int *abbrev_values;
-extern int *abbrev_quality;
-extern int *abbrev_freqs;
-
-extern int32 total_chars_trans, total_bytes_trans,
- zchars_trans_in_last_string;
-extern int put_strings_in_low_memory;
-extern int dict_entries;
-extern uchar *dictionary, *dictionary_top;
-extern int *final_dict_order;
-
-extern memory_block static_strings_area;
-extern int32 static_strings_extent;
-
-/* And now, a great many declarations for dealing with Glulx string
- compression. */
-
-extern int32 no_strings, no_dynamic_strings;
-extern int no_unicode_chars;
-
-#define MAX_DYNAMIC_STRINGS (64)
-
-typedef struct unicode_usage_s unicode_usage_t;
-struct unicode_usage_s {
- int32 ch;
- unicode_usage_t *next;
-};
-
-extern unicode_usage_t *unicode_usage_entries;
-
-/* This is the maximum number of (8-bit) bytes that can encode a single
- Huffman entity. Four should be plenty, unless someone starts encoding
- an ideographic language. */
-#define MAXHUFFBYTES (4)
-
-typedef struct huffbitlist_struct {
- uchar b[MAXHUFFBYTES];
-} huffbitlist_t;
-typedef struct huffentity_struct {
- int count;
- int type;
- union {
- int branch[2];
- unsigned char ch;
- int val;
- } u;
- int depth;
- int32 addr;
- huffbitlist_t bits;
-} huffentity_t;
-
-extern huffentity_t *huff_entities;
-
-extern int32 compression_table_size, compression_string_size;
-extern int32 *compressed_offsets;
-extern int no_huff_entities;
-extern int huff_abbrev_start, huff_dynam_start, huff_unicode_start;
-extern int huff_entity_root;
-
-extern void compress_game_text(void);
-
-/* end of the Glulx string compression stuff */
-
-extern void ao_free_arrays(void);
-extern int32 compile_string(char *b, int in_low_memory, int is_abbrev);
-extern uchar *translate_text(uchar *p, uchar *p_limit, char *s_text);
-extern void optimise_abbreviations(void);
-extern void make_abbreviation(char *text);
-extern void show_dictionary(void);
-extern void word_to_ascii(uchar *p, char *result);
-extern void write_dictionary_to_transcript(void);
-extern void sort_dictionary(void);
-extern void dictionary_prepare(char *dword, uchar *optresult);
-extern int dictionary_add(char *dword, int x, int y, int z);
-extern void dictionary_set_verb_number(char *dword, int to);
-extern int compare_sorts(uchar *d1, uchar *d2);
-extern void copy_sorts(uchar *d1, uchar *d2);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "veneer" */
-/* ------------------------------------------------------------------------- */
-
-extern int veneer_mode;
-extern int32 veneer_routine_address[];
-
-extern void compile_initial_routine(void);
-extern assembly_operand veneer_routine(int code);
-extern void compile_veneer(void);
-
-/* ------------------------------------------------------------------------- */
-/* Extern definitions for "verbs" */
-/* ------------------------------------------------------------------------- */
-
-extern int no_adjectives, no_Inform_verbs, no_grammar_token_routines,
- no_fake_actions, no_actions, no_grammar_lines, no_grammar_tokens,
- grammar_version_number;
-extern int32 grammar_version_symbol;
-extern verbt *Inform_verbs;
-extern uchar *grammar_lines;
-extern int32 grammar_lines_top;
-extern int32 *action_byte_offset,
- *grammar_token_routine,
- *adjectives;
-
-extern void find_the_actions(void);
-extern void make_fake_action(void);
-extern assembly_operand action_of_name(char *name);
-extern void make_verb(void);
-extern void extend_verb(void);
-extern void list_verb_table(void);
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "inform" : The top level of Inform: switches, pathnames, filenaming */
-/* conventions, ICL (Inform Command Line) files, main */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#define MAIN_INFORM_FILE
-#include "header.h"
-
-/* ------------------------------------------------------------------------- */
-/* Compiler progress */
-/* ------------------------------------------------------------------------- */
-
-static int no_compilations;
-
-int endofpass_flag; /* set to TRUE when an "end" directive is reached
- (the inputs routines insert one into the stream
- if necessary) */
-
-/* ------------------------------------------------------------------------- */
-/* Version control */
-/* ------------------------------------------------------------------------- */
-
-int version_number, /* 3 to 8 (Z-code) */
- instruction_set_number,
- /* 3 to 6: versions 7 and 8 use instruction set of
- version 5 */
- extend_memory_map; /* extend using function- and string-offsets */
-int32 scale_factor, /* packed address multiplier */
- length_scale_factor; /* length-in-header multiplier */
-
-int32 requested_glulx_version;
-
-extern void select_version(int vn)
-{ version_number = vn;
- extend_memory_map = FALSE;
- if ((version_number==6)||(version_number==7)) extend_memory_map = TRUE;
-
- scale_factor = 4;
- if (version_number==3) scale_factor = 2;
- if (version_number==8) scale_factor = 8;
-
- length_scale_factor = scale_factor;
- if ((version_number==6)||(version_number==7)) length_scale_factor = 8;
-
- instruction_set_number = version_number;
- if ((version_number==7)||(version_number==8)) instruction_set_number = 5;
-}
-
-static int select_glulx_version(char *str)
-{
- /* Parse an "X.Y.Z" style version number, and store it for later use. */
- char *cx = str;
- int major=0, minor=0, patch=0;
-
- while (isdigit(*cx))
- major = major*10 + ((*cx++)-'0');
- if (*cx == '.') {
- cx++;
- while (isdigit(*cx))
- minor = minor*10 + ((*cx++)-'0');
- if (*cx == '.') {
- cx++;
- while (isdigit(*cx))
- patch = patch*10 + ((*cx++)-'0');
- }
- }
-
- requested_glulx_version = ((major & 0x7FFF) << 16)
- + ((minor & 0xFF) << 8)
- + (patch & 0xFF);
- return (cx - str);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Target: variables which vary between the Z-machine and Glulx */
-/* ------------------------------------------------------------------------- */
-
-int WORDSIZE; /* Size of a machine word: 2 or 4 */
-int32 MAXINTWORD; /* 0x7FFF or 0x7FFFFFFF */
-
-/* The first property number which is an individual property. The
- eight class-system i-props (create, recreate, ... print_to_array)
- are numbered from INDIV_PROP_START to INDIV_PROP_START+7.
-*/
-int INDIV_PROP_START;
-
-/* The length of an object, as written in tables.c. It's easier to define
- it here than to repeat the same expression all over the source code.
- Not used in Z-code.
-*/
-int OBJECT_BYTE_LENGTH;
-/* The total length of a dict entry, in bytes. Not used in Z-code.
-*/
-int DICT_ENTRY_BYTE_LENGTH;
-/* The position in a dict entry that the flag values begin.
- Not used in Z-code.
-*/
-int DICT_ENTRY_FLAG_POS;
-
-static void select_target(int targ)
-{
- if (!targ) {
- /* Z-machine */
- WORDSIZE = 2;
- MAXINTWORD = 0x7FFF;
-
- if (INDIV_PROP_START != 64) {
- INDIV_PROP_START = 64;
- fatalerror("You cannot change INDIV_PROP_START in Z-code");
- }
- if (DICT_WORD_SIZE != 6) {
- DICT_WORD_SIZE = 6;
- fatalerror("You cannot change DICT_WORD_SIZE in Z-code");
- }
- if (DICT_CHAR_SIZE != 1) {
- DICT_CHAR_SIZE = 1;
- fatalerror("You cannot change DICT_CHAR_SIZE in Z-code");
- }
- if (NUM_ATTR_BYTES != 6) {
- NUM_ATTR_BYTES = 6;
- fatalerror("You cannot change NUM_ATTR_BYTES in Z-code");
- }
- if (MAX_LOCAL_VARIABLES != 16) {
- MAX_LOCAL_VARIABLES = 16;
- fatalerror("You cannot change MAX_LOCAL_VARIABLES in Z-code");
- }
- if (MAX_GLOBAL_VARIABLES != 240) {
- MAX_GLOBAL_VARIABLES = 240;
- fatalerror("You cannot change MAX_GLOBAL_VARIABLES in Z-code");
- }
- if (MAX_VERBS > 255) {
- MAX_VERBS = 255;
- fatalerror("MAX_VERBS can only go above 255 when Glulx is used");
- }
- }
- else {
- /* Glulx */
- WORDSIZE = 4;
- MAXINTWORD = 0x7FFFFFFF;
- scale_factor = 0; /* It should never even get used in Glulx */
-
- 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);
- }
-
- 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);
- }
-
- 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);
- }
- }
-
- if (MAX_LOCAL_VARIABLES >= 120) {
- MAX_LOCAL_VARIABLES = 119;
- warning("MAX_LOCAL_VARIABLES cannot exceed 119; resetting to 119");
- /* This is because the keyword table in the lexer only has 120
- entries. */
- }
- 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",
- MAX_NUM_ATTR_BYTES);
- /* MAX_NUM_ATTR_BYTES can be increased in header.h without fear. */
- }
-
- /* Set up a few more variables that depend on the above values */
-
- if (!targ) {
- /* Z-machine */
- DICT_WORD_BYTES = DICT_WORD_SIZE;
- /* The Z-code generator doesn't use the following variables, although
- it would be a little cleaner if it did. */
- OBJECT_BYTE_LENGTH = 0;
- DICT_ENTRY_BYTE_LENGTH = (version_number==3)?7:9;
- DICT_ENTRY_FLAG_POS = 0;
- }
- else {
- /* Glulx */
- OBJECT_BYTE_LENGTH = (1 + (NUM_ATTR_BYTES) + 6*4 + (GLULX_OBJECT_EXT_BYTES));
- DICT_WORD_BYTES = DICT_WORD_SIZE*DICT_CHAR_SIZE;
- if (DICT_CHAR_SIZE == 1) {
- DICT_ENTRY_BYTE_LENGTH = (7+DICT_WORD_BYTES);
- DICT_ENTRY_FLAG_POS = (1+DICT_WORD_BYTES);
- }
- else {
- DICT_ENTRY_BYTE_LENGTH = (12+DICT_WORD_BYTES);
- DICT_ENTRY_FLAG_POS = (4+DICT_WORD_BYTES);
- }
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Tracery: output control variables */
-/* ------------------------------------------------------------------------- */
-
-int asm_trace_level, /* trace assembly: 0 for off, 1 for assembly
- only, 2 for full assembly tracing with hex dumps */
- line_trace_level, /* line tracing: 0 off, 1 on */
- expr_trace_level, /* expression tracing: 0 off, 1 full, 2 brief */
- linker_trace_level, /* set by -y: 0 to 4 levels of tracing */
- tokens_trace_level; /* lexer output tracing: 0 off, 1 on */
-
-/* ------------------------------------------------------------------------- */
-/* On/off switch variables (by default all FALSE); other switch settings */
-/* ------------------------------------------------------------------------- */
-
-int bothpasses_switch, /* -b */
- concise_switch, /* -c */
- economy_switch, /* -e */
- frequencies_switch, /* -f */
- ignore_switches_switch, /* -i */
- listobjects_switch, /* -j */
- debugfile_switch, /* -k */
- listing_switch, /* -l */
- memout_switch, /* -m */
- printprops_switch, /* -n */
- offsets_switch, /* -o */
- percentages_switch, /* -p */
- obsolete_switch, /* -q */
- transcript_switch, /* -r */
- statistics_switch, /* -s */
- optimise_switch, /* -u */
- version_set_switch, /* -v */
- nowarnings_switch, /* -w */
- hash_switch, /* -x */
- memory_map_switch, /* -z */
- oddeven_packing_switch, /* -B */
- define_DEBUG_switch, /* -D */
- temporary_files_switch, /* -F */
- module_switch, /* -M */
- runtime_error_checking_switch, /* -S */
- define_USE_MODULES_switch, /* -U */
- define_INFIX_switch; /* -X */
-#ifdef ARC_THROWBACK
-int throwback_switch; /* -T */
-#endif
-#ifdef ARCHIMEDES
-int riscos_file_type_format; /* set by -R */
-#endif
-int compression_switch; /* set by -H */
-int character_set_setting, /* set by -C0 through -C9 */
- character_set_unicode, /* set by -Cu */
- error_format, /* set by -E */
- asm_trace_setting, /* set by -a and -t: value of
- asm_trace_level to use when tracing */
- double_space_setting, /* set by -d: 0, 1 or 2 */
- trace_fns_setting, /* set by -g: 0, 1 or 2 */
- linker_trace_setting, /* set by -y: ditto for linker_... */
- store_the_text; /* when set, record game text to a chunk
- of memory (used by both -r & -k) */
-static int r_e_c_s_set; /* has -S been explicitly set? */
-
-int glulx_mode; /* -G */
-
-static void reset_switch_settings(void)
-{ asm_trace_setting=0;
- linker_trace_level=0;
- tokens_trace_level=0;
-
- store_the_text = FALSE;
-
- bothpasses_switch = FALSE;
- concise_switch = FALSE;
- double_space_setting = 0;
- economy_switch = FALSE;
- frequencies_switch = FALSE;
- trace_fns_setting = 0;
- ignore_switches_switch = FALSE;
- listobjects_switch = FALSE;
- debugfile_switch = FALSE;
- listing_switch = FALSE;
- memout_switch = FALSE;
- printprops_switch = FALSE;
- offsets_switch = FALSE;
- percentages_switch = FALSE;
- obsolete_switch = FALSE;
- transcript_switch = FALSE;
- statistics_switch = FALSE;
- optimise_switch = FALSE;
- version_set_switch = FALSE;
- nowarnings_switch = FALSE;
- hash_switch = FALSE;
- memory_map_switch = FALSE;
- oddeven_packing_switch = FALSE;
- define_DEBUG_switch = FALSE;
-#ifdef USE_TEMPORARY_FILES
- temporary_files_switch = TRUE;
-#else
- temporary_files_switch = FALSE;
-#endif
- define_USE_MODULES_switch = FALSE;
- module_switch = FALSE;
-#ifdef ARC_THROWBACK
- throwback_switch = FALSE;
-#endif
- runtime_error_checking_switch = TRUE;
- r_e_c_s_set = FALSE;
- define_INFIX_switch = FALSE;
-#ifdef ARCHIMEDES
- riscos_file_type_format = 0;
-#endif
- error_format=DEFAULT_ERROR_FORMAT;
-
- character_set_setting = 1; /* Default is ISO Latin-1 */
- character_set_unicode = FALSE;
-
- compression_switch = TRUE;
- glulx_mode = FALSE;
- requested_glulx_version = 0;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Number of files given as command line parameters (0, 1 or 2) */
-/* ------------------------------------------------------------------------- */
-
-static int cli_files_specified,
- convert_filename_flag;
-
-char Source_Name[PATHLEN]; /* Processed name of first input file */
-char Code_Name[PATHLEN]; /* Processed name of output file */
-
-static char *cli_file1, *cli_file2; /* Unprocessed (and unsafe to alter) */
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-static void init_vars(void)
-{
- init_arrays_vars();
- init_asm_vars();
- init_bpatch_vars();
- init_chars_vars();
- init_directs_vars();
- init_errors_vars();
- init_expressc_vars();
- init_expressp_vars();
- init_files_vars();
- init_lexer_vars();
- init_linker_vars();
- init_memory_vars();
- init_objects_vars();
- init_states_vars();
- init_symbols_vars();
- init_syntax_vars();
- init_tables_vars();
- init_text_vars();
- init_veneer_vars();
- init_verbs_vars();
-}
-
-static void begin_pass(void)
-{
- arrays_begin_pass();
- asm_begin_pass();
- bpatch_begin_pass();
- chars_begin_pass();
- directs_begin_pass();
- errors_begin_pass();
- expressc_begin_pass();
- expressp_begin_pass();
- files_begin_pass();
-
- endofpass_flag = FALSE;
- line_trace_level = 0; expr_trace_level = 0;
- asm_trace_level = asm_trace_setting;
- linker_trace_level = linker_trace_setting;
- if (listing_switch) line_trace_level=1;
-
- lexer_begin_pass();
- linker_begin_pass();
- memory_begin_pass();
- objects_begin_pass();
- states_begin_pass();
- symbols_begin_pass();
- syntax_begin_pass();
- tables_begin_pass();
- text_begin_pass();
- veneer_begin_pass();
- verbs_begin_pass();
-
- if (!module_switch)
- {
- /* Compile a Main__ routine (see "veneer.c") */
-
- compile_initial_routine();
-
- /* Make the four metaclasses: Class must be object number 1, so
- it must come first */
-
- veneer_mode = TRUE;
-
- make_class("Class");
- make_class("Object");
- make_class("Routine");
- make_class("String");
-
- veneer_mode = FALSE;
- }
-}
-
-extern void allocate_arrays(void)
-{
- arrays_allocate_arrays();
- asm_allocate_arrays();
- bpatch_allocate_arrays();
- chars_allocate_arrays();
- directs_allocate_arrays();
- errors_allocate_arrays();
- expressc_allocate_arrays();
- expressp_allocate_arrays();
- files_allocate_arrays();
-
- lexer_allocate_arrays();
- linker_allocate_arrays();
- memory_allocate_arrays();
- objects_allocate_arrays();
- states_allocate_arrays();
- symbols_allocate_arrays();
- syntax_allocate_arrays();
- tables_allocate_arrays();
- text_allocate_arrays();
- veneer_allocate_arrays();
- verbs_allocate_arrays();
-}
-
-extern void free_arrays(void)
-{
- /* One array may survive this routine, all_the_text (used to hold
- game text until the abbreviations optimiser begins work on it): this
- array (if it was ever allocated) is freed at the top level. */
-
- arrays_free_arrays();
- asm_free_arrays();
- bpatch_free_arrays();
- chars_free_arrays();
- directs_free_arrays();
- errors_free_arrays();
- expressc_free_arrays();
- expressp_free_arrays();
- files_free_arrays();
-
- lexer_free_arrays();
- linker_free_arrays();
- memory_free_arrays();
- objects_free_arrays();
- states_free_arrays();
- symbols_free_arrays();
- syntax_free_arrays();
- tables_free_arrays();
- text_free_arrays();
- veneer_free_arrays();
- verbs_free_arrays();
-}
-
-/* ------------------------------------------------------------------------- */
-/* Name translation code for filenames */
-/* ------------------------------------------------------------------------- */
-
-static char Source_Path[PATHLEN];
-static char Include_Path[PATHLEN];
-static char Code_Path[PATHLEN];
-static char Module_Path[PATHLEN];
-static char Temporary_Path[PATHLEN];
-static char current_source_path[PATHLEN];
- char Debugging_Name[PATHLEN];
- char Transcript_Name[PATHLEN];
- char Language_Name[PATHLEN];
- char Charset_Map[PATHLEN];
-static char ICL_Path[PATHLEN];
-
-/* Set one of the above Path buffers to the given location, or list of
- locations. (A list is comma-separated, and only accepted for Source_Path,
- Include_Path, ICL_Path, Module_Path.)
-*/
-static void set_path_value(char *path, char *value)
-{ int i, j;
-
- for (i=0, j=0;;)
- {
- if (i >= PATHLEN-1) {
- printf("A specified path is longer than %d characters.\n",
- PATHLEN-1);
- exit(1);
- }
- if ((value[j] == FN_ALT) || (value[j] == 0))
- { if ((value[j] == FN_ALT)
- && (path != Source_Path) && (path != Include_Path)
- && (path != ICL_Path) && (path != Module_Path))
- { printf("The character '%c' is used to divide entries in a list \
-of possible locations, and can only be used in the Include_Path, Source_Path, \
-Module_Path or ICL_Path variables. Other paths are for output only.\n", FN_ALT);
- exit(1);
- }
- if ((path != Debugging_Name) && (path != Transcript_Name)
- && (path != Language_Name) && (path != Charset_Map)
- && (i>0) && (isalnum(path[i-1]))) path[i++] = FN_SEP;
- path[i++] = value[j++];
- if (value[j-1] == 0) return;
- }
- else path[i++] = value[j++];
- }
-}
-
-/* Prepend the given location or list of locations to one of the above
- Path buffers. This is only permitted for Source_Path, Include_Path,
- ICL_Path, Module_Path.
-
- An empty field (in the comma-separated list) means the current
- directory. If the Path buffer is entirely empty, we assume that
- we want to search both value and the current directory, so
- the result will be "value,".
-*/
-static void prepend_path_value(char *path, char *value)
-{
- int i, j;
- int oldlen = strlen(path);
- int newlen;
- char new_path[PATHLEN];
-
- if ((path != Source_Path) && (path != Include_Path)
- && (path != ICL_Path) && (path != Module_Path))
- { printf("The character '+' is used to add to a list \
-of possible locations, and can only be used in the Include_Path, Source_Path, \
-Module_Path or ICL_Path variables. Other paths are for output only.\n");
- exit(1);
- }
-
- for (i=0, j=0;;)
- {
- if (i >= PATHLEN-1) {
- printf("A specified path is longer than %d characters.\n",
- PATHLEN-1);
- exit(1);
- }
- if ((value[j] == FN_ALT) || (value[j] == 0))
- { if ((path != Debugging_Name) && (path != Transcript_Name)
- && (path != Language_Name) && (path != Charset_Map)
- && (i>0) && (isalnum(new_path[i-1]))) new_path[i++] = FN_SEP;
- new_path[i++] = value[j++];
- if (value[j-1] == 0) {
- newlen = i-1;
- break;
- }
- }
- else new_path[i++] = value[j++];
- }
-
- if (newlen+1+oldlen >= PATHLEN-1) {
- printf("A specified path is longer than %d characters.\n",
- PATHLEN-1);
- exit(1);
- }
-
- i = newlen;
- new_path[i++] = FN_ALT;
- for (j=0; j<oldlen;)
- new_path[i++] = path[j++];
- new_path[i] = 0;
-
- strcpy(path, new_path);
-}
-
-static void set_default_paths(void)
-{
- set_path_value(Source_Path, Source_Directory);
- set_path_value(Include_Path, Include_Directory);
- set_path_value(Code_Path, Code_Directory);
- set_path_value(Module_Path, Module_Directory);
- set_path_value(ICL_Path, ICL_Directory);
- set_path_value(Temporary_Path, Temporary_Directory);
- set_path_value(Debugging_Name, Debugging_File);
- set_path_value(Transcript_Name, Transcript_File);
- set_path_value(Language_Name, "english");
- set_path_value(Charset_Map, "");
-}
-
-/* Parse a path option which looks like "dir", "+dir", "pathname=dir",
- or "+pathname=dir". If there is no "=", we assume "include_path=...".
- If the option begins with a "+" the directory is prepended to the
- existing path instead of replacing it.
-*/
-static void set_path_command(char *command)
-{ int i, j; char *path_to_set = NULL;
- int prepend = 0;
-
- if (command[0] == '+') {
- prepend = 1;
- command++;
- }
-
- for (i=0; (command[i]!=0) && (command[i]!='=');i++) ;
-
- path_to_set=Include_Path;
-
- if (command[i] == '=') {
- char pathname[PATHLEN];
- if (i>=PATHLEN) i=PATHLEN-1;
- for (j=0;j<i;j++) {
- char ch = command[j];
- if (isupper(ch)) ch=tolower(ch);
- pathname[j]=ch;
- }
- pathname[j]=0;
- command = command+i+1;
-
- path_to_set = NULL;
- if (strcmp(pathname, "source_path")==0) path_to_set=Source_Path;
- if (strcmp(pathname, "include_path")==0) path_to_set=Include_Path;
- if (strcmp(pathname, "code_path")==0) path_to_set=Code_Path;
- if (strcmp(pathname, "module_path")==0) path_to_set=Module_Path;
- if (strcmp(pathname, "icl_path")==0) path_to_set=ICL_Path;
- if (strcmp(pathname, "temporary_path")==0) path_to_set=Temporary_Path;
- if (strcmp(pathname, "debugging_name")==0) path_to_set=Debugging_Name;
- if (strcmp(pathname, "transcript_name")==0) path_to_set=Transcript_Name;
- if (strcmp(pathname, "language_name")==0) path_to_set=Language_Name;
- if (strcmp(pathname, "charset_map")==0) path_to_set=Charset_Map;
-
- if (path_to_set == NULL)
- { printf("No such path setting as \"%s\"\n", pathname);
- exit(1);
- }
- }
-
- if (!prepend)
- set_path_value(path_to_set, command);
- else
- prepend_path_value(path_to_set, command);
-}
-
-static int contains_separator(char *name)
-{ int i;
- for (i=0; name[i]!=0; i++)
- if (name[i] == FN_SEP) return 1;
- return 0;
-}
-
-static int write_translated_name(char *new_name, char *old_name,
- char *prefix_path, int start_pos,
- char *extension)
-{ int x;
- if (strlen(old_name)+strlen(extension) >= PATHLEN) {
- printf("One of your filenames is longer than %d characters.\n", PATHLEN);
- exit(1);
- }
- if (prefix_path == NULL)
- { sprintf(new_name,"%s%s", old_name, extension);
- return 0;
- }
- strcpy(new_name, prefix_path + start_pos);
- for (x=0; (new_name[x]!=0) && (new_name[x]!=FN_ALT); x++) ;
- if (new_name[x] == 0) start_pos = 0; else start_pos += x+1;
- if (x+strlen(old_name)+strlen(extension) >= PATHLEN) {
- printf("One of your pathnames is longer than %d characters.\n", PATHLEN);
- exit(1);
- }
- sprintf(new_name + x, "%s%s", old_name, extension);
- return start_pos;
-}
-
-#ifdef FILE_EXTENSIONS
-static char *check_extension(char *name, char *extension)
-{ int i;
-
- /* If a filename ends in '.', remove the dot and add no file extension: */
- i = strlen(name)-1;
- if (name[i] == '.') { name[i]=0; return ""; }
-
- /* Remove the new extension if it's already got one: */
-
- for (; (i>=0) && (name[i]!=FN_SEP); i--)
- if (name[i] == '.') return "";
- return extension;
-}
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* Three translation routines have to deal with path variables which may */
-/* contain alternative locations separated by the FN_ALT character. */
-/* These have the protocol: */
-/* */
-/* int translate_*_filename(int last_value, ...) */
-/* */
-/* and should first be called with last_value equal to 0. If the */
-/* translated filename works, fine. Otherwise, if the returned integer */
-/* was zero, the caller knows that no filename works and can issue an */
-/* error message. If it was non-zero, the caller should pass it on as */
-/* the last_value again. */
-/* */
-/* As implemented below, last_value is the position in the path variable */
-/* string at which the next directory name to try begins. */
-/* ------------------------------------------------------------------------- */
-
-extern int translate_in_filename(int last_value,
- char *new_name, char *old_name,
- int same_directory_flag, int command_line_flag)
-{ char *prefix_path = NULL;
- char *extension;
- int add_path_flag = 1;
- int i;
-
- if ((same_directory_flag==0)
- && (contains_separator(old_name)==1)) add_path_flag=0;
-
- if (add_path_flag==1)
- { if (command_line_flag == 0)
- { /* File is opened as a result of an Include directive */
-
- if (same_directory_flag==1)
- prefix_path = current_source_path;
- else
- if (Include_Path[0]!=0) prefix_path = Include_Path;
- }
- /* Main file being opened from the command line */
-
- else if (Source_Path[0]!=0) prefix_path = Source_Path;
- }
-
-#ifdef FILE_EXTENSIONS
- /* Which file extension is expected? */
-
- if ((command_line_flag==1)||(same_directory_flag==1))
- extension = Source_Extension;
- else
- extension = Include_Extension;
-
- extension = check_extension(old_name, extension);
-#else
- extension = "";
-#endif
-
- last_value = write_translated_name(new_name, old_name,
- prefix_path, last_value, extension);
-
- /* Set the "current source path" (for use of Include ">...") */
-
- if (command_line_flag==1)
- { strcpy(current_source_path, new_name);
- for (i=strlen(current_source_path)-1;
- ((i>0)&&(current_source_path[i]!=FN_SEP));i--) ;
-
- if (i!=0) current_source_path[i+1] = 0; /* Current file in subdir */
- else current_source_path[0] = 0; /* Current file at root dir */
- }
-
- return last_value;
-}
-
-extern int translate_link_filename(int last_value,
- char *new_name, char *old_name)
-{ char *prefix_path = NULL;
- char *extension;
-
- if (contains_separator(old_name)==0)
- if (Module_Path[0]!=0)
- prefix_path = Module_Path;
-
-#ifdef FILE_EXTENSIONS
- extension = check_extension(old_name, Module_Extension);
-#else
- extension = "";
-#endif
-
- return write_translated_name(new_name, old_name,
- prefix_path, last_value, extension);
-}
-
-static int translate_icl_filename(int last_value,
- char *new_name, char *old_name)
-{ char *prefix_path = NULL;
- char *extension = "";
-
- if (contains_separator(old_name)==0)
- if (ICL_Path[0]!=0)
- prefix_path = ICL_Path;
-
-#ifdef FILE_EXTENSIONS
- extension = check_extension(old_name, ICL_Extension);
-#endif
-
- return write_translated_name(new_name, old_name,
- prefix_path, last_value, extension);
-}
-
-extern void translate_out_filename(char *new_name, char *old_name)
-{ char *prefix_path;
- char *extension = "";
- int i;
-
- /* If !convert_filename_flag, then the old_name is just the <file2>
- parameter on the Inform command line, which we leave alone. */
-
- if (!convert_filename_flag)
- { strcpy(new_name, old_name); return;
- }
-
- /* Remove any pathname or extension in <file1>. */
-
- if (contains_separator(old_name)==1)
- { for (i=strlen(old_name)-1; (i>0)&&(old_name[i]!=FN_SEP) ;i--) { };
- if (old_name[i]==FN_SEP) i++;
- old_name += i;
- }
-#ifdef FILE_EXTENSIONS
- for (i=strlen(old_name)-1; (i>=0)&&(old_name[i]!='.') ;i--) ;
- if (old_name[i] == '.') old_name[i] = 0;
-#endif
-
- prefix_path = NULL;
- if (module_switch)
- { extension = Module_Extension;
- if (Module_Path[0]!=0) prefix_path = Module_Path;
- }
- else
- {
- if (!glulx_mode) {
- switch(version_number)
- { case 3: extension = Code_Extension; break;
- case 4: extension = V4Code_Extension; break;
- case 5: extension = V5Code_Extension; break;
- case 6: extension = V6Code_Extension; break;
- case 7: extension = V7Code_Extension; break;
- case 8: extension = V8Code_Extension; break;
- }
- }
- else {
- extension = GlulxCode_Extension;
- }
- if (Code_Path[0]!=0) prefix_path = Code_Path;
- }
-
-#ifdef FILE_EXTENSIONS
- extension = check_extension(old_name, extension);
-#endif
-
- write_translated_name(new_name, old_name, prefix_path, 0, extension);
-}
-
-static char *name_or_unset(char *p)
-{ if (p[0]==0) return "(unset)";
- return p;
-}
-
-static void help_on_filenames(void)
-{ char old_name[PATHLEN];
- char new_name[PATHLEN];
- int save_mm = module_switch, x;
-
- module_switch = FALSE;
-
- printf("Help information on filenames:\n\n");
-
- printf(
-"The command line can take one of two forms:\n\n\
- inform [commands...] <file1>\n\
- inform [commands...] <file1> <file2>\n\n\
-Inform translates <file1> into a source file name (see below) for its input.\n\
-<file2> is usually omitted: if so, the output filename is made from <file1>\n\
-by cutting out the name part and translating that (see below).\n\
-If <file2> is given, however, the output filename is set to just <file2>\n\
-(not altered in any way).\n\n");
-
- printf(
-"Filenames given in the game source (with commands like Include \"name\" and\n\
-Link \"name\") are also translated by the rules below.\n\n");
-
- printf(
-"Rules of translation:\n\n\
-Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
-(such as \"adventure%cgames%cxyzzy\") according to the following rules.\n\n\
-1. If the name contains a '%c' character (so it's already a pathname), it\n\
- isn't changed.\n\n", FN_SEP, FN_SEP, FN_SEP);
-
- printf(
-" [Exception: when the name is given in an Include command using the >\n\
- form (such as Include \">prologue\"), the \">\" is replaced by the path\n\
- of the file doing the inclusion");
-#ifdef FILE_EXTENSIONS
- printf(" and a suitable file extension is added");
-#endif
- printf(".]\n\n");
-
- printf(
-" Filenames must never contain double-quotation marks \". To use filenames\n\
- which contain spaces, write them in double-quotes: for instance,\n\n\
- \"inform +code_path=\"Jigsaw Final Version\" jigsaw\".\n\n");
-
- printf(
-"2. The file is looked for at a particular \"path\" (the filename of a\n\
- directory), depending on what kind of file it is.\n\n\
- File type Name Current setting\n\n\
- Source code (in) source_path %s\n\
- Include file (in) include_path %s\n\
- Story file (out) code_path %s\n",
- name_or_unset(Source_Path), name_or_unset(Include_Path),
- name_or_unset(Code_Path));
-
- printf(
-" Temporary file (out) temporary_path %s\n\
- ICL command file (in) icl_path %s\n\
- Module (in & out) module_path %s\n\n",
- name_or_unset(Temporary_Path),
- name_or_unset(ICL_Path), name_or_unset(Module_Path));
-
- printf(
-" If the path is unset, then the current working directory is used (so\n\
- the filename doesn't change): if, for instance, include_path is set to\n\
- \"backup%coldlib\" then when \"parser\" is included it is looked for at\n\
- \"backup%coldlib%cparser\".\n\n\
- The paths can be set or unset on the Inform command line by, eg,\n\
- \"inform +code_path=finished jigsaw\" or\n\
- \"inform +include_path= balances\" (which unsets include_path).\n\n",
- FN_SEP, FN_SEP, FN_SEP);
-
- printf(
-" The four input path variables can be set to lists of alternative paths\n\
- separated by '%c' characters: these alternatives are always tried in\n\
- the order they are specified in, that is, left to right through the text\n\
- in the path variable.\n\n",
- FN_ALT);
- printf(
-" If two '+' signs are used (\"inform ++include_path=dir jigsaw\") then\n\
- the path or paths are added to the existing list.\n\n");
- printf(
-" (Modules are written to the first alternative in the module_path list;\n\
- it is an error to give alternatives at all for purely output paths.)\n\n");
-
-#ifdef FILE_EXTENSIONS
- printf("3. The following file extensions are added:\n\n\
- Source code: %s\n\
- Include files: %s\n\
- Story files: %s (Version 3), %s (v4), %s (v5, the default),\n\
- %s (v6), %s (v7), %s (v8), %s (Glulx)\n\
- Temporary files: .tmp\n\
- Modules: %s\n\n",
- Source_Extension, Include_Extension,
- Code_Extension, V4Code_Extension, V5Code_Extension, V6Code_Extension,
- V7Code_Extension, V8Code_Extension, GlulxCode_Extension,
- Module_Extension);
- printf("\
- except that any extension you give (on the command line or in a filename\n\
- used in a program) will override these. If you give the null extension\n\
- \".\" then Inform uses no file extension at all (removing the \".\").\n\n");
-#endif
-
- printf("Names of four individual files can also be set using the same\n\
- + command notation (though they aren't really pathnames). These are:\n\n\
- transcript_name (text written by -r switch): now \"%s\"\n\
- debugging_name (data written by -k switch): now \"%s\"\n\
- language_name (library file defining natural language of game):\n\
- now \"%s\"\n\
- charset_map (file for character set mapping): now \"%s\"\n\n",
- Transcript_Name, Debugging_Name, Language_Name, Charset_Map);
-
- translate_in_filename(0, new_name, "rezrov", 0, 1);
- printf("Examples: 1. \"inform rezrov\"\n\
- the source code is read from \"%s\"\n",
- new_name);
- convert_filename_flag = TRUE;
- translate_out_filename(new_name, "rezrov");
- printf(" and a story file is compiled to \"%s\".\n\n", new_name);
-
- translate_in_filename(0, new_name, "frotz", 0, 1);
- printf("2. \"inform -M frotz\"\n\
- the source code is read from \"%s\"\n",
- new_name);
- module_switch = TRUE;
- convert_filename_flag = TRUE;
- translate_out_filename(new_name, "frotz");
- printf(" and a module is compiled to \"%s\".\n\n", new_name);
-
- module_switch = FALSE;
-
- sprintf(old_name, "demos%cplugh", FN_SEP);
- printf("3. \"inform %s\"\n", old_name);
- translate_in_filename(0, new_name, old_name, 0, 1);
- printf(" the source code is read from \"%s\"\n", new_name);
- sprintf(old_name, "demos%cplugh", FN_SEP);
- convert_filename_flag = TRUE;
- translate_out_filename(new_name, old_name);
- printf(" and a story file is compiled to \"%s\".\n\n", new_name);
-
- printf("4. \"inform plover my_demo\"\n");
- translate_in_filename(0, new_name, "plover", 0, 1);
- printf(" the source code is read from \"%s\"\n", new_name);
- convert_filename_flag = FALSE;
- translate_out_filename(new_name, "my_demo");
- printf(" and a story file is compiled to \"%s\".\n\n", new_name);
-
- strcpy(old_name, Source_Path);
- sprintf(new_name, "%cnew%cold%crecent%cold%cancient",
- FN_ALT, FN_ALT, FN_SEP, FN_ALT, FN_SEP);
- printf("5. \"inform +source_path=%s zooge\"\n", new_name);
- printf(
-" Note that four alternative paths are given, the first being the empty\n\
- path-name (meaning: where you are now). Inform looks for the source code\n\
- by trying these four places in turn, stopping when it finds anything:\n\n");
-
- set_path_value(Source_Path, new_name);
- x = 0;
- do
- { x = translate_in_filename(x, new_name, "zooge", 0, 1);
- printf(" \"%s\"\n", new_name);
- } while (x != 0);
- strcpy(Source_Path, old_name);
- module_switch = save_mm;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Naming temporary files */
-/* (Arguably temporary files should be made using "tmpfile" in */
-/* the ANSI C library, but many supposed ANSI libraries lack it.) */
-/* ------------------------------------------------------------------------- */
-
-extern void translate_temp_filename(int i)
-{ char *p = NULL;
- switch(i)
- { case 1: p=Temp1_Name; break;
- case 2: p=Temp2_Name; break;
- case 3: p=Temp3_Name; break;
- }
- if (strlen(Temporary_Path)+strlen(Temporary_File)+6 >= PATHLEN) {
- printf ("Temporary_Path is too long.\n");
- exit(1);
- }
- sprintf(p,"%s%s%d", Temporary_Path, Temporary_File, i);
-#ifdef INCLUDE_TASK_ID
- sprintf(p+strlen(p), "_proc%08lx", (long int) unique_task_id());
-#endif
-#ifdef FILE_EXTENSIONS
- sprintf(p+strlen(p), ".tmp");
-#endif
-}
-
-#ifdef ARCHIMEDES
-static char riscos_ft_buffer[4];
-
-extern char *riscos_file_type(void)
-{
- if (riscos_file_type_format == 1)
- { if (module_switch) return("data");
- return("11A");
- }
-
- if (module_switch) return("075");
-
- sprintf(riscos_ft_buffer, "%03x", 0x60 + version_number);
- return(riscos_ft_buffer);
-}
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* The compilation pass */
-/* ------------------------------------------------------------------------- */
-
-static void run_pass(void)
-{
- lexer_begin_prepass();
- files_begin_prepass();
- load_sourcefile(Source_Name, 0);
-
- begin_pass();
-
- parse_program(NULL);
-
- find_the_actions();
- issue_unused_warnings();
- compile_veneer();
-
- lexer_endpass();
- if (module_switch) linker_endpass();
-
- close_all_source();
- if (hash_switch && hash_printed_since_newline) printf("\n");
-
- if (temporary_files_switch)
- { if (module_switch) flush_link_data();
- check_temp_files();
- }
- sort_dictionary();
- if (track_unused_routines)
- locate_dead_functions();
- construct_storyfile();
-}
-
-int output_has_occurred;
-
-static void rennab(int32 time_taken)
-{ /* rennab = reverse of banner */
-
- int t = no_warnings + no_suppressed_warnings;
-
- if (memout_switch) print_memory_usage();
-
- if ((no_errors + t)!=0)
- { printf("Compiled with ");
- if (no_errors > 0)
- { printf("%d error%s", no_errors,(no_errors==1)?"":"s");
- if (t > 0) printf(" and ");
- }
- if (no_warnings > 0)
- printf("%d warning%s", t, (t==1)?"":"s");
- if (no_suppressed_warnings > 0)
- { if (no_warnings > 0)
- printf(" (%d suppressed)", no_suppressed_warnings);
- else
- printf("%d suppressed warning%s", no_suppressed_warnings,
- (no_suppressed_warnings==1)?"":"s");
- }
- if (output_has_occurred == FALSE) printf(" (no output)");
- printf("\n");
- }
-
- if (no_compiler_errors > 0) print_sorry_message();
-
- if (statistics_switch)
- printf("Completed in %ld seconds\n", (long int) time_taken);
-}
-
-/* ------------------------------------------------------------------------- */
-/* The compiler abstracted to a routine. */
-/* ------------------------------------------------------------------------- */
-
-static int execute_icl_header(char *file1);
-
-static int compile(int number_of_files_specified, char *file1, char *file2)
-{ int32 time_start;
-
- if (execute_icl_header(file1))
- return 1;
-
- select_target(glulx_mode);
-
- if (define_INFIX_switch && glulx_mode) {
- printf("Infix (-X) facilities are not available in Glulx: \
-disabling -X switch\n");
- define_INFIX_switch = FALSE;
- }
-
- if (module_switch && glulx_mode) {
- printf("Modules are not available in Glulx: \
-disabling -M switch\n");
- module_switch = FALSE;
- }
-
- if (define_INFIX_switch && module_switch)
- { printf("Infix (-X) facilities are not available when compiling \
-modules: disabling -X switch\n");
- define_INFIX_switch = FALSE;
- }
- if (runtime_error_checking_switch && module_switch)
- { printf("Strict checking (-S) facilities are not available when \
-compiling modules: disabling -S switch\n");
- runtime_error_checking_switch = FALSE;
- }
-
- time_start=time(0); no_compilations++;
-
- strcpy(Source_Name, file1); convert_filename_flag = TRUE;
- strcpy(Code_Name, file1);
- if (number_of_files_specified == 2)
- { strcpy(Code_Name, file2); convert_filename_flag = FALSE;
- }
-
- init_vars();
-
- if (debugfile_switch) begin_debug_file();
-
- allocate_arrays();
-
- if (transcript_switch) open_transcript_file(Source_Name);
-
- run_pass();
-
- 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();
- }
-
- if (temporary_files_switch && (no_errors>0)) remove_temp_files();
-
- free_arrays();
-
- rennab((int32) (time(0)-time_start));
-
- if (optimise_switch) optimise_abbreviations();
-
- if (store_the_text) my_free(&all_text,"transcription text");
-
- return (no_errors==0)?0:1;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The command line interpreter */
-/* ------------------------------------------------------------------------- */
-
-static void cli_print_help(int help_level)
-{
- printf(
-"\nThis program is a compiler of Infocom format (also called \"Z-machine\")\n\
-story files: copyright (c) Graham Nelson 1993 - 2017.\n\n");
-
- /* For people typing just "inform", a summary only: */
-
- if (help_level==0)
- {
-
-#ifndef PROMPT_INPUT
- printf("Usage: \"inform [commands...] <file1> [<file2>]\"\n\n");
-#else
- printf("When run, Inform prompts you for commands (and switches),\n\
-which are optional, then an input <file1> and an (optional) output\n\
-<file2>.\n\n");
-#endif
-
- printf(
-"<file1> is the Inform source file of the game to be compiled. <file2>,\n\
-if given, overrides the filename Inform would normally use for the\n\
-compiled output. Try \"inform -h1\" for file-naming conventions.\n\n\
-One or more words can be supplied as \"commands\". These may be:\n\n\
- -switches a list of compiler switches, 1 or 2 letter\n\
- (see \"inform -h2\" for the full range)\n\n\
- +dir set Include_Path to this directory\n\
- +PATH=dir change the PATH to this directory\n\n\
- $... one of the following memory commands:\n");
- printf(
-" $list list current memory allocation settings\n\
- $huge make standard \"huge game\" settings %s\n\
- $large make standard \"large game\" settings %s\n\
- $small make standard \"small game\" settings %s\n\
- $?SETTING explain briefly what SETTING is for\n\
- $SETTING=number change SETTING to given number\n\n\
- (filename) read in a list of commands (in the format above)\n\
- from this \"setup file\"\n\n",
- (DEFAULT_MEMORY_SIZE==HUGE_SIZE)?"(default)":"",
- (DEFAULT_MEMORY_SIZE==LARGE_SIZE)?"(default)":"",
- (DEFAULT_MEMORY_SIZE==SMALL_SIZE)?"(default)":"");
-
-#ifndef PROMPT_INPUT
- printf("For example: \"inform -dexs $huge curses\".\n\n");
-#endif
-
- return;
- }
-
- /* The -h1 (filenaming) help information: */
-
- if (help_level == 1) { help_on_filenames(); return; }
-
- /* The -h2 (switches) help information: */
-
- printf("Help on the full list of legal switch commands:\n\n\
- a trace assembly-language (without hex dumps; see -t)\n\
- c more concise error messages\n\
- d contract double spaces after full stops in text\n\
- d2 contract double spaces after exclamation and question marks, too\n\
- e economy mode (slower): make use of declared abbreviations\n");
-
- printf("\
- f frequencies mode: show how useful abbreviations are\n\
- g traces calls to functions (except in the library)\n\
- g2 traces calls to all functions\n\
- h print this information\n");
-
- printf("\
- i ignore default switches set within the file\n\
- j list objects as constructed\n\
- k output Infix debugging information to \"%s\" (and switch -D on)\n\
- l list every statement run through Inform\n\
- m say how much memory has been allocated\n\
- n print numbers of properties, attributes and actions\n",
- Debugging_Name);
- printf("\
- o print offset addresses\n\
- p give percentage breakdown of story file\n\
- q keep quiet about obsolete usages\n\
- r record all the text to \"%s\"\n\
- s give statistics\n\
- t trace assembly-language (with full hex dumps; see -a)\n",
- Transcript_Name);
-
- printf("\
- u work out most useful abbreviations (very very slowly)\n\
- v3 compile to version-3 (\"Standard\") story file\n\
- v4 compile to version-4 (\"Plus\") story file\n\
- v5 compile to version-5 (\"Advanced\") story file: the default\n\
- v6 compile to version-6 (graphical) story file\n\
- v8 compile to version-8 (expanded \"Advanced\") story file\n\
- w disable warning messages\n\
- x print # for every 100 lines compiled\n\
- y trace linking system\n\
- z print memory map of the Z-machine\n\n");
-
-printf("\
- B use big memory model (for large V6/V7 files)\n\
- C0 text character set is plain ASCII only\n\
- Cu text character set is UTF-8\n\
- Cn text character set is ISO 8859-n (n = 1 to 9)\n\
- (1 to 4, Latin1 to Latin4; 5, Cyrillic; 6, Arabic;\n\
- 7, Greek; 8, Hebrew; 9, Latin5. Default is -C1.)\n");
-printf(" D insert \"Constant DEBUG;\" automatically\n");
-printf(" E0 Archimedes-style error messages%s\n",
- (error_format==0)?" (current setting)":"");
-printf(" E1 Microsoft-style error messages%s\n",
- (error_format==1)?" (current setting)":"");
-printf(" E2 Macintosh MPW-style error messages%s\n",
- (error_format==2)?" (current setting)":"");
-#ifdef USE_TEMPORARY_FILES
-printf(" F0 use extra memory rather than temporary files\n");
-#else
-printf(" F1 use temporary files to reduce memory consumption\n");
-#endif
-printf(" G compile a Glulx game file\n");
-printf(" H use Huffman encoding to compress Glulx strings\n");
-printf(" M compile as a Module for future linking\n");
-
-#ifdef ARCHIMEDES
-printf("\
- R0 use filetype 060 + version number for games (default)\n\
- R1 use official Acorn filetype 11A for all games\n");
-#endif
-printf(" S compile strict error-checking at run-time (on by default)\n");
-#ifdef ARC_THROWBACK
-printf(" T enable throwback of errors in the DDE\n");
-#endif
-printf(" U insert \"Constant USE_MODULES;\" automatically\n");
-printf(" V print the version and date of this program\n");
-printf(" Wn header extension table is at least n words (n = 3 to 99)\n");
-printf(" X compile with INFIX debugging facilities present\n");
- printf("\n");
-}
-
-extern void switches(char *p, int cmode)
-{ int i, s=1, state;
- /* Here cmode is 0 if switches list is from a "Switches" directive
- and 1 if from a "-switches" command-line or ICL list */
-
- if (cmode==1)
- { if (p[0]!='-')
- { printf(
- "Ignoring second word which should be a -list of switches.\n");
- return;
- }
- }
- for (i=cmode; p[i]!=0; i+=s, s=1)
- { state = TRUE;
- if (p[i] == '~')
- { state = FALSE;
- i++;
- }
- switch(p[i])
- {
- case 'a': asm_trace_setting = 1; break;
- case 'b': bothpasses_switch = state; break;
- case 'c': concise_switch = state; break;
- case 'd': switch(p[i+1])
- { case '1': double_space_setting=1; s=2; break;
- case '2': double_space_setting=2; s=2; break;
- default: double_space_setting=1; break;
- }
- break;
- case 'e': economy_switch = state; break;
- case 'f': frequencies_switch = state; break;
- case 'g': switch(p[i+1])
- { case '1': trace_fns_setting=1; s=2; break;
- case '2': trace_fns_setting=2; s=2; break;
- default: trace_fns_setting=1; break;
- }
- break;
- case 'h': switch(p[i+1])
- { case '1': cli_print_help(1); s=2; break;
- case '2': cli_print_help(2); s=2; break;
- case '0': s=2;
- default: cli_print_help(0); break;
- }
- break;
- case 'i': ignore_switches_switch = state; break;
- case 'j': listobjects_switch = state; break;
- case 'k': if (cmode == 0)
- error("The switch '-k' can't be set with 'Switches'");
- else
- { debugfile_switch = state;
- if (state) define_DEBUG_switch = TRUE;
- }
- break;
- case 'l': listing_switch = state; break;
- case 'm': memout_switch = state; break;
- case 'n': printprops_switch = state; break;
- case 'o': offsets_switch = state; break;
- case 'p': percentages_switch = state; break;
- case 'q': obsolete_switch = state; break;
- case 'r': if (cmode == 0)
- error("The switch '-r' can't be set with 'Switches'");
- else
- transcript_switch = state; break;
- case 's': statistics_switch = state; break;
- case 't': asm_trace_setting=2; break;
- case 'u': if (cmode == 0) {
- error("The switch '-u' can't be set with 'Switches'");
- break;
- }
- optimise_switch = state; break;
- case 'v': if (glulx_mode) { s = select_glulx_version(p+i+1)+1; break; }
- if ((cmode==0) && (version_set_switch)) { s=2; break; }
- version_set_switch = TRUE; s=2;
- switch(p[i+1])
- { case '3': select_version(3); break;
- case '4': select_version(4); break;
- case '5': select_version(5); break;
- case '6': select_version(6); break;
- case '7': select_version(7); break;
- case '8': select_version(8); break;
- default: printf("-v must be followed by 3 to 8\n");
- version_set_switch=0; s=1;
- break;
- }
- if ((version_number < 5) && (r_e_c_s_set == FALSE))
- runtime_error_checking_switch = FALSE;
- break;
- case 'w': nowarnings_switch = state; break;
- case 'x': hash_switch = state; break;
- case 'y': s=2; linker_trace_setting=p[i+1]-'0'; break;
- case 'z': memory_map_switch = state; break;
- case 'B': oddeven_packing_switch = state; break;
- case 'C': s=2;
- if (p[i+1] == 'u') {
- character_set_unicode = TRUE;
- /* Leave the set_setting on Latin-1, because that
- matches the first block of Unicode. */
- character_set_setting = 1;
- }
- else
- { character_set_setting=p[i+1]-'0';
- if ((character_set_setting < 0)
- || (character_set_setting > 9))
- { printf("-C must be followed by 'u' or 0 to 9. Defaulting to ISO-8859-1.\n");
- character_set_unicode = FALSE;
- character_set_setting = 1;
- }
- }
- if (cmode == 0) change_character_set();
- break;
- case 'D': define_DEBUG_switch = state; break;
- case 'E': switch(p[i+1])
- { case '0': s=2; error_format=0; break;
- case '1': s=2; error_format=1; break;
- case '2': s=2; error_format=2; break;
- default: error_format=1; break;
- }
- break;
- case 'F': if (cmode == 0) {
- error("The switch '-F' can't be set with 'Switches'");
- break;
- }
- switch(p[i+1])
- { case '0': s=2; temporary_files_switch = FALSE; break;
- case '1': s=2; temporary_files_switch = TRUE; break;
- default: temporary_files_switch = state; break;
- }
- break;
- case 'M': module_switch = state;
- if (state && (r_e_c_s_set == FALSE))
- runtime_error_checking_switch = FALSE;
- break;
-#ifdef ARCHIMEDES
- case 'R': switch(p[i+1])
- { case '0': s=2; riscos_file_type_format=0; break;
- case '1': s=2; riscos_file_type_format=1; break;
- default: riscos_file_type_format=1; break;
- }
- break;
-#endif
-#ifdef ARC_THROWBACK
- case 'T': throwback_switch = state; break;
-#endif
- case 'S': runtime_error_checking_switch = state;
- r_e_c_s_set = TRUE; break;
- case 'G': if (cmode == 0)
- error("The switch '-G' can't be set with 'Switches'");
- else
- { glulx_mode = state;
- adjust_memory_sizes();
- }
- break;
- case 'H': compression_switch = state; break;
- case 'U': define_USE_MODULES_switch = state; break;
- case 'V': exit(0); break;
- case 'W': if ((p[i+1]>='0') && (p[i+1]<='9'))
- { s=2; ZCODE_HEADER_EXT_WORDS = p[i+1]-'0';
- if ((p[i+2]>='0') && (p[i+2]<='9'))
- { s=3; ZCODE_HEADER_EXT_WORDS *= 10;
- ZCODE_HEADER_EXT_WORDS += p[i+2]-'0';
- }
- }
- break;
- case 'X': define_INFIX_switch = state; break;
- default:
- printf("Switch \"-%c\" unknown (try \"inform -h2\" for the list)\n",
- p[i]);
- break;
- }
- }
-
- if (optimise_switch && (!store_the_text))
- { store_the_text=TRUE;
-#ifdef PC_QUICKC
- if (memout_switch)
- printf("Allocation %ld bytes for transcription text\n",
- (long) MAX_TRANSCRIPT_SIZE);
- all_text = halloc(MAX_TRANSCRIPT_SIZE,1);
- malloced_bytes += MAX_TRANSCRIPT_SIZE;
- if (all_text==NULL)
- fatalerror("Can't hallocate memory for transcription text. Darn.");
-#else
- all_text=my_malloc(MAX_TRANSCRIPT_SIZE,"transcription text");
-#endif
- }
-}
-
-static int icl_command(char *p)
-{ if ((p[0]=='+')||(p[0]=='-')||(p[0]=='$')
- || ((p[0]=='(')&&(p[strlen(p)-1]==')')) ) return TRUE;
- return FALSE;
-}
-
-static void icl_error(char *filename, int line)
-{ printf("Error in ICL file '%s', line %d:\n", filename, line);
-}
-
-static void icl_header_error(char *filename, int line)
-{ printf("Error in ICL header of file '%s', line %d:\n", filename, line);
-}
-
-static int copy_icl_word(char *from, char *to, int max)
-{
- /* Copies one token from 'from' to 'to', null-terminated:
- returns the number of chars in 'from' read past (possibly 0). */
-
- int i, j, quoted_mode, truncated;
-
- i = 0; truncated = 0;
- while ((from[i] == ' ') || (from[i] == TAB_CHARACTER)
- || (from[i] == (char) 10) || (from[i] == (char) 13)) i++;
-
- if (from[i] == '!')
- { while (from[i] != 0) i++;
- to[0] = 0; return i;
- }
-
- for (quoted_mode = FALSE, j=0;;)
- { if (from[i] == 0) break;
- if (from[i] == 10) break;
- if (from[i] == 13) break;
- if (from[i] == TAB_CHARACTER) break;
- if ((from[i] == ' ') && (!quoted_mode)) break;
- if (from[i] == '\"') { quoted_mode = !quoted_mode; i++; }
- else to[j++] = from[i++];
- if (j == max) {
- j--;
- truncated = 1;
- }
- }
- to[j] = 0;
- if (truncated == 1)
- printf("The following parameter has been truncated:\n%s\n", to);
- return i;
-}
-
-static void execute_icl_command(char *p);
-
-static int execute_icl_header(char *argname)
-{
- FILE *command_file;
- char cli_buff[256], fw[256];
- int line = 0;
- int errcount = 0;
- int i;
- char filename[PATHLEN];
- int x = 0;
-
- do
- { x = translate_in_filename(x, filename, argname, 0, 1);
- command_file = fopen(filename,"r");
- } while ((command_file == NULL) && (x != 0));
- if (!command_file) {
- /* Fail silently. The regular compiler will try to open the file
- again, and report the problem. */
- return 0;
- }
-
- while (feof(command_file)==0) {
- if (fgets(cli_buff,256,command_file)==0) break;
- line++;
- if (!(cli_buff[0] == '!' && cli_buff[1] == '%'))
- break;
- i = copy_icl_word(cli_buff+2, fw, 256);
- if (icl_command(fw)) {
- execute_icl_command(fw);
- copy_icl_word(cli_buff+2 + i, fw, 256);
- if ((fw[0] != 0) && (fw[0] != '!')) {
- icl_header_error(filename, line);
- errcount++;
- printf("expected comment or nothing but found '%s'\n", fw);
- }
- }
- else {
- if (fw[0]!=0) {
- icl_header_error(filename, line);
- errcount++;
- printf("Expected command or comment but found '%s'\n", fw);
- }
- }
- }
- fclose(command_file);
-
- return (errcount==0)?0:1;
-}
-
-
-static void run_icl_file(char *filename, FILE *command_file)
-{ char cli_buff[256], fw[256];
- int i, x, line = 0;
- printf("[Running ICL file '%s']\n", filename);
-
- while (feof(command_file)==0)
- { if (fgets(cli_buff,256,command_file)==0) break;
- line++;
- i = copy_icl_word(cli_buff, fw, 256);
- if (icl_command(fw))
- { execute_icl_command(fw);
- copy_icl_word(cli_buff + i, fw, 256);
- if ((fw[0] != 0) && (fw[0] != '!'))
- { icl_error(filename, line);
- printf("expected comment or nothing but found '%s'\n", fw);
- }
- }
- else
- { if (strcmp(fw, "compile")==0)
- { char story_name[PATHLEN], code_name[PATHLEN];
- i += copy_icl_word(cli_buff + i, story_name, PATHLEN);
- i += copy_icl_word(cli_buff + i, code_name, PATHLEN);
-
- if (code_name[0] != 0) x=2;
- else if (story_name[0] != 0) x=1;
- else x=0;
-
- switch(x)
- { case 0: icl_error(filename, line);
- printf("No filename given to 'compile'\n");
- break;
- case 1: printf("[Compiling <%s>]\n", story_name);
- compile(x, story_name, code_name);
- break;
- case 2: printf("[Compiling <%s> to <%s>]\n",
- story_name, code_name);
- compile(x, story_name, code_name);
- copy_icl_word(cli_buff + i, fw, 256);
- if (fw[0]!=0)
- { icl_error(filename, line);
- printf("Expected comment or nothing but found '%s'\n",
- fw);
- }
- break;
- }
- }
- else
- if (fw[0]!=0)
- { icl_error(filename, line);
- printf("Expected command or comment but found '%s'\n", fw);
- }
- }
- }
-}
-
-static void execute_icl_command(char *p)
-{ char filename[PATHLEN], cli_buff[256];
- FILE *command_file;
-
- switch(p[0])
- { case '+': set_path_command(p+1); break;
- case '-': switches(p,1); break;
- case '$': memory_command(p+1); break;
- case '(': strcpy(cli_buff,p+1); cli_buff[strlen(cli_buff)-1]=0;
- { int x = 0;
- do
- { x = translate_icl_filename(x, filename, cli_buff);
- command_file = fopen(filename,"r");
- } while ((command_file == NULL) && (x != 0));
- }
- if (command_file == NULL)
- printf("Error in ICL: Couldn't open command file '%s'\n",
- filename);
- else
- { run_icl_file(filename, command_file);
- fclose(command_file);
- }
- break;
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Opening and closing banners */
-/* ------------------------------------------------------------------------- */
-
-char banner_line[80];
-
-static void banner(void)
-{
- sprintf(banner_line, "Inform %d.%d%d",
- (VNUMBER/100)%10, (VNUMBER/10)%10, VNUMBER%10);
-#ifdef RELEASE_SUFFIX
- strcat(banner_line, RELEASE_SUFFIX);
-#endif
-#ifdef MACHINE_STRING
- sprintf(banner_line+strlen(banner_line), " for %s", MACHINE_STRING);
-#endif
- sprintf(banner_line+strlen(banner_line), " (%s)", RELEASE_DATE);
- printf("%s\n", banner_line);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Input from the outside world */
-/* ------------------------------------------------------------------------- */
-
-#ifdef PROMPT_INPUT
-static void read_command_line(int argc, char **argv)
-{ int i;
- char buffer1[PATHLEN], buffer2[PATHLEN], buffer3[PATHLEN];
- i=0;
- printf("Source filename?\n> ");
- while (gets(buffer1)==NULL); cli_file1=buffer1;
- printf("Output filename (RETURN for the same)?\n> ");
- while (gets(buffer2)==NULL); cli_file2=buffer2;
- cli_files_specified=1;
- if (buffer2[0]!=0) cli_files_specified=2;
- do
- { printf("List of commands (RETURN to finish; \"-h\" for help)?\n> ");
- while (gets(buffer3)==NULL); execute_icl_command(buffer3);
- } while (buffer3[0]!=0);
-}
-#else
-static void read_command_line(int argc, char **argv)
-{ int i;
- if (argc==1) switches("-h",1);
-
- for (i=1, cli_files_specified=0; i<argc; i++)
- if (icl_command(argv[i]))
- execute_icl_command(argv[i]);
- else
- switch(++cli_files_specified)
- { case 1: cli_file1 = argv[i]; break;
- case 2: cli_file2 = argv[i]; break;
- default:
- printf("Command line error: unknown parameter '%s'\n",
- argv[i]); return;
- }
-}
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* M A I N : An outer shell for machine-specific quirks */
-/* Omitted altogether if EXTERNAL_SHELL is defined, as for instance is */
-/* needed for the Macintosh front end. */
-/* ------------------------------------------------------------------------- */
-
-#ifdef EXTERNAL_SHELL
-extern int sub_main(int argc, char **argv);
-#else
-
-static int sub_main(int argc, char **argv);
-#ifdef MAC_MPW
-int main(int argc, char **argv, char *envp[])
-#else
-int main(int argc, char **argv)
-#endif
-{ int rcode;
-#ifdef MAC_MPW
- InitCursorCtl((acurHandle)NULL); Show_Cursor(WATCH_CURSOR);
-#endif
- rcode = sub_main(argc, argv);
-#ifdef ARC_THROWBACK
- throwback_end();
-#endif
- return rcode;
-}
-
-#endif
-
-/* ------------------------------------------------------------------------- */
-/* M A I N II: Starting up ICL with the command line */
-/* ------------------------------------------------------------------------- */
-
-#ifdef EXTERNAL_SHELL
-extern int sub_main(int argc, char **argv)
-#else
-static int sub_main(int argc, char **argv)
-#endif
-{ int return_code;
-
-#ifdef MAC_FACE
- ProcessEvents (&g_proc);
- if (g_proc != true)
- { free_arrays();
- if (store_the_text) my_free(&all_text,"transcription text");
- longjmp (g_fallback, 1);
- }
-#endif
-
- banner();
-
- set_memory_sizes(DEFAULT_MEMORY_SIZE); set_default_paths();
- reset_switch_settings(); select_version(5);
-
- cli_files_specified = 0; no_compilations = 0;
- cli_file1 = "source"; cli_file2 = "output";
-
- read_command_line(argc, argv);
-
- if (cli_files_specified > 0)
- { return_code = compile(cli_files_specified, cli_file1, cli_file2);
-
- if (return_code != 0) return(return_code);
- }
-
- if (no_compilations == 0)
- printf("\n[No compilation requested]\n");
- if (no_compilations > 1)
- printf("[%d compilations completed]\n", no_compilations);
-
- return(0);
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "lexer" : Lexical analyser */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int total_source_line_count, /* Number of source lines so far */
-
- no_hash_printed_yet, /* Have not yet printed the first # */
- hash_printed_since_newline, /* A hash has been printed since the
- most recent new-line was printed
- (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
- keyword table is searched. */
- return_sp_as_variable; /* When TRUE, the word "sp" denotes
- the stack pointer variable
- (used in assembly language only) */
-int next_token_begins_syntax_line; /* When TRUE, start a new syntax
- line (for error reporting, etc.)
- on the source code line where
- the next token appears */
-
-int32 last_mapped_line; /* Last syntax line reported to debugging file */
-
-/* ------------------------------------------------------------------------- */
-/* The lexer's output is a sequence of triples, each called a "token", */
-/* representing one lexical unit (or "lexeme") each. Instead of providing */
-/* "lookahead" (that is, always having available the next token after the */
-/* current one, so that syntax analysers higher up in Inform can have */
-/* advance knowledge of what is coming), the lexer instead has a system */
-/* where tokens can be read in and then "put back again". */
-/* The meaning of the number (and to some extent the text) supplied with */
-/* a token depends on its type: see "header.h" for the list of types. */
-/* For example, the lexeme "$1e3" is understood by Inform as a hexadecimal */
-/* number, and translated to the token: */
-/* type NUMBER_TT, value 483, text "$1e3" */
-/* ------------------------------------------------------------------------- */
-/* These three variables are set to the current token on a call to */
-/* get_next_token() (but are not changed by a call to put_token_back()). */
-/* ------------------------------------------------------------------------- */
-
-int token_type;
-int32 token_value;
-char *token_text;
-
-/* ------------------------------------------------------------------------- */
-/* The next two variables are the head and tail of a singly linked list. */
-/* The tail stores the portion most recently read from the current */
-/* lexical block; its end values therefore describe the location of the */
-/* current token, and are updated whenever the three variables above are */
-/* via set_token_location(...). Earlier vertices, if any, represent the */
-/* regions of lexical blocks read beforehand, where new vertices are */
-/* only introduced by interruptions like a file inclusion or an EOF. */
-/* Vertices are deleted off of the front of the list once they are no */
-/* longer referenced by pending debug information records. */
-/* ------------------------------------------------------------------------- */
-
-static debug_locations *first_token_locations;
-static debug_locations *last_token_location;
-
-extern debug_location get_token_location(void)
-{ debug_location result;
- debug_location *location = &(last_token_location->location);
- result.file_index = location->file_index;
- result.beginning_byte_index = location->end_byte_index;
- result.end_byte_index = location->end_byte_index;
- result.beginning_line_number = location->end_line_number;
- result.end_line_number = location->end_line_number;
- result.beginning_character_number = location->end_character_number;
- result.end_character_number = location->end_character_number;
- result.orig_file_index = location->orig_file_index;
- result.orig_beg_line_number = location->orig_beg_line_number;
- result.orig_beg_char_number = location->orig_beg_char_number;
- return result;
-}
-
-extern debug_locations get_token_locations(void)
-{ debug_locations result;
- result.location = get_token_location();
- result.next = NULL;
- result.reference_count = 0;
- return result;
-}
-
-static void set_token_location(debug_location location)
-{ if (location.file_index == last_token_location->location.file_index)
- { last_token_location->location.end_byte_index =
- location.end_byte_index;
- last_token_location->location.end_line_number =
- location.end_line_number;
- last_token_location->location.end_character_number =
- location.end_character_number;
- last_token_location->location.orig_file_index =
- location.orig_file_index;
- last_token_location->location.orig_beg_line_number =
- location.orig_beg_line_number;
- last_token_location->location.orig_beg_char_number =
- location.orig_beg_char_number;
- } else
- { debug_locations*successor =
- my_malloc
- (sizeof(debug_locations),
- "debug locations of recent tokens");
- successor->location = location;
- successor->next = NULL;
- successor->reference_count = 0;
- last_token_location->next = successor;
- last_token_location = successor;
- }
-}
-
-extern debug_location_beginning get_token_location_beginning(void)
-{ debug_location_beginning result;
- ++(last_token_location->reference_count);
- result.head = last_token_location;
- result.beginning_byte_index =
- last_token_location->location.end_byte_index;
- result.beginning_line_number =
- last_token_location->location.end_line_number;
- result.beginning_character_number =
- last_token_location->location.end_character_number;
- result.orig_file_index = last_token_location->location.orig_file_index;
- result.orig_beg_line_number = last_token_location->location.orig_beg_line_number;
- result.orig_beg_char_number = last_token_location->location.orig_beg_char_number;
-
- return result;
-}
-
-static void cleanup_token_locations(debug_location_beginning*beginning)
-{ if (first_token_locations)
- { while (first_token_locations &&
- !first_token_locations->reference_count)
- { debug_locations*moribund = first_token_locations;
- first_token_locations = moribund->next;
- my_free(&moribund, "debug locations of recent tokens");
- if (beginning &&
- (beginning->head == moribund || !first_token_locations))
- { compiler_error
- ("Records needed by a debug_location_beginning are no "
- "longer allocated, perhaps because of an invalid reuse "
- "of this or an earlier beginning");
- }
- }
- } else
- { if (beginning)
- { compiler_error
- ("Attempt to use a debug_location_beginning when no token "
- "locations are defined");
- } else
- { compiler_error
- ("Attempt to clean up token locations when no token locations "
- "are defined");
- }
- }
-}
-
-extern void discard_token_location(debug_location_beginning beginning)
-{ --(beginning.head->reference_count);
-}
-
-extern debug_locations get_token_location_end
- (debug_location_beginning beginning)
-{ debug_locations result;
- cleanup_token_locations(&beginning);
- --(beginning.head->reference_count);
- /* Sometimes we know what we'll read before we switch to the lexical block
- where we'll read it. In such cases the beginning will be placed in the
- prior block and last exactly zero bytes there. It's misleading to
- include such ranges, so we gobble them. */
- if (beginning.head->location.end_byte_index ==
- beginning.beginning_byte_index &&
- beginning.head->next)
- { beginning.head = beginning.head->next;
- result.location = beginning.head->location;
- result.location.beginning_byte_index = 0;
- result.location.beginning_line_number = 1;
- result.location.beginning_character_number = 1;
- } else
- { result.location = beginning.head->location;
- result.location.beginning_byte_index =
- beginning.beginning_byte_index;
- result.location.beginning_line_number =
- beginning.beginning_line_number;
- result.location.beginning_character_number =
- beginning.beginning_character_number;
- }
-
- result.location.orig_file_index =
- beginning.orig_file_index;
- result.location.orig_beg_line_number =
- beginning.orig_beg_line_number;
- result.location.orig_beg_char_number =
- beginning.orig_beg_char_number;
-
- result.next = beginning.head->next;
- result.reference_count = 0;
- return result;
-}
-
-/* ------------------------------------------------------------------------- */
-/* In order to be able to put tokens back efficiently, the lexer stores */
-/* tokens in a "circle": the variable circle_position ranges between */
-/* 0 and CIRCLE_SIZE-1. We only need a circle size as large as the */
-/* maximum number of tokens ever put back at once, plus 1 (in effect, the */
-/* maximum token lookahead ever needed in syntax analysis, plus 1). */
-/* */
-/* Unlike some compilers, Inform does not have a context-free lexer: in */
-/* fact it has 12288 different possible states. However, the context only */
-/* affects the interpretation of "identifiers": lexemes beginning with a */
-/* letter and containing up to 32 chars of alphanumeric and underscore */
-/* chars. (For example, "default" may refer to the directive or statement */
-/* of that name, and which token values are returned depends on the */
-/* current lexical context.) */
-/* */
-/* Along with each token, we also store the lexical context it was */
-/* translated under; because if it is called for again, there may need */
-/* to be a fresh interpretation of it if the context has changed. */
-/* ------------------------------------------------------------------------- */
-
-#define CIRCLE_SIZE 6
-
-/* (The worst case for token lookahead is distinguishing between an
- old-style "objectloop (a in b)" and a new "objectloop (a in b ...)".) */
-
-static int circle_position;
-static token_data circle[CIRCLE_SIZE];
-
-static int token_contexts[CIRCLE_SIZE];
-
-/* ------------------------------------------------------------------------- */
-/* A complication, however, is that the text of some lexemes needs to be */
-/* held in Inform's memory for much longer periods: for example, a */
-/* dictionary word lexeme (like "'south'") must have its text preserved */
-/* until the code generation time for the expression it occurs in, when */
-/* the dictionary reference is actually made. Code generation in general */
-/* occurs as early as possible in Inform: pending some better method of */
-/* garbage collection, we simply use a buffer so large that unless */
-/* expressions spread across 10K of source code are found, there can be */
-/* no problem. */
-/* ------------------------------------------------------------------------- */
-
-static char *lexeme_memory;
-static char *lex_p; /* Current write position */
-
-/* ------------------------------------------------------------------------- */
-/* The lexer itself needs up to 3 characters of lookahead (it uses an */
-/* LR(3) grammar to translate characters into tokens). */
-/* ------------------------------------------------------------------------- */
-
-#define LOOKAHEAD_SIZE 3
-
-static int current, lookahead, /* The latest character read, and */
- lookahead2, lookahead3; /* the three characters following it */
-
-static int pipeline_made; /* Whether or not the pipeline of
- characters has been constructed
- yet (this pass) */
-
-static int (* get_next_char)(void); /* Routine for reading the stream of
- characters: the lexer does not
- need any "ungetc" routine for
- putting them back again. End of
- stream is signalled by returning
- zero. */
-
-static char *source_to_analyse; /* The current lexical source:
- NULL for "load from source files",
- otherwise this points to a string
- containing Inform code */
-
-static int tokens_put_back; /* Count of the number of backward
- moves made from the last-read
- token */
-
-extern void describe_token(token_data t)
-{
- /* Many of the token types are not set in this file, but later on in
- Inform's higher stages (for example, in the expression evaluator);
- but this routine describes them all. */
-
- printf("{ ");
-
- switch(t.type)
- {
- /* The following token types occur in lexer output: */
-
- case SYMBOL_TT: printf("symbol ");
- describe_symbol(t.value);
- break;
- case NUMBER_TT: printf("literal number %d", t.value);
- break;
- case DQ_TT: printf("string \"%s\"", t.text);
- break;
- case SQ_TT: printf("string '%s'", t.text);
- break;
- case SEP_TT: printf("separator '%s'", t.text);
- break;
- case EOF_TT: printf("end of file");
- break;
-
- case STATEMENT_TT: printf("statement name '%s'", t.text);
- break;
- case SEGMENT_MARKER_TT: printf("object segment marker '%s'", t.text);
- break;
- case DIRECTIVE_TT: printf("directive name '%s'", t.text);
- break;
- case CND_TT: printf("textual conditional '%s'", t.text);
- break;
- case OPCODE_NAME_TT: printf("opcode name '%s'", t.text);
- break;
- case SYSFUN_TT: printf("built-in function name '%s'", t.text);
- break;
- case LOCAL_VARIABLE_TT: printf("local variable name '%s'", t.text);
- break;
- case MISC_KEYWORD_TT: printf("statement keyword '%s'", t.text);
- break;
- case DIR_KEYWORD_TT: printf("directive keyword '%s'", t.text);
- break;
- case TRACE_KEYWORD_TT: printf("'trace' keyword '%s'", t.text);
- break;
- case SYSTEM_CONSTANT_TT: printf("system constant name '%s'", t.text);
- break;
-
- /* The remaining are etoken types, not set by the lexer */
-
- case OP_TT: printf("operator '%s'",
- operators[t.value].description);
- break;
- case ENDEXP_TT: printf("end of expression");
- break;
- case SUBOPEN_TT: printf("open bracket");
- break;
- case SUBCLOSE_TT: printf("close bracket");
- break;
- case LARGE_NUMBER_TT: printf("large number: '%s'=%d",t.text,t.value);
- break;
- case SMALL_NUMBER_TT: printf("small number: '%s'=%d",t.text,t.value);
- break;
- case VARIABLE_TT: printf("variable '%s'=%d", t.text, t.value);
- break;
- case DICTWORD_TT: printf("dictionary word '%s'", t.text);
- break;
- case ACTION_TT: printf("action name '%s'", t.text);
- break;
-
- default:
- printf("** unknown token type %d, text='%s', value=%d **",
- t.type, t.text, t.value);
- }
- printf(" }");
-}
-
-/* ------------------------------------------------------------------------- */
-/* All but one of the 280 Inform keywords (118 of them opcode names used */
-/* only by the assembler). (The one left over is "sp", a keyword used in */
-/* assembly language only.) */
-/* */
-/* A "keyword group" is a set of keywords to be searched for. If a match */
-/* is made on an identifier, the token type becomes that given in the KG */
-/* and the token value is its index in the KG. */
-/* */
-/* The keyword ordering must correspond with the appropriate #define's in */
-/* "header.h" but is otherwise not significant. */
-/* ------------------------------------------------------------------------- */
-
-#define MAX_KEYWORDS 350
-
-/* The values will be filled in at compile time, when we know
- which opcode set to use. */
-keyword_group opcode_names =
-{ { "" },
- OPCODE_NAME_TT, FALSE, TRUE
-};
-
-static char *opcode_list_z[] = {
- "je", "jl", "jg", "dec_chk", "inc_chk", "jin", "test", "or", "and",
- "test_attr", "set_attr", "clear_attr", "store", "insert_obj", "loadw",
- "loadb", "get_prop", "get_prop_addr", "get_next_prop", "add", "sub",
- "mul", "div", "mod", "call", "storew", "storeb", "put_prop", "sread",
- "print_char", "print_num", "random", "push", "pull", "split_window",
- "set_window", "output_stream", "input_stream", "sound_effect", "jz",
- "get_sibling", "get_child", "get_parent", "get_prop_len", "inc", "dec",
- "print_addr", "remove_obj", "print_obj", "ret", "jump", "print_paddr",
- "load", "not", "rtrue", "rfalse", "print", "print_ret", "nop", "save",
- "restore", "restart", "ret_popped", "pop", "quit", "new_line",
- "show_status", "verify", "call_2s", "call_vs", "aread", "call_vs2",
- "erase_window", "erase_line", "set_cursor", "get_cursor",
- "set_text_style", "buffer_mode", "read_char", "scan_table", "call_1s",
- "call_2n", "set_colour", "throw", "call_vn", "call_vn2", "tokenise",
- "encode_text", "copy_table", "print_table", "check_arg_count", "call_1n",
- "catch", "piracy", "log_shift", "art_shift", "set_font", "save_undo",
- "restore_undo", "draw_picture", "picture_data", "erase_picture",
- "set_margins", "move_window", "window_size", "window_style",
- "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",
- ""
-};
-
-static char *opcode_list_g[] = {
- "nop", "add", "sub", "mul", "div", "mod", "neg", "bitand", "bitor",
- "bitxor", "bitnot", "shiftl", "sshiftr", "ushiftr", "jump", "jz",
- "jnz", "jeq", "jne", "jlt", "jge", "jgt", "jle",
- "jltu", "jgeu", "jgtu", "jleu",
- "call", "return",
- "catch", "throw", "tailcall",
- "copy", "copys", "copyb", "sexs", "sexb", "aload",
- "aloads", "aloadb", "aloadbit", "astore", "astores", "astoreb",
- "astorebit", "stkcount", "stkpeek", "stkswap", "stkroll", "stkcopy",
- "streamchar", "streamnum", "streamstr",
- "gestalt", "debugtrap", "getmemsize", "setmemsize", "jumpabs",
- "random", "setrandom", "quit", "verify",
- "restart", "save", "restore", "saveundo", "restoreundo", "protect",
- "glk", "getstringtbl", "setstringtbl", "getiosys", "setiosys",
- "linearsearch", "binarysearch", "linkedsearch",
- "callf", "callfi", "callfii", "callfiii",
- "streamunichar",
- "mzero", "mcopy", "malloc", "mfree",
- "accelfunc", "accelparam",
- "numtof", "ftonumz", "ftonumn", "ceil", "floor",
- "fadd", "fsub", "fmul", "fdiv", "fmod",
- "sqrt", "exp", "log", "pow",
- "sin", "cos", "tan", "asin", "acos", "atan", "atan2",
- "jfeq", "jfne", "jflt", "jfle", "jfgt", "jfge", "jisnan", "jisinf",
- ""
-};
-
-keyword_group opcode_macros =
-{ { "" },
- OPCODE_MACRO_TT, FALSE, TRUE
-};
-
-static char *opmacro_list_z[] = { "" };
-
-static char *opmacro_list_g[] = {
- "pull", "push",
- ""
-};
-
-keyword_group directives =
-{ { "abbreviate", "array", "attribute", "class", "constant",
- "default", "dictionary", "end", "endif", "extend", "fake_action",
- "global", "ifdef", "ifndef", "ifnot", "ifv3", "ifv5", "iftrue",
- "iffalse", "import", "include", "link", "lowstring", "message",
- "nearby", "object", "origsource", "property", "release", "replace",
- "serial", "switches", "statusline", "stub", "system_file", "trace",
- "undef", "verb", "version", "zcharacter",
- "" },
- DIRECTIVE_TT, FALSE, FALSE
-};
-
-keyword_group trace_keywords =
-{ { "dictionary", "symbols", "objects", "verbs",
- "assembly", "expressions", "lines", "tokens", "linker",
- "on", "off", "" },
- TRACE_KEYWORD_TT, FALSE, TRUE
-};
-
-keyword_group segment_markers =
-{ { "class", "has", "private", "with", "" },
- SEGMENT_MARKER_TT, FALSE, TRUE
-};
-
-keyword_group directive_keywords =
-{ { "alias", "long", "additive",
- "score", "time",
- "noun", "held", "multi", "multiheld", "multiexcept",
- "multiinside", "creature", "special", "number", "scope", "topic",
- "reverse", "meta", "only", "replace", "first", "last",
- "string", "table", "buffer", "data", "initial", "initstr",
- "with", "private", "has", "class",
- "error", "fatalerror", "warning",
- "terminating",
- "" },
- DIR_KEYWORD_TT, FALSE, TRUE
-};
-
-keyword_group misc_keywords =
-{ { "char", "name", "the", "a", "an", "The", "number",
- "roman", "reverse", "bold", "underline", "fixed", "on", "off",
- "to", "address", "string", "object", "near", "from", "property", "A", "" },
- MISC_KEYWORD_TT, FALSE, TRUE
-};
-
-keyword_group statements =
-{ { "box", "break", "continue", "default", "do", "else", "font", "for",
- "give", "if", "inversion", "jump", "move", "new_line", "objectloop",
- "print", "print_ret", "quit", "read", "remove", "restore", "return",
- "rfalse", "rtrue", "save", "spaces", "string", "style", "switch",
- "until", "while", "" },
- STATEMENT_TT, FALSE, TRUE
-};
-
-keyword_group conditions =
-{ { "has", "hasnt", "in", "notin", "ofclass", "or", "provides", "" },
- CND_TT, FALSE, TRUE
-};
-
-keyword_group system_functions =
-{ { "child", "children", "elder", "eldest", "indirect", "parent", "random",
- "sibling", "younger", "youngest", "metaclass", "glk", "" },
- SYSFUN_TT, FALSE, TRUE
-};
-
-keyword_group system_constants =
-{ { "adjectives_table", "actions_table", "classes_table",
- "identifiers_table", "preactions_table", "version_number",
- "largest_object", "strings_offset", "code_offset",
- "dict_par1", "dict_par2", "dict_par3", "actual_largest_object",
- "static_memory_offset", "array_names_offset", "readable_memory_offset",
- "cpv__start", "cpv__end", "ipv__start", "ipv__end",
- "array__start", "array__end",
- "lowest_attribute_number", "highest_attribute_number",
- "attribute_names_array",
- "lowest_property_number", "highest_property_number",
- "property_names_array",
- "lowest_action_number", "highest_action_number",
- "action_names_array",
- "lowest_fake_action_number", "highest_fake_action_number",
- "fake_action_names_array",
- "lowest_routine_number", "highest_routine_number", "routines_array",
- "routine_names_array", "routine_flags_array",
- "lowest_global_number", "highest_global_number", "globals_array",
- "global_names_array", "global_flags_array",
- "lowest_array_number", "highest_array_number", "arrays_array",
- "array_names_array", "array_flags_array",
- "lowest_constant_number", "highest_constant_number", "constants_array",
- "constant_names_array",
- "lowest_class_number", "highest_class_number", "class_objects_array",
- "lowest_object_number", "highest_object_number",
- "oddeven_packing",
- "grammar_table", "dictionary_table", "dynam_string_table",
- "" },
- SYSTEM_CONSTANT_TT, FALSE, TRUE
-};
-
-keyword_group *keyword_groups[12]
-= { NULL, &opcode_names, &directives, &trace_keywords, &segment_markers,
- &directive_keywords, &misc_keywords, &statements, &conditions,
- &system_functions, &system_constants, &opcode_macros};
-
-keyword_group local_variables =
-{ { "" }, /* Filled in when routine declared */
- LOCAL_VARIABLE_TT, FALSE, FALSE
-};
-
-static int lexical_context(void)
-{
- /* The lexical context is a number representing all of the context
- information in the lexical analyser: the same input text will
- 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). */
-
- int c = 0;
- if (opcode_names.enabled) c |= 1;
- if (directives.enabled) c |= 2;
- if (trace_keywords.enabled) c |= 4;
- if (segment_markers.enabled) c |= 8;
- if (directive_keywords.enabled) c |= 16;
- if (misc_keywords.enabled) c |= 32;
- if (statements.enabled) c |= 64;
- if (conditions.enabled) c |= 128;
- if (system_functions.enabled) c |= 256;
- if (system_constants.enabled) c |= 512;
- if (local_variables.enabled) c |= 1024;
-
- if (return_sp_as_variable) c |= 2048;
- return(c);
-}
-
-static void print_context(int c)
-{
- if ((c & 1) != 0) printf("OPC ");
- if ((c & 2) != 0) printf("DIR ");
- if ((c & 4) != 0) printf("TK ");
- if ((c & 8) != 0) printf("SEG ");
- if ((c & 16) != 0) printf("DK ");
- if ((c & 32) != 0) printf("MK ");
- if ((c & 64) != 0) printf("STA ");
- if ((c & 128) != 0) printf("CND ");
- if ((c & 256) != 0) printf("SFUN ");
- if ((c & 512) != 0) printf("SCON ");
- if ((c & 1024) != 0) printf("LV ");
- if ((c & 2048) != 0) printf("sp ");
-}
-
-static int *keywords_hash_table;
-static int *keywords_hash_ends_table;
-static int *keywords_data_table;
-
-static int *local_variable_hash_table;
-static int *local_variable_hash_codes;
-char **local_variable_texts;
-static char *local_variable_text_table;
-
-static char one_letter_locals[128];
-
-static void make_keywords_tables(void)
-{ int i, j, h, tp=0;
- char **oplist, **maclist;
-
- if (!glulx_mode) {
- oplist = opcode_list_z;
- maclist = opmacro_list_z;
- }
- else {
- oplist = opcode_list_g;
- maclist = opmacro_list_g;
- }
-
- for (j=0; *(oplist[j]); j++) {
- opcode_names.keywords[j] = oplist[j];
- }
- opcode_names.keywords[j] = "";
-
- for (j=0; *(maclist[j]); j++) {
- opcode_macros.keywords[j] = maclist[j];
- }
- opcode_macros.keywords[j] = "";
-
- for (i=0; i<HASH_TAB_SIZE; i++)
- { keywords_hash_table[i] = -1;
- keywords_hash_ends_table[i] = -1;
- }
-
- for (i=1; i<=11; i++)
- { keyword_group *kg = keyword_groups[i];
- for (j=0; *(kg->keywords[j]) != 0; j++)
- { h = hash_code_from_string(kg->keywords[j]);
- if (keywords_hash_table[h] == -1)
- keywords_hash_table[h] = tp;
- else
- *(keywords_data_table + 3*(keywords_hash_ends_table[h]) + 2) = tp;
- keywords_hash_ends_table[h] = tp;
- *(keywords_data_table + 3*tp) = i;
- *(keywords_data_table + 3*tp+1) = j;
- *(keywords_data_table + 3*tp+2) = -1;
- tp++;
- }
- }
-}
-
-extern void construct_local_variable_tables(void)
-{ int i, h; char *p = local_variable_text_table;
- for (i=0; i<HASH_TAB_SIZE; i++) local_variable_hash_table[i] = -1;
- for (i=0; i<128; i++) one_letter_locals[i] = MAX_LOCAL_VARIABLES;
-
- for (i=0; i<no_locals; i++)
- { char *q = local_variables.keywords[i];
- if (q[1] == 0)
- { one_letter_locals[(uchar)q[0]] = i;
- if (isupper(q[0])) one_letter_locals[tolower(q[0])] = i;
- if (islower(q[0])) one_letter_locals[toupper(q[0])] = i;
- }
- h = hash_code_from_string(q);
- if (local_variable_hash_table[h] == -1)
- local_variable_hash_table[h] = i;
- local_variable_hash_codes[i] = h;
- local_variable_texts[i] = p;
- strcpy(p, q);
- p += strlen(p)+1;
- }
- for (;i<MAX_LOCAL_VARIABLES-1;i++)
- local_variable_texts[i] = "<no such local variable>";
-}
-
-static void interpret_identifier(int pos, int dirs_only_flag)
-{ int index, hashcode; char *p = circle[pos].text;
-
- /* An identifier is either a keyword or a "symbol", a name which the
- lexical analyser leaves to higher levels of Inform to understand. */
-
- hashcode = hash_code_from_string(p);
-
- if (dirs_only_flag) goto KeywordSearch;
-
- /* If this is assembly language, perhaps it is "sp"? */
-
- if (return_sp_as_variable && (p[0]=='s') && (p[1]=='p') && (p[2]==0))
- { circle[pos].value = 0; circle[pos].type = LOCAL_VARIABLE_TT;
- return;
- }
-
- /* Test for local variables first, quite quickly. */
-
- if (local_variables.enabled)
- { if (p[1]==0)
- { index = one_letter_locals[(uchar)p[0]];
- if (index<MAX_LOCAL_VARIABLES)
- { circle[pos].type = LOCAL_VARIABLE_TT;
- circle[pos].value = index+1;
- return;
- }
- }
- index = local_variable_hash_table[hashcode];
- if (index >= 0)
- { for (;index<no_locals;index++)
- { if (hashcode == local_variable_hash_codes[index])
- { if (strcmpcis(p, local_variable_texts[index])==0)
- { circle[pos].type = LOCAL_VARIABLE_TT;
- circle[pos].value = index+1;
- return;
- }
- }
- }
- }
- }
-
- /* Now the bulk of the keywords. Note that the lexer doesn't recognise
- the name of a system function which has been Replaced. */
-
- KeywordSearch:
- index = keywords_hash_table[hashcode];
- while (index >= 0)
- { int *i = keywords_data_table + 3*index;
- keyword_group *kg = keyword_groups[*i];
- if (((!dirs_only_flag) && (kg->enabled))
- || (dirs_only_flag && (kg == &directives)))
- { char *q = kg->keywords[*(i+1)];
- if (((kg->case_sensitive) && (strcmp(p, q)==0))
- || ((!(kg->case_sensitive)) && (strcmpcis(p, q)==0)))
- { if ((kg != &system_functions)
- || (system_function_usage[*(i+1)]!=2))
- { circle[pos].type = kg->change_token_type;
- circle[pos].value = *(i+1);
- return;
- }
- }
- }
- 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].type = SYMBOL_TT;
-}
-
-
-/* ------------------------------------------------------------------------- */
-/* The tokeniser grid aids a rapid decision about the consequences of a */
-/* character reached in the buffer. In effect it is an efficiently stored */
-/* transition table using an algorithm similar to that of S. C. Johnson's */
-/* "yacc" lexical analyser (see Aho, Sethi and Ullman, section 3.9). */
-/* My thanks to Dilip Sequeira for suggesting this. */
-/* */
-/* tokeniser_grid[c] is (16*n + m) if c is the first character of */
-/* separator numbers n, n+1, ..., n+m-1 */
-/* or certain special values (QUOTE_CODE, etc) */
-/* or 0 otherwise */
-/* */
-/* Since 1000/16 = 62, the code numbers below will need increasing if the */
-/* number of separators supported exceeds 61. */
-/* ------------------------------------------------------------------------- */
-
-static int tokeniser_grid[256];
-
-#define QUOTE_CODE 1000
-#define DQUOTE_CODE 1001
-#define NULL_CODE 1002
-#define SPACE_CODE 1003
-#define NEGATIVE_CODE 1004
-#define DIGIT_CODE 1005
-#define RADIX_CODE 1006
-#define KEYWORD_CODE 1007
-#define EOF_CODE 1008
-#define WHITESPACE_CODE 1009
-#define COMMENT_CODE 1010
-#define IDENTIFIER_CODE 1011
-
-/* This list cannot safely be changed without also changing the header
- separator #defines. The ordering is significant in that (i) all entries
- beginning with the same character must be adjacent and (ii) that if
- X is a an initial substring of Y then X must come before Y.
-
- E.g. --> must occur before -- to prevent "-->0" being tokenised
- wrongly as "--", ">", "0" rather than "-->", "0". */
-
-static const char separators[NUMBER_SEPARATORS][4] =
-{ "->", "-->", "--", "-", "++", "+", "*", "/", "%",
- "||", "|", "&&", "&", "~~",
- "~=", "~", "==", "=", ">=", ">",
- "<=", "<", "(", ")", ",",
- ".&", ".#", "..&", "..#", "..", ".",
- "::", ":", "@", ";", "[", "]", "{", "}",
- "$", "?~", "?",
- "#a$", "#g$", "#n$", "#r$", "#w$", "##", "#"
-};
-
-static void make_tokeniser_grid(void)
-{
- /* Construct the grid to the specification above. */
-
- int i, j;
-
- for (i=0; i<256; i++) tokeniser_grid[i]=0;
-
- for (i=0; i<NUMBER_SEPARATORS; i++)
- { j=separators[i][0];
- if (tokeniser_grid[j]==0)
- tokeniser_grid[j]=i*16+1; else tokeniser_grid[j]++;
- }
- tokeniser_grid['\''] = QUOTE_CODE;
- tokeniser_grid['\"'] = DQUOTE_CODE;
- tokeniser_grid[0] = EOF_CODE;
- tokeniser_grid[' '] = WHITESPACE_CODE;
- tokeniser_grid['\n'] = WHITESPACE_CODE;
- tokeniser_grid['$'] = RADIX_CODE;
- tokeniser_grid['!'] = COMMENT_CODE;
-
- tokeniser_grid['0'] = DIGIT_CODE;
- tokeniser_grid['1'] = DIGIT_CODE;
- tokeniser_grid['2'] = DIGIT_CODE;
- tokeniser_grid['3'] = DIGIT_CODE;
- tokeniser_grid['4'] = DIGIT_CODE;
- tokeniser_grid['5'] = DIGIT_CODE;
- tokeniser_grid['6'] = DIGIT_CODE;
- tokeniser_grid['7'] = DIGIT_CODE;
- tokeniser_grid['8'] = DIGIT_CODE;
- tokeniser_grid['9'] = DIGIT_CODE;
-
- tokeniser_grid['a'] = IDENTIFIER_CODE;
- tokeniser_grid['b'] = IDENTIFIER_CODE;
- tokeniser_grid['c'] = IDENTIFIER_CODE;
- tokeniser_grid['d'] = IDENTIFIER_CODE;
- tokeniser_grid['e'] = IDENTIFIER_CODE;
- tokeniser_grid['f'] = IDENTIFIER_CODE;
- tokeniser_grid['g'] = IDENTIFIER_CODE;
- tokeniser_grid['h'] = IDENTIFIER_CODE;
- tokeniser_grid['i'] = IDENTIFIER_CODE;
- tokeniser_grid['j'] = IDENTIFIER_CODE;
- tokeniser_grid['k'] = IDENTIFIER_CODE;
- tokeniser_grid['l'] = IDENTIFIER_CODE;
- tokeniser_grid['m'] = IDENTIFIER_CODE;
- tokeniser_grid['n'] = IDENTIFIER_CODE;
- tokeniser_grid['o'] = IDENTIFIER_CODE;
- tokeniser_grid['p'] = IDENTIFIER_CODE;
- tokeniser_grid['q'] = IDENTIFIER_CODE;
- tokeniser_grid['r'] = IDENTIFIER_CODE;
- tokeniser_grid['s'] = IDENTIFIER_CODE;
- tokeniser_grid['t'] = IDENTIFIER_CODE;
- tokeniser_grid['u'] = IDENTIFIER_CODE;
- tokeniser_grid['v'] = IDENTIFIER_CODE;
- tokeniser_grid['w'] = IDENTIFIER_CODE;
- tokeniser_grid['x'] = IDENTIFIER_CODE;
- tokeniser_grid['y'] = IDENTIFIER_CODE;
- tokeniser_grid['z'] = IDENTIFIER_CODE;
-
- tokeniser_grid['A'] = IDENTIFIER_CODE;
- tokeniser_grid['B'] = IDENTIFIER_CODE;
- tokeniser_grid['C'] = IDENTIFIER_CODE;
- tokeniser_grid['D'] = IDENTIFIER_CODE;
- tokeniser_grid['E'] = IDENTIFIER_CODE;
- tokeniser_grid['F'] = IDENTIFIER_CODE;
- tokeniser_grid['G'] = IDENTIFIER_CODE;
- tokeniser_grid['H'] = IDENTIFIER_CODE;
- tokeniser_grid['I'] = IDENTIFIER_CODE;
- tokeniser_grid['J'] = IDENTIFIER_CODE;
- tokeniser_grid['K'] = IDENTIFIER_CODE;
- tokeniser_grid['L'] = IDENTIFIER_CODE;
- tokeniser_grid['M'] = IDENTIFIER_CODE;
- tokeniser_grid['N'] = IDENTIFIER_CODE;
- tokeniser_grid['O'] = IDENTIFIER_CODE;
- tokeniser_grid['P'] = IDENTIFIER_CODE;
- tokeniser_grid['Q'] = IDENTIFIER_CODE;
- tokeniser_grid['R'] = IDENTIFIER_CODE;
- tokeniser_grid['S'] = IDENTIFIER_CODE;
- tokeniser_grid['T'] = IDENTIFIER_CODE;
- tokeniser_grid['U'] = IDENTIFIER_CODE;
- tokeniser_grid['V'] = IDENTIFIER_CODE;
- tokeniser_grid['W'] = IDENTIFIER_CODE;
- tokeniser_grid['X'] = IDENTIFIER_CODE;
- tokeniser_grid['Y'] = IDENTIFIER_CODE;
- tokeniser_grid['Z'] = IDENTIFIER_CODE;
-
- tokeniser_grid['_'] = IDENTIFIER_CODE;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Definition of a lexical block: a source file or a string containing */
-/* text for lexical analysis; an independent source from the point of */
-/* view of issuing error reports. */
-/* ------------------------------------------------------------------------- */
-
-typedef struct LexicalBlock_s
-{ char *filename; /* Full translated name */
- int main_flag; /* TRUE if the main file
- (the first one opened) */
- int sys_flag; /* TRUE if a System_File */
- int source_line; /* Line number count */
- int line_start; /* Char number within file
- where the current line
- starts */
- int chars_read; /* Char number of read pos */
- int file_no; /* Or 255 if not from a
- file; used for debug
- information */
- char *orig_source; /* From #origsource direct */
- int orig_file;
- int32 orig_line;
- int32 orig_char;
-} LexicalBlock;
-
-static LexicalBlock NoFileOpen =
- { "<before compilation>", FALSE, FALSE, 0, 0, 0, 255, NULL, 0, 0, 0 };
-
-static LexicalBlock MakingOutput =
- { "<constructing output>", FALSE, FALSE, 0, 0, 0, 255, NULL, 0, 0, 0 };
-
-static LexicalBlock StringLB =
- { "<veneer routine>", FALSE, TRUE, 0, 0, 0, 255, NULL, 0, 0, 0 };
-
-static LexicalBlock *CurrentLB; /* The current lexical
- block of input text */
-
-extern void declare_systemfile(void)
-{ CurrentLB->sys_flag = TRUE;
-}
-
-extern int is_systemfile(void)
-{ return ((CurrentLB->sys_flag)?1:0);
-}
-
-extern void set_origsource_location(char *source, int32 line, int32 charnum)
-{
- if (!source) {
- /* Clear the Origsource declaration. */
- CurrentLB->orig_file = 0;
- CurrentLB->orig_source = NULL;
- CurrentLB->orig_line = 0;
- CurrentLB->orig_char = 0;
- return;
- }
-
- /* Get the file number for a new or existing InputFiles entry. */
- int file_no = register_orig_sourcefile(source);
-
- CurrentLB->orig_file = file_no;
- CurrentLB->orig_source = InputFiles[file_no-1].filename;
- CurrentLB->orig_line = line;
- CurrentLB->orig_char = charnum;
-}
-
-/* Error locations. */
-
-extern debug_location get_current_debug_location(void)
-{ debug_location result;
- /* Assume that all input characters are one byte. */
- result.file_index = CurrentLB->file_no;
- result.beginning_byte_index = CurrentLB->chars_read - LOOKAHEAD_SIZE;
- result.end_byte_index = result.beginning_byte_index;
- result.beginning_line_number = CurrentLB->source_line;
- result.end_line_number = result.beginning_line_number;
- result.beginning_character_number =
- CurrentLB->chars_read - CurrentLB->line_start;
- result.end_character_number = result.beginning_character_number;
- result.orig_file_index = CurrentLB->orig_file;
- result.orig_beg_line_number = CurrentLB->orig_line;
- result.orig_beg_char_number = CurrentLB->orig_char;
- return result;
-}
-
-static debug_location ErrorReport_debug_location;
-
-extern void report_errors_at_current_line(void)
-{ ErrorReport.line_number = CurrentLB->source_line;
- ErrorReport.file_number = CurrentLB->file_no;
- if (ErrorReport.file_number == 255)
- ErrorReport.file_number = -1;
- ErrorReport.source = CurrentLB->filename;
- ErrorReport.main_flag = CurrentLB->main_flag;
- if (debugfile_switch)
- ErrorReport_debug_location = get_current_debug_location();
- ErrorReport.orig_file = CurrentLB->orig_file;
- ErrorReport.orig_source = CurrentLB->orig_source;
- ErrorReport.orig_line = CurrentLB->orig_line;
- ErrorReport.orig_char = CurrentLB->orig_char;
-}
-
-extern debug_location get_error_report_debug_location(void)
-{ return ErrorReport_debug_location;
-}
-
-extern int32 get_current_line_start(void)
-{ return CurrentLB->line_start;
-}
-
-brief_location blank_brief_location;
-
-extern brief_location get_brief_location(ErrorPosition *errpos)
-{
- brief_location loc;
- loc.file_index = errpos->file_number;
- loc.line_number = errpos->line_number;
- loc.orig_file_index = errpos->orig_file;
- loc.orig_line_number = errpos->orig_line;
- return loc;
-}
-
-extern void export_brief_location(brief_location loc, ErrorPosition *errpos)
-{
- if (loc.file_index != -1)
- { errpos->file_number = loc.file_index;
- errpos->line_number = loc.line_number;
- errpos->main_flag = (errpos->file_number == 1);
- errpos->orig_source = NULL;
- errpos->orig_file = loc.orig_file_index;
- errpos->orig_line = loc.orig_line_number;
- errpos->orig_char = 0;
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Hash printing and line counting */
-/* ------------------------------------------------------------------------- */
-
-static void print_hash(void)
-{
- /* Hash-printing is the practice of printing a # character every 100
- lines of source code (the -x switch), reassuring the user that
- progress is being made */
-
- if (no_hash_printed_yet)
- { printf("::"); no_hash_printed_yet = FALSE;
- }
- printf("#"); hash_printed_since_newline = TRUE;
-
-#ifndef MAC_FACE
- /* On some systems, text output is buffered to a line at a time, and
- this would frustrate the point of hash-printing, so: */
-
- fflush(stdout);
-#endif
-}
-
-static void reached_new_line(void)
-{
- /* Called to signal that a new line has been reached in the source code */
-
- forerrors_pointer = 0;
-
- CurrentLB->source_line++;
- CurrentLB->line_start = CurrentLB->chars_read;
-
- total_source_line_count++;
-
- if (total_source_line_count%100==0)
- { if (hash_switch) print_hash();
-#ifdef MAC_MPW
- SpinCursor(32); /* I.e., allow other tasks to run */
-#endif
- }
-
-#ifdef MAC_FACE
- if (total_source_line_count%((**g_pm_hndl).linespercheck) == 0)
- { ProcessEvents (&g_proc);
- if (g_proc != true)
- { free_arrays();
- close_all_source();
- if (temporary_files_switch)
- remove_temp_files();
- if (store_the_text)
- my_free(&all_text,"transcription text");
- abort_transcript_file();
- longjmp (g_fallback, 1);
- }
- }
-#endif
-}
-
-static void new_syntax_line(void)
-{ if (source_to_analyse != NULL) forerrors_pointer = 0;
- report_errors_at_current_line();
-}
-
-/* Return 10 raised to the expo power.
- *
- * I'm avoiding the standard pow() function for a rather lame reason:
- * it's in the libmath (-lm) library, and I don't want to change the
- * build model for the compiler. So, this is implemented with a stupid
- * lookup table. It's faster than pow() for small values of expo.
- * Probably not as fast if expo is 200, but "$+1e200" is an overflow
- * anyway, so I don't expect that to be a problem.
- *
- * (For some reason, frexp() and ldexp(), which are used later on, do
- * not require libmath to be linked in.)
- */
-static double pow10_cheap(int expo)
-{
- #define POW10_RANGE (8)
- static double powers[POW10_RANGE*2+1] = {
- 0.00000001, 0.0000001, 0.000001, 0.00001, 0.0001, 0.001, 0.01, 0.1,
- 1.0,
- 10.0, 100.0, 1000.0, 10000.0, 100000.0, 1000000.0, 10000000.0, 100000000.0
- };
-
- double res = 1.0;
-
- if (expo < 0) {
- for (; expo < -POW10_RANGE; expo += POW10_RANGE) {
- res *= powers[0];
- }
- return res * powers[POW10_RANGE+expo];
- }
- else {
- for (; expo > POW10_RANGE; expo -= POW10_RANGE) {
- res *= powers[POW10_RANGE*2];
- }
- return res * powers[POW10_RANGE+expo];
- }
-}
-
-/* Return the IEEE-754 single-precision encoding of a floating-point
- * number. See http://www.psc.edu/general/software/packages/ieee/ieee.php
- * for an explanation.
- *
- * The number is provided in the pieces it was parsed in:
- * [+|-] intv "." fracv "e" [+|-]expo
- *
- * If the magnitude is too large (beyond about 3.4e+38), this returns
- * an infinite value (0x7f800000 or 0xff800000). If the magnitude is too
- * small (below about 1e-45), this returns a zero value (0x00000000 or
- * 0x80000000). If any of the inputs are NaN, this returns NaN (but the
- * lexer should never do that).
- *
- * Note that using a float constant does *not* set the uses_float_features
- * flag (which would cause the game file to be labelled 3.1.2). There's
- * no VM feature here, just an integer. Of course, any use of the float
- * *opcodes* will set the flag.
- *
- * The math functions in this routine require #including <math.h>, but
- * they should not require linking the math library (-lm). At least,
- * they do not on OSX and Linux.
- */
-static int32 construct_float(int signbit, double intv, double fracv, int expo)
-{
- double absval = (intv + fracv) * pow10_cheap(expo);
- int32 sign = (signbit ? 0x80000000 : 0x0);
- double mant;
- int32 fbits;
-
- if (isinf(absval)) {
- return sign | 0x7f800000; /* infinity */
- }
- if (isnan(absval)) {
- return sign | 0x7fc00000;
- }
-
- mant = frexp(absval, &expo);
-
- /* Normalize mantissa to be in the range [1.0, 2.0) */
- if (0.5 <= mant && mant < 1.0) {
- mant *= 2.0;
- expo--;
- }
- else if (mant == 0.0) {
- expo = 0;
- }
- else {
- return sign | 0x7f800000; /* infinity */
- }
-
- if (expo >= 128) {
- return sign | 0x7f800000; /* infinity */
- }
- else if (expo < -126) {
- /* Denormalized (very small) number */
- mant = ldexp(mant, 126 + expo);
- expo = 0;
- }
- else if (!(expo == 0 && mant == 0.0)) {
- expo += 127;
- mant -= 1.0; /* Get rid of leading 1 */
- }
-
- mant *= 8388608.0; /* 2^23 */
- fbits = (int32)(mant + 0.5); /* round mant to nearest int */
- if (fbits >> 23) {
- /* The carry propagated out of a string of 23 1 bits. */
- fbits = 0;
- expo++;
- if (expo >= 255) {
- return sign | 0x7f800000; /* infinity */
- }
- }
-
- return (sign) | ((int32)(expo << 23)) | (fbits);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Characters are read via a "pipeline" of variables, allowing us to look */
-/* up to three characters ahead of the current position. */
-/* */
-/* There are two possible sources: from the source files being loaded in, */
-/* and from a string inside Inform (which is where the code for veneer */
-/* routines comes from). Each source has its own get-next-character */
-/* routine. */
-/* ------------------------------------------------------------------------- */
-/* Source 1: from files */
-/* */
-/* 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 */
-/* 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. */
-/* */
-/* The routine returns the number of characters it has written, and note */
-/* that this conveniently ensures that all characters in the buffer come */
-/* from the same file. */
-/* ------------------------------------------------------------------------- */
-
-#define SOURCE_BUFFER_SIZE 4096 /* Typical disc block size */
-
-typedef struct Sourcefile_s
-{ char *buffer; /* Input buffer */
- int read_pos; /* Read position in buffer */
- int size; /* Number of meaningful
- characters in buffer */
- int la, la2, la3; /* Three characters of
- lookahead pipeline */
- int file_no; /* Internal file number
- (1, 2, 3, ...) */
- LexicalBlock LB;
-} Sourcefile;
-
-static Sourcefile *FileStack;
-static int File_sp; /* Stack pointer */
-
-static Sourcefile *CF; /* Top entry on stack */
-
-static int last_input_file;
-
-static void begin_buffering_file(int i, int file_no)
-{ int j, cnt; uchar *p;
-
- if (i >= MAX_INCLUSION_DEPTH)
- memoryerror("MAX_INCLUSION_DEPTH",MAX_INCLUSION_DEPTH);
-
- p = (uchar *) FileStack[i].buffer;
-
- if (i>0)
- { FileStack[i-1].la = lookahead;
- FileStack[i-1].la2 = lookahead2;
- FileStack[i-1].la3 = lookahead3;
- }
-
- FileStack[i].file_no = file_no;
- FileStack[i].size = file_load_chars(file_no,
- (char *) p, SOURCE_BUFFER_SIZE);
- lookahead = source_to_iso_grid[p[0]];
- lookahead2 = source_to_iso_grid[p[1]];
- lookahead3 = source_to_iso_grid[p[2]];
- if (LOOKAHEAD_SIZE != 3)
- compiler_error
- ("Lexer lookahead size does not match hard-coded lookahead code");
- FileStack[i].read_pos = LOOKAHEAD_SIZE;
-
- if (file_no==1) FileStack[i].LB.main_flag = TRUE;
- else FileStack[i].LB.main_flag = FALSE;
- FileStack[i].LB.sys_flag = FALSE;
- FileStack[i].LB.source_line = 1;
- FileStack[i].LB.line_start = LOOKAHEAD_SIZE;
- FileStack[i].LB.chars_read = LOOKAHEAD_SIZE;
- FileStack[i].LB.filename = InputFiles[file_no-1].filename;
- FileStack[i].LB.file_no = file_no;
- FileStack[i].LB.orig_source = NULL; FileStack[i].LB.orig_file = 0;
- FileStack[i].LB.orig_line = 0; FileStack[i].LB.orig_char = 0;
-
- CurrentLB = &(FileStack[i].LB);
- CF = &(FileStack[i]);
-
- /* Check for recursive inclusion */
- cnt = 0;
- for (j=0; j<i; j++)
- { if (!strcmp(FileStack[i].LB.filename, FileStack[j].LB.filename))
- cnt++;
- }
- if (cnt==1)
- warning_named("File included more than once",
- FileStack[j].LB.filename);
-}
-
-static void create_char_pipeline(void)
-{
- File_sp = 0;
- begin_buffering_file(File_sp++, 1);
- pipeline_made = TRUE;
- last_input_file = current_input_file;
-}
-
-static int get_next_char_from_pipeline(void)
-{ uchar *p;
-
- while (last_input_file < current_input_file)
- {
- /* An "Include" file must have opened since the last character
- was read. Perhaps more than one. We run forward through the
- list and add them to the include stack. But we ignore
- "Origsource" files (which were never actually opened for
- reading). */
-
- last_input_file++;
- if (!InputFiles[last_input_file-1].is_input)
- continue;
-
- begin_buffering_file(File_sp++, last_input_file);
- }
- if (last_input_file != current_input_file)
- compiler_error("last_input_file did not match after Include");
-
- if (File_sp == 0)
- { lookahead = 0; lookahead2 = 0; lookahead3 = 0; return 0;
- }
-
- if (CF->read_pos == CF->size)
- { CF->size =
- file_load_chars(CF->file_no, CF->buffer, SOURCE_BUFFER_SIZE);
- CF->read_pos = 0;
- }
- else
- if (CF->read_pos == -(CF->size))
- { set_token_location(get_current_debug_location());
- File_sp--;
- if (File_sp == 0)
- { lookahead = 0; lookahead2 = 0; lookahead3 = 0; return 0;
- }
- CF = &(FileStack[File_sp-1]);
- CurrentLB = &(FileStack[File_sp-1].LB);
- lookahead = CF->la; lookahead2 = CF->la2; lookahead3 = CF->la3;
- if (CF->read_pos == CF->size)
- { CF->size =
- file_load_chars(CF->file_no, CF->buffer, SOURCE_BUFFER_SIZE);
- CF->read_pos = 0;
- }
- set_token_location(get_current_debug_location());
- }
-
- p = (uchar *) (CF->buffer);
-
- current = lookahead;
- lookahead = lookahead2;
- lookahead2 = lookahead3;
- lookahead3 = source_to_iso_grid[p[CF->read_pos++]];
-
- CurrentLB->chars_read++;
- if (forerrors_pointer < 511)
- forerrors_buff[forerrors_pointer++] = current;
- if (current == '\n') reached_new_line();
- return(current);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Source 2: from a string */
-/* ------------------------------------------------------------------------- */
-
-static int source_to_analyse_pointer; /* Current read position */
-
-static int get_next_char_from_string(void)
-{ uchar *p = (uchar *) source_to_analyse + source_to_analyse_pointer++;
- current = source_to_iso_grid[p[0]];
-
- if (current == 0) lookahead = 0;
- else lookahead = source_to_iso_grid[p[1]];
- if (lookahead == 0) lookahead2 = 0;
- else lookahead2 = source_to_iso_grid[p[2]];
- if (lookahead2 == 0) lookahead3 = 0;
- else lookahead3 = source_to_iso_grid[p[3]];
-
- CurrentLB->chars_read++;
- if (forerrors_pointer < 511)
- forerrors_buff[forerrors_pointer++] = current;
- if (current == '\n') reached_new_line();
- return(current);
-}
-
-/* ========================================================================= */
-/* The interface between the lexer and Inform's higher levels: */
-/* */
-/* put_token_back() (effectively) move the read position */
-/* back by one token */
-/* */
-/* get_next_token() copy the token at the current read */
-/* position into the triple */
-/* (token_type, token_value, token_text) */
-/* and move the read position forward */
-/* by one */
-/* */
-/* restart_lexer(source, name) if source is NULL, initialise the lexer */
-/* to read from source files; */
-/* otherwise, to read from this string. */
-/* ------------------------------------------------------------------------- */
-
-extern void put_token_back(void)
-{ tokens_put_back++;
-
- if (tokens_trace_level > 0)
- { if (tokens_trace_level == 1) printf("<- ");
- else printf("<-\n");
- }
-
- /* The following error, of course, should never happen! */
-
- if (tokens_put_back == CIRCLE_SIZE)
- { compiler_error("The lexical analyser has collapsed because of a wrong \
-assumption inside Inform");
- tokens_put_back--;
- return;
- }
-}
-
-extern void get_next_token(void)
-{ int d, i, j, k, quoted_size, e, radix, context; int32 n; char *r;
- int returning_a_put_back_token = TRUE;
-
- context = lexical_context();
-
- if (tokens_put_back > 0)
- { i = circle_position - tokens_put_back + 1;
- if (i<0) i += CIRCLE_SIZE;
- tokens_put_back--;
- if (context != token_contexts[i])
- { j = circle[i].type;
- if ((j==0) || ((j>=100) && (j<200)))
- interpret_identifier(i, FALSE);
- }
- goto ReturnBack;
- }
- returning_a_put_back_token = FALSE;
-
- if (circle_position == CIRCLE_SIZE-1) circle_position = 0;
- else circle_position++;
-
- if (lex_p > lexeme_memory + 4*MAX_QTEXT_SIZE)
- lex_p = lexeme_memory;
-
- circle[circle_position].text = lex_p;
- circle[circle_position].value = 0;
- *lex_p = 0;
-
- StartTokenAgain:
- d = (*get_next_char)();
- e = tokeniser_grid[d];
-
- if (next_token_begins_syntax_line)
- { if ((e != WHITESPACE_CODE) && (e != COMMENT_CODE))
- { new_syntax_line();
- next_token_begins_syntax_line = FALSE;
- }
- }
-
- circle[circle_position].location = get_current_debug_location();
-
- switch(e)
- { case 0: char_error("Illegal character found in source:", d);
- goto StartTokenAgain;
-
- case WHITESPACE_CODE:
- while (tokeniser_grid[lookahead] == WHITESPACE_CODE)
- (*get_next_char)();
- goto StartTokenAgain;
-
- case COMMENT_CODE:
- while ((lookahead != '\n') && (lookahead != 0))
- (*get_next_char)();
- goto StartTokenAgain;
-
- case EOF_CODE:
- circle[circle_position].type = EOF_TT;
- strcpy(lex_p, "<end of file>");
- lex_p += strlen(lex_p) + 1;
- break;
-
- case DIGIT_CODE:
- radix = 10;
- ReturnNumber:
- n=0;
- do
- { n = n*radix + character_digit_value[d];
- *lex_p++ = d;
- } while ((character_digit_value[lookahead] < radix)
- && (d = (*get_next_char)(), TRUE));
-
- *lex_p++ = 0;
- circle[circle_position].type = NUMBER_TT;
- circle[circle_position].value = n;
- break;
-
- FloatNumber:
- { int expo=0; double intv=0, fracv=0;
- int expocount=0, intcount=0, fraccount=0;
- int signbit = (d == '-');
- *lex_p++ = d;
- while (character_digit_value[lookahead] < 10) {
- intv = 10.0*intv + character_digit_value[lookahead];
- intcount++;
- *lex_p++ = lookahead;
- (*get_next_char)();
- }
- if (lookahead == '.') {
- double fracpow = 1.0;
- *lex_p++ = lookahead;
- (*get_next_char)();
- while (character_digit_value[lookahead] < 10) {
- fracpow *= 0.1;
- fracv = fracv + fracpow*character_digit_value[lookahead];
- fraccount++;
- *lex_p++ = lookahead;
- (*get_next_char)();
- }
- }
- if (lookahead == 'e' || lookahead == 'E') {
- int exposign = 0;
- *lex_p++ = lookahead;
- (*get_next_char)();
- if (lookahead == '+' || lookahead == '-') {
- exposign = (lookahead == '-');
- *lex_p++ = lookahead;
- (*get_next_char)();
- }
- while (character_digit_value[lookahead] < 10) {
- expo = 10*expo + character_digit_value[lookahead];
- expocount++;
- *lex_p++ = lookahead;
- (*get_next_char)();
- }
- if (expocount == 0)
- error("Floating-point literal must have digits after the 'e'");
- if (exposign) { expo = -expo; }
- }
- if (intcount + fraccount == 0)
- error("Floating-point literal must have digits");
- n = construct_float(signbit, intv, fracv, expo);
- }
- *lex_p++ = 0;
- circle[circle_position].type = NUMBER_TT;
- circle[circle_position].value = n;
- if (!glulx_mode && dont_enter_into_symbol_table != -2) error("Floating-point literals are not available in Z-code");
- break;
-
- case RADIX_CODE:
- radix = 16; d = (*get_next_char)();
- if (d == '-' || d == '+') { goto FloatNumber; }
- if (d == '$') { d = (*get_next_char)(); radix = 2; }
- if (character_digit_value[d] >= radix)
- { if (radix == 2)
- error("Binary number expected after '$$'");
- else
- error("Hexadecimal number expected after '$'");
- }
- goto ReturnNumber;
-
- case QUOTE_CODE: /* Single-quotes: scan a literal string */
- quoted_size=0;
- do
- { e = d; d = (*get_next_char)(); *lex_p++ = d;
- if (quoted_size++==64)
- { error(
- "Too much text for one pair of quotations '...' to hold");
- *lex_p='\''; break;
- }
- if ((d == '\'') && (e != '@'))
- { if (quoted_size == 1)
- { d = (*get_next_char)(); *lex_p++ = d;
- if (d != '\'')
- error("No text between quotation marks ''");
- }
- break;
- }
- } while (d != EOF);
- if (d==EOF) ebf_error("'\''", "end of file");
- *(lex_p-1) = 0;
- circle[circle_position].type = SQ_TT;
- break;
-
- case DQUOTE_CODE: /* Double-quotes: scan a literal string */
- quoted_size=0;
- do
- { d = (*get_next_char)(); *lex_p++ = d;
- if (quoted_size++==MAX_QTEXT_SIZE)
- { memoryerror("MAX_QTEXT_SIZE", MAX_QTEXT_SIZE);
- break;
- }
- if (d == '\n')
- { lex_p--;
- while (*(lex_p-1) == ' ') lex_p--;
- if (*(lex_p-1) != '^') *lex_p++ = ' ';
- while ((lookahead != EOF) &&
- (tokeniser_grid[lookahead] == WHITESPACE_CODE))
- (*get_next_char)();
- }
- else if (d == '\\')
- { int newline_passed = FALSE;
- lex_p--;
- while ((lookahead != EOF) &&
- (tokeniser_grid[lookahead] == WHITESPACE_CODE))
- if ((d = (*get_next_char)()) == '\n')
- newline_passed = TRUE;
- if (!newline_passed)
- { char chb[4];
- chb[0] = '\"'; chb[1] = lookahead;
- chb[2] = '\"'; chb[3] = 0;
- ebf_error("empty rest of line after '\\' in string",
- chb);
- }
- }
- } while ((d != EOF) && (d!='\"'));
- if (d==EOF) ebf_error("'\"'", "end of file");
- *(lex_p-1) = 0;
- circle[circle_position].type = DQ_TT;
- break;
-
- case IDENTIFIER_CODE: /* Letter or underscore: an identifier */
-
- *lex_p++ = d; n=1;
- while ((n<=MAX_IDENTIFIER_LENGTH)
- && ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
- || (tokeniser_grid[lookahead] == DIGIT_CODE)))
- n++, *lex_p++ = (*get_next_char)();
-
- *lex_p++ = 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, circle[circle_position].text);
- /* Trim token so that it doesn't violate
- MAX_IDENTIFIER_LENGTH during error recovery */
- circle[circle_position].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(circle_position, TRUE);
- break;
- }
-
- interpret_identifier(circle_position, FALSE);
- break;
-
- default:
-
- /* The character is initial to at least one of the separators */
-
- for (j=e>>4, k=j+(e&0x0f); j<k; j++)
- { r = (char *) separators[j];
- if (r[1]==0)
- { *lex_p++=d; *lex_p++=0;
- goto SeparatorMatched;
- }
- else
- if (r[2]==0)
- { if (*(r+1) == lookahead)
- { *lex_p++=d;
- *lex_p++=(*get_next_char)();
- *lex_p++=0;
- goto SeparatorMatched;
- }
- }
- else
- { if ((*(r+1) == lookahead) && (*(r+2) == lookahead2))
- { *lex_p++=d;
- *lex_p++=(*get_next_char)();
- *lex_p++=(*get_next_char)();
- *lex_p++=0;
- goto SeparatorMatched;
- }
- }
- }
-
- /* The following contingency never in fact arises with the
- current set of separators, but might in future */
-
- *lex_p++ = d; *lex_p++ = lookahead; *lex_p++ = lookahead2;
- *lex_p++ = 0;
- error_named("Unrecognised combination in source:", lex_p);
- goto StartTokenAgain;
-
- SeparatorMatched:
-
- circle[circle_position].type = SEP_TT;
- circle[circle_position].value = j;
- switch(j)
- { case SEMICOLON_SEP: break;
- case HASHNDOLLAR_SEP:
- case HASHWDOLLAR_SEP:
- if (tokeniser_grid[lookahead] == WHITESPACE_CODE)
- { error_named("Character expected after",
- circle[circle_position].text);
- break;
- }
- lex_p--;
- *lex_p++ = (*get_next_char)();
- while ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
- || (tokeniser_grid[lookahead] == DIGIT_CODE))
- *lex_p++ = (*get_next_char)();
- *lex_p++ = 0;
- break;
- case HASHADOLLAR_SEP:
- case HASHGDOLLAR_SEP:
- case HASHRDOLLAR_SEP:
- case HASHHASH_SEP:
- if (tokeniser_grid[lookahead] != IDENTIFIER_CODE)
- { error_named("Alphabetic character expected after",
- circle[circle_position].text);
- break;
- }
- lex_p--;
- while ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
- || (tokeniser_grid[lookahead] == DIGIT_CODE))
- *lex_p++ = (*get_next_char)();
- *lex_p++ = 0;
- break;
- }
- break;
- }
-
- i = circle_position;
-
- ReturnBack:
- token_value = circle[i].value;
- token_type = circle[i].type;
- token_text = circle[i].text;
- if (!returning_a_put_back_token)
- { set_token_location(circle[i].location);
- }
- token_contexts[i] = context;
-
- if (tokens_trace_level > 0)
- { if (tokens_trace_level == 1)
- printf("'%s' ", circle[i].text);
- else
- { printf("-> "); describe_token(circle[i]);
- printf(" ");
- if (tokens_trace_level > 2) print_context(token_contexts[i]);
- printf("\n");
- }
- }
-}
-
-static char veneer_error_title[64];
-
-extern void restart_lexer(char *lexical_source, char *name)
-{ int i;
- circle_position = 0;
- for (i=0; i<CIRCLE_SIZE; i++)
- { circle[i].type = 0;
- circle[i].value = 0;
- circle[i].text = "(if this is ever visible, there is a bug)";
- token_contexts[i] = 0;
- }
-
- lex_p = lexeme_memory;
- tokens_put_back = 0;
- forerrors_pointer = 0;
- dont_enter_into_symbol_table = FALSE;
- return_sp_as_variable = FALSE;
- next_token_begins_syntax_line = TRUE;
-
- source_to_analyse = lexical_source;
-
- if (source_to_analyse == NULL)
- { get_next_char = get_next_char_from_pipeline;
- if (!pipeline_made) create_char_pipeline();
- forerrors_buff[0] = 0; forerrors_pointer = 0;
- }
- else
- { get_next_char = get_next_char_from_string;
- source_to_analyse_pointer = 0;
- CurrentLB = &StringLB;
- sprintf(veneer_error_title, "<veneer routine '%s'>", name);
- StringLB.filename = veneer_error_title;
-
- CurrentLB->source_line = 1;
- CurrentLB->line_start = 0;
- CurrentLB->chars_read = 0;
- }
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_lexer_vars(void)
-{
- blank_brief_location.file_index = -1;
- blank_brief_location.line_number = 0;
- blank_brief_location.orig_file_index = 0;
- blank_brief_location.orig_line_number = 0;
-}
-
-extern void lexer_begin_prepass(void)
-{ total_source_line_count = 0;
- CurrentLB = &NoFileOpen;
- report_errors_at_current_line();
-}
-
-extern void lexer_begin_pass(void)
-{ no_hash_printed_yet = TRUE;
- hash_printed_since_newline = FALSE;
-
- pipeline_made = FALSE;
-
- restart_lexer(NULL, NULL);
-}
-
-extern void lexer_endpass(void)
-{ CurrentLB = &MakingOutput;
- report_errors_at_current_line();
-}
-
-extern void lexer_allocate_arrays(void)
-{ int i;
-
- FileStack = my_malloc(MAX_INCLUSION_DEPTH*sizeof(Sourcefile),
- "filestack buffer");
-
- for (i=0; i<MAX_INCLUSION_DEPTH; i++)
- FileStack[i].buffer = my_malloc(SOURCE_BUFFER_SIZE+4, "source file buffer");
-
- lexeme_memory = my_malloc(5*MAX_QTEXT_SIZE, "lexeme memory");
-
- keywords_hash_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
- "keyword hash table");
- keywords_hash_ends_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
- "keyword hash end table");
- keywords_data_table = my_calloc(sizeof(int), 3*MAX_KEYWORDS,
- "keyword hashing linked list");
- local_variable_hash_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
- "local variable hash table");
- local_variable_text_table = my_malloc(
- (MAX_LOCAL_VARIABLES-1)*(MAX_IDENTIFIER_LENGTH+1),
- "text of local variable names");
-
- local_variable_hash_codes = my_calloc(sizeof(int), MAX_LOCAL_VARIABLES,
- "local variable hash codes");
- local_variable_texts = my_calloc(sizeof(char *), MAX_LOCAL_VARIABLES,
- "local variable text pointers");
-
- make_tokeniser_grid();
- make_keywords_tables();
-
- first_token_locations =
- my_malloc(sizeof(debug_locations), "debug locations of recent tokens");
- first_token_locations->location.file_index = 0;
- first_token_locations->location.beginning_byte_index = 0;
- first_token_locations->location.end_byte_index = 0;
- first_token_locations->location.beginning_line_number = 0;
- first_token_locations->location.end_line_number = 0;
- first_token_locations->location.beginning_character_number = 0;
- first_token_locations->location.end_character_number = 0;
- first_token_locations->location.orig_file_index = 0;
- first_token_locations->location.orig_beg_line_number = 0;
- first_token_locations->location.orig_beg_char_number = 0;
- first_token_locations->next = NULL;
- first_token_locations->reference_count = 0;
- last_token_location = first_token_locations;
-}
-
-extern void lexer_free_arrays(void)
-{ int i; char *p;
-
- for (i=0; i<MAX_INCLUSION_DEPTH; i++)
- { p = FileStack[i].buffer;
- my_free(&p, "source file buffer");
- }
- my_free(&FileStack, "filestack buffer");
- my_free(&lexeme_memory, "lexeme memory");
-
- my_free(&keywords_hash_table, "keyword hash table");
- my_free(&keywords_hash_ends_table, "keyword hash end table");
- my_free(&keywords_data_table, "keyword hashing linked list");
- my_free(&local_variable_hash_table, "local variable hash table");
- my_free(&local_variable_text_table, "text of local variable names");
-
- my_free(&local_variable_hash_codes, "local variable hash codes");
- my_free(&local_variable_texts, "local variable text pointers");
-
- cleanup_token_locations(NULL);
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "linker" : For compiling and linking modules */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-memory_block link_data_area;
-uchar *link_data_holding_area, *link_data_top;
- /* Start, current top, size of */
-int32 link_data_size; /* link data table being written */
- /* (holding import/export names) */
-extern int32 *action_symbol;
-
-/* ------------------------------------------------------------------------- */
-/* Marker values */
-/* ------------------------------------------------------------------------- */
-
-extern char *describe_mv(int mval)
-{ switch(mval)
- { case NULL_MV: return("null");
-
- /* Marker values used in ordinary story file backpatching */
-
- case DWORD_MV: return("dictionary word");
- case STRING_MV: return("string literal");
- case INCON_MV: return("system constant");
- case IROUTINE_MV: return("routine");
- case VROUTINE_MV: return("veneer routine");
- case ARRAY_MV: return("internal array");
- case NO_OBJS_MV: return("the number of objects");
- case INHERIT_MV: return("inherited common p value");
- case INDIVPT_MV: return("indiv prop table address");
- case INHERIT_INDIV_MV: return("inherited indiv p value");
- case MAIN_MV: return("ref to Main");
- case SYMBOL_MV: return("ref to symbol value");
-
- /* Additional marker values used in module backpatching */
-
- case VARIABLE_MV: return("global variable");
- case IDENT_MV: return("prop identifier number");
- case ACTION_MV: return("action");
- case OBJECT_MV: return("internal object");
-
- /* Record types in the import/export table (not really marker
- values at all) */
-
- case EXPORT_MV: return("Export ");
- case EXPORTSF_MV: return("Export sf");
- case EXPORTAC_MV: return("Export ##");
- case IMPORT_MV: return("Import ");
- }
- return("** No such MV **");
-}
-
-/* ------------------------------------------------------------------------- */
-/* Import/export records */
-/* ------------------------------------------------------------------------- */
-
-typedef struct importexport_s
-{ int module_value;
- int32 symbol_number;
- char symbol_type;
- int backpatch;
- int32 symbol_value;
- char *symbol_name;
-} ImportExport;
-
-static void describe_importexport(ImportExport *I)
-{ printf("%8s %20s %04d %04x %s\n",
- describe_mv(I->module_value), I->symbol_name,
- I->symbol_number, I->symbol_value, typename(I->symbol_type));
-}
-
-/* ========================================================================= */
-/* Linking in external modules: this code is run when the external */
-/* program hits a Link directive. */
-/* ------------------------------------------------------------------------- */
-/* This map is between global variable numbers in the module and in the */
-/* external program: variables_map[n] will be the external global variable */
-/* no for module global variable no n. (The entries [0] to [15] are not */
-/* used.) */
-/* ------------------------------------------------------------------------- */
-
-static int variables_map[256], actions_map[256];
-
-int32 module_map[16];
-
-ImportExport IE;
-
-/* ------------------------------------------------------------------------- */
-/* These are offsets within the module: */
-/* ------------------------------------------------------------------------- */
-
-static int32 m_code_offset, m_strs_offset, m_static_offset, m_dict_offset,
- m_vars_offset, m_objs_offset, m_props_offset, m_class_numbers,
- m_individuals_offset, m_individuals_length;
-
-static int m_no_objects, m_no_globals, p_no_globals, lowest_imported_global_no;
-
-int32 *xref_table; int xref_top;
-int32 *property_identifier_map;
-int *accession_numbers_map;
-int32 routine_replace[64],
- routine_replace_with[64]; int no_rr;
-
-/* ------------------------------------------------------------------------- */
-/* Reading and writing bytes/words in the module (as loaded in), indexing */
-/* via "marker addresses". */
-/* ------------------------------------------------------------------------- */
-
-static int32 read_marker_address(uchar *p, int size,
- int zmachine_area, int32 offset)
-{
- /* A routine to read the value referred to by the marker address
- (zmachine_area, offset): size is 1 for byte, 2 for word, and the
- module itself resides at p. */
-
- int32 addr = 0;
-
- switch(zmachine_area)
- {
- case DYNAMIC_ARRAY_ZA:
- addr = m_vars_offset; break;
- case ZCODE_ZA:
- addr = m_code_offset; break;
- case STATIC_STRINGS_ZA:
- addr = m_strs_offset; break;
- case DICTIONARY_ZA:
- addr = m_dict_offset; break;
- case OBJECT_TREE_ZA:
- addr = m_objs_offset; break;
- case PROP_ZA:
- addr = m_props_offset; break;
- case INDIVIDUAL_PROP_ZA:
- addr = m_individuals_offset; break;
- }
- if (size == 1) return p[addr+offset];
- return 256*p[addr+offset] + p[addr+offset+1];
-}
-
-static void write_marker_address(uchar *p, int size,
- int zmachine_area, int32 offset, int32 value)
-{
- /* Similar, but to write to it. */
-
- int32 addr = 0;
-
- switch(zmachine_area)
- {
- case DYNAMIC_ARRAY_ZA:
- addr = m_vars_offset; break;
- case ZCODE_ZA:
- addr = m_code_offset; break;
- case STATIC_STRINGS_ZA:
- addr = m_strs_offset; break;
- case DICTIONARY_ZA:
- addr = m_dict_offset; break;
- case OBJECT_TREE_ZA:
- addr = m_objs_offset; break;
- case PROP_ZA:
- addr = m_props_offset; break;
- case INDIVIDUAL_PROP_ZA:
- addr = m_individuals_offset; break;
- }
- if (size == 1) { p[addr+offset] = value%256; return; }
- p[addr+offset] = value/256;
- p[addr+offset+1] = value%256;
-}
-
-int m_read_pos;
-
-static int get_next_record(uchar *p)
-{ int i;
- int record_type = p[m_read_pos++];
- switch(record_type)
- { case 0: break;
- case EXPORT_MV:
- case EXPORTSF_MV:
- case EXPORTAC_MV:
- case IMPORT_MV:
- IE.module_value = record_type;
- i=p[m_read_pos++]; IE.symbol_number = 256*i + p[m_read_pos++];
- IE.symbol_type = p[m_read_pos++];
- if (record_type != IMPORT_MV) IE.backpatch = p[m_read_pos++];
- i=p[m_read_pos++]; IE.symbol_value = 256*i + p[m_read_pos++];
- IE.symbol_name = (char *) (p+m_read_pos);
- m_read_pos += strlen((char *) (p+m_read_pos))+1;
- if (linker_trace_level >= 2) describe_importexport(&IE);
- break;
- default:
- printf("Marker value of %d\n", record_type);
- compiler_error("Link: illegal import/export marker value");
- return -1;
- }
- return record_type;
-}
-
-static char link_errorm[128];
-
-static void accept_export(void)
-{ int32 index, map_to = IE.symbol_value % 0x10000;
- index = symbol_index(IE.symbol_name, -1);
-
- xref_table[IE.symbol_number] = index;
-
- if (!(sflags[index] & UNKNOWN_SFLAG))
- { if (IE.module_value == EXPORTAC_MV)
- { if ((!(sflags[index] & ACTION_SFLAG))
- && (stypes[index] != FAKE_ACTION_T))
- link_error_named(
-"action name clash with", IE.symbol_name);
- }
- else
- if (stypes[index] == IE.symbol_type)
- { switch(IE.symbol_type)
- { case CONSTANT_T:
- if ((!(svals[index] == IE.symbol_value))
- || (IE.backpatch != 0))
- link_error_named(
-"program and module give differing values of", IE.symbol_name);
- break;
- case INDIVIDUAL_PROPERTY_T:
- property_identifier_map[IE.symbol_value] = svals[index];
- break;
- case ROUTINE_T:
- if ((IE.module_value == EXPORTSF_MV)
- && (sflags[index] & REPLACE_SFLAG))
- break;
- default:
- sprintf(link_errorm,
- "%s '%s' in both program and module",
- typename(IE.symbol_type), IE.symbol_name);
- link_error(link_errorm);
- break;
- }
- }
- else
- { sprintf(link_errorm,
- "'%s' has type %s in program but type %s in module",
- IE.symbol_name, typename(stypes[index]),
- typename(IE.symbol_type));
- link_error(link_errorm);
- }
- }
- else
- { if (IE.module_value == EXPORTAC_MV)
- { IE.symbol_value = no_actions;
- action_symbol[no_actions++] = index;
- if (linker_trace_level >= 4)
- printf("Creating action ##%s\n", (char *) symbs[index]);
- }
- else
- switch(IE.symbol_type)
- { case ROUTINE_T:
- if ((IE.module_value == EXPORTSF_MV)
- && (sflags[index] & REPLACE_SFLAG))
- { routine_replace[no_rr] = IE.symbol_value;
- routine_replace_with[no_rr++] = index;
- return;
- }
- IE.symbol_value += (zmachine_pc/scale_factor);
- break;
- case OBJECT_T:
- case CLASS_T:
- IE.symbol_value += no_objects;
- break;
- case ARRAY_T:
- IE.symbol_value += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
- break;
- case GLOBAL_VARIABLE_T:
- if (no_globals==233)
- { link_error(
-"failed because too many extra global variables needed");
- return;
- }
- variables_map[16 + m_no_globals++] = 16 + no_globals;
- set_variable_value(no_globals, IE.symbol_value);
- IE.symbol_value = 16 + no_globals++;
- break;
- case INDIVIDUAL_PROPERTY_T:
- property_identifier_map[IE.symbol_value]
- = no_individual_properties;
- IE.symbol_value = no_individual_properties++;
-
- if (debugfile_switch)
- { debug_file_printf("<property>");
- debug_file_printf
- ("<identifier>%s</identifier>", IE.symbol_name);
- debug_file_printf
- ("<value>%d</value>", IE.symbol_value);
- debug_file_printf("</property>");
- }
-
- break;
- }
- assign_symbol(index, IE.backpatch*0x10000 + IE.symbol_value,
- IE.symbol_type);
- if (IE.backpatch != 0) sflags[index] |= CHANGE_SFLAG;
- sflags[index] |= EXPORT_SFLAG;
- if (IE.module_value == EXPORTSF_MV)
- sflags[index] |= INSF_SFLAG;
- if (IE.module_value == EXPORTAC_MV)
- sflags[index] |= ACTION_SFLAG;
- }
-
- if (IE.module_value == EXPORTAC_MV)
- { if (linker_trace_level >= 4)
- printf("Map %d '%s' to %d\n",
- IE.symbol_value, (char *) (symbs[index]), svals[index]);
- actions_map[map_to] = svals[index];
- }
-}
-
-static void accept_import(void)
-{ int32 index;
-
- index = symbol_index(IE.symbol_name, -1);
- sflags[index] |= USED_SFLAG;
- xref_table[IE.symbol_number] = index;
-
- if (!(sflags[index] & UNKNOWN_SFLAG))
- { switch (IE.symbol_type)
- {
- case GLOBAL_VARIABLE_T:
- if (stypes[index] != GLOBAL_VARIABLE_T)
- link_error_named(
-"module (wrongly) declared this a variable:", IE.symbol_name);
- variables_map[IE.symbol_value] = svals[index];
- if (IE.symbol_value < lowest_imported_global_no)
- lowest_imported_global_no = IE.symbol_value;
- break;
- default:
- switch(stypes[index])
- { case ATTRIBUTE_T:
- link_error_named(
-"this attribute is undeclared within module:", IE.symbol_name);; break;
- case PROPERTY_T:
- link_error_named(
-"this property is undeclared within module:", IE.symbol_name); break;
- case INDIVIDUAL_PROPERTY_T:
- case ARRAY_T:
- case ROUTINE_T:
- case CONSTANT_T:
- case OBJECT_T:
- case CLASS_T:
- case FAKE_ACTION_T:
- break;
- default:
- link_error_named(
-"this was referred to as a constant, but isn't:", IE.symbol_name);
- break;
- }
- break;
- }
- }
- else
- { switch (IE.symbol_type)
- {
- case GLOBAL_VARIABLE_T:
- if (stypes[index] != GLOBAL_VARIABLE_T)
- link_error_named(
- "Module tried to import a Global variable not defined here:",
- IE.symbol_name);
- variables_map[IE.symbol_value] = 16;
- if (IE.symbol_value < lowest_imported_global_no)
- lowest_imported_global_no = IE.symbol_value;
- break;
- }
- }
-}
-
-static int32 backpatch_backpatch(int32 v)
-{ switch(backpatch_marker)
- {
- /* Backpatches made now which are final */
-
- case OBJECT_MV:
- v += no_objects;
- backpatch_marker = NULL_MV;
- break;
-
- case ACTION_MV:
- if ((v<0) || (v>=256) || (actions_map[v] == -1))
- { link_error("unmapped action number");
- printf("*** Link: unmapped action number %d ***", v);
- v = 0;
- break;
- }
- v = actions_map[v];
- backpatch_marker = NULL_MV;
- break;
-
- case IDENT_MV:
- { int f = v & 0x8000;
- v = f + property_identifier_map[v-f];
- backpatch_marker = NULL_MV;
- break;
- }
-
- case VARIABLE_MV:
- backpatch_marker = NULL_MV;
- if (v < lowest_imported_global_no)
- { v = v + p_no_globals; break;
- }
- if (variables_map[v] == -1)
- { printf("** Unmapped variable %d! **\n", v);
- variables_map[v] = 16;
- link_error("unmapped variable error"); break;
- }
- v = variables_map[v];
- break;
-
- /* Backpatch values which are themselves being backpatched */
-
- case INDIVPT_MV:
- v += individuals_length;
- break;
-
- case SYMBOL_MV:
- v = xref_table[v];
- if ((v<0) || (v>=no_symbols))
- { printf("** Symbol number %d cannot be crossreferenced **\n", v);
- link_error("symbol crossreference error"); v=0;
- break;
- }
- break;
-
- case STRING_MV:
- v += static_strings_extent/scale_factor;
- break;
-
- case IROUTINE_MV:
- { int i;
- for (i=0;i<no_rr;i++)
- if (v == routine_replace[i])
- { v = routine_replace_with[i];
- backpatch_marker = SYMBOL_MV;
- goto IR_Done;
- }
- v += zmachine_pc/scale_factor;
- }
- IR_Done: break;
-
- case VROUTINE_MV:
- veneer_routine(v);
- break;
-
- case ARRAY_MV:
- if (v < (MAX_GLOBAL_VARIABLES*2))
- { v = 2*(variables_map[v/2 + 16] - 16);
- }
- else
- { v += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
- }
- break;
-
- case DWORD_MV:
- v = accession_numbers_map[v];
- break;
-
- case INHERIT_MV:
- v += properties_table_size;
- break;
-
- case INHERIT_INDIV_MV:
- v += individuals_length;
- break;
- }
- return v;
-}
-
-static void backpatch_module_image(uchar *p,
- int marker_value, int zmachine_area, int32 offset)
-{ int size = (marker_value>=0x80)?1:2; int32 v;
- marker_value &= 0x7f;
-
- backpatch_marker = marker_value;
-
- if (zmachine_area == PROP_DEFAULTS_ZA) return;
-
- if (linker_trace_level >= 3)
- printf("Backpatch %s area %d offset %04x size %d: ",
- describe_mv(marker_value), zmachine_area, offset, size);
-
- v = read_marker_address(p, size, zmachine_area, offset);
- if (linker_trace_level >= 3) printf("%04x ", v);
-
- v = backpatch_backpatch(v);
-
- write_marker_address(p, size, zmachine_area, offset, v);
- if (linker_trace_level >= 3) printf("%04x\n", v);
-}
-
-/* ------------------------------------------------------------------------- */
-/* The main routine: linking in a module with the given filename. */
-/* ------------------------------------------------------------------------- */
-
-char current_module_filename[128];
-
-void link_module(char *given_filename)
-{ FILE *fin;
- int record_type;
- char filename[128];
- uchar *p, p0[64];
- int32 last, i, j, k, l, m, vn, len, size, link_offset, module_size, map,
- max_property_identifier, symbols_base = no_symbols;
-
- strcpy(current_module_filename, given_filename);
-
- /* (1) Load in the module to link */
-
- i = 0;
- do
- { i = translate_link_filename(i, filename, given_filename);
- fin=fopen(filename,"rb");
- } while ((fin == NULL) && (i != 0));
-
- if (fin==NULL)
- { error_named("Couldn't open module file", filename); return;
- }
-
- for (i=0;i<64;i++) p0[i]=fgetc(fin);
-
- vn = p0[0];
- if ((vn<65) || (vn>75))
- { error_named("File isn't a module:", filename);
- fclose(fin); return;
- }
-
- if (vn != 64 + version_number)
- { char ebuff[100];
- sprintf(ebuff,
- "module compiled as Version %d (so it can't link\
- into this V%d game):", vn-64, version_number);
- error_named(ebuff, filename);
- fclose(fin); return;
- }
-
- module_size = (256*p0[26] + p0[27])*scale_factor;
- p = my_malloc(module_size + 16, "link module storage");
- /* The + 16 allows for rounding errors */
-
- for (k=0;k<64;k++) p[k] = p0[k];
- for (k=64;k<module_size;k++) p[k] = fgetc(fin);
- fclose(fin);
-
- if ((p0[52] != 0) || (p0[53] != 0))
- { /* Then the module contains a character set table */
- if (alphabet_modified)
- { k = FALSE; m = 256*p0[52] + p0[53];
- for (i=0;i<3;i++) for (j=0;j<26;j++)
- { l = alphabet[i][j]; if (l == '~') l = '\"';
- if (l != p[m]) k = TRUE;
- }
- if (k)
- link_error("module and game both define non-standard character sets, \
-but they disagree");
- k = FALSE;
- }
- else k = TRUE;
- }
- else
- { if (alphabet_modified) k = TRUE;
- else k = FALSE;
- }
- if (k)
- link_error("module and game use different character sets");
-
- i = p[1];
- if (i > MODULE_VERSION_NUMBER)
- warning_named("module has a more advanced format than this release \
-of the Inform 6 compiler knows about: it may not link in correctly", filename);
-
- /* (2) Calculate offsets: see the header-writing code in "tables.c" */
-
- map = (256*p[6] + p[7]);
- for (i=0; i<16; i++) module_map[i] = 256*p[map + i*2] + p[map + i*2 + 1];
-
- m_vars_offset = (256*p[12] + p[13]);
- m_static_offset = (256*p[14] + p[15]);
- m_dict_offset = (256*p[8] + p[9]);
- m_code_offset = (256*p[4] + p[5]);
-
- /* (3) Read the "module map" table */
-
- if (linker_trace_level>=4)
- { printf("[Reading module map:\n");
- for (i=0; i<16; i++) printf("%04x ", module_map[i]);
- printf("]\n");
- }
-
- m_objs_offset = module_map[0];
- m_props_offset = module_map[1];
- m_strs_offset = scale_factor*module_map[2];
- m_class_numbers = module_map[3];
- m_individuals_offset = module_map[4];
- m_individuals_length = module_map[5];
-
- for (i=16;i<256;i++) variables_map[i] = -1;
- for (i=0;i<16;i++) variables_map[i] = i;
- for (i=LOWEST_SYSTEM_VAR_NUMBER;i<256;i++) variables_map[i] = i;
-
- for (i=0;i<256;i++) actions_map[i] = -1;
-
- xref_table = my_calloc(sizeof(int32), module_map[6],
- "linker cross-references table");
- for (i=0;i<module_map[6];i++) xref_table[i] = -1;
-
- max_property_identifier = module_map[7];
- property_identifier_map = my_calloc(sizeof(int32), max_property_identifier,
- "property identifier map");
- for (i=0; i<max_property_identifier; i++)
- property_identifier_map[i] = i;
-
- m_no_objects = module_map[8];
- link_offset = module_map[9];
-
- m_no_globals = 0; p_no_globals = no_globals;
- lowest_imported_global_no=236;
-
- no_rr = 0;
-
- if ((linker_trace_level>=1) || transcript_switch)
- { char link_banner[128];
- sprintf(link_banner,
- "[Linking release %d.%c%c%c%c%c%c of module '%s' (size %dK)]",
- p[2]*256 + p[3], p[18], p[19], p[20], p[21], p[22], p[23],
- filename, module_size/1024);
- if (linker_trace_level >= 1) printf("%s\n", link_banner);
- if (transcript_switch)
- write_to_transcript_file(link_banner);
- }
-
- /* (4) Merge in the dictionary */
-
- if (linker_trace_level >= 2)
- printf("Merging module's dictionary at %04x\n", m_dict_offset);
- k=m_dict_offset; k+=p[k]+1;
- len=p[k++];
- size = p[k]*256 + p[k+1]; k+=2;
-
- accession_numbers_map = my_calloc(sizeof(int), size,
- "dictionary accession numbers map");
-
- for (i=0;i<size;i++, k+=len)
- { char word[10];
- word_to_ascii(p+k,word);
- if (linker_trace_level >= 3)
- printf("%03d %04x '%s' %02x %02x %02x\n",i,k,
- word, p[k+len-3], p[k+len-2], p[k+len-1]);
-
- accession_numbers_map[i]
- = dictionary_add(word, p[k+len-3], p[k+len-2], p[k+len-1]);
- }
-
- /* (5) Run through import/export table */
-
- m_read_pos = module_map[9];
- if (linker_trace_level>=2)
- printf("Import/export table is at byte offset %04x\n", m_read_pos);
-
- do
- { record_type = get_next_record(p);
- if (((record_type == EXPORT_MV) || (record_type == EXPORTSF_MV))
- && (IE.symbol_type == INDIVIDUAL_PROPERTY_T))
- { int32 si = symbol_index(IE.symbol_name, -1);
- property_identifier_map[IE.symbol_value] = svals[si];
- }
- switch(record_type)
- { case EXPORT_MV:
- case EXPORTSF_MV:
- case EXPORTAC_MV:
- accept_export(); break;
- case IMPORT_MV:
- accept_import(); break;
- }
- } while (record_type != 0);
-
- if ((linker_trace_level >= 4) && (no_rr != 0))
- { printf("Replaced routine addresses:\n");
- for (i=0; i<no_rr; i++)
- { printf("Replace code offset %04x with %04x\n",
- routine_replace[i], routine_replace_with[i]);
- }
- }
-
- if (linker_trace_level >= 4)
- { printf("Symbol cross-references table:\n");
- for (i=0; i<module_map[6]; i++)
- { if (xref_table[i] != -1)
- printf("module %4d -> story file '%s'\n", i,
- (char *) symbs[xref_table[i]]);
- }
- }
-
- if (linker_trace_level >= 4)
- { printf("Action numbers map:\n");
- for (i=0; i<256; i++)
- if (actions_map[i] != -1)
- printf("%3d -> %3d\n", i, actions_map[i]);
- }
-
- if ((linker_trace_level >= 4) && (max_property_identifier > 72))
- { printf("Property identifier number map:\n");
- for (i=72; i<max_property_identifier; i++)
- { printf("module %04x -> program %04x\n",
- i, property_identifier_map[i]);
- }
- }
-
- /* (6) Backpatch the backpatch markers attached to exported symbols */
-
- for (i=symbols_base; i<no_symbols; i++)
- { if ((sflags[i] & CHANGE_SFLAG) && (sflags[i] & EXPORT_SFLAG))
- { backpatch_marker = svals[i]/0x10000;
- j = svals[i] % 0x10000;
-
- j = backpatch_backpatch(j);
-
- svals[i] = backpatch_marker*0x10000 + j;
- if (backpatch_marker == 0) sflags[i] &= (~(CHANGE_SFLAG));
- }
- }
-
- /* (7) Run through the Z-code backpatch table */
-
- for (i=module_map[11]; i<module_map[11]+module_map[12]; i += 3)
- { int marker_value = p[i];
- int32 offset = 256*p[i+1] + p[i+2];
-
- switch(marker_value & 0x7f)
- { case OBJECT_MV:
- case ACTION_MV:
- case IDENT_MV:
- case VARIABLE_MV:
- backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
- break;
- default:
- backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, backpatch_marker);
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, (offset + zmachine_pc)/256);
- write_byte_to_memory_block(&zcode_backpatch_table,
- zcode_backpatch_size++, (offset + zmachine_pc)%256);
- break;
- }
- }
-
- /* (8) Run through the Z-machine backpatch table */
-
- for (i=module_map[13]; i<module_map[13]+module_map[14]; i += 4)
- { int marker_value = p[i], zmachine_area = p[i+1];
- int32 offset = 256*p[i+2] + p[i+3];
-
- switch(marker_value)
- { case OBJECT_MV:
- case ACTION_MV:
- case IDENT_MV:
- backpatch_module_image(p, marker_value, zmachine_area, offset);
- break;
- default:
- backpatch_module_image(p, marker_value, zmachine_area, offset);
- switch(zmachine_area)
- { case PROP_DEFAULTS_ZA:
- break;
- case PROP_ZA:
- offset += properties_table_size; break;
- case INDIVIDUAL_PROP_ZA:
- offset += individuals_length; break;
- case DYNAMIC_ARRAY_ZA:
- if (offset < (MAX_GLOBAL_VARIABLES*2))
- { offset = 2*(variables_map[offset/2 + 16] - 16);
- }
- else
- { offset += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
- }
- break;
- }
- backpatch_zmachine(backpatch_marker, zmachine_area, offset);
- break;
- }
- }
-
- /* (9) Adjust initial values of variables */
-
- if (linker_trace_level >= 3)
- printf("\nFinal variables map, Module -> Main:\n");
-
- for (i=16;i<255;i++)
- if (variables_map[i]!=-1)
- { if (linker_trace_level>=2)
- printf("%d->%d ",i,variables_map[i]);
- if (i<lowest_imported_global_no)
- { int32 j = read_marker_address(p, 2,
- DYNAMIC_ARRAY_ZA, 2*(i-16));
- set_variable_value(variables_map[i]-16, j);
- if (linker_trace_level>=2)
- printf("(set var %d to %d) ",
- variables_map[i], j);
- }
- }
- if (linker_trace_level>=2) printf("\n");
-
- /* (10) Glue in the dynamic array data */
-
- i = m_static_offset - m_vars_offset - MAX_GLOBAL_VARIABLES*2;
- if (dynamic_array_area_size + i >= MAX_STATIC_DATA)
- memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
-
- if (linker_trace_level >= 2)
- printf("Inserting dynamic array area, %04x to %04x, at %04x\n",
- m_vars_offset + MAX_GLOBAL_VARIABLES*2, m_static_offset,
- variables_offset + dynamic_array_area_size);
- for (k=0;k<i;k++)
- { dynamic_array_area[dynamic_array_area_size+k]
- = p[m_vars_offset+MAX_GLOBAL_VARIABLES*2+k];
- }
- dynamic_array_area_size+=i;
-
- /* (11) Glue in the code area */
-
- if (linker_trace_level >= 2)
- printf("Inserting code area, %04x to %04x, at code offset %04x (+%04x)\n",
- m_code_offset, m_strs_offset, code_offset, zmachine_pc);
-
- for (k=m_code_offset;k<m_strs_offset;k++)
- { if (temporary_files_switch)
- { fputc(p[k],Temp2_fp);
- zmachine_pc++;
- }
- else
- write_byte_to_memory_block(&zcode_area, zmachine_pc++, p[k]);
- }
-
- /* (12) Glue in the static strings area */
-
- if (linker_trace_level >= 2)
- printf("Inserting strings area, %04x to %04x, \
-at strings offset %04x (+%04x)\n",
- m_strs_offset, link_offset, strings_offset,
- static_strings_extent);
- for (k=m_strs_offset;k<link_offset;k++)
- { if (temporary_files_switch)
- { fputc(p[k], Temp1_fp);
- static_strings_extent++;
- }
- else
- write_byte_to_memory_block(&static_strings_area,
- static_strings_extent++, p[k]);
- }
-
- /* (13) Append the class object-numbers table: note that modules
- provide extra information in this table */
-
- i = m_class_numbers;
- do
- { j = p[i]*256 + p[i+1]; i+=2;
- if (j == 0) break;
-
- class_object_numbers[no_classes] = j + no_objects;
- j = p[i]*256 + p[i+1]; i+=2;
- class_begins_at[no_classes++] = j + properties_table_size;
-
- } while (TRUE);
-
- /* (14) Glue on the object tree */
-
- if ((linker_trace_level>=2) && (m_no_objects>0))
- printf("Joining on object tree of size %d\n", m_no_objects);
-
- for (i=0, k=no_objects, last=m_props_offset;i<m_no_objects;i++)
- { objectsz[no_objects].atts[0]=p[m_objs_offset+14*i];
- objectsz[no_objects].atts[1]=p[m_objs_offset+14*i+1];
- objectsz[no_objects].atts[2]=p[m_objs_offset+14*i+2];
- objectsz[no_objects].atts[3]=p[m_objs_offset+14*i+3];
- objectsz[no_objects].atts[4]=p[m_objs_offset+14*i+4];
- objectsz[no_objects].atts[5]=p[m_objs_offset+14*i+5];
- objectsz[no_objects].parent =
- (p[m_objs_offset+14*i+6])*256+p[m_objs_offset+14*i+7];
- objectsz[no_objects].next =
- (p[m_objs_offset+14*i+8])*256+p[m_objs_offset+14*i+9];
- objectsz[no_objects].child =
- (p[m_objs_offset+14*i+10])*256+p[m_objs_offset+14*i+11];
- if (linker_trace_level>=4)
- printf("Module objects[%d] has %d,%d,%d\n",
- i,objectsz[no_objects].parent,
- objectsz[no_objects].next,objectsz[no_objects].child);
- if (objectsz[no_objects].parent == 0x7fff)
- { objectsz[no_objects].parent = 1;
- if (objectsz[1].child == 0)
- { objectsz[1].child = no_objects+1;
- }
- else
- { int j1 = 0, j2 = objectsz[1].child;
- while (j2 != 0)
- { j1 = j2;
- j2 = objectsz[j2].next;
- }
- objectsz[j1].next = no_objects+1;
- }
- objectsz[no_objects].next = 0;
- }
- else
- if (objectsz[no_objects].parent>0) objectsz[no_objects].parent += k;
- if (objectsz[no_objects].next>0) objectsz[no_objects].next += k;
- if (objectsz[no_objects].child>0) objectsz[no_objects].child += k;
- objectsz[no_objects].propsize =
- (p[m_objs_offset+14*i+12])*256+p[m_objs_offset+14*i+13];
- last += objectsz[no_objects].propsize;
- if (linker_trace_level>=4)
- printf("Objects[%d] has %d,%d,%d\n",
- no_objects,objectsz[no_objects].parent,
- objectsz[no_objects].next,objectsz[no_objects].child);
- no_objects++;
- }
-
- /* (15) Glue on the properties */
-
- if (last>m_props_offset)
- { i = m_static_offset - m_vars_offset - MAX_GLOBAL_VARIABLES*2;
- if (dynamic_array_area_size + i >= MAX_STATIC_DATA)
- memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
-
- if (linker_trace_level >= 2)
- printf("Inserting object properties area, %04x to %04x, at +%04x\n",
- m_props_offset, last, properties_table_size);
- for (k=0;k<last-m_props_offset;k++)
- properties_table[properties_table_size++] = p[m_props_offset+k];
- }
-
- /* (16) Bitwise OR Flags 2 (Z-machine requirements flags) */
-
- j = p[16]*256 + p[17];
- for (i=0, k=1;i<16;i++, k=k*2) flags2_requirements[i] |= ((j/k)%2);
-
- /* (17) Append the individual property values table */
-
- i = m_individuals_length;
- if (individuals_length + i >= MAX_INDIV_PROP_TABLE_SIZE)
- memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
- MAX_INDIV_PROP_TABLE_SIZE);
-
- if (linker_trace_level >= 2)
- printf("Inserting individual prop tables area, %04x to %04x, at +%04x\n",
- m_individuals_offset, m_individuals_offset + i,
- individuals_length);
- for (k=0;k<i;k++)
- { individuals_table[individuals_length + k]
- = p[m_individuals_offset + k];
- }
- individuals_length += i;
-
- /* (18) All done */
-
- if (linker_trace_level >= 2)
- printf("Link complete\n");
-
- my_free(&p, "link module storage");
- my_free(&xref_table, "linker cross-references table");
- my_free(&property_identifier_map, "property identifier map");
- my_free(&accession_numbers_map, "accession numbers map");
-}
-
-/* ========================================================================= */
-/* Writing imports, exports and markers to the link data table during */
-/* module compilation */
-/* ------------------------------------------------------------------------- */
-/* Writing to the link data table */
-/* ------------------------------------------------------------------------- */
-
-static void write_link_byte(int x)
-{ *link_data_top=(unsigned char) x; link_data_top++; link_data_size++;
- if (subtract_pointers(link_data_top,link_data_holding_area)
- >= MAX_LINK_DATA_SIZE)
- { memoryerror("MAX_LINK_DATA_SIZE",MAX_LINK_DATA_SIZE);
- }
-}
-
-extern void flush_link_data(void)
-{ int32 i, j;
- j = subtract_pointers(link_data_top, link_data_holding_area);
- if (temporary_files_switch)
- for (i=0;i<j;i++) fputc(link_data_holding_area[i], Temp3_fp);
- else
- for (i=0;i<j;i++)
- write_byte_to_memory_block(&link_data_area, link_data_size-j+i,
- link_data_holding_area[i]);
- link_data_top=link_data_holding_area;
-}
-
-static void write_link_word(int32 x)
-{ write_link_byte(x/256); write_link_byte(x%256);
-}
-
-static void write_link_string(char *s)
-{ int i;
- for (i=0; s[i]!=0; i++) write_link_byte(s[i]);
- write_link_byte(0);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Exports and imports */
-/* ------------------------------------------------------------------------- */
-
-static void export_symbols(void)
-{ int symbol_number;
-
- for (symbol_number = 0; symbol_number < no_symbols; symbol_number++)
- { int export_flag = FALSE, import_flag = FALSE;
-
- if (stypes[symbol_number]==GLOBAL_VARIABLE_T)
- { if (svals[symbol_number] < LOWEST_SYSTEM_VAR_NUMBER)
- { if (sflags[symbol_number] & IMPORT_SFLAG)
- import_flag = TRUE;
- else
- if (!(sflags[symbol_number] & SYSTEM_SFLAG))
- export_flag = TRUE;
- }
- }
- else
- { if (!(sflags[symbol_number] & SYSTEM_SFLAG))
- { if (sflags[symbol_number] & UNKNOWN_SFLAG)
- { if (sflags[symbol_number] & IMPORT_SFLAG)
- import_flag = TRUE;
- }
- else
- switch(stypes[symbol_number])
- { case LABEL_T:
- case ATTRIBUTE_T:
- case PROPERTY_T:
- /* Ephemera */
- break;
-
- default: export_flag = TRUE;
- }
- }
- }
-
- if (export_flag)
- { if (linker_trace_level >= 1)
- { IE.module_value = EXPORT_MV;
- IE.symbol_number = symbol_number;
- IE.symbol_type = stypes[symbol_number];
- IE.symbol_value = svals[symbol_number];
- IE.symbol_name = (char *) (symbs[symbol_number]);
- describe_importexport(&IE);
- }
-
- if (sflags[symbol_number] & ACTION_SFLAG)
- write_link_byte(EXPORTAC_MV);
- else
- if (sflags[symbol_number] & INSF_SFLAG)
- write_link_byte(EXPORTSF_MV);
- else
- write_link_byte(EXPORT_MV);
-
- write_link_word(symbol_number);
- write_link_byte(stypes[symbol_number]);
- if (sflags[symbol_number] & CHANGE_SFLAG)
- write_link_byte(svals[symbol_number] / 0x10000);
- else write_link_byte(0);
- write_link_word(svals[symbol_number] % 0x10000);
- write_link_string((char *) (symbs[symbol_number]));
- flush_link_data();
- }
-
- if (import_flag)
- { if (linker_trace_level >= 1)
- { IE.module_value = IMPORT_MV;
- IE.symbol_number = symbol_number;
- IE.symbol_type = stypes[symbol_number];
- IE.symbol_value = svals[symbol_number];
- IE.symbol_name = (char *) (symbs[symbol_number]);
- describe_importexport(&IE);
- }
-
- write_link_byte(IMPORT_MV);
- write_link_word(symbol_number);
- write_link_byte(stypes[symbol_number]);
- write_link_word(svals[symbol_number]);
- write_link_string((char *) (symbs[symbol_number]));
- flush_link_data();
- }
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Marking for later importation */
-/* ------------------------------------------------------------------------- */
-
-int mv_vref=LOWEST_SYSTEM_VAR_NUMBER-1;
-
-void import_symbol(int32 symbol_number)
-{ sflags[symbol_number] |= IMPORT_SFLAG;
- switch(stypes[symbol_number])
- { case GLOBAL_VARIABLE_T:
- assign_symbol(symbol_number, mv_vref--, stypes[symbol_number]);
- break;
- }
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_linker_vars(void)
-{ link_data_size = 0;
- initialise_memory_block(&link_data_area);
-}
-
-extern void linker_begin_pass(void)
-{ link_data_top = link_data_holding_area;
-}
-
-extern void linker_endpass(void)
-{ export_symbols();
- write_link_byte(0);
- flush_link_data();
-}
-
-extern void linker_allocate_arrays(void)
-{ if (!module_switch)
- link_data_holding_area
- = my_malloc(64, "link data holding area");
- else
- link_data_holding_area
- = my_malloc(MAX_LINK_DATA_SIZE, "link data holding area");
-}
-
-extern void linker_free_arrays(void)
-{ my_free(&link_data_holding_area, "link data holding area");
- deallocate_memory_block(&link_data_area);
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "memory" : Memory management and ICL memory setting commands */
-/* (For "memoryerror", see "errors.c") */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int32 malloced_bytes=0; /* Total amount of memory allocated */
-
-#ifdef PC_QUICKC
-
-extern void *my_malloc(int32 size, char *whatfor)
-{ char _huge *c;
- if (memout_switch)
- printf("Allocating %ld bytes for %s\n",size,whatfor);
- if (size==0) return(NULL);
- c=(char _huge *)halloc(size,1); malloced_bytes+=size;
- if (c==0) memory_out_error(size, 1, whatfor);
- return(c);
-}
-
-extern void my_realloc(void *pointer, int32 oldsize, int32 size,
- char *whatfor)
-{ char _huge *c;
- if (size==0) {
- my_free(pointer, whatfor);
- return;
- }
- c=halloc(size,1); malloced_bytes+=size;
- if (c==0) memory_out_error(size, 1, whatfor);
- if (memout_switch)
- printf("Increasing allocation to %ld bytes for %s was (%08lx) \
-now (%08lx)\n",
- (long int) size,whatfor,(long int) (*(int **)pointer),
- (long int) c);
- memcpy(c, *(int **)pointer, MIN(oldsize, size));
- hfree(*(int **)pointer);
- *(int **)pointer = c;
-}
-
-extern void *my_calloc(int32 size, int32 howmany, char *whatfor)
-{ void _huge *c;
- if (memout_switch)
- printf("Allocating %d bytes: array (%ld entries size %ld) for %s\n",
- size*howmany,howmany,size,whatfor);
- if ((size*howmany) == 0) return(NULL);
- c=(void _huge *)halloc(howmany*size,1); malloced_bytes+=size*howmany;
- if (c==0) memory_out_error(size, howmany, whatfor);
- return(c);
-}
-
-extern void my_recalloc(void *pointer, int32 size, int32 oldhowmany,
- int32 howmany, char *whatfor)
-{ void _huge *c;
- if (size*howmany==0) {
- my_free(pointer, whatfor);
- return;
- }
- c=(void _huge *)halloc(size*howmany,1); malloced_bytes+=size*howmany;
- if (c==0) memory_out_error(size, howmany, whatfor);
- if (memout_switch)
- printf("Increasing allocation to %ld bytes: array (%ld entries size %ld) \
-for %s was (%08lx) now (%08lx)\n",
- ((long int)size) * ((long int)howmany),
- (long int)howmany,(long int)size,whatfor,
- (long int) *(int **)pointer, (long int) c);
- memcpy(c, *(int **)pointer, MIN(size*oldhowmany, size*howmany));
- hfree(*(int **)pointer);
- *(int **)pointer = c;
-}
-
-#else
-
-extern void *my_malloc(int32 size, char *whatfor)
-{ char *c;
- if (size==0) return(NULL);
- c=malloc((size_t) size); malloced_bytes+=size;
- if (c==0) memory_out_error(size, 1, whatfor);
- if (memout_switch)
- printf("Allocating %ld bytes for %s at (%08lx)\n",
- (long int) size,whatfor,(long int) c);
- return(c);
-}
-
-extern void my_realloc(void *pointer, int32 oldsize, int32 size,
- char *whatfor)
-{ void *c;
- if (size==0) {
- my_free(pointer, whatfor);
- return;
- }
- c=realloc(*(int **)pointer, (size_t) size); malloced_bytes+=size;
- if (c==0) memory_out_error(size, 1, whatfor);
- if (memout_switch)
- printf("Increasing allocation to %ld bytes for %s was (%08lx) \
-now (%08lx)\n",
- (long int) size,whatfor,(long int) (*(int **)pointer),
- (long int) c);
- *(int **)pointer = c;
-}
-
-extern void *my_calloc(int32 size, int32 howmany, char *whatfor)
-{ void *c;
- if (size*howmany==0) return(NULL);
- c=calloc(howmany,(size_t) size); malloced_bytes+=size*howmany;
- if (c==0) memory_out_error(size, howmany, whatfor);
- if (memout_switch)
- printf("Allocating %ld bytes: array (%ld entries size %ld) \
-for %s at (%08lx)\n",
- ((long int)size) * ((long int)howmany),
- (long int)howmany,(long int)size,whatfor,
- (long int) c);
- return(c);
-}
-
-extern void my_recalloc(void *pointer, int32 size, int32 oldhowmany,
- int32 howmany, char *whatfor)
-{ void *c;
- if (size*howmany==0) {
- my_free(pointer, whatfor);
- return;
- }
- c=realloc(*(int **)pointer, (size_t)size*(size_t)howmany);
- malloced_bytes+=size*howmany;
- if (c==0) memory_out_error(size, howmany, whatfor);
- if (memout_switch)
- printf("Increasing allocation to %ld bytes: array (%ld entries size %ld) \
-for %s was (%08lx) now (%08lx)\n",
- ((long int)size) * ((long int)howmany),
- (long int)howmany,(long int)size,whatfor,
- (long int) *(int **)pointer, (long int) c);
- *(int **)pointer = c;
-}
-
-#endif
-
-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));
-#ifdef PC_QUICKC
- hfree(*(int **)pointer);
-#else
- free(*(int **)pointer);
-#endif
- *(int **)pointer = NULL;
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Extensible blocks of memory, providing a kind of RAM disc as an */
-/* alternative to the temporary files option */
-/* ------------------------------------------------------------------------- */
-
-static char chunk_name_buffer[60];
-static char *chunk_name(memory_block *MB, int no)
-{ char *p = "(unknown)";
- if (MB == &static_strings_area) p = "static strings area";
- if (MB == &zcode_area) p = "Z-code area";
- if (MB == &link_data_area) p = "link data area";
- if (MB == &zcode_backpatch_table) p = "Z-code backpatch table";
- if (MB == &zmachine_backpatch_table) p = "Z-machine backpatch table";
- sprintf(chunk_name_buffer, "%s chunk %d", p, no);
- return(chunk_name_buffer);
-}
-
-extern void initialise_memory_block(memory_block *MB)
-{ int i;
- MB->chunks = 0;
- for (i=0; i<72; i++) MB->chunk[i] = NULL;
- MB->extent_of_last = 0;
- MB->write_pos = 0;
-}
-
-extern void deallocate_memory_block(memory_block *MB)
-{ int i;
- for (i=0; i<72; i++)
- if (MB->chunk[i] != NULL)
- my_free(&(MB->chunk[i]), chunk_name(MB, i));
- MB->chunks = 0;
- MB->extent_of_last = 0;
-}
-
-extern int read_byte_from_memory_block(memory_block *MB, int32 index)
-{ uchar *p;
- p = MB->chunk[index/ALLOC_CHUNK_SIZE];
- if (p == NULL)
- { compiler_error_named("memory: read from unwritten byte in",
- chunk_name(MB, index/ALLOC_CHUNK_SIZE));
- return 0;
- }
- return p[index % ALLOC_CHUNK_SIZE];
-}
-
-extern void write_byte_to_memory_block(memory_block *MB, int32 index, int value)
-{ uchar *p; int ch = index/ALLOC_CHUNK_SIZE;
- if (ch < 0)
- { compiler_error_named("memory: negative index to", chunk_name(MB, 0));
- return;
- }
- if (ch >= 72) memoryerror("ALLOC_CHUNK_SIZE", ALLOC_CHUNK_SIZE);
-
- if (MB->chunk[ch] == NULL)
- { int i;
- MB->chunk[ch] = my_malloc(ALLOC_CHUNK_SIZE, chunk_name(MB, ch));
- p = MB->chunk[ch];
- for (i=0; i<ALLOC_CHUNK_SIZE; i++) p[i] = 255;
- }
-
- p = MB->chunk[ch];
- p[index % ALLOC_CHUNK_SIZE] = value;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Where the memory settings are declared as variables */
-/* ------------------------------------------------------------------------- */
-
-int MAX_QTEXT_SIZE;
-int MAX_SYMBOLS;
-int SYMBOLS_CHUNK_SIZE;
-int HASH_TAB_SIZE;
-int MAX_OBJECTS;
-int MAX_ARRAYS;
-int MAX_ACTIONS;
-int MAX_ADJECTIVES;
-int MAX_DICT_ENTRIES;
-int MAX_STATIC_DATA;
-int MAX_PROP_TABLE_SIZE;
-int MAX_ABBREVS;
-int MAX_EXPRESSION_NODES;
-int MAX_VERBS;
-int MAX_VERBSPACE;
-int MAX_LABELS;
-int MAX_LINESPACE;
-int32 MAX_STATIC_STRINGS;
-int32 MAX_ZCODE_SIZE;
-int MAX_LOW_STRINGS;
-int32 MAX_TRANSCRIPT_SIZE;
-int MAX_CLASSES;
-int32 MAX_LINK_DATA_SIZE;
-int MAX_INCLUSION_DEPTH;
-int MAX_SOURCE_FILES;
-int32 MAX_INDIV_PROP_TABLE_SIZE;
-int32 MAX_OBJ_PROP_TABLE_SIZE;
-int MAX_OBJ_PROP_COUNT;
-int MAX_LOCAL_VARIABLES;
-int MAX_GLOBAL_VARIABLES;
-int DICT_WORD_SIZE; /* number of characters in a dict word */
-int DICT_CHAR_SIZE; /* (glulx) 1 for one-byte chars, 4 for Unicode chars */
-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 NUM_ATTR_BYTES;
-int GLULX_OBJECT_EXT_BYTES; /* (glulx) extra bytes for each object record */
-int32 MAX_NUM_STATIC_STRINGS;
-int32 MAX_UNICODE_CHARS;
-int32 MAX_STACK_SIZE;
-int32 MEMORY_MAP_EXTENSION;
-int ALLOC_CHUNK_SIZE;
-int WARN_UNUSED_ROUTINES; /* 0: no, 1: yes except in system files, 2: yes always */
-int OMIT_UNUSED_ROUTINES; /* 0: no, 1: yes */
-
-/* The way memory sizes are set causes great nuisance for those parameters
- which have different defaults under Z-code and Glulx. We have to get
- the defaults right whether the user sets "-G $HUGE" or "$HUGE -G".
- And an explicit value set by the user should override both defaults. */
-static int32 MAX_ZCODE_SIZE_z, MAX_ZCODE_SIZE_g;
-static int MAX_PROP_TABLE_SIZE_z, MAX_PROP_TABLE_SIZE_g;
-static int MAX_GLOBAL_VARIABLES_z, MAX_GLOBAL_VARIABLES_g;
-static int MAX_LOCAL_VARIABLES_z, MAX_LOCAL_VARIABLES_g;
-static int DICT_WORD_SIZE_z, DICT_WORD_SIZE_g;
-static int NUM_ATTR_BYTES_z, NUM_ATTR_BYTES_g;
-static int ALLOC_CHUNK_SIZE_z, ALLOC_CHUNK_SIZE_g;
-
-/* ------------------------------------------------------------------------- */
-/* Memory control from the command line */
-/* ------------------------------------------------------------------------- */
-
-static void list_memory_sizes(void)
-{ printf("+--------------------------------------+\n");
- printf("| %25s = %-7s |\n","Memory setting","Value");
- printf("+--------------------------------------+\n");
- printf("| %25s = %-7d |\n","MAX_ABBREVS",MAX_ABBREVS);
- printf("| %25s = %-7d |\n","MAX_ACTIONS",MAX_ACTIONS);
- printf("| %25s = %-7d |\n","MAX_ADJECTIVES",MAX_ADJECTIVES);
- printf("| %25s = %-7d |\n","ALLOC_CHUNK_SIZE",ALLOC_CHUNK_SIZE);
- printf("| %25s = %-7d |\n","MAX_ARRAYS",MAX_ARRAYS);
- printf("| %25s = %-7d |\n","NUM_ATTR_BYTES",NUM_ATTR_BYTES);
- printf("| %25s = %-7d |\n","MAX_CLASSES",MAX_CLASSES);
- printf("| %25s = %-7d |\n","MAX_DICT_ENTRIES",MAX_DICT_ENTRIES);
- printf("| %25s = %-7d |\n","DICT_WORD_SIZE",DICT_WORD_SIZE);
- if (glulx_mode)
- printf("| %25s = %-7d |\n","DICT_CHAR_SIZE",DICT_CHAR_SIZE);
- printf("| %25s = %-7d |\n","MAX_EXPRESSION_NODES",MAX_EXPRESSION_NODES);
- printf("| %25s = %-7d |\n","MAX_GLOBAL_VARIABLES",MAX_GLOBAL_VARIABLES);
- printf("| %25s = %-7d |\n","HASH_TAB_SIZE",HASH_TAB_SIZE);
- if (!glulx_mode)
- printf("| %25s = %-7d |\n","ZCODE_HEADER_EXT_WORDS",ZCODE_HEADER_EXT_WORDS);
- if (!glulx_mode)
- printf("| %25s = %-7d |\n","ZCODE_HEADER_FLAGS_3",ZCODE_HEADER_FLAGS_3);
- printf("| %25s = %-7d |\n","MAX_INCLUSION_DEPTH",MAX_INCLUSION_DEPTH);
- printf("| %25s = %-7d |\n","MAX_INDIV_PROP_TABLE_SIZE", MAX_INDIV_PROP_TABLE_SIZE);
- printf("| %25s = %-7d |\n","INDIV_PROP_START", INDIV_PROP_START);
- printf("| %25s = %-7d |\n","MAX_LABELS",MAX_LABELS);
- printf("| %25s = %-7d |\n","MAX_LINESPACE",MAX_LINESPACE);
- printf("| %25s = %-7d |\n","MAX_LINK_DATA_SIZE",MAX_LINK_DATA_SIZE);
- if (glulx_mode)
- printf("| %25s = %-7d |\n","MAX_LOCAL_VARIABLES",MAX_LOCAL_VARIABLES);
- printf("| %25s = %-7d |\n","MAX_LOW_STRINGS",MAX_LOW_STRINGS);
- if (glulx_mode)
- printf("| %25s = %-7d |\n","MEMORY_MAP_EXTENSION",
- MEMORY_MAP_EXTENSION);
- if (glulx_mode)
- printf("| %25s = %-7d |\n","MAX_NUM_STATIC_STRINGS",
- MAX_NUM_STATIC_STRINGS);
- printf("| %25s = %-7d |\n","MAX_OBJECTS",MAX_OBJECTS);
- if (glulx_mode)
- printf("| %25s = %-7d |\n","GLULX_OBJECT_EXT_BYTES",
- GLULX_OBJECT_EXT_BYTES);
- if (glulx_mode)
- printf("| %25s = %-7d |\n","MAX_OBJ_PROP_COUNT",
- MAX_OBJ_PROP_COUNT);
- if (glulx_mode)
- printf("| %25s = %-7d |\n","MAX_OBJ_PROP_TABLE_SIZE",
- MAX_OBJ_PROP_TABLE_SIZE);
- printf("| %25s = %-7d |\n","MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
- printf("| %25s = %-7d |\n","MAX_QTEXT_SIZE",MAX_QTEXT_SIZE);
- printf("| %25s = %-7d |\n","MAX_SOURCE_FILES",MAX_SOURCE_FILES);
- if (glulx_mode)
- printf("| %25s = %-7ld |\n","MAX_STACK_SIZE",
- (long int) MAX_STACK_SIZE);
- printf("| %25s = %-7d |\n","MAX_STATIC_DATA",MAX_STATIC_DATA);
- printf("| %25s = %-7ld |\n","MAX_STATIC_STRINGS",
- (long int) MAX_STATIC_STRINGS);
- printf("| %25s = %-7d |\n","MAX_SYMBOLS",MAX_SYMBOLS);
- printf("| %25s = %-7d |\n","SYMBOLS_CHUNK_SIZE",SYMBOLS_CHUNK_SIZE);
- printf("| %25s = %-7ld |\n","MAX_TRANSCRIPT_SIZE",
- (long int) MAX_TRANSCRIPT_SIZE);
- if (glulx_mode)
- printf("| %25s = %-7ld |\n","MAX_UNICODE_CHARS",
- (long int) MAX_UNICODE_CHARS);
- printf("| %25s = %-7d |\n","WARN_UNUSED_ROUTINES",WARN_UNUSED_ROUTINES);
- printf("| %25s = %-7d |\n","OMIT_UNUSED_ROUTINES",OMIT_UNUSED_ROUTINES);
- printf("| %25s = %-7d |\n","MAX_VERBS",MAX_VERBS);
- printf("| %25s = %-7d |\n","MAX_VERBSPACE",MAX_VERBSPACE);
- printf("| %25s = %-7ld |\n","MAX_ZCODE_SIZE",
- (long int) MAX_ZCODE_SIZE);
- printf("+--------------------------------------+\n");
-}
-
-extern void set_memory_sizes(int size_flag)
-{
- if (size_flag == HUGE_SIZE)
- {
- MAX_QTEXT_SIZE = 4000;
- MAX_SYMBOLS = 10000;
-
- SYMBOLS_CHUNK_SIZE = 5000;
- HASH_TAB_SIZE = 512;
-
- MAX_OBJECTS = 640;
-
- MAX_ACTIONS = 200;
- MAX_ADJECTIVES = 50;
- MAX_DICT_ENTRIES = 2000;
- MAX_STATIC_DATA = 10000;
-
- MAX_PROP_TABLE_SIZE_z = 30000;
- MAX_PROP_TABLE_SIZE_g = 60000;
-
- MAX_ABBREVS = 64;
-
- MAX_EXPRESSION_NODES = 100;
- MAX_VERBS = 200;
- MAX_VERBSPACE = 4096;
- MAX_LABELS = 1000;
- MAX_LINESPACE = 16000;
-
- MAX_STATIC_STRINGS = 8000;
- MAX_ZCODE_SIZE_z = 20000;
- MAX_ZCODE_SIZE_g = 40000;
- MAX_LINK_DATA_SIZE = 2000;
-
- MAX_LOW_STRINGS = 2048;
-
- MAX_TRANSCRIPT_SIZE = 200000;
- MAX_NUM_STATIC_STRINGS = 20000;
-
- MAX_CLASSES = 64;
-
- MAX_OBJ_PROP_COUNT = 128;
- MAX_OBJ_PROP_TABLE_SIZE = 4096;
-
- MAX_INDIV_PROP_TABLE_SIZE = 15000;
- MAX_ARRAYS = 128;
-
- MAX_GLOBAL_VARIABLES_z = 240;
- MAX_GLOBAL_VARIABLES_g = 512;
-
- ALLOC_CHUNK_SIZE_z = 8192;
- ALLOC_CHUNK_SIZE_g = 32768;
- }
- if (size_flag == LARGE_SIZE)
- {
- MAX_QTEXT_SIZE = 4000;
- MAX_SYMBOLS = 6400;
-
- SYMBOLS_CHUNK_SIZE = 5000;
- HASH_TAB_SIZE = 512;
-
- MAX_OBJECTS = 512;
-
- MAX_ACTIONS = 200;
- MAX_ADJECTIVES = 50;
- MAX_DICT_ENTRIES = 1300;
- MAX_STATIC_DATA = 10000;
-
- MAX_PROP_TABLE_SIZE_z = 15000;
- MAX_PROP_TABLE_SIZE_g = 30000;
-
- MAX_ABBREVS = 64;
-
- MAX_EXPRESSION_NODES = 100;
- MAX_VERBS = 140;
- MAX_VERBSPACE = 4096;
- MAX_LINESPACE = 10000;
-
- MAX_LABELS = 1000;
- MAX_STATIC_STRINGS = 8000;
- MAX_ZCODE_SIZE_z = 20000;
- MAX_ZCODE_SIZE_g = 40000;
- MAX_LINK_DATA_SIZE = 2000;
-
- MAX_LOW_STRINGS = 2048;
-
- MAX_TRANSCRIPT_SIZE = 200000;
- MAX_NUM_STATIC_STRINGS = 20000;
-
- MAX_CLASSES = 64;
-
- MAX_OBJ_PROP_COUNT = 64;
- MAX_OBJ_PROP_TABLE_SIZE = 2048;
-
- MAX_INDIV_PROP_TABLE_SIZE = 10000;
- MAX_ARRAYS = 128;
-
- MAX_GLOBAL_VARIABLES_z = 240;
- MAX_GLOBAL_VARIABLES_g = 512;
-
- ALLOC_CHUNK_SIZE_z = 8192;
- ALLOC_CHUNK_SIZE_g = 16384;
- }
- if (size_flag == SMALL_SIZE)
- {
- MAX_QTEXT_SIZE = 4000;
- MAX_SYMBOLS = 3000;
-
- SYMBOLS_CHUNK_SIZE = 2500;
- HASH_TAB_SIZE = 512;
-
- MAX_OBJECTS = 300;
-
- MAX_ACTIONS = 200;
- MAX_ADJECTIVES = 50;
- MAX_DICT_ENTRIES = 700;
- MAX_STATIC_DATA = 10000;
-
- MAX_PROP_TABLE_SIZE_z = 8000;
- MAX_PROP_TABLE_SIZE_g = 16000;
-
- MAX_ABBREVS = 64;
-
- MAX_EXPRESSION_NODES = 40;
- MAX_VERBS = 110;
- MAX_VERBSPACE = 2048;
- MAX_LINESPACE = 10000;
- MAX_LABELS = 1000;
-
- MAX_STATIC_STRINGS = 8000;
- MAX_ZCODE_SIZE_z = 10000;
- MAX_ZCODE_SIZE_g = 20000;
- MAX_LINK_DATA_SIZE = 1000;
-
- MAX_LOW_STRINGS = 1024;
-
- MAX_TRANSCRIPT_SIZE = 100000;
- MAX_NUM_STATIC_STRINGS = 10000;
-
- MAX_CLASSES = 32;
-
- MAX_OBJ_PROP_COUNT = 64;
- MAX_OBJ_PROP_TABLE_SIZE = 1024;
-
- MAX_INDIV_PROP_TABLE_SIZE = 5000;
- MAX_ARRAYS = 64;
-
- MAX_GLOBAL_VARIABLES_z = 240;
- MAX_GLOBAL_VARIABLES_g = 256;
-
- ALLOC_CHUNK_SIZE_z = 8192;
- ALLOC_CHUNK_SIZE_g = 8192;
- }
-
- /* Regardless of size_flag... */
- MAX_SOURCE_FILES = 256;
- MAX_INCLUSION_DEPTH = 5;
- MAX_LOCAL_VARIABLES_z = 16;
- MAX_LOCAL_VARIABLES_g = 32;
- DICT_CHAR_SIZE = 1;
- DICT_WORD_SIZE_z = 6;
- DICT_WORD_SIZE_g = 9;
- NUM_ATTR_BYTES_z = 6;
- NUM_ATTR_BYTES_g = 7;
- /* Backwards-compatible behavior: allow for a unicode table
- whether we need one or not. The user can set this to zero if
- there's no unicode table. */
- ZCODE_HEADER_EXT_WORDS = 3;
- ZCODE_HEADER_FLAGS_3 = 0;
- GLULX_OBJECT_EXT_BYTES = 0;
- MAX_UNICODE_CHARS = 64;
- MEMORY_MAP_EXTENSION = 0;
- /* We estimate the default Glulx stack size at 4096. That's about
- enough for 90 nested function calls with 8 locals each -- the
- same capacity as the Z-Spec's suggestion for Z-machine stack
- size. Note that Inform 7 wants more stack; I7-generated code
- sets MAX_STACK_SIZE to 65536 by default. */
- MAX_STACK_SIZE = 4096;
- OMIT_UNUSED_ROUTINES = 0;
- WARN_UNUSED_ROUTINES = 0;
-
- adjust_memory_sizes();
-}
-
-extern void adjust_memory_sizes()
-{
- if (!glulx_mode) {
- MAX_ZCODE_SIZE = MAX_ZCODE_SIZE_z;
- MAX_PROP_TABLE_SIZE = MAX_PROP_TABLE_SIZE_z;
- MAX_GLOBAL_VARIABLES = MAX_GLOBAL_VARIABLES_z;
- MAX_LOCAL_VARIABLES = MAX_LOCAL_VARIABLES_z;
- DICT_WORD_SIZE = DICT_WORD_SIZE_z;
- NUM_ATTR_BYTES = NUM_ATTR_BYTES_z;
- ALLOC_CHUNK_SIZE = ALLOC_CHUNK_SIZE_z;
- INDIV_PROP_START = 64;
- }
- else {
- MAX_ZCODE_SIZE = MAX_ZCODE_SIZE_g;
- MAX_PROP_TABLE_SIZE = MAX_PROP_TABLE_SIZE_g;
- MAX_GLOBAL_VARIABLES = MAX_GLOBAL_VARIABLES_g;
- MAX_LOCAL_VARIABLES = MAX_LOCAL_VARIABLES_g;
- DICT_WORD_SIZE = DICT_WORD_SIZE_g;
- NUM_ATTR_BYTES = NUM_ATTR_BYTES_g;
- ALLOC_CHUNK_SIZE = ALLOC_CHUNK_SIZE_g;
- INDIV_PROP_START = 256;
- }
-}
-
-static void explain_parameter(char *command)
-{ printf("\n");
- if (strcmp(command,"MAX_QTEXT_SIZE")==0)
- { printf(
-" MAX_QTEXT_SIZE is the maximum length of a quoted string. Increasing\n\
- by 1 costs 5 bytes (for lexical analysis memory). Inform automatically\n\
- ensures that MAX_STATIC_STRINGS is at least twice the size of this.");
- return;
- }
- if (strcmp(command,"MAX_SYMBOLS")==0)
- { printf(
-" MAX_SYMBOLS is the maximum number of symbols - names of variables, \n\
- objects, routines, the many internal Inform-generated names and so on.\n");
- return;
- }
- if (strcmp(command,"SYMBOLS_CHUNK_SIZE")==0)
- { printf(
-" The symbols names are stored in memory which is allocated in chunks \n\
- of size SYMBOLS_CHUNK_SIZE.\n");
- return;
- }
- if (strcmp(command,"HASH_TAB_SIZE")==0)
- { printf(
-" HASH_TAB_SIZE is the size of the hash tables used for the heaviest \n\
- symbols banks.\n");
- return;
- }
- if (strcmp(command,"MAX_OBJECTS")==0)
- { printf(
-" MAX_OBJECTS is the maximum number of objects. (If compiling a version-3 \n\
- game, 255 is an absolute maximum in any event.)\n");
- return;
- }
- if (strcmp(command,"MAX_ACTIONS")==0)
- { printf(
-" MAX_ACTIONS is the maximum number of actions - that is, routines such as \n\
- TakeSub which are referenced in the grammar table.\n");
- return;
- }
- if (strcmp(command,"MAX_ADJECTIVES")==0)
- { printf(
-" MAX_ADJECTIVES is the maximum number of different \"adjectives\" in the \n\
- grammar table. Adjectives are misleadingly named: they are words such as \n\
- \"in\", \"under\" and the like.\n");
- return;
- }
- if (strcmp(command,"MAX_DICT_ENTRIES")==0)
- { printf(
-" MAX_DICT_ENTRIES is the maximum number of words which can be entered \n\
- into the game's dictionary. It costs 29 bytes to increase this by one.\n");
- return;
- }
- if (strcmp(command,"DICT_WORD_SIZE")==0)
- { printf(
-" DICT_WORD_SIZE is the number of characters in a dictionary word. In \n\
- Z-code this is always 6 (only 4 are used in v3 games). In Glulx it \n\
- can be any number.\n");
- return;
- }
- if (strcmp(command,"DICT_CHAR_SIZE")==0)
- { printf(
-" DICT_CHAR_SIZE is the byte size of one character in the dictionary. \n\
- (This is only meaningful in Glulx, since Z-code has compressed dictionary \n\
- words.) It can be either 1 (the default) or 4 (to enable full Unicode \n\
- input.)\n");
- return;
- }
- if (strcmp(command,"NUM_ATTR_BYTES")==0)
- { printf(
-" NUM_ATTR_BYTES is the space used to store attribute flags. Each byte \n\
- stores eight attributes. In Z-code this is always 6 (only 4 are used in \n\
- v3 games). In Glulx it can be any number which is a multiple of four, \n\
- plus three.\n");
- return;
- }
- if (strcmp(command,"ZCODE_HEADER_EXT_WORDS")==0)
- { printf(
-" ZCODE_HEADER_EXT_WORDS is the number of words in the Z-code header \n\
- extension table (Z-Spec 1.0). The -W switch also sets this. It defaults \n\
- to 3, but can be set higher. (It can be set lower if no Unicode \n\
- translation table is created.)\n");
- return;
- }
- if (strcmp(command,"ZCODE_HEADER_FLAGS_3")==0)
- { printf(
-" ZCODE_HEADER_FLAGS_3 is the value to store in the Flags 3 word of the \n\
- header extension table (Z-Spec 1.1).\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\
- object record. It is initialized to zero bytes, and the game is free to \n\
- use it as desired. (This is only meaningful in Glulx, since Z-code \n\
- specifies the object structure.)\n");
- return;
- }
- if (strcmp(command,"MAX_STATIC_DATA")==0)
- { printf(
-" MAX_STATIC_DATA is the size of an array of integers holding initial \n\
- values for arrays and strings stored as ASCII inside the Z-machine. It \n\
- should be at least 1024 but seldom needs much more.\n");
- return;
- }
- if (strcmp(command,"MAX_PROP_TABLE_SIZE")==0)
- { printf(
-" MAX_PROP_TABLE_SIZE is the number of bytes allocated to hold the \n\
- properties table.\n");
- return;
- }
- if (strcmp(command,"MAX_ABBREVS")==0)
- { printf(
-" MAX_ABBREVS is the maximum number of declared abbreviations. It is not \n\
- allowed to exceed 64.\n");
- return;
- }
- if (strcmp(command,"MAX_ARRAYS")==0)
- { printf(
-" MAX_ARRAYS is the maximum number of declared arrays.\n");
- return;
- }
- if (strcmp(command,"MAX_EXPRESSION_NODES")==0)
- { printf(
-" MAX_EXPRESSION_NODES is the maximum number of nodes in the expression \n\
- evaluator's storage for parse trees. In effect, it measures how \n\
- complicated algebraic expressions are allowed to be. Increasing it by \n\
- one costs about 80 bytes.\n");
- return;
- }
- if (strcmp(command,"MAX_VERBS")==0)
- { printf(
-" MAX_VERBS is the maximum number of verbs (such as \"take\") which can be \n\
- defined, each with its own grammar. To increase it by one costs about\n\
- 128 bytes. A full game will contain at least 100.\n");
- return;
- }
- if (strcmp(command,"MAX_VERBSPACE")==0)
- { printf(
-" MAX_VERBSPACE is the size of workspace used to store verb words, so may\n\
- need increasing in games with many synonyms: unlikely to exceed 4K.\n");
- return;
- }
- if (strcmp(command,"MAX_LABELS")==0)
- { printf(
-" MAX_LABELS is the maximum number of label points in any one routine.\n\
- (If the -k debugging information switch is set, MAX_LABELS is raised to\n\
- a minimum level of 2000, as about twice the normal number of label points\n\
- are needed to generate tables of how source code corresponds to positions\n\
- in compiled code.)");
- return;
- }
- if (strcmp(command,"MAX_LINESPACE")==0)
- { printf(
-" MAX_LINESPACE is the size of workspace used to store grammar lines, so \n\
- may need increasing in games with complex or extensive grammars.\n");
- return;
- }
- if (strcmp(command,"MAX_STATIC_STRINGS")==0)
- {
- printf(
-" MAX_STATIC_STRINGS is the size in bytes of a buffer to hold compiled\n\
- strings before they're written into longer-term storage. 2000 bytes is \n\
- plenty, allowing string constants of up to about 3000 characters long.\n\
- Inform automatically ensures that this is at least twice the size of\n\
- MAX_QTEXT_SIZE, to be on the safe side.");
- return;
- }
- if (strcmp(command,"MAX_ZCODE_SIZE")==0)
- {
- printf(
-" MAX_ZCODE_SIZE is the size in bytes of a buffer to hold compiled \n\
- code for a single routine. (It applies to both Z-code and Glulx, \n\
- despite the name.) As a guide, the longest library routine is \n\
- about 6500 bytes long in Z-code; about twice that in Glulx.");
- return;
- }
- if (strcmp(command,"MAX_LINK_DATA_SIZE")==0)
- {
- printf(
-" MAX_LINK_DATA_SIZE is the size in bytes of a buffer to hold module \n\
- link data before it's written into longer-term storage. 2000 bytes \n\
- is plenty.");
- return;
- }
- if (strcmp(command,"MAX_LOW_STRINGS")==0)
- { printf(
-" MAX_LOW_STRINGS is the size in bytes of a buffer to hold all the \n\
- compiled \"low strings\" which are to be written above the synonyms table \n\
- in the Z-machine. 1024 is plenty.\n");
- return;
- }
- if (strcmp(command,"MAX_TRANSCRIPT_SIZE")==0)
- { printf(
-" MAX_TRANSCRIPT_SIZE is only allocated for the abbreviations optimisation \n\
- switch, and has the size in bytes of a buffer to hold the entire text of\n\
- the game being compiled: it has to be enormous, say 100000 to 200000.\n");
- return;
- }
- if (strcmp(command,"MAX_CLASSES")==0)
- { printf(
-" MAX_CLASSES maximum number of object classes which can be defined. This\n\
- is cheap to increase.\n");
- return;
- }
- if (strcmp(command,"MAX_INCLUSION_DEPTH")==0)
- { printf(
-" MAX_INCLUSION_DEPTH is the number of nested includes permitted.\n");
- return;
- }
- if (strcmp(command,"MAX_SOURCE_FILES")==0)
- { printf(
-" MAX_SOURCE_FILES is the number of source files that can be read in the \n\
- compilation.\n");
- return;
- }
- if (strcmp(command,"MAX_INDIV_PROP_TABLE_SIZE")==0)
- { printf(
-" MAX_INDIV_PROP_TABLE_SIZE is the number of bytes allocated to hold the \n\
- table of ..variable values.\n");
- return;
- }
- if (strcmp(command,"INDIV_PROP_START")==0)
- { printf(
-" Properties 1 to INDIV_PROP_START-1 are common properties; individual\n\
- properties are numbered INDIV_PROP_START and up.\n");
- return;
- }
- if (strcmp(command,"MAX_OBJ_PROP_COUNT")==0)
- { printf(
-" MAX_OBJ_PROP_COUNT is the maximum number of properties a single object \n\
- can have. (Glulx only)\n");
- return;
- }
- if (strcmp(command,"MAX_OBJ_PROP_TABLE_SIZE")==0)
- { printf(
-" MAX_OBJ_PROP_TABLE_SIZE is the number of words allocated to hold a \n\
- single object's properties. (Glulx only)\n");
- return;
- }
- if (strcmp(command,"MAX_LOCAL_VARIABLES")==0)
- { printf(
-" MAX_LOCAL_VARIABLES is the number of local variables (including \n\
- arguments) allowed in a procedure. (Glulx only)\n");
- return;
- }
- if (strcmp(command,"MAX_GLOBAL_VARIABLES")==0)
- { printf(
-" MAX_GLOBAL_VARIABLES is the number of global variables allowed in the \n\
- program. (Glulx only)\n");
- return;
- }
- if (strcmp(command,"MAX_NUM_STATIC_STRINGS")==0)
- {
- printf(
-" MAX_NUM_STATIC_STRINGS is the maximum number of compiled strings \n\
- allowed in the program. (Glulx only)\n");
- return;
- }
- if (strcmp(command,"MAX_UNICODE_CHARS")==0)
- {
- printf(
-" MAX_UNICODE_CHARS is the maximum number of different Unicode characters \n\
- (beyond the Latin-1 range, $00..$FF) which the game text can use. \n\
- (Glulx only)\n");
- return;
- }
- if (strcmp(command,"ALLOC_CHUNK_SIZE")==0)
- {
- printf(
-" ALLOC_CHUNK_SIZE is a base unit of Inform's internal memory allocation \n\
- for various structures.\n");
- return;
- }
- if (strcmp(command,"MAX_STACK_SIZE")==0)
- {
- printf(
-" MAX_STACK_SIZE is the maximum size (in bytes) of the interpreter stack \n\
- during gameplay. (Glulx only)\n");
- return;
- }
- if (strcmp(command,"MEMORY_MAP_EXTENSION")==0)
- {
- printf(
-" MEMORY_MAP_EXTENSION is the number of bytes (all zeroes) to map into \n\
- memory after the game file. (Glulx only)\n");
- return;
- }
- if (strcmp(command,"WARN_UNUSED_ROUTINES")==0)
- {
- printf(
-" WARN_UNUSED_ROUTINES, if set to 2, will display a warning for each \n\
- routine in the game file which is never called. (This includes \n\
- routines called only from uncalled routines, etc.) If set to 1, will warn \n\
- only about functions in game code, not in the system library.\n");
- return;
- }
- if (strcmp(command,"OMIT_UNUSED_ROUTINES")==0)
- {
- printf(
-" OMIT_UNUSED_ROUTINES, if set to 1, will avoid compiling unused routines \n\
- into the game file.\n");
- return;
- }
- if (strcmp(command,"SERIAL")==0)
- {
- printf(
-" SERIAL, if set, will be used as the six digit serial number written into \n\
- the header of the output file.\n");
- return;
- }
-
- printf("No such memory setting as \"%s\"\n",command);
-
- return;
-}
-
-/* Parse a decimal number as an int32. Return true if a valid number
- was found; otherwise print a warning and return false.
-
- Anything over nine digits is considered an overflow; we report a
- warning but return +/- 999999999 (and true). This is not entirely
- clever about leading zeroes ("0000000001" is treated as an
- overflow) but this is better than trying to detect genuine
- overflows in a long.
-
- (Some Glulx settings might conceivably want to go up to $7FFFFFFF,
- which is a ten-digit number, but we're not going to allow that
- today.)
-
- This used to rely on atoi(), and we retain the atoi() behavior of
- ignoring garbage characters after a valid decimal number.
- */
-static int parse_memory_setting(char *str, char *label, int32 *result)
-{
- char *cx = str;
- char *ex;
- long val;
-
- *result = 0;
-
- while (*cx == ' ') cx++;
-
- val = strtol(cx, &ex, 10);
-
- if (ex == cx) {
- printf("Bad numerical setting in $ command \"%s=%s\"\n",
- label, str);
- return 0;
- }
-
- if (*cx == '-') {
- if (ex > cx+10) {
- val = -999999999;
- printf("Numerical setting underflowed in $ command \"%s=%s\" (limiting to %ld)\n",
- label, str, val);
- }
- }
- else {
- if (ex > cx+9) {
- val = 999999999;
- printf("Numerical setting overflowed in $ command \"%s=%s\" (limiting to %ld)\n",
- label, str, val);
- }
- }
-
- *result = (int32)val;
- return 1;
-}
-
-extern void memory_command(char *command)
-{ int i, k, flag=0; int32 j;
-
- for (k=0; command[k]!=0; k++)
- if (islower(command[k])) command[k]=toupper(command[k]);
-
- if (command[0]=='?') { explain_parameter(command+1); return; }
-
- if (strcmp(command, "HUGE")==0) { set_memory_sizes(HUGE_SIZE); return; }
- if (strcmp(command, "LARGE")==0) { set_memory_sizes(LARGE_SIZE); return; }
- if (strcmp(command, "SMALL")==0) { set_memory_sizes(SMALL_SIZE); return; }
- if (strcmp(command, "LIST")==0) { list_memory_sizes(); return; }
- for (i=0; command[i]!=0; i++)
- { if (command[i]=='=')
- { command[i]=0;
- if (!parse_memory_setting(command+i+1, command, &j)) {
- return;
- }
- if (strcmp(command,"BUFFER_LENGTH")==0)
- flag=2;
- if (strcmp(command,"MAX_QTEXT_SIZE")==0)
- { MAX_QTEXT_SIZE=j, flag=1;
- if (2*MAX_QTEXT_SIZE > MAX_STATIC_STRINGS)
- MAX_STATIC_STRINGS = 2*MAX_QTEXT_SIZE;
- }
- if (strcmp(command,"MAX_SYMBOLS")==0)
- MAX_SYMBOLS=j, flag=1;
- if (strcmp(command,"MAX_BANK_SIZE")==0)
- flag=2;
- if (strcmp(command,"SYMBOLS_CHUNK_SIZE")==0)
- SYMBOLS_CHUNK_SIZE=j, flag=1;
- if (strcmp(command,"BANK_CHUNK_SIZE")==0)
- flag=2;
- if (strcmp(command,"HASH_TAB_SIZE")==0)
- HASH_TAB_SIZE=j, flag=1;
- if (strcmp(command,"MAX_OBJECTS")==0)
- MAX_OBJECTS=j, flag=1;
- if (strcmp(command,"MAX_ACTIONS")==0)
- MAX_ACTIONS=j, flag=1;
- if (strcmp(command,"MAX_ADJECTIVES")==0)
- MAX_ADJECTIVES=j, flag=1;
- if (strcmp(command,"MAX_DICT_ENTRIES")==0)
- MAX_DICT_ENTRIES=j, flag=1;
- if (strcmp(command,"DICT_WORD_SIZE")==0)
- { DICT_WORD_SIZE=j, flag=1;
- DICT_WORD_SIZE_g=DICT_WORD_SIZE_z=j;
- }
- if (strcmp(command,"DICT_CHAR_SIZE")==0)
- DICT_CHAR_SIZE=j, flag=1;
- if (strcmp(command,"NUM_ATTR_BYTES")==0)
- { NUM_ATTR_BYTES=j, flag=1;
- NUM_ATTR_BYTES_g=NUM_ATTR_BYTES_z=j;
- }
- if (strcmp(command,"ZCODE_HEADER_EXT_WORDS")==0)
- ZCODE_HEADER_EXT_WORDS=j, flag=1;
- if (strcmp(command,"ZCODE_HEADER_FLAGS_3")==0)
- ZCODE_HEADER_FLAGS_3=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)
- MAX_STATIC_DATA=j, flag=1;
- if (strcmp(command,"MAX_OLDEPTH")==0)
- flag=2;
- if (strcmp(command,"MAX_ROUTINES")==0)
- flag=2;
- if (strcmp(command,"MAX_GCONSTANTS")==0)
- flag=2;
- if (strcmp(command,"MAX_PROP_TABLE_SIZE")==0)
- { MAX_PROP_TABLE_SIZE=j, flag=1;
- MAX_PROP_TABLE_SIZE_g=MAX_PROP_TABLE_SIZE_z=j;
- }
- if (strcmp(command,"MAX_FORWARD_REFS")==0)
- flag=2;
- if (strcmp(command,"STACK_SIZE")==0)
- flag=2;
- if (strcmp(command,"STACK_LONG_SLOTS")==0)
- flag=2;
- if (strcmp(command,"STACK_SHORT_LENGTH")==0)
- flag=2;
- if (strcmp(command,"MAX_ABBREVS")==0)
- MAX_ABBREVS=j, flag=1;
- if (strcmp(command,"MAX_ARRAYS")==0)
- MAX_ARRAYS=j, flag=1;
- if (strcmp(command,"MAX_EXPRESSION_NODES")==0)
- MAX_EXPRESSION_NODES=j, flag=1;
- if (strcmp(command,"MAX_VERBS")==0)
- MAX_VERBS=j, flag=1;
- if (strcmp(command,"MAX_VERBSPACE")==0)
- MAX_VERBSPACE=j, flag=1;
- if (strcmp(command,"MAX_LABELS")==0)
- MAX_LABELS=j, flag=1;
- if (strcmp(command,"MAX_LINESPACE")==0)
- MAX_LINESPACE=j, flag=1;
- if (strcmp(command,"MAX_NUM_STATIC_STRINGS")==0)
- MAX_NUM_STATIC_STRINGS=j, flag=1;
- if (strcmp(command,"MAX_STATIC_STRINGS")==0)
- { MAX_STATIC_STRINGS=j, flag=1;
- if (2*MAX_QTEXT_SIZE > MAX_STATIC_STRINGS)
- MAX_STATIC_STRINGS = 2*MAX_QTEXT_SIZE;
- }
- if (strcmp(command,"MAX_ZCODE_SIZE")==0)
- { MAX_ZCODE_SIZE=j, flag=1;
- MAX_ZCODE_SIZE_g=MAX_ZCODE_SIZE_z=j;
- }
- if (strcmp(command,"MAX_LINK_DATA_SIZE")==0)
- MAX_LINK_DATA_SIZE=j, flag=1;
- if (strcmp(command,"MAX_LOW_STRINGS")==0)
- MAX_LOW_STRINGS=j, flag=1;
- if (strcmp(command,"MAX_TRANSCRIPT_SIZE")==0)
- MAX_TRANSCRIPT_SIZE=j, flag=1;
- if (strcmp(command,"MAX_CLASSES")==0)
- MAX_CLASSES=j, flag=1;
- if (strcmp(command,"MAX_INCLUSION_DEPTH")==0)
- MAX_INCLUSION_DEPTH=j, flag=1;
- if (strcmp(command,"MAX_SOURCE_FILES")==0)
- MAX_SOURCE_FILES=j, flag=1;
- if (strcmp(command,"MAX_INDIV_PROP_TABLE_SIZE")==0)
- MAX_INDIV_PROP_TABLE_SIZE=j, flag=1;
- if (strcmp(command,"INDIV_PROP_START")==0)
- INDIV_PROP_START=j, flag=1;
- if (strcmp(command,"MAX_OBJ_PROP_TABLE_SIZE")==0)
- MAX_OBJ_PROP_TABLE_SIZE=j, flag=1;
- if (strcmp(command,"MAX_OBJ_PROP_COUNT")==0)
- MAX_OBJ_PROP_COUNT=j, flag=1;
- if (strcmp(command,"MAX_LOCAL_VARIABLES")==0)
- { MAX_LOCAL_VARIABLES=j, flag=1;
- MAX_LOCAL_VARIABLES_g=MAX_LOCAL_VARIABLES_z=j;
- }
- if (strcmp(command,"MAX_GLOBAL_VARIABLES")==0)
- { MAX_GLOBAL_VARIABLES=j, flag=1;
- MAX_GLOBAL_VARIABLES_g=MAX_GLOBAL_VARIABLES_z=j;
- }
- if (strcmp(command,"ALLOC_CHUNK_SIZE")==0)
- { ALLOC_CHUNK_SIZE=j, flag=1;
- ALLOC_CHUNK_SIZE_g=ALLOC_CHUNK_SIZE_z=j;
- }
- if (strcmp(command,"MAX_UNICODE_CHARS")==0)
- MAX_UNICODE_CHARS=j, flag=1;
- if (strcmp(command,"MAX_STACK_SIZE")==0)
- {
- MAX_STACK_SIZE=j, flag=1;
- /* Adjust up to a 256-byte boundary. */
- MAX_STACK_SIZE = (MAX_STACK_SIZE + 0xFF) & (~0xFF);
- }
- if (strcmp(command,"MEMORY_MAP_EXTENSION")==0)
- {
- MEMORY_MAP_EXTENSION=j, flag=1;
- /* Adjust up to a 256-byte boundary. */
- MEMORY_MAP_EXTENSION = (MEMORY_MAP_EXTENSION + 0xFF) & (~0xFF);
- }
- if (strcmp(command,"WARN_UNUSED_ROUTINES")==0)
- {
- WARN_UNUSED_ROUTINES=j, flag=1;
- if (WARN_UNUSED_ROUTINES > 2 || WARN_UNUSED_ROUTINES < 0)
- WARN_UNUSED_ROUTINES = 2;
- }
- if (strcmp(command,"OMIT_UNUSED_ROUTINES")==0)
- {
- OMIT_UNUSED_ROUTINES=j, flag=1;
- if (OMIT_UNUSED_ROUTINES > 1 || OMIT_UNUSED_ROUTINES < 0)
- OMIT_UNUSED_ROUTINES = 1;
- }
- if (strcmp(command,"SERIAL")==0)
- {
- if (j >= 0 && j <= 999999)
- {
- sprintf(serial_code_buffer,"%06d",j);
- serial_code_given_in_program = TRUE;
- flag=1;
- }
- }
-
- if (flag==0)
- printf("No such memory setting as \"%s\"\n", command);
- if (flag==2)
- printf("The Inform 5 memory setting \"%s\" has been withdrawn.\n\
-It should be safe to omit it (putting nothing in its place).\n", command);
- return;
- }
- }
- printf("No such memory $ command as \"%s\"\n",command);
-}
-
-extern void print_memory_usage(void)
-{
- printf("Properties table used %d\n",
- properties_table_size);
- printf("Allocated a total of %ld bytes of memory\n",
- (long int) malloced_bytes);
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_memory_vars(void)
-{ malloced_bytes = 0;
-}
-
-extern void memory_begin_pass(void) { }
-
-extern void memory_allocate_arrays(void) { }
-
-extern void memory_free_arrays(void) { }
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "objects" : [1] the object-maker, which constructs objects and enters */
-/* them into the tree, given a low-level specification; */
-/* */
-/* [2] the parser of Object/Nearby/Class directives, which */
-/* checks syntax and translates such directives into */
-/* specifications for the object-maker. */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-/* ------------------------------------------------------------------------- */
-/* Objects. */
-/* ------------------------------------------------------------------------- */
-
-int no_objects; /* Number of objects made so far */
-
-static int no_embedded_routines; /* Used for naming routines which
- are given as property values: these
- are called EmbeddedRoutine__1, ... */
-
-static fpropt full_object; /* "fpropt" is a typedef for a struct
- containing an array to hold the
- attribute and property values of
- a single object. We only keep one
- of these, for the current object
- being made, and compile it into
- Z-machine tables when each object
- definition is complete, since
- sizeof(fpropt) is about 6200 bytes */
-static fproptg full_object_g; /* Equivalent for Glulx. This object
- is very small, since the large arrays
- are allocated dynamically by the
- Glulx compiler */
-static char shortname_buffer[766]; /* Text buffer to hold the short name
- (which is read in first, but
- written almost last) */
-static int parent_of_this_obj;
-
-static char *classname_text, *objectname_text;
- /* For printing names of embedded
- routines only */
-
-/* ------------------------------------------------------------------------- */
-/* Classes. */
-/* ------------------------------------------------------------------------- */
-/* Arrays defined below: */
-/* */
-/* int32 class_begins_at[n] offset of properties block for */
-/* nth class (always an offset */
-/* inside the properties_table) */
-/* int classes_to_inherit_from[] The list of classes to inherit */
-/* from as taken from the current */
-/* Nearby/Object/Class definition */
-/* int class_object_numbers[n] The number of the prototype-object */
-/* for the nth class */
-/* ------------------------------------------------------------------------- */
-
-int no_classes; /* Number of class defns made so far */
-
-static int current_defn_is_class, /* TRUE if current Nearby/Object/Class
- defn is in fact a Class definition */
- no_classes_to_inherit_from; /* Number of classes in the list
- of classes to inherit in the
- current Nearby/Object/Class defn */
-
-/* ------------------------------------------------------------------------- */
-/* Making attributes and properties. */
-/* ------------------------------------------------------------------------- */
-
-int no_attributes, /* Number of attributes defined so far */
- no_properties; /* Number of properties defined so far,
- plus 1 (properties are numbered from
- 1 and Inform creates "name" and two
- others itself, so the variable begins
- the compilation pass set to 4) */
-
-static void trace_s(char *name, int32 number, int f)
-{ if (!printprops_switch) return;
- printf("%s %02ld ",(f==0)?"Attr":"Prop",(long int) number);
- if (f==0) printf(" ");
- else printf("%s%s",(prop_is_long[number])?"L":" ",
- (prop_is_additive[number])?"A":" ");
- printf(" %s\n",name);
-}
-
-extern void make_attribute(void)
-{ int i; char *name;
- debug_location_beginning beginning_debug_location =
- get_token_location_beginning();
-
- if (!glulx_mode) {
- if (no_attributes==((version_number==3)?32:48))
- { discard_token_location(beginning_debug_location);
- if (version_number==3)
- error("All 32 attributes already declared (compile as Advanced \
-game to get an extra 16)");
- else
- error("All 48 attributes already declared");
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
- }
- 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",
- NUM_ATTR_BYTES*8);
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
- }
-
- get_next_token();
- i = token_value; name = token_text;
- if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
- { discard_token_location(beginning_debug_location);
- ebf_error("new attribute name", token_text);
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
-
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
-
- if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
- { get_next_token();
- if (!((token_type == SYMBOL_TT)
- && (stypes[token_value] == ATTRIBUTE_T)))
- { discard_token_location(beginning_debug_location);
- ebf_error("an existing attribute name after 'alias'",
- token_text);
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
- assign_symbol(i, svals[token_value], ATTRIBUTE_T);
- sflags[token_value] |= ALIASED_SFLAG;
- sflags[i] |= ALIASED_SFLAG;
- }
- else
- { assign_symbol(i, no_attributes++, ATTRIBUTE_T);
- put_token_back();
- }
-
- if (debugfile_switch)
- { debug_file_printf("<attribute>");
- debug_file_printf("<identifier>%s</identifier>", name);
- debug_file_printf("<value>%d</value>", svals[i]);
- write_debug_locations(get_token_location_end(beginning_debug_location));
- debug_file_printf("</attribute>");
- }
-
- trace_s(name, svals[i], 0);
- return;
-}
-
-extern void make_property(void)
-{ int32 default_value, i;
- int additive_flag=FALSE; char *name;
- assembly_operand AO;
- debug_location_beginning beginning_debug_location =
- get_token_location_beginning();
-
- if (!glulx_mode) {
- if (no_properties==((version_number==3)?32:64))
- { discard_token_location(beginning_debug_location);
- if (version_number==3)
- error("All 30 properties already declared (compile as \
-Advanced game to get an extra 62)");
- else
- error("All 62 properties already declared");
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
- }
- else {
- if (no_properties==INDIV_PROP_START) {
- discard_token_location(beginning_debug_location);
- error_numbered("All properties already declared -- max is",
- INDIV_PROP_START);
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
- }
-
- do
- { directive_keywords.enabled = TRUE;
- get_next_token();
- if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK))
- obsolete_warning("all properties are now automatically 'long'");
- else
- if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK))
- additive_flag = TRUE;
- else break;
- } while (TRUE);
-
- put_token_back();
- directive_keywords.enabled = FALSE;
- get_next_token();
-
- i = token_value; name = token_text;
- if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
- { discard_token_location(beginning_debug_location);
- ebf_error("new property name", token_text);
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
-
- directive_keywords.enabled = TRUE;
- get_next_token();
- directive_keywords.enabled = FALSE;
-
- if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG;
-
- if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
- { discard_token_location(beginning_debug_location);
- if (additive_flag)
- { error("'alias' incompatible with 'additive'");
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
- get_next_token();
- if (!((token_type == SYMBOL_TT)
- && (stypes[token_value] == PROPERTY_T)))
- { ebf_error("an existing property name after 'alias'",
- token_text);
- panic_mode_error_recovery();
- put_token_back();
- return;
- }
-
- assign_symbol(i, svals[token_value], PROPERTY_T);
- trace_s(name, svals[i], 1);
- sflags[token_value] |= ALIASED_SFLAG;
- sflags[i] |= ALIASED_SFLAG;
- return;
- }
-
- default_value = 0;
- put_token_back();
-
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { AO = parse_expression(CONSTANT_CONTEXT);
- default_value = AO.value;
- if (AO.marker != 0)
- backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
- (no_properties-1) * WORDSIZE);
- }
-
- prop_default_value[no_properties] = default_value;
- prop_is_long[no_properties] = TRUE;
- prop_is_additive[no_properties] = additive_flag;
-
- assign_symbol(i, no_properties++, PROPERTY_T);
-
- if (debugfile_switch)
- { debug_file_printf("<property>");
- debug_file_printf("<identifier>%s</identifier>", name);
- debug_file_printf("<value>%d</value>", svals[i]);
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</property>");
- }
-
- trace_s(name, svals[i], 1);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Properties. */
-/* ------------------------------------------------------------------------- */
-
-int32 *prop_default_value; /* Default values for properties */
-int *prop_is_long, /* Property modifiers, TRUE or FALSE:
- "long" means "never write a 1-byte
- value to this property", and is an
- obsolete feature: since Inform 5
- all properties have been "long" */
- *prop_is_additive; /* "additive" means that values
- accumulate rather than erase each
- other during class inheritance */
-char *properties_table; /* Holds the table of property values
- (holding one block for each object
- and coming immediately after the
- object tree in Z-memory) */
-int properties_table_size; /* Number of bytes in this table */
-
-/* ------------------------------------------------------------------------- */
-/* Individual properties */
-/* */
-/* Each new i.p. name is given a unique number. These numbers start from */
-/* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */
-/* and 64 to 71 are kept for methods of the metaclass Class (for example, */
-/* 64 is "create"). */
-/* */
-/* An object provides individual properties by having property 3 set to a */
-/* non-zero value, which must be a byte address of a table in the form: */
-/* */
-/* <record-1> ... <record-n> 00 00 */
-/* */
-/* where a <record> looks like */
-/* */
-/* <identifier> <size> <up to 255 bytes of data> */
-/* or <identifier + 0x8000> */
-/* ----- 2 bytes ---------- 1 byte <size> number of bytes */
-/* */
-/* The <identifier> part is the number allocated to the name of what is */
-/* being provided. The top bit of this word is set to indicate that */
-/* although the individual property is being provided, it is provided */
-/* only privately (so that it is inaccessible except to the object's own */
-/* embedded routines). */
-/* */
-/* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */
-/* properties, common and individual, are stored in the same table. */
-/* ------------------------------------------------------------------------- */
-
- int no_individual_properties; /* Actually equal to the next
- identifier number to be allocated,
- so this is initially 72 even though
- none have been made yet. */
-static int individual_prop_table_size; /* Size of the table of individual
- properties so far for current obj */
- uchar *individuals_table; /* Table of records, each being the
- i.p. table for an object */
- int i_m; /* Write mark position in the above */
- int individuals_length; /* Extent of individuals_table */
-
-/* ------------------------------------------------------------------------- */
-/* Arrays used by this file */
-/* ------------------------------------------------------------------------- */
-
-objecttz *objectsz; /* Z-code only */
-objecttg *objectsg; /* Glulx only */
-uchar *objectatts; /* Glulx only */
-static int *classes_to_inherit_from;
-int *class_object_numbers;
-int32 *class_begins_at;
-
-
-/* ------------------------------------------------------------------------- */
-/* Tracing for compiler maintenance */
-/* ------------------------------------------------------------------------- */
-
-extern void list_object_tree(void)
-{ int i;
- printf("obj par nxt chl Object tree:\n");
- for (i=0; i<no_objects; i++)
- printf("%3d %3d %3d %3d\n",
- i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Object and class manufacture begins here. */
-/* */
-/* These definitions have headers (parsed far, far below) and a series */
-/* of segments, introduced by keywords and optionally separated by commas. */
-/* Each segment has its own parsing routine. Note that when errors are */
-/* detected, parsing continues rather than being abandoned, which assists */
-/* a little in "error recovery" (i.e. in stopping lots more errors being */
-/* produced for essentially the same mistake). */
-/* ------------------------------------------------------------------------- */
-
-/* ========================================================================= */
-/* [1] The object-maker: builds an object from a specification, viz.: */
-/* */
-/* full_object, */
-/* shortname_buffer, */
-/* parent_of_this_obj, */
-/* current_defn_is_class (flag) */
-/* classes_to_inherit_from[], no_classes_to_inherit_from, */
-/* individual_prop_table_size (to date ) */
-/* */
-/* For efficiency's sake, the individual properties table has already been */
-/* created (as far as possible, i.e., all except for inherited individual */
-/* properties); unless the flag is clear, in which case the actual */
-/* definition did not specify any individual properties. */
-/* ========================================================================= */
-/* Property inheritance from classes. */
-/* ------------------------------------------------------------------------- */
-
-static void property_inheritance_z(void)
-{
- /* Apply the property inheritance rules to full_object, which should
- initially be complete (i.e., this routine takes place after the whole
- Nearby/Object/Class definition has been parsed through).
-
- On exit, full_object contains the final state of the properties to
- be written. */
-
- int i, j, k, kmax, class, mark,
- prop_number, prop_length, prop_in_current_defn;
- uchar *class_prop_block;
-
- ASSERT_ZCODE();
-
- for (class=0; class<no_classes_to_inherit_from; class++)
- {
- j=0;
- mark = class_begins_at[classes_to_inherit_from[class]-1];
- class_prop_block = (uchar *) (properties_table + mark);
-
- while (class_prop_block[j]!=0)
- { if (version_number == 3)
- { prop_number = class_prop_block[j]%32;
- prop_length = 1 + class_prop_block[j++]/32;
- }
- else
- { prop_number = class_prop_block[j]%64;
- prop_length = 1 + class_prop_block[j++]/64;
- if (prop_length > 2)
- prop_length = class_prop_block[j++]%64;
- }
-
- /* So we now have property number prop_number present in the
- property block for the class being read: its bytes are
-
- class_prop_block[j, ..., j + prop_length - 1]
-
- Question now is: is there already a value given in the
- current definition under this property name? */
-
- prop_in_current_defn = FALSE;
-
- kmax = full_object.l;
-
- for (k=0; k<kmax; k++)
- if (full_object.pp[k].num == prop_number)
- { prop_in_current_defn = TRUE;
-
- /* (Note that the built-in "name" property is additive) */
-
- if ((prop_number==1) || (prop_is_additive[prop_number]))
- {
- /* The additive case: we accumulate the class
- property values onto the end of the full_object
- property */
-
- for (i=full_object.pp[k].l;
- i<full_object.pp[k].l+prop_length/2; i++)
- { if (i >= 32)
- { error("An additive property has inherited \
-so many values that the list has overflowed the maximum 32 entries");
- break;
- }
- full_object.pp[k].ao[i].value = mark + j;
- j += 2;
- full_object.pp[k].ao[i].marker = INHERIT_MV;
- full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
- }
- full_object.pp[k].l += prop_length/2;
- }
- else
- /* The ordinary case: the full_object property
- values simply overrides the class definition,
- so we skip over the values in the class table */
-
- j+=prop_length;
-
- if (prop_number==3)
- { int y, z, class_block_offset;
- uchar *p;
-
- /* Property 3 holds the address of the table of
- instance variables, so this is the case where
- the object already has instance variables in its
- own table but must inherit some more from the
- class */
-
- class_block_offset = class_prop_block[j-2]*256
- + class_prop_block[j-1];
-
- p = individuals_table + class_block_offset;
- z = class_block_offset;
- while ((p[0]!=0)||(p[1]!=0))
- { int already_present = FALSE, l;
- for (l = full_object.pp[k].ao[0].value; l < i_m;
- l = l + 3 + individuals_table[l + 2])
- if (individuals_table[l] == p[0]
- && individuals_table[l + 1] == p[1])
- { already_present = TRUE; break;
- }
- if (already_present == FALSE)
- { if (module_switch)
- backpatch_zmachine(IDENT_MV,
- INDIVIDUAL_PROP_ZA, i_m);
- if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
- memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
- MAX_INDIV_PROP_TABLE_SIZE);
- individuals_table[i_m++] = p[0];
- individuals_table[i_m++] = p[1];
- individuals_table[i_m++] = p[2];
- for (y=0;y < p[2]/2;y++)
- { individuals_table[i_m++] = (z+3+y*2)/256;
- individuals_table[i_m++] = (z+3+y*2)%256;
- backpatch_zmachine(INHERIT_INDIV_MV,
- INDIVIDUAL_PROP_ZA, i_m-2);
- }
- }
- z += p[2] + 3;
- p += p[2] + 3;
- }
- individuals_length = i_m;
- }
-
- /* For efficiency we exit the loop now (this property
- number has been dealt with) */
-
- break;
- }
-
- if (!prop_in_current_defn)
- {
- /* The case where the class defined a property which wasn't
- defined at all in full_object: we copy out the data into
- a new property added to full_object */
-
- k=full_object.l++;
- full_object.pp[k].num = prop_number;
- full_object.pp[k].l = prop_length/2;
- for (i=0; i<prop_length/2; i++)
- { full_object.pp[k].ao[i].value = mark + j;
- j+=2;
- full_object.pp[k].ao[i].marker = INHERIT_MV;
- full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
- }
-
- if (prop_number==3)
- { int y, z, class_block_offset;
- uchar *p;
-
- /* Property 3 holds the address of the table of
- instance variables, so this is the case where
- the object had no instance variables of its own
- but must inherit some more from the class */
-
- if (individual_prop_table_size++ == 0)
- { full_object.pp[k].num = 3;
- full_object.pp[k].l = 1;
- full_object.pp[k].ao[0].value
- = individuals_length;
- full_object.pp[k].ao[0].marker = INDIVPT_MV;
- full_object.pp[k].ao[0].type = LONG_CONSTANT_OT;
- i_m = individuals_length;
- }
- class_block_offset = class_prop_block[j-2]*256
- + class_prop_block[j-1];
-
- p = individuals_table + class_block_offset;
- z = class_block_offset;
- while ((p[0]!=0)||(p[1]!=0))
- { if (module_switch)
- backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
- if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
- memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
- MAX_INDIV_PROP_TABLE_SIZE);
- individuals_table[i_m++] = p[0];
- individuals_table[i_m++] = p[1];
- individuals_table[i_m++] = p[2];
- for (y=0;y < p[2]/2;y++)
- { individuals_table[i_m++] = (z+3+y*2)/256;
- individuals_table[i_m++] = (z+3+y*2)%256;
- backpatch_zmachine(INHERIT_INDIV_MV,
- INDIVIDUAL_PROP_ZA, i_m-2);
- }
- z += p[2] + 3;
- p += p[2] + 3;
- }
- individuals_length = i_m;
- }
- }
- }
- }
-
- if (individual_prop_table_size > 0)
- {
- if (i_m+2 > MAX_INDIV_PROP_TABLE_SIZE)
- memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
- MAX_INDIV_PROP_TABLE_SIZE);
-
- individuals_table[i_m++] = 0;
- individuals_table[i_m++] = 0;
- individuals_length += 2;
- }
-}
-
-static void property_inheritance_g(void)
-{
- /* Apply the property inheritance rules to full_object, which should
- initially be complete (i.e., this routine takes place after the whole
- Nearby/Object/Class definition has been parsed through).
-
- On exit, full_object contains the final state of the properties to
- be written. */
-
- int i, j, k, class, num_props,
- prop_number, prop_length, prop_flags, prop_in_current_defn;
- int32 mark, prop_addr;
- uchar *cpb, *pe;
-
- ASSERT_GLULX();
-
- for (class=0; class<no_classes_to_inherit_from; class++) {
- mark = class_begins_at[classes_to_inherit_from[class]-1];
- cpb = (uchar *) (properties_table + mark);
- /* This now points to the compiled property-table for the class.
- We'll have to go through and decompile it. (For our sins.) */
- num_props = ReadInt32(cpb);
- for (j=0; j<num_props; j++) {
- pe = cpb + 4 + j*10;
- prop_number = ReadInt16(pe);
- pe += 2;
- prop_length = ReadInt16(pe);
- pe += 2;
- prop_addr = ReadInt32(pe);
- pe += 4;
- prop_flags = ReadInt16(pe);
- pe += 2;
-
- /* So we now have property number prop_number present in the
- property block for the class being read. Its bytes are
- cpb[prop_addr ... prop_addr + prop_length - 1]
- Question now is: is there already a value given in the
- current definition under this property name? */
-
- prop_in_current_defn = FALSE;
-
- for (k=0; k<full_object_g.numprops; k++) {
- if (full_object_g.props[k].num == prop_number) {
- prop_in_current_defn = TRUE;
- break;
- }
- }
-
- if (prop_in_current_defn) {
- if ((prop_number==1)
- || (prop_number < INDIV_PROP_START
- && prop_is_additive[prop_number])) {
- /* The additive case: we accumulate the class
- property values onto the end of the full_object
- properties. Remember that k is still the index number
- of the first prop-block matching our property number. */
- int prevcont;
- if (full_object_g.props[k].continuation == 0) {
- full_object_g.props[k].continuation = 1;
- prevcont = 1;
- }
- else {
- prevcont = full_object_g.props[k].continuation;
- for (k++; k<full_object_g.numprops; k++) {
- if (full_object_g.props[k].num == prop_number) {
- prevcont = full_object_g.props[k].continuation;
- }
- }
- }
- k = full_object_g.numprops++;
- full_object_g.props[k].num = prop_number;
- full_object_g.props[k].flags = 0;
- full_object_g.props[k].datastart = full_object_g.propdatasize;
- full_object_g.props[k].continuation = prevcont+1;
- full_object_g.props[k].datalen = prop_length;
- if (full_object_g.propdatasize + prop_length
- > MAX_OBJ_PROP_TABLE_SIZE) {
- memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
- }
-
- for (i=0; i<prop_length; i++) {
- int ppos = full_object_g.propdatasize++;
- full_object_g.propdata[ppos].value = prop_addr + 4*i;
- full_object_g.propdata[ppos].marker = INHERIT_MV;
- full_object_g.propdata[ppos].type = CONSTANT_OT;
- }
- }
- else {
- /* The ordinary case: the full_object_g property
- values simply overrides the class definition,
- so we skip over the values in the class table. */
- }
- }
- else {
- /* The case where the class defined a property which wasn't
- defined at all in full_object_g: we copy out the data into
- a new property added to full_object_g. */
- k = full_object_g.numprops++;
- full_object_g.props[k].num = prop_number;
- full_object_g.props[k].flags = prop_flags;
- full_object_g.props[k].datastart = full_object_g.propdatasize;
- full_object_g.props[k].continuation = 0;
- full_object_g.props[k].datalen = prop_length;
- if (full_object_g.propdatasize + prop_length
- > MAX_OBJ_PROP_TABLE_SIZE) {
- memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
- }
-
- for (i=0; i<prop_length; i++) {
- int ppos = full_object_g.propdatasize++;
- full_object_g.propdata[ppos].value = prop_addr + 4*i;
- full_object_g.propdata[ppos].marker = INHERIT_MV;
- full_object_g.propdata[ppos].type = CONSTANT_OT;
- }
- }
-
- if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
- memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
- }
- }
- }
-
-}
-
-/* ------------------------------------------------------------------------- */
-/* Construction of Z-machine-format property blocks. */
-/* ------------------------------------------------------------------------- */
-
-static int write_properties_between(uchar *p, int mark, int from, int to)
-{ int j, k, prop_number, prop_length;
- /* Note that p is properties_table. */
- for (prop_number=to; prop_number>=from; prop_number--)
- { for (j=0; j<full_object.l; j++)
- { if ((full_object.pp[j].num == prop_number)
- && (full_object.pp[j].l != 100))
- { prop_length = 2*full_object.pp[j].l;
- if (mark+2+prop_length >= MAX_PROP_TABLE_SIZE)
- memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
- if (version_number == 3)
- p[mark++] = prop_number + (prop_length - 1)*32;
- else
- { switch(prop_length)
- { case 1:
- p[mark++] = prop_number; break;
- case 2:
- p[mark++] = prop_number + 0x40; break;
- default:
- p[mark++] = prop_number + 0x80;
- p[mark++] = prop_length + 0x80; break;
- }
- }
-
- for (k=0; k<full_object.pp[j].l; k++)
- { if (full_object.pp[j].ao[k].marker != 0)
- backpatch_zmachine(full_object.pp[j].ao[k].marker,
- PROP_ZA, mark);
- p[mark++] = full_object.pp[j].ao[k].value/256;
- p[mark++] = full_object.pp[j].ao[k].value%256;
- }
- }
- }
- }
-
- p[mark++]=0;
- return(mark);
-}
-
-static int write_property_block_z(char *shortname)
-{
- /* Compile the (now complete) full_object properties into a
- property-table block at "p" in Inform's memory.
- "shortname" is the object's short name, if specified; otherwise
- NULL.
-
- Return the number of bytes written to the block. */
-
- int32 mark = properties_table_size, i;
- uchar *p = (uchar *) properties_table;
-
- /* printf("Object at %04x\n", mark); */
-
- if (shortname != NULL)
- { uchar *tmp;
- if (mark+1+510 >= MAX_PROP_TABLE_SIZE)
- memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
- tmp = translate_text(p+mark+1,p+mark+1+510,shortname);
- if (!tmp) error ("Short name of object exceeded 765 Z-characters");
- i = subtract_pointers(tmp,(p+mark+1));
- p[mark] = i/2;
- mark += i+1;
- }
- if (current_defn_is_class)
- { mark = write_properties_between(p,mark,3,3);
- for (i=0;i<6;i++)
- p[mark++] = full_object.atts[i];
- class_begins_at[no_classes++] = mark;
- }
-
- mark = write_properties_between(p, mark, 1, (version_number==3)?31:63);
-
- i = mark - properties_table_size;
- properties_table_size = mark;
-
- return(i);
-}
-
-static int gpropsort(void *ptr1, void *ptr2)
-{
- propg *prop1 = ptr1;
- propg *prop2 = ptr2;
-
- if (prop2->num == -1)
- return -1;
- if (prop1->num == -1)
- return 1;
- if (prop1->num < prop2->num)
- return -1;
- if (prop1->num > prop2->num)
- return 1;
-
- return (prop1->continuation - prop2->continuation);
-}
-
-static int32 write_property_block_g(void)
-{
- /* Compile the (now complete) full_object properties into a
- property-table block at "p" in Inform's memory.
- Return the number of bytes written to the block.
- In Glulx, the shortname property isn't used here; it's already
- been compiled into an ordinary string. */
-
- int32 i;
- int ix, jx, kx, totalprops;
- int32 mark = properties_table_size;
- int32 datamark;
- uchar *p = (uchar *) properties_table;
-
- if (current_defn_is_class) {
- for (i=0;i<NUM_ATTR_BYTES;i++)
- p[mark++] = full_object_g.atts[i];
- class_begins_at[no_classes++] = mark;
- }
-
- qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
- (int (*)(const void *, const void *))(&gpropsort));
-
- full_object_g.finalpropaddr = mark;
-
- totalprops = 0;
-
- for (ix=0; ix<full_object_g.numprops; ix=jx) {
- int propnum = full_object_g.props[ix].num;
- if (propnum == -1)
- break;
- for (jx=ix;
- jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
- jx++);
- totalprops++;
- }
-
- /* Write out the number of properties in this table. */
- if (mark+4 >= MAX_PROP_TABLE_SIZE)
- memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
- WriteInt32(p+mark, totalprops);
- mark += 4;
-
- datamark = mark + 10*totalprops;
-
- for (ix=0; ix<full_object_g.numprops; ix=jx) {
- int propnum = full_object_g.props[ix].num;
- int flags = full_object_g.props[ix].flags;
- int totallen = 0;
- int32 datamarkstart = datamark;
- if (propnum == -1)
- break;
- for (jx=ix;
- jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
- jx++) {
- int32 datastart = full_object_g.props[jx].datastart;
- if (datamark+4*full_object_g.props[jx].datalen >= MAX_PROP_TABLE_SIZE)
- memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
- for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
- int32 val = full_object_g.propdata[datastart+kx].value;
- WriteInt32(p+datamark, val);
- if (full_object_g.propdata[datastart+kx].marker != 0)
- backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
- PROP_ZA, datamark);
- totallen++;
- datamark += 4;
- }
- }
- if (mark+10 >= MAX_PROP_TABLE_SIZE)
- memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
- WriteInt16(p+mark, propnum);
- mark += 2;
- WriteInt16(p+mark, totallen);
- mark += 2;
- WriteInt32(p+mark, datamarkstart);
- mark += 4;
- WriteInt16(p+mark, flags);
- mark += 2;
- }
-
- mark = datamark;
-
- i = mark - properties_table_size;
- properties_table_size = mark;
- return i;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The final stage in Nearby/Object/Class definition processing. */
-/* ------------------------------------------------------------------------- */
-
-static void manufacture_object_z(void)
-{ int i, j;
-
- segment_markers.enabled = FALSE;
- directives.enabled = TRUE;
-
- property_inheritance_z();
-
- objectsz[no_objects].parent = parent_of_this_obj;
- objectsz[no_objects].next = 0;
- objectsz[no_objects].child = 0;
-
- if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
- { i = objectsz[parent_of_this_obj-1].child;
- if (i == 0)
- objectsz[parent_of_this_obj-1].child = no_objects + 1;
- else
- { while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
- objectsz[i-1].next = no_objects+1;
- }
- }
-
- /* The properties table consists simply of a sequence of property
- blocks, one for each object in order of definition, exactly as
- it will appear in the final Z-machine. */
-
- j = write_property_block_z(shortname_buffer);
-
- objectsz[no_objects].propsize = j;
- if (properties_table_size >= MAX_PROP_TABLE_SIZE)
- memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
-
- if (current_defn_is_class)
- for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
- else
- for (i=0;i<6;i++)
- objectsz[no_objects].atts[i] = full_object.atts[i];
-
- no_objects++;
-}
-
-static void manufacture_object_g(void)
-{ int32 i, j;
-
- segment_markers.enabled = FALSE;
- directives.enabled = TRUE;
-
- property_inheritance_g();
-
- objectsg[no_objects].parent = parent_of_this_obj;
- objectsg[no_objects].next = 0;
- objectsg[no_objects].child = 0;
-
- if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
- { i = objectsg[parent_of_this_obj-1].child;
- if (i == 0)
- objectsg[parent_of_this_obj-1].child = no_objects + 1;
- else
- { while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
- objectsg[i-1].next = no_objects+1;
- }
- }
-
- objectsg[no_objects].shortname = compile_string(shortname_buffer,
- FALSE, FALSE);
-
- /* The properties table consists simply of a sequence of property
- blocks, one for each object in order of definition, exactly as
- it will appear in the final machine image. */
-
- j = write_property_block_g();
-
- objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
-
- objectsg[no_objects].propsize = j;
- if (properties_table_size >= MAX_PROP_TABLE_SIZE)
- memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
-
- if (current_defn_is_class)
- for (i=0;i<NUM_ATTR_BYTES;i++)
- objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
- else
- for (i=0;i<NUM_ATTR_BYTES;i++)
- objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
-
- no_objects++;
-}
-
-
-/* ========================================================================= */
-/* [2] The Object/Nearby/Class directives parser: translating the syntax */
-/* into object specifications and then triggering off the above. */
-/* ========================================================================= */
-/* Properties ("with" or "private") segment. */
-/* ------------------------------------------------------------------------- */
-
-static int *defined_this_segment;
-static long defined_this_segment_size; /* calloc size */
-static int def_t_s;
-
-static void ensure_defined_this_segment(int newsize)
-{
- int oldsize = defined_this_segment_size;
- defined_this_segment_size = newsize;
- my_recalloc(&defined_this_segment, sizeof(int), oldsize,
- defined_this_segment_size, "defined this segment table");
-}
-
-static void properties_segment_z(int this_segment)
-{
- /* Parse through the "with" part of an object/class definition:
-
- <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
-
- This routine also handles "private", with this_segment being equal
- to the token value for the introductory word ("private" or "with"). */
-
-
- int i, property_name_symbol, property_number=0, next_prop=0, length,
- individual_property, this_identifier_number;
-
- do
- { get_next_token_with_directives();
- if ((token_type == SEGMENT_MARKER_TT)
- || (token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { put_token_back(); return;
- }
-
- if (token_type != SYMBOL_TT)
- { ebf_error("property name", token_text);
- return;
- }
-
- individual_property = (stypes[token_value] != PROPERTY_T);
-
- if (individual_property)
- { if (sflags[token_value] & UNKNOWN_SFLAG)
- { this_identifier_number = no_individual_properties++;
- assign_symbol(token_value, this_identifier_number,
- INDIVIDUAL_PROPERTY_T);
-
- if (debugfile_switch)
- { debug_file_printf("<property>");
- debug_file_printf
- ("<identifier>%s</identifier>", token_text);
- debug_file_printf
- ("<value>%d</value>", this_identifier_number);
- debug_file_printf("</property>");
- }
-
- }
- else
- { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
- this_identifier_number = svals[token_value];
- else
- { char already_error[128];
- sprintf(already_error,
- "\"%s\" is a name already in use (with type %s) \
-and may not be used as a property name too",
- token_text, typename(stypes[token_value]));
- error(already_error);
- return;
- }
- }
-
- if (def_t_s >= defined_this_segment_size)
- ensure_defined_this_segment(def_t_s*2);
- defined_this_segment[def_t_s++] = token_value;
-
- if (individual_prop_table_size++ == 0)
- { full_object.pp[full_object.l].num = 3;
- full_object.pp[full_object.l].l = 1;
- full_object.pp[full_object.l].ao[0].value
- = individuals_length;
- full_object.pp[full_object.l].ao[0].type = LONG_CONSTANT_OT;
- full_object.pp[full_object.l].ao[0].marker = INDIVPT_MV;
-
- i_m = individuals_length;
- full_object.l++;
- }
- individuals_table[i_m] = this_identifier_number/256;
- if (this_segment == PRIVATE_SEGMENT)
- individuals_table[i_m] |= 0x80;
- individuals_table[i_m+1] = this_identifier_number%256;
- if (module_switch)
- backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
- individuals_table[i_m+2] = 0;
- }
- else
- { if (sflags[token_value] & UNKNOWN_SFLAG)
- { error_named("No such property name as", token_text);
- return;
- }
- if (this_segment == PRIVATE_SEGMENT)
- error_named("Property should be declared in 'with', \
-not 'private':", token_text);
- if (def_t_s >= defined_this_segment_size)
- ensure_defined_this_segment(def_t_s*2);
- defined_this_segment[def_t_s++] = token_value;
- property_number = svals[token_value];
-
- next_prop=full_object.l++;
- full_object.pp[next_prop].num = property_number;
- }
-
- for (i=0; i<(def_t_s-1); i++)
- if (defined_this_segment[i] == token_value)
- { error_named("Property given twice in the same declaration:",
- (char *) symbs[token_value]);
- }
- else
- if (svals[defined_this_segment[i]] == svals[token_value])
- { char error_b[128];
- sprintf(error_b,
- "Property given twice in the same declaration, because \
-the names '%s' and '%s' actually refer to the same property",
- (char *) symbs[defined_this_segment[i]],
- (char *) symbs[token_value]);
- error(error_b);
- }
-
- property_name_symbol = token_value;
- sflags[token_value] |= USED_SFLAG;
-
- length=0;
- do
- { assembly_operand AO;
- get_next_token_with_directives();
- if ((token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
- break;
-
- if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
-
- if ((!individual_property) && (property_number==1)
- && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
- && (token_type != DQ_TT)
- )
- warning ("'name' property should only contain dictionary words");
-
- if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
- { char embedded_name[80];
- if (current_defn_is_class)
- { sprintf(embedded_name,
- "%s::%s", classname_text,
- (char *) symbs[property_name_symbol]);
- }
- else
- { sprintf(embedded_name,
- "%s.%s", objectname_text,
- (char *) symbs[property_name_symbol]);
- }
- AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
- AO.type = LONG_CONSTANT_OT;
- AO.marker = IROUTINE_MV;
-
- directives.enabled = FALSE;
- segment_markers.enabled = TRUE;
-
- statements.enabled = FALSE;
- misc_keywords.enabled = FALSE;
- local_variables.enabled = FALSE;
- system_functions.enabled = FALSE;
- conditions.enabled = FALSE;
- }
- else
-
- /* A special rule applies to values in double-quotes of the
- built-in property "name", which always has number 1: such
- property values are dictionary entries and not static
- strings */
-
- if ((!individual_property) &&
- (property_number==1) && (token_type == DQ_TT))
- { AO.value = dictionary_add(token_text, 0x80, 0, 0);
- AO.type = LONG_CONSTANT_OT;
- AO.marker = DWORD_MV;
- }
- else
- { if (length!=0)
- {
- if ((token_type == SYMBOL_TT)
- && (stypes[token_value]==PROPERTY_T))
- {
- /* This is not necessarily an error: it's possible
- to imagine a property whose value is a list
- of other properties to look up, but far more
- likely that a comma has been omitted in between
- two property blocks */
-
- warning_named(
- "Missing ','? Property data seems to contain the property name",
- token_text);
- }
- }
-
- /* An ordinary value, then: */
-
- put_token_back();
- AO = parse_expression(ARRAY_CONTEXT);
- }
-
- if (length == 64)
- { error_named("Limit (of 32 values) exceeded for property",
- (char *) symbs[property_name_symbol]);
- break;
- }
-
- if (individual_property)
- { if (AO.marker != 0)
- backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
- i_m+3+length);
- individuals_table[i_m+3+length++] = AO.value/256;
- individuals_table[i_m+3+length++] = AO.value%256;
- }
- else
- { full_object.pp[next_prop].ao[length/2] = AO;
- length = length + 2;
- }
-
- } while (TRUE);
-
- /* People rarely do, but it is legal to declare a property without
- a value at all:
-
- with name "fish", number, time_left;
-
- in which case the properties "number" and "time_left" are
- created as in effect variables and initialised to zero. */
-
- if (length == 0)
- { if (individual_property)
- { individuals_table[i_m+3+length++] = 0;
- individuals_table[i_m+3+length++] = 0;
- }
- else
- { full_object.pp[next_prop].ao[0].value = 0;
- full_object.pp[next_prop].ao[0].type = LONG_CONSTANT_OT;
- full_object.pp[next_prop].ao[0].marker = 0;
- length = 2;
- }
- }
-
- 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",
- (char *) symbs[property_name_symbol]);
- full_object.pp[next_prop].l=4;
- }
- }
-
- if (individual_property)
- {
- if (individuals_length+length+3 > MAX_INDIV_PROP_TABLE_SIZE)
- memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
- MAX_INDIV_PROP_TABLE_SIZE);
- individuals_table[i_m + 2] = length;
- individuals_length += length+3;
- i_m = individuals_length;
- }
- else
- full_object.pp[next_prop].l = length/2;
-
- if ((token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { put_token_back(); return;
- }
-
- } while (TRUE);
-}
-
-
-static void properties_segment_g(int this_segment)
-{
- /* Parse through the "with" part of an object/class definition:
-
- <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
-
- This routine also handles "private", with this_segment being equal
- to the token value for the introductory word ("private" or "with"). */
-
-
- int i, next_prop,
- individual_property, this_identifier_number;
- int32 property_name_symbol, property_number, length;
-
- do
- { get_next_token_with_directives();
- if ((token_type == SEGMENT_MARKER_TT)
- || (token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { put_token_back(); return;
- }
-
- if (token_type != SYMBOL_TT)
- { ebf_error("property name", token_text);
- return;
- }
-
- individual_property = (stypes[token_value] != PROPERTY_T);
-
- if (individual_property)
- { if (sflags[token_value] & UNKNOWN_SFLAG)
- { this_identifier_number = no_individual_properties++;
- assign_symbol(token_value, this_identifier_number,
- INDIVIDUAL_PROPERTY_T);
-
- if (debugfile_switch)
- { debug_file_printf("<property>");
- debug_file_printf
- ("<identifier>%s</identifier>", token_text);
- debug_file_printf
- ("<value>%d</value>", this_identifier_number);
- debug_file_printf("</property>");
- }
-
- }
- else
- { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
- this_identifier_number = svals[token_value];
- else
- { char already_error[128];
- sprintf(already_error,
- "\"%s\" is a name already in use (with type %s) \
-and may not be used as a property name too",
- token_text, typename(stypes[token_value]));
- error(already_error);
- return;
- }
- }
-
- if (def_t_s >= defined_this_segment_size)
- ensure_defined_this_segment(def_t_s*2);
- defined_this_segment[def_t_s++] = token_value;
- property_number = svals[token_value];
-
- next_prop=full_object_g.numprops++;
- full_object_g.props[next_prop].num = property_number;
- full_object_g.props[next_prop].flags =
- ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
- full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
- full_object_g.props[next_prop].continuation = 0;
- full_object_g.props[next_prop].datalen = 0;
- }
- else
- { if (sflags[token_value] & UNKNOWN_SFLAG)
- { error_named("No such property name as", token_text);
- return;
- }
- if (this_segment == PRIVATE_SEGMENT)
- error_named("Property should be declared in 'with', \
-not 'private':", token_text);
-
- if (def_t_s >= defined_this_segment_size)
- ensure_defined_this_segment(def_t_s*2);
- defined_this_segment[def_t_s++] = token_value;
- property_number = svals[token_value];
-
- next_prop=full_object_g.numprops++;
- full_object_g.props[next_prop].num = property_number;
- full_object_g.props[next_prop].flags = 0;
- full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
- full_object_g.props[next_prop].continuation = 0;
- full_object_g.props[next_prop].datalen = 0;
- }
-
- for (i=0; i<(def_t_s-1); i++)
- if (defined_this_segment[i] == token_value)
- { error_named("Property given twice in the same declaration:",
- (char *) symbs[token_value]);
- }
- else
- if (svals[defined_this_segment[i]] == svals[token_value])
- { char error_b[128];
- sprintf(error_b,
- "Property given twice in the same declaration, because \
-the names '%s' and '%s' actually refer to the same property",
- (char *) symbs[defined_this_segment[i]],
- (char *) symbs[token_value]);
- error(error_b);
- }
-
- if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
- memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
- }
-
- property_name_symbol = token_value;
- sflags[token_value] |= USED_SFLAG;
-
- length=0;
- do
- { assembly_operand AO;
- get_next_token_with_directives();
- if ((token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
- break;
-
- if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
-
- if ((!individual_property) && (property_number==1)
- && (token_type != SQ_TT) && (token_type != DQ_TT)
- )
- warning ("'name' property should only contain dictionary words");
-
- if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
- { char embedded_name[80];
- if (current_defn_is_class)
- { sprintf(embedded_name,
- "%s::%s", classname_text,
- (char *) symbs[property_name_symbol]);
- }
- else
- { sprintf(embedded_name,
- "%s.%s", objectname_text,
- (char *) symbs[property_name_symbol]);
- }
- AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
- AO.type = CONSTANT_OT;
- AO.marker = IROUTINE_MV;
-
- directives.enabled = FALSE;
- segment_markers.enabled = TRUE;
-
- statements.enabled = FALSE;
- misc_keywords.enabled = FALSE;
- local_variables.enabled = FALSE;
- system_functions.enabled = FALSE;
- conditions.enabled = FALSE;
- }
- else
-
- /* A special rule applies to values in double-quotes of the
- built-in property "name", which always has number 1: such
- property values are dictionary entries and not static
- strings */
-
- if ((!individual_property) &&
- (property_number==1) && (token_type == DQ_TT))
- { AO.value = dictionary_add(token_text, 0x80, 0, 0);
- AO.type = CONSTANT_OT;
- AO.marker = DWORD_MV;
- }
- else
- { if (length!=0)
- {
- if ((token_type == SYMBOL_TT)
- && (stypes[token_value]==PROPERTY_T))
- {
- /* This is not necessarily an error: it's possible
- to imagine a property whose value is a list
- of other properties to look up, but far more
- likely that a comma has been omitted in between
- two property blocks */
-
- warning_named(
- "Missing ','? Property data seems to contain the property name",
- token_text);
- }
- }
-
- /* An ordinary value, then: */
-
- put_token_back();
- AO = parse_expression(ARRAY_CONTEXT);
- }
-
- if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
- { error_named("Limit (of 32768 values) exceeded for property",
- (char *) symbs[property_name_symbol]);
- break;
- }
-
- if (full_object_g.propdatasize >= MAX_OBJ_PROP_TABLE_SIZE) {
- memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
- }
-
- full_object_g.propdata[full_object_g.propdatasize++] = AO;
- length += 1;
-
- } while (TRUE);
-
- /* People rarely do, but it is legal to declare a property without
- a value at all:
-
- with name "fish", number, time_left;
-
- in which case the properties "number" and "time_left" are
- created as in effect variables and initialised to zero. */
-
- if (length == 0)
- {
- assembly_operand AO;
- AO.value = 0;
- AO.type = CONSTANT_OT;
- AO.marker = 0;
- full_object_g.propdata[full_object_g.propdatasize++] = AO;
- length += 1;
- }
-
- full_object_g.props[next_prop].datalen = length;
-
- if ((token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { put_token_back(); return;
- }
-
- } while (TRUE);
-}
-
-static void properties_segment(int this_segment)
-{
- if (!glulx_mode)
- properties_segment_z(this_segment);
- else
- properties_segment_g(this_segment);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Attributes ("has") segment. */
-/* ------------------------------------------------------------------------- */
-
-static void attributes_segment(void)
-{
- /* Parse through the "has" part of an object/class definition:
-
- [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
-
- int attribute_number, truth_state, bitmask;
- uchar *attrbyte;
- do
- { truth_state = TRUE;
-
- ParseAttrN:
-
- get_next_token_with_directives();
- if ((token_type == SEGMENT_MARKER_TT)
- || (token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { if (!truth_state)
- ebf_error("attribute name after '~'", token_text);
- put_token_back(); return;
- }
- if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
-
- if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
- { truth_state = !truth_state; goto ParseAttrN;
- }
-
- if ((token_type != SYMBOL_TT)
- || (stypes[token_value] != ATTRIBUTE_T))
- { ebf_error("name of an already-declared attribute", token_text);
- return;
- }
-
- attribute_number = svals[token_value];
- sflags[token_value] |= USED_SFLAG;
-
- if (!glulx_mode) {
- bitmask = (1 << (7-attribute_number%8));
- attrbyte = &(full_object.atts[attribute_number/8]);
- }
- else {
- /* In Glulx, my prejudices rule, and therefore bits are numbered
- from least to most significant. This is the opposite of the
- way the Z-machine works. */
- bitmask = (1 << (attribute_number%8));
- attrbyte = &(full_object_g.atts[attribute_number/8]);
- }
-
- if (truth_state)
- *attrbyte |= bitmask; /* Set attribute bit */
- else
- *attrbyte &= ~bitmask; /* Clear attribute bit */
-
- } while (TRUE);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Classes ("class") segment. */
-/* ------------------------------------------------------------------------- */
-
-static void add_class_to_inheritance_list(int class_number)
-{
- int i;
-
- /* The class number is actually the class's object number, which needs
- to be translated into its actual class number: */
-
- for (i=0;i<no_classes;i++)
- if (class_number == class_object_numbers[i])
- { class_number = i+1;
- break;
- }
-
- /* Remember the inheritance list so that property inheritance can
- be sorted out later on, when the definition has been finished: */
-
- classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
-
- /* Inheriting attributes from the class at once: */
-
- if (!glulx_mode) {
- for (i=0; i<6; i++)
- full_object.atts[i]
- |= properties_table[class_begins_at[class_number-1] - 6 + i];
- }
- else {
- for (i=0; i<NUM_ATTR_BYTES; i++)
- full_object_g.atts[i]
- |= properties_table[class_begins_at[class_number-1]
- - NUM_ATTR_BYTES + i];
- }
-}
-
-static void classes_segment(void)
-{
- /* Parse through the "class" part of an object/class definition:
-
- <class-1> ... <class-n> */
-
- do
- { get_next_token_with_directives();
- if ((token_type == SEGMENT_MARKER_TT)
- || (token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { put_token_back(); return;
- }
- if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
-
- if ((token_type != SYMBOL_TT)
- || (stypes[token_value] != CLASS_T))
- { ebf_error("name of an already-declared class", token_text);
- return;
- }
-
- sflags[token_value] |= USED_SFLAG;
- add_class_to_inheritance_list(svals[token_value]);
- } while (TRUE);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Parse the body of a Nearby/Object/Class definition. */
-/* ------------------------------------------------------------------------- */
-
-static void parse_body_of_definition(void)
-{ int commas_in_row;
-
- def_t_s = 0;
-
- do
- { commas_in_row = -1;
- do
- { get_next_token_with_directives(); commas_in_row++;
- } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
-
- if (commas_in_row>1)
- error("Two commas ',' in a row in object/class definition");
-
- if ((token_type == EOF_TT)
- || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- { if (commas_in_row > 0)
- error("Object/class definition finishes with ','");
- if (token_type == EOF_TT)
- error("Object/class definition incomplete (no ';') at end of file");
- break;
- }
-
- if (token_type != SEGMENT_MARKER_TT)
- { error_named("Expected 'with', 'has' or 'class' in \
-object/class definition but found", token_text);
- break;
- }
- else
- switch(token_value)
- { case WITH_SEGMENT:
- properties_segment(WITH_SEGMENT);
- break;
- case PRIVATE_SEGMENT:
- properties_segment(PRIVATE_SEGMENT);
- break;
- case HAS_SEGMENT:
- attributes_segment();
- break;
- case CLASS_SEGMENT:
- classes_segment();
- break;
- }
-
- } while (TRUE);
-
-}
-
-/* ------------------------------------------------------------------------- */
-/* Class directives: */
-/* */
-/* Class <name> <body of definition> */
-/* ------------------------------------------------------------------------- */
-
-static void initialise_full_object(void)
-{
- int i;
- if (!glulx_mode) {
- full_object.l = 0;
- full_object.atts[0] = 0;
- full_object.atts[1] = 0;
- full_object.atts[2] = 0;
- full_object.atts[3] = 0;
- full_object.atts[4] = 0;
- full_object.atts[5] = 0;
- }
- else {
- full_object_g.numprops = 0;
- full_object_g.propdatasize = 0;
- for (i=0; i<NUM_ATTR_BYTES; i++)
- full_object_g.atts[i] = 0;
- }
-}
-
-extern void make_class(char * metaclass_name)
-{ int n, duplicates_to_make = 0, class_number = no_objects+1,
- metaclass_flag = (metaclass_name != NULL);
- char duplicate_name[128];
- int class_symbol;
- debug_location_beginning beginning_debug_location =
- get_token_location_beginning();
-
- current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
- individual_prop_table_size = 0;
-
- if (no_classes==MAX_CLASSES)
- memoryerror("MAX_CLASSES", MAX_CLASSES);
-
- if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
- fatalerror("Inform's maximum possible number of classes (whatever \
-amount of memory is allocated) has been reached. If this causes serious \
-inconvenience, please contact the maintainers.");
-
- directives.enabled = FALSE;
-
- if (metaclass_flag)
- { token_text = metaclass_name;
- token_value = symbol_index(token_text, -1);
- token_type = SYMBOL_TT;
- }
- else
- { get_next_token();
- if ((token_type != SYMBOL_TT)
- || (!(sflags[token_value] & UNKNOWN_SFLAG)))
- { discard_token_location(beginning_debug_location);
- ebf_error("new class name", token_text);
- panic_mode_error_recovery();
- return;
- }
- }
-
- /* Each class also creates a modest object representing itself: */
-
- strcpy(shortname_buffer, token_text);
-
- assign_symbol(token_value, class_number, CLASS_T);
- classname_text = (char *) symbs[token_value];
-
- if (!glulx_mode) {
- if (metaclass_flag) sflags[token_value] |= SYSTEM_SFLAG;
- }
- else {
- /* In Glulx, metaclasses have to be backpatched too! So we can't
- mark it as "system", but we should mark it "used". */
- if (metaclass_flag) sflags[token_value] |= USED_SFLAG;
- }
-
- /* "Class" (object 1) has no parent, whereas all other classes are
- the children of "Class". Since "Class" is not present in a module,
- a special value is used which is corrected to 1 by the linker. */
-
- if (metaclass_flag) parent_of_this_obj = 0;
- else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
-
- class_object_numbers[no_classes] = class_number;
-
- initialise_full_object();
-
- /* Give the class the (nameless in Inform syntax) "inheritance" property
- with value its own class number. (This therefore accumulates onto
- the inheritance property of any object inheriting from the class,
- since property 2 is always set to "additive" -- see below) */
-
- if (!glulx_mode) {
- full_object.l = 1;
- full_object.pp[0].num = 2;
- full_object.pp[0].l = 1;
- full_object.pp[0].ao[0].value = no_objects + 1;
- full_object.pp[0].ao[0].type = LONG_CONSTANT_OT;
- full_object.pp[0].ao[0].marker = OBJECT_MV;
- }
- else {
- full_object_g.numprops = 1;
- full_object_g.props[0].num = 2;
- full_object_g.props[0].flags = 0;
- full_object_g.props[0].datastart = 0;
- full_object_g.props[0].continuation = 0;
- full_object_g.props[0].datalen = 1;
- full_object_g.propdatasize = 1;
- full_object_g.propdata[0].value = no_objects + 1;
- full_object_g.propdata[0].type = CONSTANT_OT;
- full_object_g.propdata[0].marker = OBJECT_MV;
- }
-
- class_symbol = token_value;
-
- if (!metaclass_flag)
- { get_next_token();
- if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
- { assembly_operand AO;
- AO = parse_expression(CONSTANT_CONTEXT);
- if (AO.marker != 0)
- { error("Duplicate-number not known at compile time");
- n=0;
- }
- else
- n = AO.value;
- if ((n<0) || (n>10000))
- { error("The number of duplicates must be 0 to 10000");
- n=0;
- }
-
- /* Make one extra duplicate, since the veneer routines need
- always to keep an undamaged prototype for the class in stock */
-
- duplicates_to_make = n + 1;
-
- match_close_bracket();
- } else put_token_back();
-
- /* Parse the body of the definition: */
-
- parse_body_of_definition();
- }
-
- if (debugfile_switch)
- { debug_file_printf("<class>");
- debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
- debug_file_printf("<class-number>%d</class-number>", no_classes);
- debug_file_printf("<value>");
- write_debug_object_backpatch(no_objects + 1);
- debug_file_printf("</value>");
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</class>");
- }
-
- if (!glulx_mode)
- manufacture_object_z();
- else
- manufacture_object_g();
-
- if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
- error("This class is too complex: it now carries too many properties. \
-You may be able to get round this by declaring some of its property names as \
-\"common properties\" using the 'Property' directive.");
-
- if (duplicates_to_make > 0)
- { sprintf(duplicate_name, "%s_1", shortname_buffer);
- for (n=1; (duplicates_to_make--) > 0; n++)
- { if (n>1)
- { int i = strlen(duplicate_name);
- while (duplicate_name[i] != '_') i--;
- sprintf(duplicate_name+i+1, "%d", n);
- }
- make_object(FALSE, duplicate_name, class_number, class_number, -1);
- }
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Object/Nearby directives: */
-/* */
-/* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
-/* */
-/* Nearby <name-1> ... <name-n> "short name" <body of definition> */
-/* ------------------------------------------------------------------------- */
-
-static int end_of_header(void)
-{ if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
- || (token_type == SEGMENT_MARKER_TT)) return TRUE;
- return FALSE;
-}
-
-extern void make_object(int nearby_flag,
- char *textual_name, int specified_parent, int specified_class,
- int instance_of)
-{
- /* Ordinarily this is called with nearby_flag TRUE for "Nearby",
- FALSE for "Object"; and textual_name NULL, specified_parent and
- specified_class both -1. The next three arguments are used when
- the routine is called for class duplicates manufacture (see above).
- The last is used to create instances of a particular class. */
-
- int i, tree_depth, internal_name_symbol = 0;
- char internal_name[64];
- debug_location_beginning beginning_debug_location =
- get_token_location_beginning();
-
- directives.enabled = FALSE;
-
- if (no_objects==MAX_OBJECTS) memoryerror("MAX_OBJECTS", MAX_OBJECTS);
-
- sprintf(internal_name, "nameless_obj__%d", no_objects+1);
- objectname_text = internal_name;
-
- current_defn_is_class = FALSE;
-
- no_classes_to_inherit_from=0;
-
- individual_prop_table_size = 0;
-
- if (nearby_flag) tree_depth=1; else tree_depth=0;
-
- if (specified_class != -1) goto HeaderPassed;
-
- get_next_token();
-
- /* Read past and count a sequence of "->"s, if any are present */
-
- if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
- { if (nearby_flag)
- error("The syntax '->' is only used as an alternative to 'Nearby'");
-
- while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
- { tree_depth++;
- get_next_token();
- }
- }
-
- sprintf(shortname_buffer, "?");
-
- segment_markers.enabled = TRUE;
-
- /* This first word is either an internal name, or a textual short name,
- or the end of the header part */
-
- if (end_of_header()) goto HeaderPassed;
-
- if (token_type == DQ_TT) textual_name = token_text;
- else
- { if ((token_type != SYMBOL_TT)
- || (!(sflags[token_value] & UNKNOWN_SFLAG)))
- ebf_error("name for new object or its textual short name",
- token_text);
- else
- { internal_name_symbol = token_value;
- strcpy(internal_name, token_text);
- }
- }
-
- /* The next word is either a parent object, or
- a textual short name, or the end of the header part */
-
- get_next_token_with_directives();
- if (end_of_header()) goto HeaderPassed;
-
- if (token_type == DQ_TT)
- { if (textual_name != NULL)
- error("Two textual short names given for only one object");
- else
- textual_name = token_text;
- }
- else
- { if ((token_type != SYMBOL_TT)
- || (sflags[token_value] & UNKNOWN_SFLAG))
- { if (textual_name == NULL)
- ebf_error("parent object or the object's textual short name",
- token_text);
- else
- ebf_error("parent object", token_text);
- }
- else goto SpecParent;
- }
-
- /* Finally, it's possible that there is still a parent object */
-
- get_next_token();
- if (end_of_header()) goto HeaderPassed;
-
- if (specified_parent != -1)
- ebf_error("body of object definition", token_text);
- else
- { SpecParent:
- if ((stypes[token_value] == OBJECT_T)
- || (stypes[token_value] == CLASS_T))
- { specified_parent = svals[token_value];
- sflags[token_value] |= USED_SFLAG;
- }
- else ebf_error("name of (the parent) object", token_text);
- }
-
- /* Now it really has to be the body of the definition. */
-
- get_next_token_with_directives();
- if (end_of_header()) goto HeaderPassed;
-
- ebf_error("body of object definition", token_text);
-
- HeaderPassed:
- if (specified_class == -1) put_token_back();
-
- if (internal_name_symbol > 0)
- assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
-
- if (listobjects_switch)
- printf("%3d \"%s\"\n", no_objects+1,
- (textual_name==NULL)?"(with no short name)":textual_name);
- if (textual_name == NULL)
- { if (internal_name_symbol > 0)
- sprintf(shortname_buffer, "(%s)",
- (char *) symbs[internal_name_symbol]);
- else
- 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 (specified_parent != -1)
- { if (tree_depth > 0)
- error("Use of '->' (or 'Nearby') clashes with giving a parent");
- parent_of_this_obj = specified_parent;
- }
- else
- { parent_of_this_obj = 0;
- if (tree_depth>0)
- {
- /* We have to set the parent object to the most recently defined
- object at level (tree_depth - 1) in the tree.
-
- A complication is that objects are numbered 1, 2, ... in the
- Z-machine (and in the objects[].parent, etc., fields) but
- 0, 1, 2, ... internally (and as indices to object[]). */
-
- for (i=no_objects-1; i>=0; i--)
- { int j = i, k = 0;
-
- /* Metaclass or class objects cannot be '->' parents: */
- if ((!module_switch) && (i<4))
- continue;
-
- if (!glulx_mode) {
- if (objectsz[i].parent == 1)
- continue;
- while (objectsz[j].parent != 0)
- { j = objectsz[j].parent - 1; k++; }
- }
- else {
- if (objectsg[i].parent == 1)
- continue;
- while (objectsg[j].parent != 0)
- { j = objectsg[j].parent - 1; k++; }
- }
-
- if (k == tree_depth - 1)
- { parent_of_this_obj = i+1;
- break;
- }
- }
- if (parent_of_this_obj == 0)
- { if (tree_depth == 1)
- error("'->' (or 'Nearby') fails because there is no previous object");
- else
- error("'-> -> ...' fails because no previous object is deep enough");
- }
- }
- }
-
- initialise_full_object();
- if (instance_of != -1) add_class_to_inheritance_list(instance_of);
-
- if (specified_class == -1) parse_body_of_definition();
- else add_class_to_inheritance_list(specified_class);
-
- if (debugfile_switch)
- { debug_file_printf("<object>");
- if (internal_name_symbol > 0)
- { debug_file_printf("<identifier>%s</identifier>", internal_name);
- } else
- { debug_file_printf
- ("<identifier artificial=\"true\">%s</identifier>",
- internal_name);
- }
- debug_file_printf("<value>");
- write_debug_object_backpatch(no_objects + 1);
- debug_file_printf("</value>");
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</object>");
- }
-
- if (!glulx_mode)
- manufacture_object_z();
- else
- manufacture_object_g();
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_objects_vars(void)
-{
- properties_table = NULL;
- prop_is_long = NULL;
- prop_is_additive = NULL;
- prop_default_value = NULL;
-
- objectsz = NULL;
- objectsg = NULL;
- objectatts = NULL;
- classes_to_inherit_from = NULL;
- class_begins_at = NULL;
-}
-
-extern void objects_begin_pass(void)
-{
- properties_table_size=0;
- prop_is_long[1] = TRUE; prop_is_additive[1] = TRUE; /* "name" */
- prop_is_long[2] = TRUE; prop_is_additive[2] = TRUE; /* inheritance prop */
- if (!glulx_mode)
- prop_is_long[3] = TRUE; prop_is_additive[3] = FALSE;
- /* instance variables table address */
- no_properties = 4;
-
- if (debugfile_switch)
- { debug_file_printf("<property>");
- debug_file_printf
- ("<identifier artificial=\"true\">inheritance class</identifier>");
- debug_file_printf("<value>2</value>");
- debug_file_printf("</property>");
- debug_file_printf("<property>");
- debug_file_printf
- ("<identifier artificial=\"true\">instance variables table address "
- "(Z-code)</identifier>");
- debug_file_printf("<value>3</value>");
- debug_file_printf("</property>");
- }
-
- if (define_INFIX_switch) no_attributes = 1;
- else no_attributes = 0;
-
- no_objects = 0;
- if (!glulx_mode) {
- objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
- no_individual_properties=72;
- }
- else {
- objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
- no_individual_properties = INDIV_PROP_START+8;
- }
- no_classes = 0;
-
- no_embedded_routines = 0;
-
- individuals_length=0;
-}
-
-extern void objects_allocate_arrays(void)
-{
- objectsz = NULL;
- objectsg = NULL;
- objectatts = NULL;
-
- prop_default_value = my_calloc(sizeof(int32), INDIV_PROP_START,
- "property default values");
- prop_is_long = my_calloc(sizeof(int), INDIV_PROP_START,
- "property-is-long flags");
- prop_is_additive = my_calloc(sizeof(int), INDIV_PROP_START,
- "property-is-additive flags");
-
- classes_to_inherit_from = my_calloc(sizeof(int), MAX_CLASSES,
- "inherited classes list");
- class_begins_at = my_calloc(sizeof(int32), MAX_CLASSES,
- "pointers to classes");
- class_object_numbers = my_calloc(sizeof(int), MAX_CLASSES,
- "class object numbers");
-
- properties_table = my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
- individuals_table = my_malloc(MAX_INDIV_PROP_TABLE_SIZE,
- "individual properties table");
-
- defined_this_segment_size = 128;
- defined_this_segment = my_calloc(sizeof(int), defined_this_segment_size,
- "defined this segment table");
-
- if (!glulx_mode) {
- objectsz = my_calloc(sizeof(objecttz), MAX_OBJECTS,
- "z-objects");
- }
- else {
- objectsg = my_calloc(sizeof(objecttg), MAX_OBJECTS,
- "g-objects");
- objectatts = my_calloc(NUM_ATTR_BYTES, MAX_OBJECTS,
- "g-attributes");
- full_object_g.props = my_calloc(sizeof(propg), MAX_OBJ_PROP_COUNT,
- "object property list");
- full_object_g.propdata = my_calloc(sizeof(assembly_operand),
- MAX_OBJ_PROP_TABLE_SIZE,
- "object property data table");
- }
-}
-
-extern void objects_free_arrays(void)
-{
- my_free(&prop_default_value, "property default values");
- my_free(&prop_is_long, "property-is-long flags");
- my_free(&prop_is_additive, "property-is-additive flags");
-
- my_free(&objectsz, "z-objects");
- my_free(&objectsg, "g-objects");
- my_free(&objectatts, "g-attributes");
- my_free(&class_object_numbers,"class object numbers");
- my_free(&classes_to_inherit_from, "inherited classes list");
- my_free(&class_begins_at, "pointers to classes");
-
- my_free(&properties_table, "properties table");
- my_free(&individuals_table,"individual properties table");
-
- my_free(&defined_this_segment,"defined this segment table");
-
- if (!glulx_mode) {
- my_free(&full_object_g.props, "object property list");
- my_free(&full_object_g.propdata, "object property data table");
- }
-
-}
-
-/* ========================================================================= */
better when the Inform standard library is in a non-standard
location.
-Compiling Inform is very easy. Install GCC and then:
+Compiling Inform is very easy. You'll need a compiler (like GCC),
+along with the GNU Autotools and GNU Make.
-gcc *.c -o inform
+First run autoreconf --install; then see the INSTALL file for
+installation information.
Inform 6 is published under the original Inform licence (which is
proprietary), or under the Artistic License 2.0, at the user's choice.
--- /dev/null
+# This file is part of Inform.
+#
+# Inform is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# theFree Software Foundation, either version 3 of the License, or
+#(at your option) any later version.
+#
+# Inform is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Inform. If not, see https://gnu.org/licenses/
+
+bin_PROGRAMS = inform
+inform_SOURCES = arrays.c asm.c bpatch.c chars.c directs.c errors.c expressc.c expressp.c files.c header.h inform.c lexer.c linker.c memory.c objects.c states.c symbols.c syntax.c tables.c text.c veneer.c verbs.c
\ No newline at end of file
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "arrays" : Parses array declarations and constructs arrays from them; */
+/* likewise global variables, which are in some ways a */
+/* simpler form of the same thing. */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+/* ------------------------------------------------------------------------- */
+/* Arrays defined below: */
+/* */
+/* int dynamic_array_area[] Initial values for the bytes of */
+/* the dynamic array area */
+/* int32 global_initial_value[n] The initialised value of the nth */
+/* global variable (counting 0 - 239) */
+/* */
+/* The "dynamic array area" is the Z-machine area holding the current */
+/* values of the global variables (in 240x2 = 480 bytes) followed by any */
+/* (dynamic) arrays which may be defined. Owing to a poor choice of name */
+/* some years ago, this is also called the "static data area", which is */
+/* why the memory setting for its maximum extent is "MAX_STATIC_DATA". */
+/* */
+/* In Glulx, that 240 is changed to MAX_GLOBAL_VAR_NUMBER, and we take */
+/* correspondingly more space for the globals. This *really* ought to be */
+/* split into two segments. */
+/* ------------------------------------------------------------------------- */
+int *dynamic_array_area; /* See above */
+int32 *global_initial_value;
+
+int no_globals; /* Number of global variables used
+ by the programmer (Inform itself
+ uses the top seven -- but these do
+ not count) */
+ /* In Glulx, Inform uses the bottom
+ ten. */
+
+int dynamic_array_area_size; /* Size in bytes */
+
+int no_arrays;
+int32 *array_symbols;
+int *array_sizes, *array_types;
+
+static int array_entry_size, /* 1 for byte array, 2 for word array */
+ array_base; /* Offset in dynamic array area of the
+ array being constructed. During the
+ same time, dynamic_array_area_size
+ is the offset of the initial entry
+ in the array: so for "table" and
+ "string" arrays, these numbers are
+ different (by 2 and 1 bytes resp) */
+
+ /* In Glulx, of course, that will be
+ 4 instead of 2. */
+
+extern void finish_array(int32 i)
+{
+ /* Write the array size into the 0th byte/word of the array, if it's
+ a "table" or "string" array */
+ if (!glulx_mode) {
+
+ if (array_base!=dynamic_array_area_size)
+ { if (dynamic_array_area_size-array_base==2)
+ { dynamic_array_area[array_base] = i/256;
+ dynamic_array_area[array_base+1] = i%256;
+ }
+ else
+ { if (i>=256)
+ error("A 'string' array can have at most 256 entries");
+ dynamic_array_area[array_base] = i;
+ }
+ }
+
+ }
+ else {
+ if (array_base!=dynamic_array_area_size)
+ { if (dynamic_array_area_size-array_base==4)
+ {
+ dynamic_array_area[array_base] = (i >> 24) & 0xFF;
+ dynamic_array_area[array_base+1] = (i >> 16) & 0xFF;
+ dynamic_array_area[array_base+2] = (i >> 8) & 0xFF;
+ dynamic_array_area[array_base+3] = (i) & 0xFF;
+ }
+ else
+ { if (i>=256)
+ error("A 'string' array can have at most 256 entries");
+ dynamic_array_area[array_base] = i;
+ }
+ }
+
+ }
+
+ /* Move on the dynamic array size so that it now points to the next
+ available free space */
+
+ dynamic_array_area_size += i*array_entry_size;
+
+}
+
+extern void array_entry(int32 i, assembly_operand VAL)
+{
+ if (!glulx_mode) {
+ /* Array entry i (initial entry has i=0) is set to Z-machine value j */
+
+ if (dynamic_array_area_size+(i+1)*array_entry_size > MAX_STATIC_DATA)
+ memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
+
+ if (array_entry_size==1)
+ { dynamic_array_area[dynamic_array_area_size+i] = (VAL.value)%256;
+
+ if (VAL.marker != 0)
+ error("Entries in byte arrays and strings must be known constants");
+
+ /* If the entry is too large for a byte array, issue a warning
+ and truncate the value */
+ else
+ if (VAL.value >= 256)
+ warning("Entry in '->', 'string' or 'buffer' array not in range 0 to 255");
+ }
+ else
+ { dynamic_array_area[dynamic_array_area_size + 2*i] = (VAL.value)/256;
+ dynamic_array_area[dynamic_array_area_size + 2*i+1] = (VAL.value)%256;
+ if (VAL.marker != 0)
+ backpatch_zmachine(VAL.marker, DYNAMIC_ARRAY_ZA,
+ dynamic_array_area_size + 2*i);
+ }
+ }
+ else {
+ /* Array entry i (initial entry has i=0) is set to value j */
+
+ if (dynamic_array_area_size+(i+1)*array_entry_size > MAX_STATIC_DATA)
+ memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
+
+ if (array_entry_size==1)
+ { dynamic_array_area[dynamic_array_area_size+i] = (VAL.value) & 0xFF;
+
+ if (VAL.marker != 0)
+ error("Entries in byte arrays and strings must be known constants");
+
+ /* If the entry is too large for a byte array, issue a warning
+ and truncate the value */
+ else
+ if (VAL.value >= 256)
+ warning("Entry in '->', 'string' or 'buffer' array not in range 0 to 255");
+ }
+ else if (array_entry_size==4)
+ { dynamic_array_area[dynamic_array_area_size + 4*i] = (VAL.value >> 24) & 0xFF;
+ dynamic_array_area[dynamic_array_area_size + 4*i+1] = (VAL.value >> 16) & 0xFF;
+ dynamic_array_area[dynamic_array_area_size + 4*i+2] = (VAL.value >> 8) & 0xFF;
+ dynamic_array_area[dynamic_array_area_size + 4*i+3] = (VAL.value) & 0xFF;
+ if (VAL.marker != 0)
+ backpatch_zmachine(VAL.marker, ARRAY_ZA,
+ dynamic_array_area_size - 4*MAX_GLOBAL_VARIABLES + 4*i);
+ }
+ else
+ {
+ error("Somehow created an array of shorts");
+ }
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Global and Array directives. */
+/* */
+/* Global <variablename> | */
+/* | = <value> */
+/* | <array specification> */
+/* */
+/* Array <arrayname> <array specification> */
+/* */
+/* where an array specification is: */
+/* */
+/* | -> | <number-of-entries> */
+/* | --> | <entry-1> ... <entry-n> */
+/* | string | [ <entry-1> [,] [;] <entry-2> ... <entry-n> ]; */
+/* | table */
+/* */
+/* ------------------------------------------------------------------------- */
+
+extern void set_variable_value(int i, int32 v)
+{ global_initial_value[i]=v;
+}
+
+/* There are four ways to initialise arrays: */
+
+#define UNSPECIFIED_AI -1
+#define NULLS_AI 0
+#define DATA_AI 1
+#define ASCII_AI 2
+#define BRACKET_AI 3
+
+extern void make_global(int array_flag, int name_only)
+{
+ /* array_flag is TRUE for an Array directive, FALSE for a Global;
+ name_only is only TRUE for parsing an imported variable name, so
+ array_flag is always FALSE in that case. */
+
+ int32 i;
+ int array_type, data_type;
+ assembly_operand AO;
+
+ int32 global_symbol;
+ const char *global_name;
+ debug_location_beginning beginning_debug_location =
+ get_token_location_beginning();
+
+ directive_keywords.enabled = FALSE;
+ get_next_token();
+ i = token_value;
+ global_symbol = i;
+ global_name = token_text;
+
+ if (!glulx_mode) {
+ if ((token_type==SYMBOL_TT) && (stypes[i]==GLOBAL_VARIABLE_T)
+ && (svals[i] >= LOWEST_SYSTEM_VAR_NUMBER))
+ goto RedefinitionOfSystemVar;
+ }
+ else {
+ if ((token_type==SYMBOL_TT) && (stypes[i]==GLOBAL_VARIABLE_T))
+ goto RedefinitionOfSystemVar;
+ }
+
+ if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
+ { discard_token_location(beginning_debug_location);
+ if (array_flag)
+ ebf_error("new array name", token_text);
+ else ebf_error("new global variable name", token_text);
+ panic_mode_error_recovery(); return;
+ }
+
+ if ((!array_flag) && (sflags[i] & USED_SFLAG))
+ error_named("Variable must be defined before use:", token_text);
+
+ if (array_flag)
+ {
+ if (!glulx_mode)
+ assign_symbol(i, dynamic_array_area_size, ARRAY_T);
+ else
+ assign_symbol(i,
+ dynamic_array_area_size - 4*MAX_GLOBAL_VARIABLES, ARRAY_T);
+ if (no_arrays == MAX_ARRAYS)
+ memoryerror("MAX_ARRAYS", MAX_ARRAYS);
+ array_symbols[no_arrays] = i;
+ }
+ else
+ { if (!glulx_mode && no_globals==233)
+ { discard_token_location(beginning_debug_location);
+ error("All 233 global variables already declared");
+ panic_mode_error_recovery();
+ return;
+ }
+ if (glulx_mode && no_globals==MAX_GLOBAL_VARIABLES)
+ { discard_token_location(beginning_debug_location);
+ memoryerror("MAX_GLOBAL_VARIABLES", MAX_GLOBAL_VARIABLES);
+ panic_mode_error_recovery();
+ return;
+ }
+
+ variable_tokens[MAX_LOCAL_VARIABLES+no_globals] = i;
+ assign_symbol(i, MAX_LOCAL_VARIABLES+no_globals, GLOBAL_VARIABLE_T);
+ variable_tokens[svals[i]] = i;
+
+ if (name_only) import_symbol(i);
+ else global_initial_value[no_globals++]=0;
+ }
+
+ directive_keywords.enabled = TRUE;
+
+ RedefinitionOfSystemVar:
+
+ if (name_only)
+ { discard_token_location(beginning_debug_location);
+ return;
+ }
+
+ get_next_token();
+
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { if (array_flag)
+ { discard_token_location(beginning_debug_location);
+ ebf_error("array definition", token_text);
+ }
+ put_token_back();
+ if (debugfile_switch && !array_flag)
+ { debug_file_printf("<global-variable>");
+ debug_file_printf("<identifier>%s</identifier>", global_name);
+ debug_file_printf("<address>");
+ write_debug_global_backpatch(svals[global_symbol]);
+ debug_file_printf("</address>");
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ debug_file_printf("</global-variable>");
+ }
+ return;
+ }
+
+ if (!array_flag)
+ {
+ if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
+ { AO = parse_expression(CONSTANT_CONTEXT);
+ if (!glulx_mode) {
+ if (AO.marker != 0)
+ backpatch_zmachine(AO.marker, DYNAMIC_ARRAY_ZA,
+ 2*(no_globals-1));
+ }
+ else {
+ if (AO.marker != 0)
+ backpatch_zmachine(AO.marker, GLOBALVAR_ZA,
+ 4*(no_globals-1));
+ }
+ global_initial_value[no_globals-1] = AO.value;
+ if (debugfile_switch)
+ { debug_file_printf("<global-variable>");
+ debug_file_printf("<identifier>%s</identifier>", global_name);
+ debug_file_printf("<address>");
+ write_debug_global_backpatch(svals[global_symbol]);
+ debug_file_printf("</address>");
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ debug_file_printf("</global-variable>");
+ }
+ return;
+ }
+
+ obsolete_warning("more modern to use 'Array', not 'Global'");
+
+ if (!glulx_mode) {
+ backpatch_zmachine(ARRAY_MV, DYNAMIC_ARRAY_ZA, 2*(no_globals-1));
+ global_initial_value[no_globals-1]
+ = dynamic_array_area_size+variables_offset;
+ }
+ else {
+ backpatch_zmachine(ARRAY_MV, GLOBALVAR_ZA, 4*(no_globals-1));
+ global_initial_value[no_globals-1]
+ = dynamic_array_area_size - 4*MAX_GLOBAL_VARIABLES;
+ }
+ }
+
+ array_type = BYTE_ARRAY; data_type = UNSPECIFIED_AI;
+
+ if ((!array_flag) &&
+ ((token_type==DIR_KEYWORD_TT)&&(token_value==DATA_DK)))
+ data_type=NULLS_AI;
+ else if ((!array_flag) &&
+ ((token_type==DIR_KEYWORD_TT)&&(token_value==INITIAL_DK)))
+ data_type=DATA_AI;
+ else if ((!array_flag) &&
+ ((token_type==DIR_KEYWORD_TT)&&(token_value==INITSTR_DK)))
+ data_type=ASCII_AI;
+
+ else if ((token_type==SEP_TT)&&(token_value==ARROW_SEP))
+ array_type = BYTE_ARRAY;
+ else if ((token_type==SEP_TT)&&(token_value==DARROW_SEP))
+ array_type = WORD_ARRAY;
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==STRING_DK))
+ array_type = STRING_ARRAY;
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==TABLE_DK))
+ array_type = TABLE_ARRAY;
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==BUFFER_DK))
+ array_type = BUFFER_ARRAY;
+ else
+ { discard_token_location(beginning_debug_location);
+ if (array_flag)
+ ebf_error
+ ("'->', '-->', 'string', 'table' or 'buffer'", token_text);
+ else
+ ebf_error
+ ("'=', '->', '-->', 'string', 'table' or 'buffer'", token_text);
+ panic_mode_error_recovery();
+ return;
+ }
+
+ array_entry_size=1;
+ if ((array_type==WORD_ARRAY) || (array_type==TABLE_ARRAY))
+ array_entry_size=WORDSIZE;
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { discard_token_location(beginning_debug_location);
+ error("No array size or initial values given");
+ put_token_back();
+ return;
+ }
+
+ switch(data_type)
+ { case UNSPECIFIED_AI:
+ if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
+ data_type = BRACKET_AI;
+ else
+ { data_type = NULLS_AI;
+ if (token_type == DQ_TT) data_type = ASCII_AI;
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ data_type = DATA_AI;
+ put_token_back();
+ put_token_back();
+ }
+ break;
+ case NULLS_AI: obsolete_warning("use '->' instead of 'data'"); break;
+ case DATA_AI: obsolete_warning("use '->' instead of 'initial'"); break;
+ case ASCII_AI: obsolete_warning("use '->' instead of 'initstr'"); break;
+ }
+
+ array_base = dynamic_array_area_size;
+
+ /* Leave room to write the array size in later, if string/table array */
+
+ if ((array_type==STRING_ARRAY) || (array_type==TABLE_ARRAY))
+ dynamic_array_area_size += array_entry_size;
+ if (array_type==BUFFER_ARRAY)
+ dynamic_array_area_size += WORDSIZE;
+ array_types[no_arrays] = array_type;
+
+ switch(data_type)
+ {
+ case NULLS_AI:
+
+ AO = parse_expression(CONSTANT_CONTEXT);
+
+ CalculatedArraySize:
+
+ if (module_switch && (AO.marker != 0))
+ { error("Array sizes must be known now, not externally defined");
+ break;
+ }
+
+ if (!glulx_mode) {
+ if ((AO.value <= 0) || (AO.value >= 32768))
+ { error("An array must have between 1 and 32767 entries");
+ AO.value = 1;
+ }
+ }
+ else {
+ if (AO.value <= 0 || (AO.value & 0x80000000))
+ { error("An array may not have 0 or fewer entries");
+ AO.value = 1;
+ }
+ }
+
+ { for (i=0; i<AO.value; i++) array_entry(i, zero_operand);
+ }
+ break;
+
+ case DATA_AI:
+
+ /* In this case the array is initialised to the sequence of
+ constant values supplied on the same line */
+
+ i=0;
+ do
+ { get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ break;
+
+ if ((token_type == SEP_TT)
+ && ((token_value == OPEN_SQUARE_SEP)
+ || (token_value == CLOSE_SQUARE_SEP)))
+ { discard_token_location(beginning_debug_location);
+ error("Missing ';' to end the initial array values "
+ "before \"[\" or \"]\"");
+ return;
+ }
+ put_token_back();
+
+ AO = parse_expression(ARRAY_CONTEXT);
+
+ if (i == 0)
+ { get_next_token();
+ put_token_back();
+ if ((token_type == SEP_TT)
+ && (token_value == SEMICOLON_SEP))
+ { data_type = NULLS_AI;
+ goto CalculatedArraySize;
+ }
+ }
+
+ array_entry(i, AO);
+ i++;
+ } while (TRUE);
+ put_token_back();
+ break;
+
+ case ASCII_AI:
+
+ /* In this case the array is initialised to the ASCII values of
+ the characters of a given "quoted string" */
+
+ get_next_token();
+ if (token_type != DQ_TT)
+ { ebf_error("literal text in double-quotes", token_text);
+ token_text = "error";
+ }
+
+ { assembly_operand chars;
+
+ int j;
+ INITAO(&chars);
+ for (i=0,j=0; token_text[j]!=0; i++,j+=textual_form_length)
+ {
+ int32 unicode; int zscii;
+ unicode = text_to_unicode(token_text+j);
+ if (glulx_mode)
+ {
+ if (array_entry_size == 1 && (unicode < 0 || unicode >= 256))
+ {
+ error("Unicode characters beyond Latin-1 cannot be used in a byte array");
+ }
+ else
+ {
+ chars.value = unicode;
+ }
+ }
+ else /* Z-code */
+ {
+ zscii = unicode_to_zscii(unicode);
+ if ((zscii != 5) && (zscii < 0x100)) chars.value = zscii;
+ else
+ { unicode_char_error("Character can only be used if declared in \
+advance as part of 'Zcharacter table':", unicode);
+ chars.value = '?';
+ }
+ }
+ chars.marker = 0;
+ set_constant_ot(&chars);
+ array_entry(i, chars);
+ }
+ }
+ break;
+
+ case BRACKET_AI:
+
+ /* In this case the array is initialised to the sequence of
+ constant values given over a whole range of compiler-lines,
+ between square brackets [ and ] */
+
+ i = 0;
+ while (TRUE)
+ { get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ continue;
+ if ((token_type == SEP_TT) && (token_value == CLOSE_SQUARE_SEP))
+ break;
+ if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
+ { /* Minimal error recovery: we assume that a ] has
+ been missed, and the programmer is now starting
+ a new routine */
+
+ ebf_error("']'", token_text);
+ put_token_back(); break;
+ }
+ put_token_back();
+ array_entry(i, parse_expression(ARRAY_CONTEXT));
+ i++;
+ }
+ }
+
+ finish_array(i);
+
+ if (debugfile_switch)
+ { debug_file_printf("<array>");
+ debug_file_printf("<identifier>%s</identifier>", global_name);
+ debug_file_printf("<value>");
+ write_debug_array_backpatch(svals[global_symbol]);
+ debug_file_printf("</value>");
+ debug_file_printf
+ ("<byte-count>%d</byte-count>",
+ dynamic_array_area_size - array_base);
+ debug_file_printf
+ ("<bytes-per-element>%d</bytes-per-element>",
+ array_entry_size);
+ debug_file_printf
+ ("<zeroth-element-holds-length>%s</zeroth-element-holds-length>",
+ (array_type == STRING_ARRAY || array_type == TABLE_ARRAY) ?
+ "true" : "false");
+ get_next_token();
+ write_debug_locations(get_token_location_end(beginning_debug_location));
+ put_token_back();
+ debug_file_printf("</array>");
+ }
+
+ if ((array_type==BYTE_ARRAY) || (array_type==WORD_ARRAY)) i--;
+ if (array_type==BUFFER_ARRAY) i+=WORDSIZE-1;
+ array_sizes[no_arrays++] = i;
+}
+
+extern int32 begin_table_array(void)
+{
+ /* The "box" statement needs to be able to construct (static) table
+ arrays of strings like this */
+
+ array_base = dynamic_array_area_size;
+ array_entry_size = WORDSIZE;
+
+ /* Leave room to write the array size in later */
+
+ dynamic_array_area_size += array_entry_size;
+
+ if (!glulx_mode)
+ return array_base;
+ else
+ return array_base - WORDSIZE * MAX_GLOBAL_VARIABLES;
+}
+
+extern int32 begin_word_array(void)
+{
+ /* The "random(a, b, ...)" function needs to be able to construct
+ (static) word arrays like this */
+
+ array_base = dynamic_array_area_size;
+ array_entry_size = WORDSIZE;
+
+ if (!glulx_mode)
+ return array_base;
+ else
+ return array_base - WORDSIZE * MAX_GLOBAL_VARIABLES;
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_arrays_vars(void)
+{ dynamic_array_area = NULL;
+ global_initial_value = NULL;
+ array_sizes = NULL; array_symbols = NULL; array_types = NULL;
+}
+
+extern void arrays_begin_pass(void)
+{ no_arrays = 0;
+ if (!glulx_mode)
+ no_globals=0;
+ else
+ no_globals=11;
+ dynamic_array_area_size = WORDSIZE * MAX_GLOBAL_VARIABLES;
+}
+
+extern void arrays_allocate_arrays(void)
+{ dynamic_array_area = my_calloc(sizeof(int), MAX_STATIC_DATA,
+ "static data");
+ array_sizes = my_calloc(sizeof(int), MAX_ARRAYS, "array sizes");
+ array_types = my_calloc(sizeof(int), MAX_ARRAYS, "array types");
+ array_symbols = my_calloc(sizeof(int32), MAX_ARRAYS, "array symbols");
+ global_initial_value = my_calloc(sizeof(int32), MAX_GLOBAL_VARIABLES,
+ "global values");
+}
+
+extern void arrays_free_arrays(void)
+{ my_free(&dynamic_array_area, "static data");
+ my_free(&global_initial_value, "global values");
+ my_free(&array_sizes, "array sizes");
+ my_free(&array_types, "array sizes");
+ my_free(&array_symbols, "array sizes");
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "asm" : The Inform assembler */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+uchar *zcode_holding_area; /* Area holding code yet to be transferred
+ to either zcode_area or temp file no 1 */
+uchar *zcode_markers; /* Bytes holding marker values for this
+ code */
+static int zcode_ha_size; /* Number of bytes in holding area */
+
+memory_block zcode_area; /* Block to hold assembled code (if
+ temporary files are not being used) */
+
+int32 zmachine_pc; /* PC position of assembly (byte offset
+ from start of Z-code area) */
+
+int32 no_instructions; /* Number of instructions assembled */
+int execution_never_reaches_here, /* TRUE if the current PC value in the
+ code area cannot be reached: e.g. if
+ the previous instruction was a "quit"
+ opcode and no label is set to here */
+ next_label, /* Used to count the labels created all
+ over Inform in current routine, from 0 */
+ next_sequence_point; /* Likewise, for sequence points */
+int no_sequence_points; /* Kept for statistics purposes only */
+
+static int label_moved_error_already_given;
+ /* When one label has moved, all subsequent
+ ones probably have too, and this flag
+ suppresses the runaway chain of error
+ messages which would otherwise result */
+
+int sequence_point_follows; /* Will the next instruction assembled */
+ /* be at a sequence point in the routine? */
+
+int uses_unicode_features; /* Makes use of Glulx Unicode (3.0)
+ features? */
+int uses_memheap_features; /* Makes use of Glulx mem/heap (3.1)
+ features? */
+int uses_acceleration_features; /* Makes use of Glulx acceleration (3.1.1)
+ features? */
+int uses_float_features; /* Makes use of Glulx floating-point (3.1.2)
+ features? */
+
+debug_location statement_debug_location;
+ /* Location of current statement */
+
+
+int32 *variable_tokens; /* The allocated size is
+ (MAX_LOCAL_VARIABLES +
+ MAX_GLOBAL_VARIABLES). The entries
+ MAX_LOCAL_VARIABLES and up give the
+ symbol table index for the names of
+ the global variables */
+int *variable_usage; /* TRUE if referred to, FALSE otherwise */
+
+assembly_instruction AI; /* A structure used to hold the full
+ specification of a single Z-code
+ instruction: effectively this is the
+ input to the routine
+ assemble_instruction() */
+
+static char opcode_syntax_string[128]; /* Text buffer holding the correct
+ syntax for an opcode: used to produce
+ helpful assembler error messages */
+
+static int routine_symbol; /* The symbol index of the routine currently
+ being compiled */
+static char *routine_name; /* The name of the routine currently being
+ compiled */
+static int routine_locals; /* The number of local variables used by
+ the routine currently being compiled */
+
+static int32 routine_start_pc;
+
+int32 *named_routine_symbols;
+
+static void transfer_routine_z(void);
+static void transfer_routine_g(void);
+
+/* ------------------------------------------------------------------------- */
+/* Label data */
+/* ------------------------------------------------------------------------- */
+
+static int first_label, last_label;
+static int32 *label_offsets; /* Double-linked list of label offsets */
+static int *label_next, /* (i.e. zmachine_pc values) in PC order */
+ *label_prev;
+static int32 *label_symbols; /* Symbol numbers if defined in source */
+
+static int *sequence_point_labels;
+ /* Label numbers for each */
+static debug_location *sequence_point_locations;
+ /* Source code references for each */
+ /* (used for making debugging file) */
+
+static void set_label_offset(int label, int32 offset)
+{
+ if (label >= MAX_LABELS) memoryerror("MAX_LABELS", MAX_LABELS);
+
+ label_offsets[label] = offset;
+ if (last_label == -1)
+ { label_prev[label] = -1;
+ first_label = label;
+ }
+ else
+ { label_prev[label] = last_label;
+ label_next[last_label] = label;
+ }
+ last_label = label;
+ label_next[label] = -1;
+ label_symbols[label] = -1;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Useful tool for building operands */
+/* ------------------------------------------------------------------------- */
+
+extern void set_constant_ot(assembly_operand *AO)
+{
+ if (!glulx_mode) {
+ if (AO->value >= 0 && AO->value <= 255)
+ AO->type = SHORT_CONSTANT_OT;
+ else
+ AO->type = LONG_CONSTANT_OT;
+ }
+ else {
+ if (AO->value == 0)
+ AO->type = ZEROCONSTANT_OT;
+ else if (AO->value >= -0x80 && AO->value < 0x80)
+ AO->type = BYTECONSTANT_OT;
+ else if (AO->value >= -0x8000 && AO->value < 0x8000)
+ AO->type = HALFCONSTANT_OT;
+ else
+ AO->type = CONSTANT_OT;
+ }
+}
+
+extern int is_constant_ot(int otval)
+{
+ if (!glulx_mode) {
+ return ((otval == LONG_CONSTANT_OT)
+ || (otval == SHORT_CONSTANT_OT));
+ }
+ else {
+ return ((otval == CONSTANT_OT)
+ || (otval == HALFCONSTANT_OT)
+ || (otval == BYTECONSTANT_OT)
+ || (otval == ZEROCONSTANT_OT));
+ }
+}
+
+extern int is_variable_ot(int otval)
+{
+ if (!glulx_mode) {
+ return (otval == VARIABLE_OT);
+ }
+ else {
+ return ((otval == LOCALVAR_OT)
+ || (otval == GLOBALVAR_OT));
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Used in printing assembly traces */
+/* ------------------------------------------------------------------------- */
+
+extern char *variable_name(int32 i)
+{
+ if (i==0) return("sp");
+ if (i<MAX_LOCAL_VARIABLES) return local_variable_texts[i-1];
+
+ if (!glulx_mode) {
+ if (i==255) return("TEMP1");
+ if (i==254) return("TEMP2");
+ if (i==253) return("TEMP3");
+ if (i==252) return("TEMP4");
+ if (i==251) return("self");
+ if (i==250) return("sender");
+ if (i==249) return("sw__var");
+ if (i >= 256 && i < 286)
+ { if (i - 256 < NUMBER_SYSTEM_FUNCTIONS) return system_functions.keywords[i - 256];
+ return "<unnamed system function>";
+ }
+ }
+ else {
+ switch (i - MAX_LOCAL_VARIABLES) {
+ case 0: return "temp_global";
+ case 1: return "temp__global2";
+ case 2: return "temp__global3";
+ case 3: return "temp__global4";
+ case 4: return "self";
+ case 5: return "sender";
+ case 6: return "sw__var";
+ case 7: return "sys__glob0";
+ case 8: return "sys__glob1";
+ case 9: return "sys__glob2";
+ case 10: return "sys_statusline_flag";
+ }
+ }
+
+ return ((char *) symbs[variable_tokens[i]]);
+}
+
+static void print_operand_z(assembly_operand o)
+{ switch(o.type)
+ { case EXPRESSION_OT: printf("expr_"); break;
+ case LONG_CONSTANT_OT: printf("long_"); break;
+ case SHORT_CONSTANT_OT: printf("short_"); break;
+ case VARIABLE_OT:
+ if (o.value==0) { printf("sp"); return; }
+ printf("%s", variable_name(o.value)); return;
+ case OMITTED_OT: printf("<no value>"); return;
+ }
+ printf("%d", o.value);
+}
+
+static void print_operand_g(assembly_operand o)
+{
+ switch (o.type) {
+ case EXPRESSION_OT: printf("expr_"); break;
+ case CONSTANT_OT: printf("long_"); break;
+ case HALFCONSTANT_OT: printf("short_"); break;
+ case BYTECONSTANT_OT: printf("byte_"); break;
+ case ZEROCONSTANT_OT: printf("zero_"); return;
+ case DEREFERENCE_OT: printf("*"); break;
+ case GLOBALVAR_OT:
+ printf("%s (global_%d)", variable_name(o.value), o.value);
+ return;
+ case LOCALVAR_OT:
+ if (o.value == 0)
+ printf("stackptr");
+ else
+ printf("%s (local_%d)", variable_name(o.value), o.value-1);
+ return;
+ case SYSFUN_OT:
+ if (o.value >= 0 && o.value < NUMBER_SYSTEM_FUNCTIONS)
+ printf("%s", system_functions.keywords[o.value]);
+ else
+ printf("<unnamed system function>");
+ return;
+ case OMITTED_OT: printf("<no value>"); return;
+ default: printf("???_"); break;
+ }
+ printf("%d", o.value);
+}
+
+extern void print_operand(assembly_operand o)
+{
+ if (!glulx_mode)
+ print_operand_z(o);
+ else
+ print_operand_g(o);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Writing bytes to the code area */
+/* ------------------------------------------------------------------------- */
+
+static void byteout(int32 i, int mv)
+{ if (zcode_ha_size >= MAX_ZCODE_SIZE)
+ memoryerror("MAX_ZCODE_SIZE",MAX_ZCODE_SIZE);
+ zcode_markers[zcode_ha_size] = (uchar) mv;
+ zcode_holding_area[zcode_ha_size++] = (uchar) i;
+ zmachine_pc++;
+}
+
+/* ------------------------------------------------------------------------- */
+/* A database of the 115 canonical Infocom opcodes in Versions 3 to 6 */
+/* And of the however-many-there-are Glulx opcode */
+/* ------------------------------------------------------------------------- */
+
+typedef struct opcodez
+{ uchar *name; /* Lower case standard name */
+ int version1; /* Valid from this version number... */
+ int version2; /* ...until this one (or forever if this is 0) */
+ int extension; /* In later versions, see this line in extension table:
+ if -1, the opcode is illegal in later versions */
+ int code; /* Opcode number within its operand-number block */
+ int flags; /* Flags (see below) */
+ int op_rules; /* Any unusual operand rule applying (see below) */
+ int flags2_set; /* If not zero, set this bit in Flags 2 in the header
+ of any game using the opcode */
+ int no; /* Number of operands (see below) */
+} opcodez;
+
+typedef struct opcodeg
+{ uchar *name; /* Lower case standard name */
+ int32 code; /* Opcode number */
+ int flags; /* Flags (see below) */
+ int op_rules; /* Any unusual operand rule applying (see below) */
+ int no; /* Number of operands */
+} opcodeg;
+
+ /* Flags which can be set */
+
+#define St 1 /* Store */
+#define Br 2 /* Branch */
+#define Rf 4 /* "Return flag": execution never continues after this
+ opcode (e.g., is a return or unconditional jump) */
+#define St2 8 /* Store2 (second-to-last operand is store (Glulx)) */
+
+ /* Codes for any unusual operand assembly rules */
+
+ /* Z-code: */
+
+#define VARIAB 1 /* First operand expected to be a variable name and
+ assembled to a short constant: the variable number */
+#define TEXT 2 /* One text operand, to be Z-encoded into the program */
+#define LABEL 3 /* One operand, a label, given as long constant offset */
+#define CALL 4 /* First operand is name of a routine, to be assembled
+ as long constant (the routine's packed address):
+ as if the name were prefixed by #r$ */
+
+ /* Glulx: (bit flags for Glulx VM features) */
+
+#define GOP_Unicode 1 /* uses_unicode_features */
+#define GOP_MemHeap 2 /* uses_memheap_features */
+#define GOP_Acceleration 4 /* uses_acceleration_features */
+#define GOP_Float 8 /* uses_float_features */
+
+ /* Codes for the number of operands */
+
+#define TWO 1 /* 2 (with certain types of operand, compiled as VAR) */
+#define VAR 2 /* 0 to 4 */
+#define VAR_LONG 3 /* 0 to 8 */
+#define ONE 4 /* 1 */
+#define ZERO 5 /* 0 */
+#define EXT 6 /* Extended opcode set VAR: 0 to 4 */
+#define EXT_LONG 7 /* Extended: 0 to 8 (not used by the canonical opcodes) */
+
+static opcodez opcodes_table_z[] =
+{
+ /* Opcodes introduced in Version 3 */
+
+/* 0 */ { (uchar *) "je", 3, 0, -1, 0x01, Br, 0, 0, TWO },
+/* 1 */ { (uchar *) "jl", 3, 0, -1, 0x02, Br, 0, 0, TWO },
+/* 2 */ { (uchar *) "jg", 3, 0, -1, 0x03, Br, 0, 0, TWO },
+/* 3 */ { (uchar *) "dec_chk", 3, 0, -1, 0x04, Br, VARIAB, 0, TWO },
+/* 4 */ { (uchar *) "inc_chk", 3, 0, -1, 0x05, Br, VARIAB, 0, TWO },
+/* 5 */ { (uchar *) "jin", 3, 0, -1, 0x06, Br, 0, 0, TWO },
+/* 6 */ { (uchar *) "test", 3, 0, -1, 0x07, Br, 0, 0, TWO },
+/* 7 */ { (uchar *) "or", 3, 0, -1, 0x08, St, 0, 0, TWO },
+/* 8 */ { (uchar *) "and", 3, 0, -1, 0x09, St, 0, 0, TWO },
+/* 9 */ { (uchar *) "test_attr", 3, 0, -1, 0x0A, Br, 0, 0, TWO },
+/* 10 */ {(uchar *) "set_attr", 3, 0, -1, 0x0B, 0, 0, 0, TWO },
+/* 11 */ {(uchar *) "clear_attr", 3, 0, -1, 0x0C, 0, 0, 0, TWO },
+/* 12 */ {(uchar *) "store", 3, 0, -1, 0x0D, 0, VARIAB, 0, TWO },
+/* 13 */ {(uchar *) "insert_obj", 3, 0, -1, 0x0E, 0, 0, 0, TWO },
+/* 14 */ {(uchar *) "loadw", 3, 0, -1, 0x0F, St, 0, 0, TWO },
+/* 15 */ {(uchar *) "loadb", 3, 0, -1, 0x10, St, 0, 0, TWO },
+/* 16 */ {(uchar *) "get_prop", 3, 0, -1, 0x11, St, 0, 0, TWO },
+/* 17 */ {(uchar *) "get_prop_addr", 3, 0, -1, 0x12, St, 0, 0, TWO },
+/* 18 */ {(uchar *) "get_next_prop", 3, 0, -1, 0x13, St, 0, 0, TWO },
+/* 19 */ {(uchar *) "add", 3, 0, -1, 0x14, St, 0, 0, TWO },
+/* 20 */ {(uchar *) "sub", 3, 0, -1, 0x15, St, 0, 0, TWO },
+/* 21 */ {(uchar *) "mul", 3, 0, -1, 0x16, St, 0, 0, TWO },
+/* 22 */ {(uchar *) "div", 3, 0, -1, 0x17, St, 0, 0, TWO },
+/* 23 */ {(uchar *) "mod", 3, 0, -1, 0x18, St, 0, 0, TWO },
+/* 24 */ {(uchar *) "call", 3, 0, -1, 0x20, St, CALL, 0, VAR },
+/* 25 */ {(uchar *) "storew", 3, 0, -1, 0x21, 0, 0, 0, VAR },
+/* 26 */ {(uchar *) "storeb", 3, 0, -1, 0x22, 0, 0, 0, VAR },
+/* 27 */ {(uchar *) "put_prop", 3, 0, -1, 0x23, 0, 0, 0, VAR },
+ /* This is the version of "read" called "sread" internally: */
+/* 28 */ {(uchar *) "read", 3, 0, -1, 0x24, 0, 0, 0, VAR },
+/* 29 */ {(uchar *) "print_char", 3, 0, -1, 0x25, 0, 0, 0, VAR },
+/* 30 */ {(uchar *) "print_num", 3, 0, -1, 0x26, 0, 0, 0, VAR },
+/* 31 */ {(uchar *) "random", 3, 0, -1, 0x27, St, 0, 0, VAR },
+/* 32 */ {(uchar *) "push", 3, 0, -1, 0x28, 0, 0, 0, VAR },
+/* 33 */ {(uchar *) "pull", 3, 5, 6, 0x29, 0, VARIAB, 0, VAR },
+/* 34 */ {(uchar *) "split_window", 3, 0, -1, 0x2A, 0, 0, 0, VAR },
+/* 35 */ {(uchar *) "set_window", 3, 0, -1, 0x2B, 0, 0, 0, VAR },
+/* 36 */ {(uchar *) "output_stream", 3, 0, -1, 0x33, 0, 0, 0, VAR },
+/* 37 */ {(uchar *) "input_stream", 3, 0, -1, 0x34, 0, 0, 0, VAR },
+/* 38 */ {(uchar *) "sound_effect", 3, 0, -1, 0x35, 0, 0, 7, VAR },
+/* 39 */ {(uchar *) "jz", 3, 0, -1, 0x00, Br, 0, 0, ONE },
+/* 40 */ {(uchar *) "get_sibling", 3, 0, -1, 0x01, St+Br, 0, 0, ONE },
+/* 41 */ {(uchar *) "get_child", 3, 0, -1, 0x02, St+Br, 0, 0, ONE },
+/* 42 */ {(uchar *) "get_parent", 3, 0, -1, 0x03, St, 0, 0, ONE },
+/* 43 */ {(uchar *) "get_prop_len", 3, 0, -1, 0x04, St, 0, 0, ONE },
+/* 44 */ {(uchar *) "inc", 3, 0, -1, 0x05, 0, VARIAB, 0, ONE },
+/* 45 */ {(uchar *) "dec", 3, 0, -1, 0x06, 0, VARIAB, 0, ONE },
+/* 46 */ {(uchar *) "print_addr", 3, 0, -1, 0x07, 0, 0, 0, ONE },
+/* 47 */ {(uchar *) "remove_obj", 3, 0, -1, 0x09, 0, 0, 0, ONE },
+/* 48 */ {(uchar *) "print_obj", 3, 0, -1, 0x0A, 0, 0, 0, ONE },
+/* 49 */ {(uchar *) "ret", 3, 0, -1, 0x0B, Rf, 0, 0, ONE },
+/* 50 */ {(uchar *) "jump", 3, 0, -1, 0x0C, Rf, LABEL, 0, ONE },
+/* 51 */ {(uchar *) "print_paddr", 3, 0, -1, 0x0D, 0, 0, 0, ONE },
+/* 52 */ {(uchar *) "load", 3, 0, -1, 0x0E, St, VARIAB, 0, ONE },
+/* 53 */ {(uchar *) "not", 3, 3, 0, 0x0F, St, 0, 0, ONE },
+/* 54 */ {(uchar *) "rtrue", 3, 0, -1, 0x00, Rf, 0, 0,ZERO },
+/* 55 */ {(uchar *) "rfalse", 3, 0, -1, 0x01, Rf, 0, 0,ZERO },
+/* 56 */ {(uchar *) "print", 3, 0, -1, 0x02, 0, TEXT, 0,ZERO },
+/* 57 */ {(uchar *) "print_ret", 3, 0, -1, 0x03, Rf, TEXT, 0,ZERO },
+/* 58 */ {(uchar *) "nop", 3, 0, -1, 0x04, 0, 0, 0,ZERO },
+/* 59 */ {(uchar *) "save", 3, 3, 1, 0x05, Br, 0, 0,ZERO },
+/* 60 */ {(uchar *) "restore", 3, 3, 2, 0x06, Br, 0, 0,ZERO },
+/* 61 */ {(uchar *) "restart", 3, 0, -1, 0x07, 0, 0, 0,ZERO },
+/* 62 */ {(uchar *) "ret_popped", 3, 0, -1, 0x08, Rf, 0, 0,ZERO },
+/* 63 */ {(uchar *) "pop", 3, 4, -1, 0x09, 0, 0, 0,ZERO },
+/* 64 */ {(uchar *) "quit", 3, 0, -1, 0x0A, Rf, 0, 0,ZERO },
+/* 65 */ {(uchar *) "new_line", 3, 0, -1, 0x0B, 0, 0, 0,ZERO },
+/* 66 */ {(uchar *) "show_status", 3, 3, -1, 0x0C, 0, 0, 0,ZERO },
+/* 67 */ {(uchar *) "verify", 3, 0, -1, 0x0D, Br, 0, 0,ZERO },
+
+ /* Opcodes introduced in Version 4 */
+
+/* 68 */ {(uchar *) "call_2s", 4, 0, -1, 0x19, St, CALL, 0, TWO },
+/* 69 */ {(uchar *) "call_vs", 4, 0, -1, 0x20, St, CALL, 0, VAR },
+ /* This is the version of "read" called "aread" internally: */
+/* 70 */ {(uchar *) "read", 4, 0, -1, 0x24, St, 0, 0, VAR },
+/* 71 */ {(uchar *) "call_vs2", 4, 0, -1, 0x2C, St, CALL, 0,
+ VAR_LONG },
+/* 72 */ {(uchar *) "erase_window", 4, 0, -1, 0x2D, 0, 0, 0, VAR },
+/* 73 */ {(uchar *) "erase_line", 4, 0, -1, 0x2E, 0, 0, 0, VAR },
+/* 74 */ {(uchar *) "set_cursor", 4, 0, -1, 0x2F, 0, 0, 0, VAR },
+/* 75 */ {(uchar *) "get_cursor", 4, 0, -1, 0x30, 0, 0, 0, VAR },
+/* 76 */ {(uchar *) "set_text_style", 4, 0, -1, 0x31, 0, 0, 0, VAR },
+/* 77 */ {(uchar *) "buffer_mode", 4, 0, -1, 0x32, 0, 0, 0, VAR },
+/* 78 */ {(uchar *) "read_char", 4, 0, -1, 0x36, St, 0, 0, VAR },
+/* 79 */ {(uchar *) "scan_table", 4, 0, -1, 0x37, St+Br, 0, 0, VAR },
+/* 80 */ {(uchar *) "call_1s", 4, 0, -1, 0x08, St, CALL, 0, ONE },
+
+ /* Opcodes introduced in Version 5 */
+
+/* 81 */ {(uchar *) "call_2n", 5, 0, -1, 0x1a, 0, CALL, 0, TWO },
+/* 82 */ {(uchar *) "set_colour", 5, 0, -1, 0x1b, 0, 0, 6, TWO },
+/* 83 */ {(uchar *) "throw", 5, 0, -1, 0x1c, 0, 0, 0, TWO },
+/* 84 */ {(uchar *) "call_vn", 5, 0, -1, 0x39, 0, CALL, 0, VAR },
+/* 85 */ {(uchar *) "call_vn2", 5, 0, -1, 0x3a, 0, CALL, 0,
+ VAR_LONG },
+/* 86 */ {(uchar *) "tokenise", 5, 0, -1, 0x3b, 0, 0, 0, VAR },
+/* 87 */ {(uchar *) "encode_text", 5, 0, -1, 0x3c, 0, 0, 0, VAR },
+/* 88 */ {(uchar *) "copy_table", 5, 0, -1, 0x3d, 0, 0, 0, VAR },
+/* 89 */ {(uchar *) "print_table", 5, 0, -1, 0x3e, 0, 0, 0, VAR },
+/* 90 */ {(uchar *) "check_arg_count", 5, 0, -1, 0x3f, Br, 0, 0, VAR },
+/* 91 */ {(uchar *) "call_1n", 5, 0, -1, 0x0F, 0, CALL, 0, ONE },
+/* 92 */ {(uchar *) "catch", 5, 0, -1, 0x09, St, 0, 0, ZERO },
+/* 93 */ {(uchar *) "piracy", 5, 0, -1, 0x0F, Br, 0, 0, ZERO },
+/* 94 */ {(uchar *) "log_shift", 5, 0, -1, 0x02, St, 0, 0, EXT },
+/* 95 */ {(uchar *) "art_shift", 5, 0, -1, 0x03, St, 0, 0, EXT },
+/* 96 */ {(uchar *) "set_font", 5, 0, -1, 0x04, St, 0, 0, EXT },
+/* 97 */ {(uchar *) "save_undo", 5, 0, -1, 0x09, St, 0, 4, EXT },
+/* 98 */ {(uchar *) "restore_undo", 5, 0, -1, 0x0A, St, 0, 4, EXT },
+
+ /* Opcodes introduced in Version 6 */
+
+/* 99 */ { (uchar *) "draw_picture", 6, 6, -1, 0x05, 0, 0, 3, EXT },
+/* 100 */ { (uchar *) "picture_data", 6, 6, -1, 0x06, Br, 0, 3, EXT },
+/* 101 */ { (uchar *) "erase_picture", 6, 6, -1, 0x07, 0, 0, 3, EXT },
+/* 102 */ { (uchar *) "set_margins", 6, 6, -1, 0x08, 0, 0, 0, EXT },
+/* 103 */ { (uchar *) "move_window", 6, 6, -1, 0x10, 0, 0, 0, EXT },
+/* 104 */ { (uchar *) "window_size", 6, 6, -1, 0x11, 0, 0, 0, EXT },
+/* 105 */ { (uchar *) "window_style", 6, 6, -1, 0x12, 0, 0, 0, EXT },
+/* 106 */ { (uchar *) "get_wind_prop", 6, 6, -1, 0x13, St, 0, 0, EXT },
+/* 107 */ { (uchar *) "scroll_window", 6, 6, -1, 0x14, 0, 0, 0, EXT },
+/* 108 */ { (uchar *) "pop_stack", 6, 6, -1, 0x15, 0, 0, 0, EXT },
+/* 109 */ { (uchar *) "read_mouse", 6, 6, -1, 0x16, 0, 0, 5, EXT },
+/* 110 */ { (uchar *) "mouse_window", 6, 6, -1, 0x17, 0, 0, 5, EXT },
+/* 111 */ { (uchar *) "push_stack", 6, 6, -1, 0x18, Br, 0, 0, EXT },
+/* 112 */ { (uchar *) "put_wind_prop", 6, 6, -1, 0x19, 0, 0, 0, EXT },
+/* 113 */ { (uchar *) "print_form", 6, 6, -1, 0x1a, 0, 0, 0, EXT },
+/* 114 */ { (uchar *) "make_menu", 6, 6, -1, 0x1b, Br, 0, 8, EXT },
+/* 115 */ { (uchar *) "picture_table", 6, 6, -1, 0x1c, 0, 0, 3, EXT },
+
+ /* 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 }
+};
+
+ /* Subsequent forms for opcodes whose meaning changes with version */
+
+static opcodez extension_table_z[] =
+{
+/* 0 */ { (uchar *) "not", 4, 4, 3, 0x0F, St, 0, 0, ONE },
+/* 1 */ { (uchar *) "save", 4, 4, 4, 0x05, St, 0, 0,ZERO },
+/* 2 */ { (uchar *) "restore", 4, 4, 5, 0x06, St, 0, 0,ZERO },
+/* 3 */ { (uchar *) "not", 5, 0, -1, 0x38, St, 0, 0, VAR },
+/* 4 */ { (uchar *) "save", 5, 0, -1, 0x00, St, 0, 0, EXT },
+/* 5 */ { (uchar *) "restore", 5, 0, -1, 0x01, St, 0, 0, EXT },
+/* 6 */ { (uchar *) "pull", 6, 6, -1, 0x29, St, 0, 0, VAR }
+};
+
+static opcodez invalid_opcode_z =
+ { (uchar *) "invalid", 0, 0, -1, 0xff, 0, 0, 0, ZERO};
+
+static opcodez custom_opcode_z;
+
+/* Note that this table assumes that all opcodes have at most two
+ branch-label or store operands, and that if they exist, they are the
+ last operands. Glulx does not actually guarantee this. But it is
+ true for all opcodes in the current Glulx spec, so we will assume
+ it for now.
+
+ Also note that Inform can only compile branches to constant offsets,
+ even though the Glulx machine can handle stack or memory-loaded
+ operands in a branch instruction.
+*/
+
+static opcodeg opcodes_table_g[] = {
+ { (uchar *) "nop", 0x00, 0, 0, 0 },
+ { (uchar *) "add", 0x10, St, 0, 3 },
+ { (uchar *) "sub", 0x11, St, 0, 3 },
+ { (uchar *) "mul", 0x12, St, 0, 3 },
+ { (uchar *) "div", 0x13, St, 0, 3 },
+ { (uchar *) "mod", 0x14, St, 0, 3 },
+ { (uchar *) "neg", 0x15, St, 0, 2 },
+ { (uchar *) "bitand", 0x18, St, 0, 3 },
+ { (uchar *) "bitor", 0x19, St, 0, 3 },
+ { (uchar *) "bitxor", 0x1A, St, 0, 3 },
+ { (uchar *) "bitnot", 0x1B, St, 0, 2 },
+ { (uchar *) "shiftl", 0x1C, St, 0, 3 },
+ { (uchar *) "sshiftr", 0x1D, St, 0, 3 },
+ { (uchar *) "ushiftr", 0x1E, St, 0, 3 },
+ { (uchar *) "jump", 0x20, Br|Rf, 0, 1 },
+ { (uchar *) "jz", 0x22, Br, 0, 2 },
+ { (uchar *) "jnz", 0x23, Br, 0, 2 },
+ { (uchar *) "jeq", 0x24, Br, 0, 3 },
+ { (uchar *) "jne", 0x25, Br, 0, 3 },
+ { (uchar *) "jlt", 0x26, Br, 0, 3 },
+ { (uchar *) "jge", 0x27, Br, 0, 3 },
+ { (uchar *) "jgt", 0x28, Br, 0, 3 },
+ { (uchar *) "jle", 0x29, Br, 0, 3 },
+ { (uchar *) "jltu", 0x2A, Br, 0, 3 },
+ { (uchar *) "jgeu", 0x2B, Br, 0, 3 },
+ { (uchar *) "jgtu", 0x2C, Br, 0, 3 },
+ { (uchar *) "jleu", 0x2D, Br, 0, 3 },
+ { (uchar *) "call", 0x30, St, 0, 3 },
+ { (uchar *) "return", 0x31, Rf, 0, 1 },
+ { (uchar *) "catch", 0x32, Br|St, 0, 2 },
+ { (uchar *) "throw", 0x33, Rf, 0, 2 },
+ { (uchar *) "tailcall", 0x34, Rf, 0, 2 },
+ { (uchar *) "copy", 0x40, St, 0, 2 },
+ { (uchar *) "copys", 0x41, St, 0, 2 },
+ { (uchar *) "copyb", 0x42, St, 0, 2 },
+ { (uchar *) "sexs", 0x44, St, 0, 2 },
+ { (uchar *) "sexb", 0x45, St, 0, 2 },
+ { (uchar *) "aload", 0x48, St, 0, 3 },
+ { (uchar *) "aloads", 0x49, St, 0, 3 },
+ { (uchar *) "aloadb", 0x4A, St, 0, 3 },
+ { (uchar *) "aloadbit", 0x4B, St, 0, 3 },
+ { (uchar *) "astore", 0x4C, 0, 0, 3 },
+ { (uchar *) "astores", 0x4D, 0, 0, 3 },
+ { (uchar *) "astoreb", 0x4E, 0, 0, 3 },
+ { (uchar *) "astorebit", 0x4F, 0, 0, 3 },
+ { (uchar *) "stkcount", 0x50, St, 0, 1 },
+ { (uchar *) "stkpeek", 0x51, St, 0, 2 },
+ { (uchar *) "stkswap", 0x52, 0, 0, 0 },
+ { (uchar *) "stkroll", 0x53, 0, 0, 2 },
+ { (uchar *) "stkcopy", 0x54, 0, 0, 1 },
+ { (uchar *) "streamchar", 0x70, 0, 0, 1 },
+ { (uchar *) "streamnum", 0x71, 0, 0, 1 },
+ { (uchar *) "streamstr", 0x72, 0, 0, 1 },
+ { (uchar *) "gestalt", 0x0100, St, 0, 3 },
+ { (uchar *) "debugtrap", 0x0101, 0, 0, 1 },
+ { (uchar *) "getmemsize", 0x0102, St, 0, 1 },
+ { (uchar *) "setmemsize", 0x0103, St, 0, 2 },
+ { (uchar *) "jumpabs", 0x0104, Rf, 0, 1 },
+ { (uchar *) "random", 0x0110, St, 0, 2 },
+ { (uchar *) "setrandom", 0x0111, 0, 0, 1 },
+ { (uchar *) "quit", 0x0120, Rf, 0, 0 },
+ { (uchar *) "verify", 0x0121, St, 0, 1 },
+ { (uchar *) "restart", 0x0122, 0, 0, 0 },
+ { (uchar *) "save", 0x0123, St, 0, 2 },
+ { (uchar *) "restore", 0x0124, St, 0, 2 },
+ { (uchar *) "saveundo", 0x0125, St, 0, 1 },
+ { (uchar *) "restoreundo", 0x0126, St, 0, 1 },
+ { (uchar *) "protect", 0x0127, 0, 0, 2 },
+ { (uchar *) "glk", 0x0130, St, 0, 3 },
+ { (uchar *) "getstringtbl", 0x0140, St, 0, 1 },
+ { (uchar *) "setstringtbl", 0x0141, 0, 0, 1 },
+ { (uchar *) "getiosys", 0x0148, St|St2, 0, 2 },
+ { (uchar *) "setiosys", 0x0149, 0, 0, 2 },
+ { (uchar *) "linearsearch", 0x0150, St, 0, 8 },
+ { (uchar *) "binarysearch", 0x0151, St, 0, 8 },
+ { (uchar *) "linkedsearch", 0x0152, St, 0, 7 },
+ { (uchar *) "callf", 0x0160, St, 0, 2 },
+ { (uchar *) "callfi", 0x0161, St, 0, 3 },
+ { (uchar *) "callfii", 0x0162, St, 0, 4 },
+ { (uchar *) "callfiii", 0x0163, St, 0, 5 },
+ { (uchar *) "streamunichar", 0x73, 0, GOP_Unicode, 1 },
+ { (uchar *) "mzero", 0x170, 0, GOP_MemHeap, 2 },
+ { (uchar *) "mcopy", 0x171, 0, GOP_MemHeap, 3 },
+ { (uchar *) "malloc", 0x178, St, GOP_MemHeap, 2 },
+ { (uchar *) "mfree", 0x179, 0, GOP_MemHeap, 1 },
+ { (uchar *) "accelfunc", 0x180, 0, GOP_Acceleration, 2 },
+ { (uchar *) "accelparam", 0x181, 0, GOP_Acceleration, 2 },
+ { (uchar *) "numtof", 0x190, St, GOP_Float, 2 },
+ { (uchar *) "ftonumz", 0x191, St, GOP_Float, 2 },
+ { (uchar *) "ftonumn", 0x192, St, GOP_Float, 2 },
+ { (uchar *) "ceil", 0x198, St, GOP_Float, 2 },
+ { (uchar *) "floor", 0x199, St, GOP_Float, 2 },
+ { (uchar *) "fadd", 0x1A0, St, GOP_Float, 3 },
+ { (uchar *) "fsub", 0x1A1, St, GOP_Float, 3 },
+ { (uchar *) "fmul", 0x1A2, St, GOP_Float, 3 },
+ { (uchar *) "fdiv", 0x1A3, St, GOP_Float, 3 },
+ { (uchar *) "fmod", 0x1A4, St|St2, GOP_Float, 4 },
+ { (uchar *) "sqrt", 0x1A8, St, GOP_Float, 2 },
+ { (uchar *) "exp", 0x1A9, St, GOP_Float, 2 },
+ { (uchar *) "log", 0x1AA, St, GOP_Float, 2 },
+ { (uchar *) "pow", 0x1AB, St, GOP_Float, 3 },
+ { (uchar *) "sin", 0x1B0, St, GOP_Float, 2 },
+ { (uchar *) "cos", 0x1B1, St, GOP_Float, 2 },
+ { (uchar *) "tan", 0x1B2, St, GOP_Float, 2 },
+ { (uchar *) "asin", 0x1B3, St, GOP_Float, 2 },
+ { (uchar *) "acos", 0x1B4, St, GOP_Float, 2 },
+ { (uchar *) "atan", 0x1B5, St, GOP_Float, 2 },
+ { (uchar *) "atan2", 0x1B6, St, GOP_Float, 3 },
+ { (uchar *) "jfeq", 0x1C0, Br, GOP_Float, 4 },
+ { (uchar *) "jfne", 0x1C1, Br, GOP_Float, 4 },
+ { (uchar *) "jflt", 0x1C2, Br, GOP_Float, 3 },
+ { (uchar *) "jfle", 0x1C3, Br, GOP_Float, 3 },
+ { (uchar *) "jfgt", 0x1C4, Br, GOP_Float, 3 },
+ { (uchar *) "jfge", 0x1C5, Br, GOP_Float, 3 },
+ { (uchar *) "jisnan", 0x1C8, Br, GOP_Float, 2 },
+ { (uchar *) "jisinf", 0x1C9, Br, GOP_Float, 2 },
+};
+
+/* The opmacros table is used for fake opcodes. The opcode numbers are
+ ignored; this table is only used for argument parsing. */
+static opcodeg opmacros_table_g[] = {
+ { (uchar *) "pull", 0, St, 0, 1 },
+ { (uchar *) "push", 0, 0, 0, 1 },
+};
+
+static opcodeg custom_opcode_g;
+
+static opcodez internal_number_to_opcode_z(int32 i)
+{ opcodez x;
+ ASSERT_ZCODE();
+ if (i == -1) return custom_opcode_z;
+ x = opcodes_table_z[i];
+ if (instruction_set_number < x.version1) return invalid_opcode_z;
+ if (x.version2 == 0) return x;
+ if (instruction_set_number <= x.version2) return x;
+ i = x.extension;
+ if (i < 0) return invalid_opcode_z;
+ x = extension_table_z[i];
+ if (instruction_set_number < x.version1) return invalid_opcode_z;
+ if (x.version2 == 0) return x;
+ if (instruction_set_number <= x.version2) return x;
+ return extension_table_z[x.extension];
+}
+
+static void make_opcode_syntax_z(opcodez opco)
+{ char *p = "", *q = opcode_syntax_string;
+ sprintf(q, "%s", opco.name);
+ switch(opco.no)
+ { case ONE: p=" <operand>"; break;
+ case TWO: p=" <operand1> <operand2>"; break;
+ case EXT:
+ case VAR: p=" <0 to 4 operands>"; break;
+ case VAR_LONG: p=" <0 to 8 operands>"; break;
+ }
+ switch(opco.op_rules)
+ { case TEXT: sprintf(q+strlen(q), " <text>"); return;
+ case LABEL: sprintf(q+strlen(q), " <label>"); return;
+ case VARIAB:
+ sprintf(q+strlen(q), " <variable>");
+ case CALL:
+ if (opco.op_rules==CALL) sprintf(q+strlen(q), " <routine>");
+ switch(opco.no)
+ { case ONE: p=""; break;
+ case TWO: p=" <operand>"; break;
+ case EXT:
+ case VAR: p=" <1 to 4 operands>"; break;
+ case VAR_LONG: p=" <1 to 8 operands>"; break;
+ }
+ break;
+ }
+ sprintf(q+strlen(q), "%s", p);
+ if ((opco.flags & St) != 0) sprintf(q+strlen(q), " -> <result-variable>");
+ if ((opco.flags & Br) != 0) sprintf(q+strlen(q), " ?[~]<label>");
+}
+
+static opcodeg internal_number_to_opcode_g(int32 i)
+{
+ opcodeg x;
+ if (i == -1) return custom_opcode_g;
+ x = opcodes_table_g[i];
+ return x;
+}
+
+static opcodeg internal_number_to_opmacro_g(int32 i)
+{
+ return opmacros_table_g[i];
+}
+
+static void make_opcode_syntax_g(opcodeg opco)
+{
+ int ix;
+ char *cx;
+ char *q = opcode_syntax_string;
+
+ sprintf(q, "%s", opco.name);
+ sprintf(q+strlen(q), " <%d operand%s", opco.no,
+ ((opco.no==1) ? "" : "s"));
+ if (opco.no) {
+ cx = q+strlen(q);
+ strcpy(cx, ": ");
+ cx += strlen(cx);
+ for (ix=0; ix<opco.no; ix++) {
+ if (ix) {
+ *cx = ' ';
+ cx++;
+ }
+ if (ix == opco.no-1) {
+ if (opco.flags & Br) {
+ strcpy(cx, "Lb");
+ }
+ else if (opco.flags & St) {
+ strcpy(cx, "S");
+ }
+ else {
+ strcpy(cx, "L");
+ }
+ }
+ else if (ix == opco.no-2 && (opco.flags & Br) && (opco.flags & St)) {
+ strcpy(cx, "S");
+ }
+ else if (ix == opco.no-2 && (opco.flags & St2)) {
+ strcpy(cx, "S");
+ }
+ else {
+ strcpy(cx, "L");
+ }
+ cx += strlen(cx);
+ sprintf(cx, "%d", ix+1);
+ cx += strlen(cx);
+ }
+ }
+ sprintf(q+strlen(q), ">");
+}
+
+
+/* ========================================================================= */
+/* The assembler itself does four things: */
+/* */
+/* assembles instructions */
+/* sets label N to the current code position */
+/* assembles routine headers */
+/* assembles routine ends */
+/* ------------------------------------------------------------------------- */
+
+/* This is for Z-code only. */
+static void write_operand(assembly_operand op)
+{ int32 j;
+ if (module_switch && (op.marker != 0))
+ { if ((op.marker != VARIABLE_MV) && (op.type == SHORT_CONSTANT_OT))
+ op.type = LONG_CONSTANT_OT;
+ }
+ j=op.value;
+ switch(op.type)
+ { case LONG_CONSTANT_OT:
+ byteout(j/256, op.marker); byteout(j%256, 0); return;
+ case SHORT_CONSTANT_OT:
+ if (op.marker == 0)
+ byteout(j, 0);
+ else byteout(j, 0x80 + op.marker); return;
+ case VARIABLE_OT:
+ byteout(j, (module_switch)?(0x80 + op.marker):0); return;
+ case CONSTANT_OT:
+ case HALFCONSTANT_OT:
+ case BYTECONSTANT_OT:
+ case ZEROCONSTANT_OT:
+ case SYSFUN_OT:
+ case DEREFERENCE_OT:
+ case LOCALVAR_OT:
+ case GLOBALVAR_OT:
+ compiler_error("Glulx OT in Z-code assembly operand.");
+ return;
+ }
+}
+
+extern void assemblez_instruction(assembly_instruction *AI)
+{
+ uchar *start_pc, *operands_pc;
+ int32 offset, j, topbits=0, types_byte1, types_byte2;
+ int operand_rules, min=0, max=0, no_operands_given, at_seq_point = FALSE;
+ assembly_operand o1, o2;
+ opcodez opco;
+
+ ASSERT_ZCODE();
+
+ offset = zmachine_pc;
+
+ no_instructions++;
+
+ if (veneer_mode) sequence_point_follows = FALSE;
+ if (sequence_point_follows)
+ { sequence_point_follows = FALSE; at_seq_point = TRUE;
+ if (debugfile_switch)
+ { sequence_point_labels[next_sequence_point] = next_label;
+ sequence_point_locations[next_sequence_point] =
+ statement_debug_location;
+ set_label_offset(next_label++, zmachine_pc);
+ }
+ next_sequence_point++;
+ }
+
+ opco = internal_number_to_opcode_z(AI->internal_number);
+ if (opco.version1==0)
+ { error_named("Opcode unavailable in this Z-machine version",
+ opcode_names.keywords[AI->internal_number]);
+ return;
+ }
+
+ if (execution_never_reaches_here)
+ warning("This statement can never be reached");
+
+ operand_rules = opco.op_rules;
+ execution_never_reaches_here = ((opco.flags & Rf) != 0);
+
+ if (opco.flags2_set != 0) flags2_requirements[opco.flags2_set] = 1;
+
+ no_operands_given = AI->operand_count;
+
+ if ((opco.no == TWO) && ((no_operands_given==3)||(no_operands_given==4)))
+ opco.no = VAR;
+
+ /* 1. Write the opcode byte(s) */
+
+ start_pc = zcode_holding_area + zcode_ha_size;
+
+ switch(opco.no)
+ { case VAR_LONG: topbits=0xc0; min=0; max=8; break;
+ case VAR: topbits=0xc0; min=0; max=4; break;
+ case ZERO: topbits=0xb0; min=0; max=0; break;
+ case ONE: topbits=0x80; min=1; max=1; break;
+ case TWO: topbits=0x00; min=2; max=2; break;
+ case EXT: topbits=0x00; min=0; max=4;
+ byteout(0xbe, 0); opco.no=VAR; break;
+ case EXT_LONG: topbits=0x00; min=0; max=8;
+ byteout(0xbe, 0); opco.no=VAR_LONG; break;
+ }
+ byteout(opco.code + topbits, 0);
+
+ operands_pc = zcode_holding_area + zcode_ha_size;
+
+ /* 2. Dispose of the special rules LABEL and TEXT */
+
+ if (operand_rules==LABEL)
+ { j = (AI->operand[0]).value;
+ byteout(j/256, LABEL_MV); byteout(j%256, 0);
+ goto Instruction_Done;
+ }
+
+ if (operand_rules==TEXT)
+ { int32 i;
+ uchar *tmp = translate_text(zcode_holding_area + zcode_ha_size, zcode_holding_area+MAX_ZCODE_SIZE, AI->text);
+ if (!tmp)
+ memoryerror("MAX_ZCODE_SIZE", MAX_ZCODE_SIZE);
+ j = subtract_pointers(tmp, (zcode_holding_area + zcode_ha_size));
+ for (i=0; i<j; i++) zcode_markers[zcode_ha_size++] = 0;
+ zmachine_pc += j;
+ goto Instruction_Done;
+ }
+
+ /* 3. Sort out the operands */
+
+ if ((no_operands_given < min) || (no_operands_given > max))
+ goto OpcodeSyntaxError;
+
+ switch(opco.no)
+ { case VAR:
+ case VAR_LONG:
+ byteout(0, 0);
+ if (opco.no == VAR_LONG) byteout(0, 0);
+ types_byte1=0xff; types_byte2=0xff;
+ for (j=0; j<no_operands_given; j++)
+ { int multi=0, mask=0;
+ switch(j)
+ { case 0: case 4: multi=0x40; mask=0xc0; break;
+ case 1: case 5: multi=0x10; mask=0x30; break;
+ case 2: case 6: multi=0x04; mask=0x0c; break;
+ case 3: case 7: multi=0x01; mask=0x03; break;
+ }
+ o1 = AI->operand[j];
+ write_operand(o1);
+ if (j<4)
+ types_byte1 = (types_byte1 & (~mask)) + o1.type*multi;
+ else
+ types_byte2 = (types_byte2 & (~mask)) + o1.type*multi;
+ }
+ *operands_pc=types_byte1;
+ if (opco.no == VAR_LONG) *(operands_pc+1)=types_byte2;
+ break;
+
+ case ONE:
+ o1 = AI->operand[0];
+ *start_pc=(*start_pc) + o1.type*0x10;
+ write_operand(o1);
+ break;
+
+ case TWO:
+ o1 = AI->operand[0];
+ o2 = AI->operand[1];
+
+ /* Transfer to VAR form if either operand is a long constant */
+
+ if ((o1.type==LONG_CONSTANT_OT)||(o2.type==LONG_CONSTANT_OT))
+ { *start_pc=(*start_pc) + 0xc0;
+ byteout(o1.type*0x40 + o2.type*0x10 + 0x0f, 0);
+ }
+ else
+ { if (o1.type==VARIABLE_OT) *start_pc=(*start_pc) + 0x40;
+ if (o2.type==VARIABLE_OT) *start_pc=(*start_pc) + 0x20;
+ }
+ write_operand(o1);
+ write_operand(o2);
+ break;
+ }
+
+ /* 4. Assemble a Store destination, if needed */
+
+ if ((AI->store_variable_number) != -1)
+ { if (AI->store_variable_number >= MAX_LOCAL_VARIABLES+MAX_GLOBAL_VARIABLES) {
+ goto OpcodeSyntaxError;
+ }
+ o1.type = VARIABLE_OT;
+ o1.value = AI->store_variable_number;
+ variable_usage[o1.value] = TRUE;
+ o1.marker = 0;
+
+ /* Note that variable numbers 249 to 255 (i.e. globals 233 to 239)
+ are used as scratch workspace, so need no mapping between
+ modules and story files: nor do local variables 0 to 15 */
+
+ if ((o1.value >= MAX_LOCAL_VARIABLES) && (o1.value < 249))
+ o1.marker = VARIABLE_MV;
+ write_operand(o1);
+ }
+
+ /* 5. Assemble a branch, if needed */
+
+ if (AI->branch_label_number != -1)
+ { int32 addr, long_form;
+ int branch_on_true = (AI->branch_flag)?1:0;
+
+ switch (AI->branch_label_number)
+ { case -2: addr = 2; branch_on_true = 0; long_form = 0; break;
+ /* branch nowhere, carry on */
+ case -3: addr = 0; long_form = 0; break; /* rfalse on condition */
+ case -4: addr = 1; long_form = 0; break; /* rtrue on condition */
+ default:
+ long_form = 1; addr = AI->branch_label_number;
+ break;
+ }
+ if (addr > 0x7fff) fatalerror("Too many branch points in routine.");
+ if (long_form==1)
+ { byteout(branch_on_true*0x80 + addr/256, BRANCH_MV);
+ byteout(addr%256, 0);
+ }
+ else
+ byteout(branch_on_true*0x80+ 0x40 + (addr&0x3f), 0);
+ }
+
+ Instruction_Done:
+
+ if (asm_trace_level > 0)
+ { int i;
+ printf("%5d +%05lx %3s %-12s ", ErrorReport.line_number,
+ ((long int) offset),
+ (at_seq_point)?"<*>":" ", opco.name);
+
+ if ((AI->internal_number == print_zc)
+ || (AI->internal_number == print_ret_zc))
+ { printf("\"");
+ for (i=0;(AI->text)[i]!=0 && i<35; i++) printf("%c",(AI->text)[i]);
+ if (i == 35) printf("...");
+ printf("\"");
+ }
+
+ for (i=0; i<AI->operand_count; i++)
+ { if ((i==0) && (opco.op_rules == VARIAB))
+ { if ((AI->operand[0]).type == VARIABLE_OT)
+ { printf("["); print_operand_z(AI->operand[i]); }
+ else
+ printf("%s", variable_name((AI->operand[0]).value));
+ }
+ else
+ if ((i==0) && (opco.op_rules == LABEL))
+ { printf("L%d", AI->operand[0].value);
+ }
+ else print_operand_z(AI->operand[i]);
+ printf(" ");
+ }
+ if (AI->store_variable_number != -1)
+ { assembly_operand AO;
+ printf("-> ");
+ AO.type = VARIABLE_OT; AO.value = AI->store_variable_number;
+ print_operand_z(AO); printf(" ");
+ }
+
+ switch(AI->branch_label_number)
+ { case -4: printf("rtrue if %s", (AI->branch_flag)?"TRUE":"FALSE");
+ break;
+ case -3: printf("rfalse if %s", (AI->branch_flag)?"TRUE":"FALSE");
+ break;
+ case -2: printf("(no branch)"); break;
+ case -1: break;
+ default:
+ printf("to L%d if %s", AI->branch_label_number,
+ (AI->branch_flag)?"TRUE":"FALSE"); break;
+ }
+
+ if (asm_trace_level>=2)
+ { for (j=0;start_pc<zcode_holding_area + zcode_ha_size;
+ j++, start_pc++)
+ { if (j%16==0) printf("\n ");
+ printf("%02x ", *start_pc);
+ }
+ }
+ printf("\n");
+ }
+
+ if (module_switch) flush_link_data();
+
+ return;
+
+ OpcodeSyntaxError:
+
+ make_opcode_syntax_z(opco);
+ error_named("Assembly mistake: syntax is", opcode_syntax_string);
+}
+
+static void assembleg_macro(assembly_instruction *AI)
+{
+ /* validate macro syntax first */
+ int ix, no_operands_given;
+ opcodeg opco;
+
+ opco = internal_number_to_opmacro_g(AI->internal_number);
+ no_operands_given = AI->operand_count;
+
+ if (no_operands_given != opco.no)
+ goto OpcodeSyntaxError;
+
+ for (ix = 0; ix < no_operands_given; ix++) {
+ int type = AI->operand[ix].type;
+ if ((opco.flags & St)
+ && ((!(opco.flags & Br) && (ix == no_operands_given-1))
+ || ((opco.flags & Br) && (ix == no_operands_given-2)))) {
+ if (is_constant_ot(type)) {
+ error("*** assembly macro tried to store to a constant ***");
+ goto OpcodeSyntaxError;
+ }
+ }
+ if ((opco.flags & St2)
+ && (ix == no_operands_given-2)) {
+ if (is_constant_ot(type)) {
+ error("*** assembly macro tried to store to a constant ***");
+ goto OpcodeSyntaxError;
+ }
+ }
+ }
+
+ /* expand the macro */
+ switch (AI->internal_number) {
+ case pull_gm:
+ assembleg_store(AI->operand[0], stack_pointer);
+ break;
+
+ case push_gm:
+ assembleg_store(stack_pointer, AI->operand[0]);
+ break;
+
+ default:
+ compiler_error("Invalid Glulx assembly macro");
+ break;
+ }
+
+ return;
+
+ OpcodeSyntaxError:
+
+ make_opcode_syntax_g(opco);
+ error_named("Assembly mistake: syntax is", opcode_syntax_string);
+}
+
+extern void assembleg_instruction(assembly_instruction *AI)
+{
+ uchar *start_pc, *opmodes_pc;
+ int32 offset, j;
+ int no_operands_given, at_seq_point = FALSE;
+ int ix, k;
+ opcodeg opco;
+
+ ASSERT_GLULX();
+
+ offset = zmachine_pc;
+
+ no_instructions++;
+
+ if (veneer_mode) sequence_point_follows = FALSE;
+ if (sequence_point_follows)
+ { sequence_point_follows = FALSE; at_seq_point = TRUE;
+ if (debugfile_switch)
+ { sequence_point_labels[next_sequence_point] = next_label;
+ sequence_point_locations[next_sequence_point] =
+ statement_debug_location;
+ set_label_offset(next_label++, zmachine_pc);
+ }
+ next_sequence_point++;
+ }
+
+ opco = internal_number_to_opcode_g(AI->internal_number);
+
+ if (execution_never_reaches_here)
+ warning("This statement can never be reached");
+
+ execution_never_reaches_here = ((opco.flags & Rf) != 0);
+
+ if (opco.op_rules & GOP_Unicode) {
+ uses_unicode_features = TRUE;
+ }
+ if (opco.op_rules & GOP_MemHeap) {
+ uses_memheap_features = TRUE;
+ }
+ if (opco.op_rules & GOP_Acceleration) {
+ uses_acceleration_features = TRUE;
+ }
+ if (opco.op_rules & GOP_Float) {
+ uses_float_features = TRUE;
+ }
+
+ no_operands_given = AI->operand_count;
+
+ /* 1. Write the opcode byte(s) */
+
+ start_pc = zcode_holding_area + zcode_ha_size;
+
+ if (opco.code < 0x80) {
+ byteout(opco.code, 0);
+ }
+ else if (opco.code < 0x4000) {
+ byteout(((opco.code >> 8) & 0xFF) | 0x80, 0);
+ byteout((opco.code & 0xFF), 0);
+ }
+ else {
+ byteout(((opco.code >> 24) & 0xFF) | 0xC0, 0);
+ byteout(((opco.code >> 16) & 0xFF), 0);
+ byteout(((opco.code >> 8) & 0xFF), 0);
+ byteout(((opco.code) & 0xFF), 0);
+ }
+
+ /* ... and the operand addressing modes. There's one byte for
+ every two operands (rounded up). We write zeroes for now;
+ when the operands are written, we'll go back and fix them. */
+
+ opmodes_pc = zcode_holding_area + zcode_ha_size;
+
+ for (ix=0; ix<opco.no; ix+=2) {
+ byteout(0, 0);
+ }
+
+ /* 2. Dispose of the special rules */
+ /* There aren't any in Glulx. */
+
+ /* 3. Sort out the operands */
+
+ if (no_operands_given != opco.no) {
+ goto OpcodeSyntaxError;
+ }
+
+ for (ix=0; ix<no_operands_given; ix++) {
+ int marker = AI->operand[ix].marker;
+ int type = AI->operand[ix].type;
+ k = AI->operand[ix].value;
+
+ if ((opco.flags & Br) && (ix == no_operands_given-1)) {
+ if (!(marker >= BRANCH_MV && marker < BRANCHMAX_MV)) {
+ compiler_error("Assembling branch without BRANCH_MV marker");
+ goto OpcodeSyntaxError;
+ }
+ if (k == -2) {
+ k = 2; /* branch no-op */
+ type = BYTECONSTANT_OT;
+ marker = 0;
+ }
+ else if (k == -3) {
+ k = 0; /* branch return 0 */
+ type = ZEROCONSTANT_OT;
+ marker = 0;
+ }
+ else if (k == -4) {
+ k = 1; /* branch return 1 */
+ type = BYTECONSTANT_OT;
+ marker = 0;
+ }
+ else {
+ /* branch to label k */
+ j = subtract_pointers((zcode_holding_area + zcode_ha_size),
+ opmodes_pc);
+ j = 2*j - ix;
+ marker = BRANCH_MV + j;
+ if (!(marker >= BRANCH_MV && marker < BRANCHMAX_MV)) {
+ error("*** branch marker too far from opmode byte ***");
+ goto OpcodeSyntaxError;
+ }
+ }
+ }
+ if ((opco.flags & St)
+ && ((!(opco.flags & Br) && (ix == no_operands_given-1))
+ || ((opco.flags & Br) && (ix == no_operands_given-2)))) {
+ if (type == BYTECONSTANT_OT || type == HALFCONSTANT_OT
+ || type == CONSTANT_OT) {
+ error("*** instruction tried to store to a constant ***");
+ goto OpcodeSyntaxError;
+ }
+ }
+ if ((opco.flags & St2)
+ && (ix == no_operands_given-2)) {
+ if (type == BYTECONSTANT_OT || type == HALFCONSTANT_OT
+ || type == CONSTANT_OT) {
+ error("*** instruction tried to store to a constant ***");
+ goto OpcodeSyntaxError;
+ }
+ }
+
+ if (marker && (type == HALFCONSTANT_OT
+ || type == BYTECONSTANT_OT
+ || type == ZEROCONSTANT_OT)) {
+ compiler_error("Assembling marker in less than 32-bit constant.");
+ /* Actually we should store marker|0x80 for a byte constant,
+ but let's hold off on that. */
+ }
+
+ switch (type) {
+ case LONG_CONSTANT_OT:
+ case SHORT_CONSTANT_OT:
+ case VARIABLE_OT:
+ j = 0;
+ compiler_error("Z-code OT in Glulx assembly operand.");
+ break;
+ case CONSTANT_OT:
+ j = 3;
+ byteout((k >> 24) & 0xFF, marker);
+ byteout((k >> 16) & 0xFF, 0);
+ byteout((k >> 8) & 0xFF, 0);
+ byteout((k & 0xFF), 0);
+ break;
+ case HALFCONSTANT_OT:
+ j = 2;
+ byteout((k >> 8) & 0xFF, marker);
+ byteout((k & 0xFF), 0);
+ break;
+ case BYTECONSTANT_OT:
+ j = 1;
+ byteout((k & 0xFF), marker);
+ break;
+ case ZEROCONSTANT_OT:
+ j = 0;
+ break;
+ case DEREFERENCE_OT:
+ j = 7;
+ byteout((k >> 24) & 0xFF, marker);
+ byteout((k >> 16) & 0xFF, 0);
+ byteout((k >> 8) & 0xFF, 0);
+ byteout((k & 0xFF), 0);
+ break;
+ case GLOBALVAR_OT:
+ /* Global variable -- a constant address. */
+ k -= MAX_LOCAL_VARIABLES;
+ if (/* DISABLES CODE */ (0)) {
+ /* We could write the value as a marker and patch it later... */
+ j = 7;
+ byteout(((k) >> 24) & 0xFF, VARIABLE_MV);
+ byteout(((k) >> 16) & 0xFF, 0);
+ byteout(((k) >> 8) & 0xFF, 0);
+ byteout(((k) & 0xFF), 0);
+ }
+ else {
+ /* ...but it's more efficient to write it as a RAM operand,
+ which can be 1, 2, or 4 bytes. Remember that global variables
+ are the very first thing in RAM. */
+ k = k * 4; /* each variable is four bytes */
+ if (k <= 255) {
+ j = 13;
+ byteout(((k) & 0xFF), 0);
+ }
+ else if (k <= 65535) {
+ j = 14;
+ byteout(((k) >> 8) & 0xFF, 0);
+ byteout(((k) & 0xFF), 0);
+ }
+ else {
+ j = 15;
+ byteout(((k) >> 24) & 0xFF, 0);
+ byteout(((k) >> 16) & 0xFF, 0);
+ byteout(((k) >> 8) & 0xFF, 0);
+ byteout(((k) & 0xFF), 0);
+ }
+ }
+ break;
+ case LOCALVAR_OT:
+ if (k == 0) {
+ /* Stack-pointer magic variable */
+ j = 8;
+ }
+ else {
+ /* Local variable -- a byte or short offset from the
+ frame pointer. It's an unsigned offset, so we can
+ fit up to long 63 (offset 4*63) in a byte. */
+ if ((k-1) < 64) {
+ j = 9;
+ byteout((k-1)*4, 0);
+ }
+ else {
+ j = 10;
+ byteout((((k-1)*4) >> 8) & 0xFF, 0);
+ byteout(((k-1)*4) & 0xFF, 0);
+ }
+ }
+ break;
+ default:
+ j = 0;
+ break;
+ }
+
+ if (ix & 1)
+ j = (j << 4);
+ opmodes_pc[ix/2] |= j;
+ }
+
+ /* Print assembly trace. */
+ if (asm_trace_level > 0) {
+ int i;
+ printf("%5d +%05lx %3s %-12s ", ErrorReport.line_number,
+ ((long int) offset),
+ (at_seq_point)?"<*>":" ", opco.name);
+ for (i=0; i<AI->operand_count; i++) {
+ if ((opco.flags & Br) && (i == opco.no-1)) {
+ if (AI->operand[i].value == -4)
+ printf("to rtrue");
+ else if (AI->operand[i].value == -3)
+ printf("to rfalse");
+ else
+ printf("to L%d", AI->operand[i].value);
+ }
+ else {
+ print_operand_g(AI->operand[i]);
+ }
+ printf(" ");
+ }
+
+ if (asm_trace_level>=2) {
+ for (j=0;
+ start_pc<zcode_holding_area + zcode_ha_size;
+ j++, start_pc++) {
+ if (j%16==0) printf("\n ");
+ if (/* DISABLES CODE */ (0)) {
+ printf("%02x ", *start_pc);
+ }
+ else {
+ printf("%02x", *start_pc);
+ if (zcode_markers[start_pc-zcode_holding_area])
+ printf("{%02x}", zcode_markers[start_pc-zcode_holding_area]);
+ printf(" ");
+ }
+ }
+ }
+ printf("\n");
+ }
+
+ if (module_switch) flush_link_data();
+
+ return;
+
+ OpcodeSyntaxError:
+
+ make_opcode_syntax_g(opco);
+ error_named("Assembly mistake: syntax is", opcode_syntax_string);
+}
+
+extern void assemble_label_no(int n)
+{
+ if (asm_trace_level > 0)
+ printf("%5d +%05lx .L%d\n", ErrorReport.line_number,
+ ((long int) zmachine_pc), n);
+ set_label_offset(n, zmachine_pc);
+ execution_never_reaches_here = FALSE;
+}
+
+extern void define_symbol_label(int symbol)
+{ label_symbols[svals[symbol]] = symbol;
+}
+
+extern int32 assemble_routine_header(int no_locals,
+ int routine_asterisked, char *name, int embedded_flag, int the_symbol)
+{ int i, rv;
+ int stackargs = FALSE;
+ int name_length;
+
+ execution_never_reaches_here = FALSE;
+
+ routine_locals = no_locals;
+ for (i=0; i<MAX_LOCAL_VARIABLES; i++) variable_usage[i] = FALSE;
+
+ if (no_locals >= 1
+ && !strcmp(local_variables.keywords[0], "_vararg_count")) {
+ stackargs = TRUE;
+ }
+
+ if (veneer_mode) routine_starts_line = blank_brief_location;
+ else routine_starts_line = get_brief_location(&ErrorReport);
+
+ if (asm_trace_level > 0)
+ { printf("\n%5d +%05lx [ %s ", ErrorReport.line_number,
+ ((long int) zmachine_pc), name);
+ for (i=1; i<=no_locals; i++) printf("%s ", variable_name(i));
+ printf("\n\n");
+ }
+
+ routine_start_pc = zmachine_pc;
+
+ if (track_unused_routines) {
+ /* The name of an embedded function is in a temporary buffer,
+ so we shouldn't keep a reference to it. (It is sad that we
+ have to know this here.) */
+ char *funcname = name;
+ if (embedded_flag)
+ funcname = "<embedded>";
+
+ df_note_function_start(funcname, zmachine_pc, embedded_flag,
+ routine_starts_line);
+ }
+
+ routine_symbol = the_symbol;
+ name_length = strlen(name) + 1;
+ routine_name =
+ my_malloc(name_length * sizeof(char), "temporary copy of routine name");
+ strncpy(routine_name, name, name_length);
+
+ /* Update the routine counter */
+
+ no_routines++;
+
+ /* Actually assemble the routine header into the code area; note */
+ /* Inform doesn't support the setting of local variables to default */
+ /* values other than 0 in V3 and V4. (In V5+ the Z-Machine doesn't */
+ /* provide the possibility in any case.) */
+
+ if (!glulx_mode) {
+
+ if (stackargs)
+ warning("Z-code does not support stack-argument function definitions.");
+
+ byteout(no_locals, 0);
+
+ /* Not the packed address, but the scaled offset from code area start: */
+
+ rv = zmachine_pc/scale_factor;
+
+ if (instruction_set_number<5)
+ for (i=0; i<no_locals; i++) { byteout(0,0); byteout(0,0); }
+
+ next_label = 0; next_sequence_point = 0; last_label = -1;
+
+ /* Compile code to print out text like "a=3, b=4, c=5" when the */
+ /* function is called, if it's required. */
+
+ if ((routine_asterisked) || (define_INFIX_switch))
+ { char fnt[256]; assembly_operand PV, RFA, CON, STP, SLF; int ln, ln2;
+
+ ln = next_label++;
+ ln2 = next_label++;
+
+ if (define_INFIX_switch)
+ {
+ if (embedded_flag)
+ { SLF.value = 251; SLF.type = VARIABLE_OT; SLF.marker = 0;
+ CON.value = 0; CON.type = SHORT_CONSTANT_OT; CON.marker = 0;
+ assemblez_2_branch(test_attr_zc, SLF, CON, ln2, FALSE);
+ }
+ else
+ { i = no_named_routines++;
+ named_routine_symbols[i] = the_symbol;
+ CON.value = i/8; CON.type = LONG_CONSTANT_OT; CON.marker = 0;
+ RFA.value = routine_flags_array_SC;
+ RFA.type = LONG_CONSTANT_OT; RFA.marker = INCON_MV;
+ STP.value = 0; STP.type = VARIABLE_OT; STP.marker = 0;
+ assemblez_2_to(loadb_zc, RFA, CON, STP);
+ CON.value = (1 << (i%8)); CON.type = SHORT_CONSTANT_OT;
+ assemblez_2_to(and_zc, STP, CON, STP);
+ assemblez_1_branch(jz_zc, STP, ln2, TRUE);
+ }
+ }
+ sprintf(fnt, "[ %s(", name);
+ AI.text = fnt; assemblez_0(print_zc);
+ for (i=1; (i<=7)&&(i<=no_locals); i++)
+ { if (version_number >= 5)
+ { PV.type = SHORT_CONSTANT_OT;
+ PV.value = i; PV.marker = 0;
+ assemblez_1_branch(check_arg_count_zc, PV, ln, FALSE);
+ }
+ sprintf(fnt, "%s%s = ", (i==1)?"":", ", variable_name(i));
+ AI.text = fnt; assemblez_0(print_zc);
+ PV.type = VARIABLE_OT; PV.value = i; PV.marker = 0;
+ assemblez_1(print_num_zc, PV);
+ }
+ assemble_label_no(ln);
+ sprintf(fnt, ") ]^"); AI.text = fnt;
+ assemblez_0(print_zc);
+ assemble_label_no(ln2);
+ }
+
+ }
+ else {
+ rv = zmachine_pc;
+
+ if (stackargs)
+ byteout(0xC0, 0); /* Glulx type byte for function */
+ else
+ byteout(0xC1, 0); /* Glulx type byte for function */
+
+ /* Now the locals format list. This is simple; we only use
+ four-byte locals. That's a single pair, unless we have more
+ than 255 locals, or none at all. */
+ i = no_locals;
+ while (i) {
+ int j = i;
+ if (j > 255)
+ j = 255;
+ byteout(4, 0);
+ byteout(j, 0);
+ i -= j;
+ }
+ /* Terminate the list with a (0, 0) pair. */
+ byteout(0, 0);
+ byteout(0, 0);
+
+ if (stackargs) {
+ /* The top stack value is the number of function arguments. Let's
+ move that into the first local, which is _vararg_count. */
+ /* @copy sp _vararg_count; */
+ byteout(0x40, 0); byteout(0x98, 0); byteout(0x00, 0);
+ }
+
+ next_label = 0; next_sequence_point = 0; last_label = -1;
+
+ if ((routine_asterisked) || (define_INFIX_switch)) {
+ int ix;
+ char fnt[256];
+ assembly_operand AO, AO2;
+ if (define_INFIX_switch) {
+ /* This isn't supported */
+ if (embedded_flag) {
+ }
+ else {
+ i = no_named_routines++;
+ named_routine_symbols[i] = the_symbol;
+ }
+ }
+ sprintf(fnt, "[ %s(", name);
+ AO.marker = STRING_MV;
+ AO.type = CONSTANT_OT;
+ AO.value = compile_string(fnt, FALSE, FALSE);
+ assembleg_1(streamstr_gc, AO);
+
+ if (!stackargs) {
+ for (ix=1; ix<=no_locals; ix++) {
+ sprintf(fnt, "%s%s = ", (ix==1)?"":", ", variable_name(ix));
+ AO.marker = STRING_MV;
+ AO.type = CONSTANT_OT;
+ AO.value = compile_string(fnt, FALSE, FALSE);
+ assembleg_1(streamstr_gc, AO);
+ AO.marker = 0;
+ AO.type = LOCALVAR_OT;
+ AO.value = ix;
+ assembleg_1(streamnum_gc, AO);
+ }
+ }
+ else {
+ int lntop, lnbottom;
+ sprintf(fnt, "%s = ", variable_name(1));
+ AO.marker = STRING_MV;
+ AO.type = CONSTANT_OT;
+ AO.value = compile_string(fnt, FALSE, FALSE);
+ assembleg_1(streamstr_gc, AO);
+ AO.marker = 0;
+ AO.type = LOCALVAR_OT;
+ AO.value = 1;
+ assembleg_1(streamnum_gc, AO);
+ AO2.type = BYTECONSTANT_OT;
+ AO2.marker = 0;
+ AO2.value = ':';
+ assembleg_1(streamchar_gc, AO2);
+ AO2.type = BYTECONSTANT_OT;
+ AO2.marker = 0;
+ AO2.value = ' ';
+ /* for (temp_var4=0 : temp_var4<_vararg_count : temp_var4++) {
+ @streamchar ' ';
+ @stkpeek temp_var4 sp;
+ @stream_num sp;
+ }
+ */
+ assembleg_store(temp_var4, zero_operand);
+ lntop = next_label++;
+ lnbottom = next_label++;
+ assemble_label_no(lntop);
+ assembleg_2_branch(jge_gc, temp_var4, AO, lnbottom); /* AO is _vararg_count */
+ assembleg_1(streamchar_gc, AO2); /* AO2 is space */
+ assembleg_2(stkpeek_gc, temp_var4, stack_pointer);
+ assembleg_1(streamnum_gc, stack_pointer);
+ assembleg_3(add_gc, temp_var4, one_operand, temp_var4);
+ assembleg_0_branch(jump_gc, lntop);
+ assemble_label_no(lnbottom);
+ }
+
+ AO.marker = STRING_MV;
+ AO.type = CONSTANT_OT;
+ AO.value = compile_string(") ]^", FALSE, FALSE);
+ assembleg_1(streamstr_gc, AO);
+ }
+ }
+
+ return rv;
+}
+
+void assemble_routine_end(int embedded_flag, debug_locations locations)
+{ int32 i;
+
+ /* No marker is made in the Z-machine's code area to indicate the */
+ /* end of a routine. Instead, we simply assemble a return opcode if */
+ /* need be (it won't be if the last instruction was, say, a "quit"). */
+ /* The return value is true (1) for normal routines, false (0) for */
+ /* embedded routines (e.g. the library uses this for "before" */
+ /* properties). */
+
+ if (!execution_never_reaches_here)
+ {
+ if (!glulx_mode) {
+ if (embedded_flag) assemblez_0(rfalse_zc);
+ else assemblez_0(rtrue_zc);
+ }
+ else {
+ assembly_operand AO;
+ if (embedded_flag)
+ AO = zero_operand;
+ else
+ AO = one_operand;
+ assembleg_1(return_gc, AO);
+ }
+ }
+
+ /* Dump the contents of the current routine into longer-term Z-code
+ storage */
+
+ if (!glulx_mode)
+ transfer_routine_z();
+ else
+ transfer_routine_g();
+
+ if (track_unused_routines)
+ df_note_function_end(zmachine_pc);
+
+ /* Tell the debugging file about the routine just ended. */
+
+ if (debugfile_switch)
+ {
+ debug_file_printf("<routine>");
+ if (embedded_flag)
+ { debug_file_printf
+ ("<identifier artificial=\"true\">%s</identifier>",
+ routine_name);
+ }
+ else if (sflags[routine_symbol] & REPLACE_SFLAG)
+ { /* The symbol type will be set to ROUTINE_T once the replaced
+ version has been given; if it is already set, we must be dealing
+ with a replacement, and we can use the routine name as-is.
+ Otherwise we look for a rename. And if that doesn't work, we
+ fall back to an artificial identifier. */
+ if (stypes[routine_symbol] == ROUTINE_T)
+ { /* Optional because there may be further replacements. */
+ write_debug_optional_identifier(routine_symbol);
+ }
+ else if (find_symbol_replacement(&routine_symbol))
+ { debug_file_printf
+ ("<identifier>%s</identifier>", symbs[routine_symbol]);
+ }
+ else
+ { debug_file_printf
+ ("<identifier artificial=\"true\">%s (replaced)"
+ "</identifier>",
+ routine_name);
+ }
+ } else
+ { debug_file_printf("<identifier>%s</identifier>", routine_name);
+ }
+ debug_file_printf("<value>");
+ if (glulx_mode)
+ { write_debug_code_backpatch(routine_start_pc);
+ } else
+ { write_debug_packed_code_backpatch(routine_start_pc);
+ }
+ debug_file_printf("</value>");
+ debug_file_printf("<address>");
+ write_debug_code_backpatch(routine_start_pc);
+ debug_file_printf("</address>");
+ debug_file_printf
+ ("<byte-count>%d</byte-count>", zmachine_pc - routine_start_pc);
+ write_debug_locations(locations);
+ for (i = 1; i <= routine_locals; ++i)
+ { debug_file_printf("<local-variable>");
+ debug_file_printf("<identifier>%s</identifier>", variable_name(i));
+ if (glulx_mode)
+ { debug_file_printf
+ ("<frame-offset>%d</frame-offset>", 4 * (i - 1));
+ }
+ else
+ { debug_file_printf("<index>%d</index>", i);
+ }
+ debug_file_printf("</local-variable>");
+ }
+ for (i = 0; i < next_sequence_point; ++i)
+ { debug_file_printf("<sequence-point>");
+ debug_file_printf("<address>");
+ write_debug_code_backpatch
+ (label_offsets[sequence_point_labels[i]]);
+ debug_file_printf("</address>");
+ write_debug_location(sequence_point_locations[i]);
+ debug_file_printf("</sequence-point>");
+ }
+ debug_file_printf("</routine>");
+ }
+
+ my_free(&routine_name, "temporary copy of routine name");
+
+ /* Issue warnings about any local variables not used in the routine. */
+
+ for (i=1; i<=routine_locals; i++)
+ if (!(variable_usage[i]))
+ dbnu_warning("Local variable", variable_name(i),
+ routine_starts_line);
+
+ for (i=0; i<next_label; i++)
+ { int j = label_symbols[i];
+ if (j != -1)
+ { if (sflags[j] & CHANGE_SFLAG)
+ error_named_at("Routine contains no such label as",
+ (char *) symbs[j], slines[j]);
+ else
+ if ((sflags[j] & USED_SFLAG) == 0)
+ dbnu_warning("Label", (char *) symbs[j], slines[j]);
+ stypes[j] = CONSTANT_T;
+ sflags[j] = UNKNOWN_SFLAG;
+ }
+ }
+ no_sequence_points += next_sequence_point;
+ next_label = 0; next_sequence_point = 0;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Called when the holding area contains an entire routine of code: */
+/* backpatches the labels, issues module markers, then dumps the routine */
+/* into longer-term storage. */
+/* Note that in the code received, all branches have long form, and their */
+/* contents are not an offset but the label numbers they branch to. */
+/* Similarly, LABEL operands (those of "jump" instructions) are label */
+/* numbers. So this routine must change the label numbers to offsets, */
+/* slimming the code down as it does so to take advantage of short-form */
+/* branch operands where possible. */
+/* ------------------------------------------------------------------------- */
+
+static int32 adjusted_pc;
+
+static void transfer_to_temp_file(uchar *c)
+{ fputc(*c,Temp2_fp);
+ adjusted_pc++;
+}
+
+static void transfer_to_zcode_area(uchar *c)
+{ write_byte_to_memory_block(&zcode_area, adjusted_pc++, *c);
+}
+
+static void transfer_routine_z(void)
+{ int32 i, j, pc, new_pc, label, long_form, offset_of_next, addr,
+ branch_on_true, rstart_pc;
+ void (* transfer_byte)(uchar *);
+
+ adjusted_pc = zmachine_pc - zcode_ha_size; rstart_pc = adjusted_pc;
+
+ if (asm_trace_level >= 3)
+ { printf("Backpatching routine at %05lx: initial size %d, %d labels\n",
+ (long int) adjusted_pc, zcode_ha_size, next_label);
+ }
+
+ transfer_byte =
+ (temporary_files_switch)?transfer_to_temp_file:transfer_to_zcode_area;
+
+ /* (1) Scan through for branches and make short/long decisions in each
+ case. Mark omitted bytes (2nd bytes in branches converted to
+ short form) with DELETED_MV. */
+
+ for (i=0, pc=adjusted_pc; i<zcode_ha_size; i++, pc++)
+ { if (zcode_markers[i] == BRANCH_MV)
+ { if (asm_trace_level >= 4)
+ printf("Branch detected at offset %04x\n", pc);
+ j = (256*zcode_holding_area[i] + zcode_holding_area[i+1]) & 0x7fff;
+ if (asm_trace_level >= 4)
+ printf("To label %d, which is %d from here\n",
+ j, label_offsets[j]-pc);
+ if ((label_offsets[j] >= pc+2) && (label_offsets[j] < pc+64))
+ { if (asm_trace_level >= 4) printf("Short form\n");
+ zcode_markers[i+1] = DELETED_MV;
+ }
+ }
+ }
+
+ /* (2) Calculate the new positions of the labels. Note that since the
+ long/short decision was taken on the basis of the old labels,
+ and since the new labels are slightly closer together because
+ of branch bytes deleted, there may be a few further branch
+ optimisations which are possible but which have been missed
+ (if two labels move inside the "short" range as a result of
+ a previous optimisation). However, this is acceptably uncommon. */
+
+ if (next_label > 0)
+ { if (asm_trace_level >= 4)
+ { printf("Opening label: %d\n", first_label);
+ for (i=0;i<next_label;i++)
+ printf("Label %d offset %04x next -> %d previous -> %d\n",
+ i, label_offsets[i], label_next[i], label_prev[i]);
+ }
+
+ for (i=0, pc=adjusted_pc, new_pc=adjusted_pc, label = first_label;
+ i<zcode_ha_size; i++, pc++)
+ { while ((label != -1) && (label_offsets[label] == pc))
+ { if (asm_trace_level >= 4)
+ printf("Position of L%d corrected from %04x to %04x\n",
+ label, label_offsets[label], new_pc);
+ label_offsets[label] = new_pc;
+ label = label_next[label];
+ }
+ if (zcode_markers[i] != DELETED_MV) new_pc++;
+ }
+ }
+
+ /* (3) As we are transferring, replace the label numbers in branch
+ operands with offsets to those labels. Also issue markers, now
+ that we know where they occur in the final Z-code area. */
+
+ for (i=0, new_pc=adjusted_pc; i<zcode_ha_size; i++)
+ { switch(zcode_markers[i])
+ { case BRANCH_MV:
+ long_form = 1; if (zcode_markers[i+1] == DELETED_MV) long_form = 0;
+
+ j = (256*zcode_holding_area[i] + zcode_holding_area[i+1]) & 0x7fff;
+ branch_on_true = ((zcode_holding_area[i]) & 0x80);
+ offset_of_next = new_pc + long_form + 1;
+
+ addr = label_offsets[j] - offset_of_next + 2;
+ if (addr<-0x2000 || addr>0x1fff)
+ fatalerror("Branch out of range: divide the routine up?");
+ if (addr<0) addr+=(int32) 0x10000L;
+
+ addr=addr&0x3fff;
+ if (long_form==1)
+ { zcode_holding_area[i] = branch_on_true + addr/256;
+ zcode_holding_area[i+1] = addr%256;
+ }
+ else
+ { if (addr >= 64)
+ { compiler_error("Label out of range for branch");
+ printf("Addr is %04x\n", addr);
+ }
+ zcode_holding_area[i] = branch_on_true + 0x40 + (addr&0x3f);
+ }
+ transfer_byte(zcode_holding_area + i); new_pc++;
+ break;
+
+ case LABEL_MV:
+ j = 256*zcode_holding_area[i] + zcode_holding_area[i+1];
+ addr = label_offsets[j] - new_pc;
+ if (addr<-0x8000 || addr>0x7fff)
+ fatalerror("Jump out of range: divide the routine up?");
+ if (addr<0) addr += (int32) 0x10000L;
+ zcode_holding_area[i] = addr/256;
+ zcode_holding_area[i+1] = addr%256;
+ transfer_byte(zcode_holding_area + i); new_pc++;
+ break;
+
+ case DELETED_MV:
+ break;
+
+ default:
+ switch(zcode_markers[i] & 0x7f)
+ { case NULL_MV: break;
+ case VARIABLE_MV:
+ case OBJECT_MV:
+ case ACTION_MV:
+ case IDENT_MV:
+ if (!module_switch) break;
+ default:
+ if ((zcode_markers[i] & 0x7f) > LARGEST_BPATCH_MV)
+ { compiler_error("Illegal code backpatch value");
+ printf("Illegal value of %02x at PC = %04x\n",
+ zcode_markers[i] & 0x7f, new_pc);
+ break;
+ }
+
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++,
+ zcode_markers[i] + 32*(new_pc/65536));
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, (new_pc/256)%256);
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, new_pc%256);
+ break;
+ }
+ transfer_byte(zcode_holding_area + i); new_pc++;
+ break;
+ }
+ }
+
+ if (asm_trace_level >= 3)
+ { printf("After branch optimisation, routine length is %d bytes\n",
+ new_pc - rstart_pc);
+ }
+
+ /* Insert null bytes if necessary to ensure the next routine address is */
+ /* expressible as a packed address */
+
+ { uchar zero[1];
+ zero[0] = 0;
+ if (oddeven_packing_switch)
+ while ((adjusted_pc%(scale_factor*2))!=0) transfer_byte(zero);
+ else
+ while ((adjusted_pc%scale_factor)!=0) transfer_byte(zero);
+ }
+
+ zmachine_pc = adjusted_pc;
+ zcode_ha_size = 0;
+}
+
+static void transfer_routine_g(void)
+{ int32 i, j, pc, new_pc, label, form_len, offset_of_next, addr,
+ rstart_pc;
+ void (* transfer_byte)(uchar *);
+
+ adjusted_pc = zmachine_pc - zcode_ha_size; rstart_pc = adjusted_pc;
+
+ if (asm_trace_level >= 3)
+ { printf("Backpatching routine at %05lx: initial size %d, %d labels\n",
+ (long int) adjusted_pc, zcode_ha_size, next_label);
+ }
+
+ transfer_byte =
+ (temporary_files_switch)?transfer_to_temp_file:transfer_to_zcode_area;
+
+ /* (1) Scan through for branches and make short/long decisions in each
+ case. Mark omitted bytes (bytes 2-4 in branches converted to
+ short form) with DELETED_MV. */
+
+ for (i=0, pc=adjusted_pc; i<zcode_ha_size; i++, pc++) {
+ if (zcode_markers[i] >= BRANCH_MV && zcode_markers[i] < BRANCHMAX_MV) {
+ int opmodeoffset = (zcode_markers[i] - BRANCH_MV);
+ int32 opmodebyte;
+ if (asm_trace_level >= 4)
+ printf("Branch detected at offset %04x\n", pc);
+ j = ((zcode_holding_area[i] << 24)
+ | (zcode_holding_area[i+1] << 16)
+ | (zcode_holding_area[i+2] << 8)
+ | (zcode_holding_area[i+3]));
+ offset_of_next = pc + 4;
+ addr = (label_offsets[j] - offset_of_next) + 2;
+ if (asm_trace_level >= 4)
+ printf("To label %d, which is (%d-2) = %d from here\n",
+ j, addr, label_offsets[j] - offset_of_next);
+ if (addr >= -0x80 && addr < 0x80) {
+ if (asm_trace_level >= 4) printf("...Byte form\n");
+ zcode_markers[i+1] = DELETED_MV;
+ zcode_markers[i+2] = DELETED_MV;
+ zcode_markers[i+3] = DELETED_MV;
+ opmodebyte = i - ((opmodeoffset+1)/2);
+ if ((opmodeoffset & 1) == 0)
+ zcode_holding_area[opmodebyte] =
+ (zcode_holding_area[opmodebyte] & 0xF0) | 0x01;
+ else
+ zcode_holding_area[opmodebyte] =
+ (zcode_holding_area[opmodebyte] & 0x0F) | 0x10;
+ }
+ else if (addr >= -0x8000 && addr < 0x8000) {
+ if (asm_trace_level >= 4) printf("...Short form\n");
+ zcode_markers[i+2] = DELETED_MV;
+ zcode_markers[i+3] = DELETED_MV;
+ opmodebyte = i - ((opmodeoffset+1)/2);
+ if ((opmodeoffset & 1) == 0)
+ zcode_holding_area[opmodebyte] =
+ (zcode_holding_area[opmodebyte] & 0xF0) | 0x02;
+ else
+ zcode_holding_area[opmodebyte] =
+ (zcode_holding_area[opmodebyte] & 0x0F) | 0x20;
+ }
+ }
+ }
+
+ /* (2) Calculate the new positions of the labels. Note that since the
+ long/short decision was taken on the basis of the old labels,
+ and since the new labels are slightly closer together because
+ of branch bytes deleted, there may be a few further branch
+ optimisations which are possible but which have been missed
+ (if two labels move inside the "short" range as a result of
+ a previous optimisation). However, this is acceptably uncommon. */
+ if (next_label > 0) {
+ if (asm_trace_level >= 4) {
+ printf("Opening label: %d\n", first_label);
+ for (i=0;i<next_label;i++)
+ printf("Label %d offset %04x next -> %d previous -> %d\n",
+ i, label_offsets[i], label_next[i], label_prev[i]);
+ }
+
+ for (i=0, pc=adjusted_pc, new_pc=adjusted_pc, label = first_label;
+ i<zcode_ha_size;
+ i++, pc++) {
+ while ((label != -1) && (label_offsets[label] == pc)) {
+ if (asm_trace_level >= 4)
+ printf("Position of L%d corrected from %04x to %04x\n",
+ label, label_offsets[label], new_pc);
+ label_offsets[label] = new_pc;
+ label = label_next[label];
+ }
+ if (zcode_markers[i] != DELETED_MV) new_pc++;
+ }
+ }
+
+ /* (3) As we are transferring, replace the label numbers in branch
+ operands with offsets to those labels. Also issue markers, now
+ that we know where they occur in the final Z-code area. */
+
+ for (i=0, new_pc=adjusted_pc; i<zcode_ha_size; i++) {
+
+ if (zcode_markers[i] >= BRANCH_MV && zcode_markers[i] < BRANCHMAX_MV) {
+ form_len = 4;
+ if (zcode_markers[i+1] == DELETED_MV) {
+ form_len = 1;
+ }
+ else {
+ if (zcode_markers[i+2] == DELETED_MV)
+ form_len = 2;
+ }
+ j = ((zcode_holding_area[i] << 24)
+ | (zcode_holding_area[i+1] << 16)
+ | (zcode_holding_area[i+2] << 8)
+ | (zcode_holding_area[i+3]));
+
+ /* At the moment, we can safely assume that the branch operand
+ is the end of the opcode, so the next opcode starts right
+ after it. */
+ offset_of_next = new_pc + form_len;
+
+ addr = (label_offsets[j] - offset_of_next) + 2;
+ if (asm_trace_level >= 4) {
+ printf("Branch at offset %04x: %04x (%s)\n",
+ new_pc, addr, ((form_len == 1) ? "byte" :
+ ((form_len == 2) ? "short" : "long")));
+ }
+ if (form_len == 1) {
+ if (addr < -0x80 && addr >= 0x80) {
+ error("*** Label out of range for byte branch ***");
+ }
+ zcode_holding_area[i] = (addr) & 0xFF;
+ }
+ else if (form_len == 2) {
+ if (addr < -0x8000 && addr >= 0x8000) {
+ error("*** Label out of range for short branch ***");
+ }
+ zcode_holding_area[i] = (addr >> 8) & 0xFF;
+ zcode_holding_area[i+1] = (addr) & 0xFF;
+ }
+ else {
+ zcode_holding_area[i] = (addr >> 24) & 0xFF;
+ zcode_holding_area[i+1] = (addr >> 16) & 0xFF;
+ zcode_holding_area[i+2] = (addr >> 8) & 0xFF;
+ zcode_holding_area[i+3] = (addr) & 0xFF;
+ }
+ transfer_byte(zcode_holding_area + i); new_pc++;
+ }
+ else if (zcode_markers[i] == LABEL_MV) {
+ error("*** No LABEL opcodes in Glulx ***");
+ }
+ else if (zcode_markers[i] == DELETED_MV) {
+ /* skip it */
+ }
+ else {
+ switch(zcode_markers[i] & 0x7f) {
+ case NULL_MV:
+ break;
+ case ACTION_MV:
+ case IDENT_MV:
+ if (!module_switch) break;
+ case OBJECT_MV:
+ case VARIABLE_MV:
+ default:
+ if ((zcode_markers[i] & 0x7f) > LARGEST_BPATCH_MV) {
+ error("*** Illegal code backpatch value ***");
+ printf("Illegal value of %02x at PC = %04x\n",
+ zcode_markers[i] & 0x7f, new_pc);
+ break;
+ }
+ /* The backpatch table format for Glulx:
+ First, the marker byte (0..LARGEST_BPATCH_MV).
+ Then a byte indicating the data size to be patched (1, 2, 4).
+ Then the four-byte address (new_pc).
+ */
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++,
+ zcode_markers[i]);
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++,
+ 4);
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, ((new_pc >> 24) & 0xFF));
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, ((new_pc >> 16) & 0xFF));
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, ((new_pc >> 8) & 0xFF));
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, (new_pc & 0xFF));
+ break;
+ }
+ transfer_byte(zcode_holding_area + i); new_pc++;
+ }
+ }
+
+ if (asm_trace_level >= 3)
+ { printf("After branch optimisation, routine length is %d bytes\n",
+ new_pc - rstart_pc);
+ }
+
+ zmachine_pc = adjusted_pc;
+ zcode_ha_size = 0;
+}
+
+
+/* ========================================================================= */
+/* Front ends for the instruction assembler: convenient shorthand forms */
+/* used in various code generation routines all over Inform. */
+/* ------------------------------------------------------------------------- */
+
+void assemble_jump(int n)
+{
+ if (!glulx_mode)
+ assemblez_jump(n);
+ else
+ assembleg_jump(n);
+}
+
+void assemblez_0(int internal_number)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 0;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_0_to(int internal_number, assembly_operand o)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 0;
+ AI.store_variable_number = o.value;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_0_branch(int internal_number, int label, int flag)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 0;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = label;
+ AI.branch_flag = flag;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_1(int internal_number, assembly_operand o1)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 1;
+ AI.operand[0] = o1;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_1_to(int internal_number,
+ assembly_operand o1, assembly_operand st)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 1;
+ AI.operand[0] = o1;
+ AI.store_variable_number = st.value;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_1_branch(int internal_number,
+ assembly_operand o1, int label, int flag)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 1;
+ AI.operand[0] = o1;
+ AI.branch_label_number = label;
+ AI.store_variable_number = -1;
+ AI.branch_flag = flag;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_2(int internal_number,
+ assembly_operand o1, assembly_operand o2)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 2;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_3(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 3;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_3_to(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ assembly_operand st)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 3;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.store_variable_number = st.value;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_3_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ int label, int flag)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 3;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = label;
+ AI.branch_flag = flag;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_4(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ assembly_operand o4)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 4;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_5(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ assembly_operand o4, assembly_operand o5)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 5;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ AI.operand[4] = o5;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_6(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ assembly_operand o4, assembly_operand o5, assembly_operand o6)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 6;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ AI.operand[4] = o5;
+ AI.operand[5] = o6;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_4_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ assembly_operand o4, int label, int flag)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 4;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = label;
+ AI.branch_flag = flag;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_4_to(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ assembly_operand o4, assembly_operand st)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 4;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ AI.store_variable_number = st.value;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_5_to(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand o3,
+ assembly_operand o4, assembly_operand o5, assembly_operand st)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 5;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ AI.operand[4] = o5;
+ AI.store_variable_number = st.value;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_2_to(int internal_number,
+ assembly_operand o1, assembly_operand o2, assembly_operand st)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 2;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.store_variable_number = st.value;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_2_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2, int label, int flag)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 2;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.branch_label_number = label;
+ AI.store_variable_number = -1;
+ AI.branch_flag = flag;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_objcode(int internal_number,
+ assembly_operand o1, assembly_operand st, int label, int flag)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 1;
+ AI.operand[0] = o1;
+ AI.branch_label_number = label;
+ AI.store_variable_number = st.value;
+ AI.branch_flag = flag;
+ assemblez_instruction(&AI);
+}
+
+extern void assemblez_inc(assembly_operand o1)
+{ int m = 0;
+ if ((o1.value >= MAX_LOCAL_VARIABLES)
+ && (o1.value<LOWEST_SYSTEM_VAR_NUMBER))
+ m = VARIABLE_MV;
+ AI.internal_number = inc_zc;
+ AI.operand_count = 1;
+ AI.operand[0].value = o1.value;
+ AI.operand[0].type = SHORT_CONSTANT_OT;
+ AI.operand[0].marker = m;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+extern void assemblez_dec(assembly_operand o1)
+{ int m = 0;
+ if ((o1.value >= MAX_LOCAL_VARIABLES)
+ && (o1.value<LOWEST_SYSTEM_VAR_NUMBER))
+ m = VARIABLE_MV;
+ AI.internal_number = dec_zc;
+ AI.operand_count = 1;
+ AI.operand[0].value = o1.value;
+ AI.operand[0].type = SHORT_CONSTANT_OT;
+ AI.operand[0].marker = m;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+extern void assemblez_store(assembly_operand o1, assembly_operand o2)
+{ int m = 0;
+ if ((o1.value >= MAX_LOCAL_VARIABLES)
+ && (o1.value<LOWEST_SYSTEM_VAR_NUMBER))
+ m = VARIABLE_MV;
+
+ if ((o2.type == VARIABLE_OT) && (o2.value == 0))
+ {
+ /* Assemble "pull VAR" rather than "store VAR sp",
+ saving 1 byte */
+
+ AI.internal_number = pull_zc;
+ if (instruction_set_number == 6)
+ { AI.operand_count = 0;
+ AI.store_variable_number = o1.value;
+ }
+ else
+ { AI.operand_count = 1;
+ AI.operand[0].value = o1.value;
+ AI.operand[0].type = SHORT_CONSTANT_OT;
+ AI.operand[0].marker = m;
+ AI.store_variable_number = -1;
+ }
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+ return;
+ }
+
+ if ((o1.type == VARIABLE_OT) && (o1.value == 0))
+ { /* Assemble "push VAR" rather than "store sp VAR",
+ saving 1 byte */
+
+ AI.internal_number = push_zc;
+ AI.operand_count = 1;
+ AI.operand[0] = o2;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+ return;
+ }
+ AI.internal_number = store_zc;
+ AI.operand_count = 2;
+ AI.operand[0].value = o1.value;
+ AI.operand[0].type = SHORT_CONSTANT_OT;
+ AI.operand[0].marker = m;
+ AI.operand[1] = o2;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+}
+
+void assemblez_jump(int n)
+{ assembly_operand AO;
+ if (n==-4) assemblez_0(rtrue_zc);
+ else if (n==-3) assemblez_0(rfalse_zc);
+ else
+ { AO.type = LONG_CONSTANT_OT; AO.value = n; AO.marker = 0;
+ assemblez_1(jump_zc, AO);
+ }
+}
+
+void assembleg_0(int internal_number)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 0;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_1(int internal_number, assembly_operand o1)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 1;
+ AI.operand[0] = o1;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_2(int internal_number, assembly_operand o1,
+ assembly_operand o2)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 2;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_3(int internal_number, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 3;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_4(int internal_number, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3,
+ assembly_operand o4)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 4;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_5(int internal_number, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3,
+ assembly_operand o4, assembly_operand o5)
+{ AI.internal_number = internal_number;
+ AI.operand_count = 5;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2] = o3;
+ AI.operand[3] = o4;
+ AI.operand[4] = o5;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_0_branch(int internal_number,
+ int label)
+{
+ AI.internal_number = internal_number;
+ AI.operand_count = 1;
+ AI.operand[0].type = CONSTANT_OT;
+ AI.operand[0].value = label;
+ AI.operand[0].marker = BRANCH_MV;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_1_branch(int internal_number,
+ assembly_operand o1, int label)
+{
+ /* Some clever optimizations first. A constant is always or never equal
+ to zero. */
+ if (o1.marker == 0 && is_constant_ot(o1.type)) {
+ if ((internal_number == jz_gc && o1.value == 0)
+ || (internal_number == jnz_gc && o1.value != 0)) {
+ assembleg_0_branch(jump_gc, label);
+ /* We clear the "can't reach statement" flag here,
+ so that "if (1)" doesn't produce that warning. */
+ execution_never_reaches_here = 0;
+ return;
+ }
+ if ((internal_number == jz_gc && o1.value != 0)
+ || (internal_number == jnz_gc && o1.value == 0)) {
+ /* assemble nothing at all! */
+ return;
+ }
+ }
+ AI.internal_number = internal_number;
+ AI.operand_count = 2;
+ AI.operand[0] = o1;
+ AI.operand[1].type = CONSTANT_OT;
+ AI.operand[1].value = label;
+ AI.operand[1].marker = BRANCH_MV;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_2_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2, int label)
+{
+ AI.internal_number = internal_number;
+ AI.operand_count = 3;
+ AI.operand[0] = o1;
+ AI.operand[1] = o2;
+ AI.operand[2].type = CONSTANT_OT;
+ AI.operand[2].value = label;
+ AI.operand[2].marker = BRANCH_MV;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_call_1(assembly_operand oaddr, assembly_operand o1,
+ assembly_operand odest)
+{
+ assembleg_3(callfi_gc, oaddr, o1, odest);
+}
+
+void assembleg_call_2(assembly_operand oaddr, assembly_operand o1,
+ assembly_operand o2, assembly_operand odest)
+{
+ assembleg_4(callfii_gc, oaddr, o1, o2, odest);
+}
+
+void assembleg_call_3(assembly_operand oaddr, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3, assembly_operand odest)
+{
+ assembleg_5(callfiii_gc, oaddr, o1, o2, o3, odest);
+}
+
+void assembleg_inc(assembly_operand o1)
+{
+ AI.internal_number = add_gc;
+ AI.operand_count = 3;
+ AI.operand[0] = o1;
+ AI.operand[1] = one_operand;
+ AI.operand[2] = o1;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_dec(assembly_operand o1)
+{
+ AI.internal_number = sub_gc;
+ AI.operand_count = 3;
+ AI.operand[0] = o1;
+ AI.operand[1] = one_operand;
+ AI.operand[2] = o1;
+ assembleg_instruction(&AI);
+}
+
+void assembleg_store(assembly_operand o1, assembly_operand o2)
+{
+ /* Note the order is reversed: "o1 = o2;" */
+ assembleg_2(copy_gc, o2, o1);
+}
+
+void assembleg_jump(int n)
+{
+ if (n==-4) {
+ assembleg_1(return_gc, one_operand);
+ }
+ else if (n==-3) {
+ assembleg_1(return_gc, zero_operand);
+ }
+ else {
+ assembleg_0_branch(jump_gc, n);
+ }
+}
+
+/* ========================================================================= */
+/* Parsing and then calling the assembler for @ (assembly language) */
+/* statements */
+/* ------------------------------------------------------------------------- */
+
+static assembly_operand parse_operand_z(void)
+{ assembly_operand AO;
+
+ AO = parse_expression(ASSEMBLY_CONTEXT);
+ if (AO.type == EXPRESSION_OT)
+ { ebf_error("variable or constant", "expression");
+ AO.type = SHORT_CONSTANT_OT;
+ }
+ return(AO);
+}
+
+static void parse_assembly_z(void)
+{ int n, min, max, indirect_addressed, error_flag = FALSE;
+ opcodez O;
+
+ AI.operand_count = 0;
+ AI.store_variable_number = -1;
+ AI.branch_label_number = -1;
+ AI.text = NULL;
+
+ opcode_names.enabled = TRUE;
+ get_next_token();
+ opcode_names.enabled = FALSE;
+
+ if (token_type == DQ_TT)
+ { int i;
+ AI.internal_number = -1;
+
+ custom_opcode_z.name = (uchar *) token_text;
+ custom_opcode_z.version1 = instruction_set_number;
+ custom_opcode_z.version2 = instruction_set_number;
+ custom_opcode_z.extension = -1;
+ custom_opcode_z.flags = 0;
+ custom_opcode_z.op_rules = 0;
+ custom_opcode_z.flags2_set = 0;
+ custom_opcode_z.no = ZERO;
+
+ for (i=0; token_text[i]!=0; i++)
+ { if (token_text[i] == ':')
+ { token_text[i++] = 0;
+ break;
+ }
+ }
+ if (token_text[i] == 0)
+ error("Opcode specification should have form \"VAR:102\"");
+
+ n = -1;
+ if (strcmp(token_text, "0OP")==0) n=ZERO;
+ if (strcmp(token_text, "1OP")==0) n=ONE;
+ if (strcmp(token_text, "2OP")==0) n=TWO;
+ if (strcmp(token_text, "VAR")==0) n=VAR;
+ if (strcmp(token_text, "EXT")==0) n=EXT;
+ if (strcmp(token_text, "VAR_LONG")==0) n=VAR_LONG;
+ if (strcmp(token_text, "EXT_LONG")==0) n=EXT_LONG;
+
+ 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);
+ n = EXT;
+ }
+ custom_opcode_z.no = n;
+
+ custom_opcode_z.code = atoi(token_text+i);
+ while (isdigit(token_text[i])) i++;
+
+ { max = 0; min = 0;
+ switch(n)
+ { case ZERO: case ONE: max = 16; break;
+ case VAR: case VAR_LONG: min = 32; max = 64; break;
+ case EXT: case EXT_LONG: max = 256; break;
+ 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);
+ custom_opcode_z.code = min;
+ }
+ }
+
+ while (token_text[i++] != 0)
+ { switch(token_text[i-1])
+ { case 'B': custom_opcode_z.flags |= Br; break;
+ case 'S': custom_opcode_z.flags |= St; break;
+ case 'T': custom_opcode_z.op_rules = TEXT; break;
+ case 'I': custom_opcode_z.op_rules = VARIAB; break;
+ case 'F': custom_opcode_z.flags2_set = atoi(token_text+i);
+ while (isdigit(token_text[i])) i++; break;
+ default:
+ error("Unknown flag: options are B (branch), S (store), \
+T (text), I (indirect addressing), F** (set this Flags 2 bit)");
+ break;
+ }
+ }
+ O = custom_opcode_z;
+ }
+ else
+ { if (token_type != OPCODE_NAME_TT)
+ { ebf_error("an opcode name", token_text);
+ panic_mode_error_recovery();
+ return;
+ }
+ AI.internal_number = token_value;
+ O = internal_number_to_opcode_z(AI.internal_number);
+ }
+
+ indirect_addressed = (O.op_rules == VARIAB);
+
+ if (O.op_rules == TEXT)
+ { get_next_token();
+ if (token_type != DQ_TT)
+ ebf_error("literal text in double-quotes", token_text);
+ AI.text = token_text;
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { assemblez_instruction(&AI);
+ return;
+ }
+ ebf_error("semicolon ';' after print string", token_text);
+ put_token_back();
+ return;
+ }
+
+ return_sp_as_variable = TRUE;
+ do
+ { get_next_token();
+
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
+
+ if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
+ { if (AI.store_variable_number != -1)
+ error("Only one '->' store destination can be given");
+ get_next_token();
+ if ((token_type != SYMBOL_TT)
+ && (token_type != LOCAL_VARIABLE_TT))
+ ebf_error("variable name or 'sp'", token_text);
+ n = 255;
+ if (token_type == LOCAL_VARIABLE_TT) n = token_value;
+ else
+ { if (strcmp(token_text, "sp") == 0) n = 0;
+ else
+ { if (stypes[token_value] != GLOBAL_VARIABLE_T)
+ error_named(
+ "Store '->' destination not 'sp' or a variable:",
+ token_text);
+ else n = svals[token_value];
+ }
+ }
+ AI.store_variable_number = n;
+ continue;
+ }
+
+ if ((token_type == SEP_TT) &&
+ ((token_value == BRANCH_SEP) || (token_value == NBRANCH_SEP)))
+ { if (AI.branch_label_number != -1)
+ error("Only one '?' branch destination can be given");
+
+ AI.branch_flag = (token_value == BRANCH_SEP);
+
+ opcode_names.enabled = TRUE;
+ get_next_token();
+ opcode_names.enabled = FALSE;
+
+ n = -2;
+ if ((token_type == OPCODE_NAME_TT)
+ && (token_value == rfalse_zc)) n = -3;
+ else
+ if ((token_type == OPCODE_NAME_TT)
+ && (token_value == rtrue_zc)) n = -4;
+ else
+ { if (token_type == SYMBOL_TT)
+ { put_token_back();
+ n = parse_label();
+ }
+ else
+ ebf_error("label name after '?' or '?~'", token_text);
+ }
+ AI.branch_label_number = n;
+ continue;
+ }
+
+ if (AI.operand_count == 8)
+ { error("No assembly instruction may have more than 8 operands");
+ panic_mode_error_recovery(); break;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
+ { if (!indirect_addressed)
+ error("This opcode does not use indirect addressing");
+ if (AI.operand_count > 0)
+ error("Indirect addressing can only be used on the first operand");
+ 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);
+ put_token_back();
+ }
+ }
+ else
+ { put_token_back();
+ AI.operand[AI.operand_count++] = parse_operand_z();
+ if ((indirect_addressed) && (AI.operand_count == 1)
+ && (AI.operand[AI.operand_count-1].type == VARIABLE_OT))
+ { AI.operand[AI.operand_count-1].type = SHORT_CONSTANT_OT;
+ AI.operand[AI.operand_count-1].marker = VARIABLE_MV;
+ }
+ }
+
+ } while (TRUE);
+
+ return_sp_as_variable = FALSE;
+
+
+ if (O.version1 == 0)
+ { error_named("Opcode unavailable in this Z-machine version:",
+ opcode_names.keywords[AI.internal_number]);
+ return;
+ }
+
+ if (((O.flags) & Br) != 0)
+ { if (AI.branch_label_number == -1)
+ { error_flag = TRUE;
+ AI.branch_label_number = -2;
+ }
+ }
+ else
+ { if (AI.branch_label_number != -1)
+ { error_flag = TRUE;
+ AI.branch_label_number = -1;
+ }
+ }
+ if (((O.flags) & St) != 0)
+ { if (AI.store_variable_number == -1)
+ { if (AI.operand_count == 0)
+ { error_flag = TRUE;
+ AI.store_variable_number = 255;
+ }
+ else
+ { AI.store_variable_number
+ = AI.operand[--AI.operand_count].value;
+ if (AI.operand[AI.operand_count].type != VARIABLE_OT)
+ error("Store destination (the last operand) is not a variable");
+ }
+ }
+ }
+ else
+ { if (AI.store_variable_number != -1)
+ { error_flag = TRUE;
+ AI.store_variable_number = -1;
+ }
+ }
+
+ min = 0; max = 0;
+ switch(O.no)
+ { case TWO: min = 2; max = 2;
+ /* Exception for the V6 set_colour, which can take
+ a third argument, thus forcing it into VAR form: */
+ if ((version_number == 6) && (O.code == 0x1b)) max = 3;
+ /* Also an exception for je, which can take from 1
+ argument (useless) to 4 arguments */
+ if (O.code == 0x01) { min = 1; max = 4; }
+ break;
+ case VAR: min = 0; max = 4; break;
+ case VAR_LONG: min = 0; max = 8; break;
+ case ONE: min = 1; max = 1; break;
+ case ZERO: min = 0; max = 0; break;
+ case EXT: min = 0; max = 4; break;
+ case EXT_LONG: min = 0; max = 8; break;
+ }
+
+ if ((AI.operand_count >= min) && (AI.operand_count <= max))
+ assemblez_instruction(&AI);
+ else error_flag = TRUE;
+
+ if (error_flag)
+ { make_opcode_syntax_z(O);
+ error_named("Assembly mistake: syntax is",
+ opcode_syntax_string);
+ }
+}
+
+static assembly_operand parse_operand_g(void)
+{ assembly_operand AO;
+
+ AO = parse_expression(ASSEMBLY_CONTEXT);
+ if (AO.type == EXPRESSION_OT)
+ { ebf_error("variable or constant", "expression");
+ AO.type = CONSTANT_OT;
+ }
+ return(AO);
+}
+
+static void parse_assembly_g(void)
+{
+ opcodeg O;
+ assembly_operand AO;
+ int error_flag = FALSE, is_macro = FALSE;
+
+ AI.operand_count = 0;
+
+ 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) {
+ 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++;
+ }
+
+ return_sp_as_variable = FALSE;
+
+ 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) {
+ make_opcode_syntax_g(O);
+ error_named("Assembly mistake: syntax is",
+ opcode_syntax_string);
+ }
+}
+
+extern void parse_assembly(void)
+{
+ if (!glulx_mode)
+ parse_assembly_z();
+ else
+ parse_assembly_g();
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void asm_begin_pass(void)
+{ no_instructions = 0;
+ zmachine_pc = 0;
+ no_sequence_points = 0;
+ next_label = 0;
+ next_sequence_point = 0;
+ zcode_ha_size = 0;
+}
+
+extern void init_asm_vars(void)
+{ int i;
+
+ for (i=0;i<16;i++) flags2_requirements[i]=0;
+
+ uses_unicode_features = FALSE;
+ uses_memheap_features = FALSE;
+ uses_acceleration_features = FALSE;
+ uses_float_features = FALSE;
+
+ sequence_point_follows = TRUE;
+ label_moved_error_already_given = FALSE;
+
+ initialise_memory_block(&zcode_area);
+}
+
+extern void asm_allocate_arrays(void)
+{ if ((debugfile_switch) && (MAX_LABELS < 2000)) MAX_LABELS = 2000;
+
+ variable_tokens = my_calloc(sizeof(int32),
+ MAX_LOCAL_VARIABLES+MAX_GLOBAL_VARIABLES, "variable tokens");
+ variable_usage = my_calloc(sizeof(int),
+ MAX_LOCAL_VARIABLES+MAX_GLOBAL_VARIABLES, "variable usage");
+
+ label_offsets = my_calloc(sizeof(int32), MAX_LABELS, "label offsets");
+ label_symbols = my_calloc(sizeof(int32), MAX_LABELS, "label symbols");
+ label_next = my_calloc(sizeof(int), MAX_LABELS, "label dll 1");
+ label_prev = my_calloc(sizeof(int), MAX_LABELS, "label dll 1");
+ sequence_point_labels
+ = my_calloc(sizeof(int), MAX_LABELS, "sequence point labels");
+ sequence_point_locations
+ = my_calloc(sizeof(debug_location),
+ MAX_LABELS,
+ "sequence point locations");
+
+ zcode_holding_area = my_malloc(MAX_ZCODE_SIZE,"compiled routine code area");
+ zcode_markers = my_malloc(MAX_ZCODE_SIZE, "compiled routine code area");
+
+ named_routine_symbols
+ = my_calloc(sizeof(int32), MAX_SYMBOLS, "named routine symbols");
+}
+
+extern void asm_free_arrays(void)
+{
+ my_free(&variable_tokens, "variable tokens");
+ my_free(&variable_usage, "variable usage");
+
+ my_free(&label_offsets, "label offsets");
+ my_free(&label_symbols, "label symbols");
+ my_free(&label_next, "label dll 1");
+ my_free(&label_prev, "label dll 2");
+ my_free(&sequence_point_labels, "sequence point labels");
+ my_free(&sequence_point_locations, "sequence point locations");
+
+ my_free(&zcode_holding_area, "compiled routine code area");
+ my_free(&zcode_markers, "compiled routine code markers");
+
+ my_free(&named_routine_symbols, "named routine symbols");
+ deallocate_memory_block(&zcode_area);
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "bpatch" : Keeps track of, and finally acts on, backpatch markers, */
+/* correcting symbol values not known at compilation time */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+memory_block zcode_backpatch_table, zmachine_backpatch_table;
+int32 zcode_backpatch_size, zmachine_backpatch_size;
+
+/* ------------------------------------------------------------------------- */
+/* The mending operation */
+/* ------------------------------------------------------------------------- */
+
+int backpatch_marker, backpatch_size, backpatch_error_flag;
+
+static int32 backpatch_value_z(int32 value)
+{ /* Corrects the quantity "value" according to backpatch_marker */
+
+ ASSERT_ZCODE();
+
+ if (asm_trace_level >= 4)
+ printf("BP %s applied to %04x giving ",
+ describe_mv(backpatch_marker), value);
+
+ switch(backpatch_marker)
+ { case STRING_MV:
+ value += strings_offset/scale_factor; break;
+ case ARRAY_MV:
+ value += variables_offset; break;
+ case IROUTINE_MV:
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset/scale_factor;
+ break;
+ case VROUTINE_MV:
+ if ((value<0) || (value>=VENEER_ROUTINES))
+ { if (no_link_errors > 0) break;
+ if (compiler_error
+ ("Backpatch veneer routine number out of range"))
+ { printf("Illegal BP veneer routine number: %d\n", value);
+ backpatch_error_flag = TRUE;
+ }
+ value = 0;
+ break;
+ }
+ value = veneer_routine_address[value];
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset/scale_factor;
+ break;
+ case NO_OBJS_MV:
+ value = no_objects; break;
+ case INCON_MV:
+ if ((value<0) || (value>=NO_SYSTEM_CONSTANTS))
+ { if (no_link_errors > 0) break;
+ if (compiler_error
+ ("Backpatch system constant number out of range"))
+ { printf("Illegal BP system constant number: %d\n", value);
+ backpatch_error_flag = TRUE;
+ }
+ value = 0;
+ break;
+ }
+ value = value_of_system_constant(value); break;
+ case DWORD_MV:
+ value = dictionary_offset + 7 +
+ final_dict_order[value]*((version_number==3)?7:9);
+ break;
+ case ACTION_MV:
+ break;
+ case INHERIT_MV:
+ value = 256*zmachine_paged_memory[value + prop_values_offset]
+ + zmachine_paged_memory[value + prop_values_offset + 1];
+ break;
+ case INHERIT_INDIV_MV:
+ value = 256*zmachine_paged_memory[value
+ + individuals_offset]
+ + zmachine_paged_memory[value
+ + individuals_offset + 1];
+ break;
+ case INDIVPT_MV:
+ value += individuals_offset;
+ break;
+ case MAIN_MV:
+ value = symbol_index("Main", -1);
+ if (stypes[value] != ROUTINE_T)
+ error("No 'Main' routine has been defined");
+ sflags[value] |= USED_SFLAG;
+ value = svals[value];
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset/scale_factor;
+ break;
+ case SYMBOL_MV:
+ if ((value<0) || (value>=no_symbols))
+ { if (no_link_errors > 0) break;
+ if (compiler_error("Backpatch symbol number out of range"))
+ { printf("Illegal BP symbol number: %d\n", value);
+ backpatch_error_flag = TRUE;
+ }
+ value = 0;
+ break;
+ }
+ if (sflags[value] & UNKNOWN_SFLAG)
+ { if (!(sflags[value] & UERROR_SFLAG))
+ { sflags[value] |= UERROR_SFLAG;
+ error_named_at("No such constant as",
+ (char *) symbs[value], slines[value]);
+ }
+ }
+ else
+ if (sflags[value] & CHANGE_SFLAG)
+ { sflags[value] &= (~(CHANGE_SFLAG));
+ backpatch_marker = (svals[value]/0x10000);
+ if ((backpatch_marker < 0)
+ || (backpatch_marker > LARGEST_BPATCH_MV))
+ {
+ if (no_link_errors == 0)
+ { compiler_error_named(
+ "Illegal backpatch marker attached to symbol",
+ (char *) symbs[value]);
+ backpatch_error_flag = TRUE;
+ }
+ }
+ else
+ svals[value] = backpatch_value_z((svals[value]) % 0x10000);
+ }
+
+ sflags[value] |= USED_SFLAG;
+ { int t = stypes[value];
+ value = svals[value];
+ switch(t)
+ { case ROUTINE_T:
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset/scale_factor;
+ break;
+ case ARRAY_T: value += variables_offset; break;
+ }
+ }
+ break;
+ default:
+ if (no_link_errors > 0) break;
+ if (compiler_error("Illegal backpatch marker"))
+ { printf("Illegal backpatch marker %d value %04x\n",
+ backpatch_marker, value);
+ backpatch_error_flag = TRUE;
+ }
+ break;
+ }
+
+ if (asm_trace_level >= 4) printf(" %04x\n", value);
+
+ return(value);
+}
+
+static int32 backpatch_value_g(int32 value)
+{ /* Corrects the quantity "value" according to backpatch_marker */
+ int32 valaddr;
+
+ ASSERT_GLULX();
+
+ if (asm_trace_level >= 4)
+ printf("BP %s applied to %04x giving ",
+ describe_mv(backpatch_marker), value);
+
+ switch(backpatch_marker)
+ {
+ case STRING_MV:
+ if (value <= 0 || value > no_strings)
+ compiler_error("Illegal string marker.");
+ value = strings_offset + compressed_offsets[value-1]; break;
+ case IROUTINE_MV:
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset;
+ break;
+ case ARRAY_MV:
+ value += arrays_offset; break;
+ case VARIABLE_MV:
+ value = variables_offset + (4*value); break;
+ case OBJECT_MV:
+ value = object_tree_offset + (OBJECT_BYTE_LENGTH*(value-1));
+ break;
+ case VROUTINE_MV:
+ if ((value<0) || (value>=VENEER_ROUTINES))
+ { if (no_link_errors > 0) break;
+ if (compiler_error
+ ("Backpatch veneer routine number out of range"))
+ { printf("Illegal BP veneer routine number: %d\n", value);
+ backpatch_error_flag = TRUE;
+ }
+ value = 0;
+ break;
+ }
+ value = veneer_routine_address[value];
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset;
+ break;
+ case NO_OBJS_MV:
+ value = no_objects; break;
+ case INCON_MV:
+ if ((value<0) || (value>=NO_SYSTEM_CONSTANTS))
+ { if (no_link_errors > 0) break;
+ if (compiler_error
+ ("Backpatch system constant number out of range"))
+ { printf("Illegal BP system constant number: %d\n", value);
+ backpatch_error_flag = TRUE;
+ }
+ value = 0;
+ break;
+ }
+ value = value_of_system_constant(value); break;
+ case DWORD_MV:
+ value = dictionary_offset + 4
+ + final_dict_order[value]*DICT_ENTRY_BYTE_LENGTH;
+ break;
+ case ACTION_MV:
+ break;
+ case INHERIT_MV:
+ valaddr = (prop_values_offset - Write_RAM_At) + value;
+ value = ReadInt32(zmachine_paged_memory + valaddr);
+ break;
+ case INHERIT_INDIV_MV:
+ error("*** No individual property storage in Glulx ***");
+ break;
+ case INDIVPT_MV:
+ value += individuals_offset;
+ break;
+ case MAIN_MV:
+ value = symbol_index("Main", -1);
+ if (stypes[value] != ROUTINE_T)
+ error("No 'Main' routine has been defined");
+ sflags[value] |= USED_SFLAG;
+ value = svals[value];
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset;
+ break;
+ case SYMBOL_MV:
+ if ((value<0) || (value>=no_symbols))
+ { if (no_link_errors > 0) break;
+ if (compiler_error("Backpatch symbol number out of range"))
+ { printf("Illegal BP symbol number: %d\n", value);
+ backpatch_error_flag = TRUE;
+ }
+ value = 0;
+ break;
+ }
+ if (sflags[value] & UNKNOWN_SFLAG)
+ { if (!(sflags[value] & UERROR_SFLAG))
+ { sflags[value] |= UERROR_SFLAG;
+ error_named_at("No such constant as",
+ (char *) symbs[value], slines[value]);
+ }
+ }
+ else
+ if (sflags[value] & CHANGE_SFLAG)
+ { sflags[value] &= (~(CHANGE_SFLAG));
+ backpatch_marker = smarks[value];
+ if ((backpatch_marker < 0)
+ || (backpatch_marker > LARGEST_BPATCH_MV))
+ {
+ if (no_link_errors == 0)
+ { compiler_error_named(
+ "Illegal backpatch marker attached to symbol",
+ (char *) symbs[value]);
+ backpatch_error_flag = TRUE;
+ }
+ }
+ else
+ svals[value] = backpatch_value_g(svals[value]);
+ }
+
+ sflags[value] |= USED_SFLAG;
+ { int t = stypes[value];
+ value = svals[value];
+ switch(t)
+ {
+ case ROUTINE_T:
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset;
+ break;
+ case ARRAY_T: value += arrays_offset; break;
+ case OBJECT_T:
+ case CLASS_T:
+ value = object_tree_offset +
+ (OBJECT_BYTE_LENGTH*(value-1));
+ break;
+ case ATTRIBUTE_T:
+ /* value is unchanged */
+ break;
+ case CONSTANT_T:
+ case INDIVIDUAL_PROPERTY_T:
+ /* value is unchanged */
+ break;
+ default:
+ error("*** Illegal backpatch marker in forward-declared \
+symbol");
+ break;
+ }
+ }
+ break;
+ default:
+ if (no_link_errors > 0) break;
+ if (compiler_error("Illegal backpatch marker"))
+ { printf("Illegal backpatch marker %d value %04x\n",
+ backpatch_marker, value);
+ backpatch_error_flag = TRUE;
+ }
+ break;
+ }
+
+ if (asm_trace_level >= 4) printf(" %04x\n", value);
+
+ return(value);
+}
+
+extern int32 backpatch_value(int32 value)
+{
+ if (!glulx_mode)
+ return backpatch_value_z(value);
+ else
+ return backpatch_value_g(value);
+}
+
+static void backpatch_zmachine_z(int mv, int zmachine_area, int32 offset)
+{ if (module_switch)
+ { if (zmachine_area == PROP_DEFAULTS_ZA) return;
+ }
+ else
+ { if (mv == OBJECT_MV) return;
+ if (mv == IDENT_MV) return;
+ if (mv == ACTION_MV) return;
+ }
+
+ /* printf("MV %d ZA %d Off %04x\n", mv, zmachine_area, offset); */
+
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, mv);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, zmachine_area);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, offset/256);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, offset%256);
+}
+
+static void backpatch_zmachine_g(int mv, int zmachine_area, int32 offset)
+{ if (module_switch)
+ { if (zmachine_area == PROP_DEFAULTS_ZA) return;
+ }
+ else
+ { if (mv == IDENT_MV) return;
+ if (mv == ACTION_MV) return;
+ }
+
+/* The backpatch table format for Glulx:
+ First, the marker byte.
+ Then, the zmachine area being patched.
+ Then the four-byte address.
+*/
+
+/* printf("+MV %d ZA %d Off %06x\n", mv, zmachine_area, offset); */
+
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, mv);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, zmachine_area);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, (offset >> 24) & 0xFF);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, (offset >> 16) & 0xFF);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, (offset >> 8) & 0xFF);
+ write_byte_to_memory_block(&zmachine_backpatch_table,
+ zmachine_backpatch_size++, (offset) & 0xFF);
+}
+
+extern void backpatch_zmachine(int mv, int zmachine_area, int32 offset)
+{
+ if (!glulx_mode)
+ backpatch_zmachine_z(mv, zmachine_area, offset);
+ else
+ backpatch_zmachine_g(mv, zmachine_area, offset);
+}
+
+extern void backpatch_zmachine_image_z(void)
+{ int bm = 0, zmachine_area; int32 offset, value, addr = 0;
+ ASSERT_ZCODE();
+ backpatch_error_flag = FALSE;
+ while (bm < zmachine_backpatch_size)
+ { backpatch_marker
+ = read_byte_from_memory_block(&zmachine_backpatch_table, bm);
+ zmachine_area
+ = read_byte_from_memory_block(&zmachine_backpatch_table, bm+1);
+ offset
+ = 256*read_byte_from_memory_block(&zmachine_backpatch_table,bm+2)
+ + read_byte_from_memory_block(&zmachine_backpatch_table, bm+3);
+ bm += 4;
+
+ switch(zmachine_area)
+ { case PROP_DEFAULTS_ZA: addr = prop_defaults_offset; break;
+ case PROP_ZA: addr = prop_values_offset; break;
+ case INDIVIDUAL_PROP_ZA: addr = individuals_offset; break;
+ case DYNAMIC_ARRAY_ZA: addr = variables_offset; break;
+ default:
+ if (no_link_errors == 0)
+ if (compiler_error("Illegal area to backpatch"))
+ backpatch_error_flag = TRUE;
+ }
+ addr += offset;
+
+ value = 256*zmachine_paged_memory[addr]
+ + zmachine_paged_memory[addr+1];
+ value = backpatch_value_z(value);
+ zmachine_paged_memory[addr] = value/256;
+ zmachine_paged_memory[addr+1] = value%256;
+
+ if (backpatch_error_flag)
+ { backpatch_error_flag = FALSE;
+ if (no_link_errors == 0)
+ printf("*** MV %d ZA %d Off %04x ***\n",
+ backpatch_marker, zmachine_area, offset);
+ }
+ }
+}
+
+extern void backpatch_zmachine_image_g(void)
+{ int bm = 0, zmachine_area; int32 offset, value, addr = 0;
+ ASSERT_GLULX();
+ backpatch_error_flag = FALSE;
+ while (bm < zmachine_backpatch_size)
+ { backpatch_marker
+ = read_byte_from_memory_block(&zmachine_backpatch_table, bm);
+ zmachine_area
+ = read_byte_from_memory_block(&zmachine_backpatch_table, bm+1);
+ offset = read_byte_from_memory_block(&zmachine_backpatch_table, bm+2);
+ offset = (offset << 8) |
+ read_byte_from_memory_block(&zmachine_backpatch_table, bm+3);
+ offset = (offset << 8) |
+ read_byte_from_memory_block(&zmachine_backpatch_table, bm+4);
+ offset = (offset << 8) |
+ read_byte_from_memory_block(&zmachine_backpatch_table, bm+5);
+ bm += 6;
+
+ /* printf("-MV %d ZA %d Off %06x\n", backpatch_marker, zmachine_area, offset); */
+
+ switch(zmachine_area) {
+ case PROP_DEFAULTS_ZA: addr = prop_defaults_offset+4; break;
+ case PROP_ZA: addr = prop_values_offset; break;
+ case INDIVIDUAL_PROP_ZA: addr = individuals_offset; break;
+ case ARRAY_ZA: addr = arrays_offset; break;
+ case GLOBALVAR_ZA: addr = variables_offset; break;
+ default:
+ if (no_link_errors == 0)
+ if (compiler_error("Illegal area to backpatch"))
+ backpatch_error_flag = TRUE;
+ }
+ addr = addr + offset - Write_RAM_At;
+
+ value = (zmachine_paged_memory[addr] << 24)
+ | (zmachine_paged_memory[addr+1] << 16)
+ | (zmachine_paged_memory[addr+2] << 8)
+ | (zmachine_paged_memory[addr+3]);
+ value = backpatch_value_g(value);
+ zmachine_paged_memory[addr] = (value >> 24) & 0xFF;
+ zmachine_paged_memory[addr+1] = (value >> 16) & 0xFF;
+ zmachine_paged_memory[addr+2] = (value >> 8) & 0xFF;
+ zmachine_paged_memory[addr+3] = (value) & 0xFF;
+
+ if (backpatch_error_flag)
+ { backpatch_error_flag = FALSE;
+ if (no_link_errors == 0)
+ printf("*** MV %d ZA %d Off %04x ***\n",
+ backpatch_marker, zmachine_area, offset);
+ }
+ }
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_bpatch_vars(void)
+{ initialise_memory_block(&zcode_backpatch_table);
+ initialise_memory_block(&zmachine_backpatch_table);
+}
+
+extern void bpatch_begin_pass(void)
+{ zcode_backpatch_size = 0;
+ zmachine_backpatch_size = 0;
+}
+
+extern void bpatch_allocate_arrays(void)
+{
+}
+
+extern void bpatch_free_arrays(void)
+{ deallocate_memory_block(&zcode_backpatch_table);
+ deallocate_memory_block(&zmachine_backpatch_table);
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "chars" : Character set mappings and the Z-machine alphabet table */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+/* Inform uses six different character representations: */
+/* */
+/* ASCII plain ASCII characters in range $20 to $7e */
+/* (unsigned 7-bit number) */
+/* Source raw bytes from source code */
+/* (unsigned 8-bit number) */
+/* ISO plain ASCII or ISO 8859-1 to -9, according to value */
+/* character_set_setting == 0 or 1 to 9 */
+/* in Unicode mode (character_set_unicode), individual */
+/* UTF-8 bytes */
+/* (unsigned 8-bit number) */
+/* ZSCII the Z-machine's character set */
+/* (unsigned 10-bit number) */
+/* textual such as the text @'e to mean e-acute */
+/* or @$03a3 to mean capital Greek sigma */
+/* in Unicode mode, the operations manipulating multibyte */
+/* UCS representations are included in text routines */
+/* (sequence of ASCII characters) */
+/* Unicode a unifying character set holding all possible characters */
+/* Inform can ever deal with */
+/* (unsigned 16-bit number) */
+/* */
+/* Conversion can always be made down this list, but generally not up. */
+/* Note that all ASCII values are the same in any version of ISO */
+/* and in Unicode. */
+/* */
+/* There is a seventh form: sequences of 5-bit "Z-chars" which encode */
+/* ZSCII into the story file in compressed form. Conversion of ZSCII to */
+/* and from Z-char sequences, although it uses the alphabet table, is done */
+/* in "text.c". */
+/* ------------------------------------------------------------------------- */
+/* The main data structures need to be modified in mid-compilation, but */
+/* several of them depend on each other, and must remain consistent; */
+/* and rebuilding one sometimes uses conversion routines depending on */
+/* information held in the others: */
+/* */
+/* Structure If changed, need to rebuild: */
+/* character_set_setting source_to_iso_grid[] */
+/* zscii_to_unicode_grid[] */
+/* zscii_to_iso_grid[] */
+/* iso_to_unicode_grid[] */
+/* alphabet[][] iso_to_alphabet_grid[] */
+/* zscii_to_alphabet_grid[] */
+/* zscii_to_unicode_grid[] iso_to_alphabet_grid[] */
+/* source_to_iso_grid[] <nothing> */
+/* iso_to_alphabet_grid[] <nothing> */
+/* zscii_to_alphabet_grid[] <nothing> */
+/* zscii_to_iso_grid[] <nothing> */
+/* */
+/* (zscii_to_iso_grid[] is made whenever iso_to_alphabet_grid[] is */
+/* made but does not depend on alphabet[].) */
+/* */
+/* Conversion routine Makes use of: */
+/* iso_to_unicode character_set_setting */
+/* unicode_to_zscii character_set_setting */
+/* zscii_to_unicode_grid[] */
+/* zscii_to_unicode character_set_setting */
+/* zscii_to_unicode_grid[] */
+/* text_to_unicode <nothing> */
+/* zscii_to_text character_set_setting */
+/* zscii_to_unicode_grid[] */
+/* zscii_to_iso_grid[] */
+/* */
+/* For example, if we want to change alphabet[][] then we can safely */
+/* use any of the conversion routines while working on the change, but */
+/* must rebuild the iso_to_alphabet_grid[] before allowing Inform to */
+/* continue compiling. */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+uchar source_to_iso_grid[0x100]; /* Filters source code into legal ISO */
+
+int32 iso_to_unicode_grid[0x100]; /* Filters ISO into Unicode */
+
+int character_digit_value[128]; /* Parsing of binary, decimal and hex */
+
+static char *accents = /* Standard 0.2 stock of accented... */
+
+ ":a:o:u:A:O:Uss>><<:e:i:y:E:I'a'e'i'o'u'y'A'E'I'O'U'Y`a`e`i`o`u\
+`A`E`I`O`U^a^e^i^o^u^A^E^I^O^UoaoA/o/O~a~n~o~A~N~OaeAEcccCthetThEtLLoeOE!!??";
+
+ /* ...characters, numbered upwards */
+ /* from 155 */
+
+/* ------------------------------------------------------------------------- */
+
+uchar alphabet[3][27]; /* The alphabet table. */
+
+int alphabet_modified; /* Has the default been changed? */
+
+char alphabet_used[78]; /* Flags (holding 'N' or 'Y') for
+ which of the Z-alphabet letters
+ have actually been encrypted */
+
+/* ------------------------------------------------------------------------- */
+
+int iso_to_alphabet_grid[0x100];
+
+/* This array combines two conversion processes which have to run quickly:
+ an ISO character n is being converted for text purposes into a stream
+ of Z-chars (anything from 1 up to 8 of these). Unicode but non-ISO
+ characters are also converted from text, but far less often, and
+ different (and slower) methods are used to carry this out.
+
+ iso_to_alphabet_grid[n]
+ = i if the character exists in ZSCII and is located at
+ position i in the Z-machine alphabet (where 0 to 25
+ give positions in A0, 26 to 51 in A1 and 52 to 77 in A2);
+
+ -z if the character exists in ZSCII as value z, but is not
+ located anywhere in the Z-machine alphabet;
+
+ -5 if the character does not exist in ZSCII. (It will still
+ be printable using an 8-Z-char sequence to encode it in
+ Unicode form, but there's no ZSCII form.)
+
+ Note that ISO tilde ~ is interpreted as ZSCII double-quote ",
+ and ISO circumflex ^ is interpreted as ZSCII new-line, in accordance
+ with the Inform syntax for strings. This is automatic from the
+ structure of alphabet[][]:
+
+ alphabet[i][j] = the ZSCII code of letter j (0 to 25)
+ in alphabet i (0 to 2)
+
+ _except that_
+
+ alphabet[2][0] is ignored by the Z-machine and Inform
+ (char 0 in A2 is an escape)
+ alphabet[2][1] is ignored by the Z-machine
+ (char 1 in A2 means new-line)
+ but used by Inform to hold ISO circumflex
+ so that ^ is translated as new-line
+ alphabet[2][19] is used by Inform to hold ISO tilde
+ so that ~ is translated as ": after
+ compilation, when the alphabet table is
+ written into the Z-machine, this entry
+ is changed back to ".
+
+ Note that the alphabet can only hold ZSCII values between 0 and 255.
+
+ The array is dimensioned as [3][27], not [3][26], to make it easier to
+ initialise using strcpy (see below), but the zero entries [x][26] are
+ not used */
+
+int zscii_to_alphabet_grid[0x100];
+
+/* The same, except that the index is a ZSCII character, not an ISO one. */
+
+int zscii_to_iso_grid[0x100]; /* Converts ZSCII between 0 and 255 to
+ codes in current ISO set: or to 0 if
+ code isn't in the current ISO set. */
+
+static void make_iso_to_alphabet_grid(void)
+{ int i, j, k; int z;
+
+ for (j=0; j<0x100; j++)
+ { zscii_to_iso_grid[j] = 0;
+ zscii_to_alphabet_grid[j] = -j;
+ }
+
+ for (j=0; j<0x100; j++)
+ { iso_to_alphabet_grid[j]=-5;
+ if ((j >= 0x20) && (j <= 0x7e))
+ { iso_to_alphabet_grid[j] = -j;
+ zscii_to_iso_grid[j] = j;
+ }
+ if ((j >= 0xa1) && (j <= 0xff))
+ { z = unicode_to_zscii(iso_to_unicode(j));
+ if (character_set_setting != 0)
+ zscii_to_iso_grid[z] = j;
+ iso_to_alphabet_grid[j] = -z;
+ }
+ iso_to_unicode_grid[j] = iso_to_unicode(j);
+ }
+ for (j=0; j<3; j++)
+ for (k=(j<2?0:1); k<26; k++)
+ { i=(int) ((alphabet[j])[k]);
+ zscii_to_alphabet_grid[i] = k + j*26;
+ iso_to_alphabet_grid[zscii_to_iso_grid[i]] = k + j*26;
+ }
+}
+
+extern void map_new_zchar(int32 unicode)
+{ /* Attempts to enter the given Unicode character into the "alphabet[]"
+ array, in place of one which has not so far been used in the
+ compilation of the current file. This may of course fail. */
+
+ int i, j; int zscii;
+
+ zscii = unicode_to_zscii(unicode);
+
+ /* Out of ZSCII range? */
+ if ((zscii == 5) || (zscii >= 0x100))
+ { unicode_char_error(
+ "Character must first be entered into Zcharacter table:", unicode);
+ return;
+ }
+
+ /* Already there? */
+ for (i=0;i<3;i++) for (j=0;j<26;j++)
+ if (alphabet[i][j] == zscii) return;
+
+ /* A0 and A1 are never changed. Try to find a place in alphabet A2:
+
+ xx0123456789.,!?_#'~/\-:()
+ ^^^^^^^^^^ ^^^^^ ^^^^^^
+
+ The letters marked ^ are considered to be replaceable, as long as
+ they haven't yet been used in any text already encoded, and haven't
+ already been replaced. The routine works along from the left, since
+ numerals are more of a luxury than punctuation. */
+
+ for (i=2; i<26; i++)
+ { if ((i == 12) || (i == 13) || (i == 19)) continue;
+ if (alphabet_used[52+i] == 'N')
+ { alphabet_used[52+i] = 'Y';
+ alphabet[2][i] = zscii;
+ alphabet_modified = TRUE;
+ make_iso_to_alphabet_grid();
+ return;
+ }
+ }
+}
+
+extern void new_alphabet(char *text, int which_alph)
+{
+ /* Called three times in succession, with which_alph = 0, 1, 2 */
+
+ int i, j, zscii; int32 unicode;
+
+ alphabet_modified = TRUE;
+
+ if (which_alph == 2)
+ { i=3; alphabet[2][2] = '~';
+ }
+ else i=0;
+
+ for (j=0; i<26; i++)
+ { if (text[j] == 0) goto WrongSizeError;
+
+ unicode = text_to_unicode(text+j);
+ j += textual_form_length;
+
+ zscii = unicode_to_zscii(unicode);
+ if ((zscii == 5) || (zscii >= 0x100))
+ unicode_char_error("Character can't be used in alphabets unless \
+entered into Zcharacter table", unicode);
+ else alphabet[which_alph][i] = zscii;
+ }
+
+ if (text[j] != 0)
+ { WrongSizeError:
+ if (which_alph == 2)
+ error("Alphabet string must give exactly 23 characters");
+ else
+ error("Alphabet string must give exactly 26 characters");
+ }
+
+ if (which_alph == 2)
+ { int test_dups[0x100];
+ for (i=0; i<0x100; i++) test_dups[i] = 0;
+ for (i=0; i<3; i++) for (j=0; j<26; j++)
+ { if (test_dups[alphabet[i][j]]++ == 1)
+ unicode_char_error("Character duplicated in alphabet:",
+ zscii_to_unicode(alphabet[i][j]));
+ }
+
+ make_iso_to_alphabet_grid();
+ }
+}
+
+static void read_source_to_iso_file(uchar *uccg)
+{ FILE *charset_file;
+ char cs_buff[256];
+ char *p;
+ int i=0;
+
+ charset_file=fopen(Charset_Map, "r");
+ if (charset_file==NULL)
+ fatalerror_named("Couldn't open character set mapping", Charset_Map);
+
+ while (feof(charset_file)==0)
+ { if (fgets(cs_buff,256,charset_file)==0) break;
+
+ switch (cs_buff[0])
+ { case '!': /* Ignore comments in file */
+ break;
+ case 'C': /* Set character set */
+ character_set_setting = cs_buff[1]-'0';
+ if ((character_set_setting < 0) || (character_set_setting > 9))
+ { fatalerror_named("Character set in mapping must be 0 to 9",
+ Charset_Map);
+ }
+ break;
+ default:
+ p = cs_buff;
+ while ((i<256) && (p!=NULL))
+ {
+ uccg[i++] = (uchar)atoi(p);
+ p = strchr(p,',');
+ if (p != NULL)
+ p++;
+ }
+ break;
+ }
+ }
+ fclose(charset_file);
+}
+
+/* ========================================================================= */
+/* Conversion functions (without side effects) */
+/* ------------------------------------------------------------------------- */
+/* (1) Source -> ISO */
+/* */
+/* 00 remains 0 (meaning "end of file") */
+/* TAB becomes SPACE */
+/* 0c ("form feed") becomes '\n' */
+/* 0d becomes '\n' */
+/* other control characters become '?' */
+/* 7f becomes '?' */
+/* 80 to 9f become '?' */
+/* a0 (ISO "non-breaking space") becomes SPACE */
+/* ad (ISO "soft hyphen") becomes '-' */
+/* any character undefined in ISO is mapped to '?' */
+/* In Unicode mode, characters 80 and upwards are preserved. */
+/* */
+/* ------------------------------------------------------------------------- */
+
+static void make_source_to_iso_grid(void)
+{ int n; uchar *uccg = (uchar *) source_to_iso_grid;
+
+ for (n=0; n<0x100; n++) uccg[n] = (char) n;
+
+ if (Charset_Map[0] != '\0')
+ read_source_to_iso_file(uccg);
+ else
+ { source_to_iso_grid[0] = (char) 0;
+ 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[127] = '?';
+ source_to_iso_grid[TAB_CHARACTER] = ' ';
+
+ if (character_set_unicode) /* No need to meddle with 8-bit for UTF-8 */
+ return;
+
+ for (n=0x80; n<0xa0; n++) source_to_iso_grid[n] = '?';
+ source_to_iso_grid[0xa0] = ' ';
+ source_to_iso_grid[0xad] = '-';
+
+ switch(character_set_setting)
+ { case 0:
+ for (n=0xa0; n<0x100; n++)
+ source_to_iso_grid[n] = '?';
+ break;
+ case 6: /* Arabic */
+ for (n=0xa0; n<0xc1; n++)
+ switch(n)
+ { case 0xa0: case 0xa4: case 0xac: case 0xad:
+ case 0xbb: case 0xbf: break;
+ default: source_to_iso_grid[n] = '?';
+ }
+ for (n=0xdb; n<0xe0; n++)
+ source_to_iso_grid[n] = '?';
+ for (n=0xf3; n<0x100; n++)
+ source_to_iso_grid[n] = '?';
+ break;
+ case 7: /* Greek */
+ source_to_iso_grid[0xa4] = '?';
+ source_to_iso_grid[0xa5] = '?';
+ source_to_iso_grid[0xaa] = '?';
+ source_to_iso_grid[0xae] = '?';
+ source_to_iso_grid[0xd2] = '?';
+ source_to_iso_grid[0xff] = '?';
+ break;
+ case 8: /* Hebrew */
+ source_to_iso_grid[0xa1] = '?';
+ for (n=0xbf; n<0xdf; n++)
+ source_to_iso_grid[n] = '?';
+ for (n=0xfb; n<0x100; n++)
+ source_to_iso_grid[n] = '?';
+ break;
+ }
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* (2) ISO -> Unicode */
+/* */
+/* Need not be rapid, as the results are mostly cached. */
+/* Always succeeds. */
+/* ------------------------------------------------------------------------- */
+
+extern int iso_to_unicode(int iso)
+{ int u = iso;
+ switch(character_set_setting)
+ {
+
+ case 0: /* Plain ASCII only */
+ break;
+
+ case 1: /* ISO 8859-1: Latin1: west European */
+ break;
+
+ case 2: /* ISO 8859-2: Latin2: central European */
+
+switch(iso)
+{ case 0xA1: u=0x0104; break; /* LATIN CAP A WITH OGONEK */
+ case 0xA2: u=0x02D8; break; /* BREVE */
+ case 0xA3: u=0x0141; break; /* LATIN CAP L WITH STROKE */
+ case 0xA5: u=0x013D; break; /* LATIN CAP L WITH CARON */
+ case 0xA6: u=0x015A; break; /* LATIN CAP S WITH ACUTE */
+ case 0xA9: u=0x0160; break; /* LATIN CAP S WITH CARON */
+ case 0xAA: u=0x015E; break; /* LATIN CAP S WITH CEDILLA */
+ case 0xAB: u=0x0164; break; /* LATIN CAP T WITH CARON */
+ case 0xAC: u=0x0179; break; /* LATIN CAP Z WITH ACUTE */
+ case 0xAE: u=0x017D; break; /* LATIN CAP Z WITH CARON */
+ case 0xAF: u=0x017B; break; /* LATIN CAP Z WITH DOT ABOVE */
+ case 0xB1: u=0x0105; break; /* LATIN SMALL A WITH OGONEK */
+ case 0xB2: u=0x02DB; break; /* OGONEK */
+ case 0xB3: u=0x0142; break; /* LATIN SMALL L WITH STROKE */
+ case 0xB5: u=0x013E; break; /* LATIN SMALL L WITH CARON */
+ case 0xB6: u=0x015B; break; /* LATIN SMALL S WITH ACUTE */
+ case 0xB7: u=0x02C7; break; /* CARON */
+ case 0xB9: u=0x0161; break; /* LATIN SMALL S WITH CARON */
+ case 0xBA: u=0x015F; break; /* LATIN SMALL S WITH CEDILLA */
+ case 0xBB: u=0x0165; break; /* LATIN SMALL T WITH CARON */
+ case 0xBC: u=0x017A; break; /* LATIN SMALL Z WITH ACUTE */
+ case 0xBD: u=0x02DD; break; /* DOUBLE ACUTE ACCENT */
+ case 0xBE: u=0x017E; break; /* LATIN SMALL Z WITH CARON */
+ case 0xBF: u=0x017C; break; /* LATIN SMALL Z WITH DOT ABOVE */
+ case 0xC0: u=0x0154; break; /* LATIN CAP R WITH ACUTE */
+ case 0xC3: u=0x0102; break; /* LATIN CAP A WITH BREVE */
+ case 0xC5: u=0x0139; break; /* LATIN CAP L WITH ACUTE */
+ case 0xC6: u=0x0106; break; /* LATIN CAP C WITH ACUTE */
+ case 0xC8: u=0x010C; break; /* LATIN CAP C WITH CARON */
+ case 0xCA: u=0x0118; break; /* LATIN CAP E WITH OGONEK */
+ case 0xCC: u=0x011A; break; /* LATIN CAP E WITH CARON */
+ case 0xCF: u=0x010E; break; /* LATIN CAP D WITH CARON */
+ case 0xD0: u=0x0110; break; /* LATIN CAP D WITH STROKE */
+ case 0xD1: u=0x0143; break; /* LATIN CAP N WITH ACUTE */
+ case 0xD2: u=0x0147; break; /* LATIN CAP N WITH CARON */
+ case 0xD5: u=0x0150; break; /* LATIN CAP O WITH DOUBLE ACUTE */
+ case 0xD8: u=0x0158; break; /* LATIN CAP R WITH CARON */
+ case 0xD9: u=0x016E; break; /* LATIN CAP U WITH RING ABOVE */
+ case 0xDB: u=0x0170; break; /* LATIN CAP U WITH DOUBLE ACUTE */
+ case 0xDE: u=0x0162; break; /* LATIN CAP T WITH CEDILLA */
+ case 0xE0: u=0x0155; break; /* LATIN SMALL R WITH ACUTE */
+ case 0xE3: u=0x0103; break; /* LATIN SMALL A WITH BREVE */
+ case 0xE5: u=0x013A; break; /* LATIN SMALL L WITH ACUTE */
+ case 0xE6: u=0x0107; break; /* LATIN SMALL C WITH ACUTE */
+ case 0xE8: u=0x010D; break; /* LATIN SMALL C WITH CARON */
+ case 0xEA: u=0x0119; break; /* LATIN SMALL E WITH OGONEK */
+ case 0xEC: u=0x011B; break; /* LATIN SMALL E WITH CARON */
+ case 0xEF: u=0x010F; break; /* LATIN SMALL D WITH CARON */
+ case 0xF0: u=0x0111; break; /* LATIN SMALL D WITH STROKE */
+ case 0xF1: u=0x0144; break; /* LATIN SMALL N WITH ACUTE */
+ case 0xF2: u=0x0148; break; /* LATIN SMALL N WITH CARON */
+ case 0xF5: u=0x0151; break; /* LATIN SMALL O WITH DOUBLE ACUTE */
+ case 0xF8: u=0x0159; break; /* LATIN SMALL R WITH CARON */
+ case 0xF9: u=0x016F; break; /* LATIN SMALL U WITH RING ABOVE */
+ case 0xFB: u=0x0171; break; /* LATIN SMALL U WITH DOUBLE ACUTE */
+ case 0xFE: u=0x0163; break; /* LATIN SMALL T WITH CEDILLA */
+ case 0xFF: u=0x02D9; break; /* DOT ABOVE */
+} break;
+
+ case 3: /* ISO 8859-3: Latin3: central European */
+
+switch(iso)
+{ case 0xA1: u=0x0126; break; /* LATIN CAP H WITH STROKE */
+ case 0xA2: u=0x02D8; break; /* BREVE */
+ case 0xA6: u=0x0124; break; /* LATIN CAP H WITH CIRCUMFLEX */
+ case 0xA9: u=0x0130; break; /* LATIN CAP I WITH DOT ABOVE */
+ case 0xAA: u=0x015E; break; /* LATIN CAP S WITH CEDILLA */
+ case 0xAB: u=0x011E; break; /* LATIN CAP G WITH BREVE */
+ case 0xAC: u=0x0134; break; /* LATIN CAP J WITH CIRCUMFLEX */
+ case 0xAF: u=0x017B; break; /* LATIN CAP Z WITH DOT ABOVE */
+ case 0xB1: u=0x0127; break; /* LATIN SMALL H WITH STROKE */
+ case 0xB6: u=0x0125; break; /* LATIN SMALL H WITH CIRCUMFLEX */
+ case 0xB9: u=0x0131; break; /* LATIN SMALL DOTLESS I */
+ case 0xBA: u=0x015F; break; /* LATIN SMALL S WITH CEDILLA */
+ case 0xBB: u=0x011F; break; /* LATIN SMALL G WITH BREVE */
+ case 0xBC: u=0x0135; break; /* LATIN SMALL J WITH CIRCUMFLEX */
+ case 0xBF: u=0x017C; break; /* LATIN SMALL Z WITH DOT ABOVE */
+ case 0xC5: u=0x010A; break; /* LATIN CAP C WITH DOT ABOVE */
+ case 0xC6: u=0x0108; break; /* LATIN CAP C WITH CIRCUMFLEX */
+ case 0xD5: u=0x0120; break; /* LATIN CAP G WITH DOT ABOVE */
+ case 0xD8: u=0x011C; break; /* LATIN CAP G WITH CIRCUMFLEX */
+ case 0xDD: u=0x016C; break; /* LATIN CAP U WITH BREVE */
+ case 0xDE: u=0x015C; break; /* LATIN CAP S WITH CIRCUMFLEX */
+ case 0xE5: u=0x010B; break; /* LATIN SMALL C WITH DOT ABOVE */
+ case 0xE6: u=0x0109; break; /* LATIN SMALL C WITH CIRCUMFLEX */
+ case 0xF5: u=0x0121; break; /* LATIN SMALL G WITH DOT ABOVE */
+ case 0xF8: u=0x011D; break; /* LATIN SMALL G WITH CIRCUMFLEX */
+ case 0xFD: u=0x016D; break; /* LATIN SMALL U WITH BREVE */
+ case 0xFE: u=0x015D; break; /* LATIN SMALL S WITH CIRCUMFLEX */
+ case 0xFF: u=0x02D9; break; /* DOT ABOVE */
+} break;
+
+ case 4: /* ISO 8859-4: Latin4: central European */
+
+switch(iso)
+{ case 0xA1: u=0x0104; break; /* LATIN CAP A WITH OGONEK */
+ case 0xA2: u=0x0138; break; /* LATIN SMALL KRA */
+ case 0xA3: u=0x0156; break; /* LATIN CAP R WITH CEDILLA */
+ case 0xA5: u=0x0128; break; /* LATIN CAP I WITH TILDE */
+ case 0xA6: u=0x013B; break; /* LATIN CAP L WITH CEDILLA */
+ case 0xA9: u=0x0160; break; /* LATIN CAP S WITH CARON */
+ case 0xAA: u=0x0112; break; /* LATIN CAP E WITH MACRON */
+ case 0xAB: u=0x0122; break; /* LATIN CAP G WITH CEDILLA */
+ case 0xAC: u=0x0166; break; /* LATIN CAP T WITH STROKE */
+ case 0xAE: u=0x017D; break; /* LATIN CAP Z WITH CARON */
+ case 0xB1: u=0x0105; break; /* LATIN SMALL A WITH OGONEK */
+ case 0xB2: u=0x02DB; break; /* OGONEK */
+ case 0xB3: u=0x0157; break; /* LATIN SMALL R WITH CEDILLA */
+ case 0xB5: u=0x0129; break; /* LATIN SMALL I WITH TILDE */
+ case 0xB6: u=0x013C; break; /* LATIN SMALL L WITH CEDILLA */
+ case 0xB7: u=0x02C7; break; /* CARON */
+ case 0xB9: u=0x0161; break; /* LATIN SMALL S WITH CARON */
+ case 0xBA: u=0x0113; break; /* LATIN SMALL E WITH MACRON */
+ case 0xBB: u=0x0123; break; /* LATIN SMALL G WITH CEDILLA */
+ case 0xBC: u=0x0167; break; /* LATIN SMALL T WITH STROKE */
+ case 0xBD: u=0x014A; break; /* LATIN CAP ENG */
+ case 0xBE: u=0x017E; break; /* LATIN SMALL Z WITH CARON */
+ case 0xBF: u=0x014B; break; /* LATIN SMALL ENG */
+ case 0xC0: u=0x0100; break; /* LATIN CAP A WITH MACRON */
+ case 0xC7: u=0x012E; break; /* LATIN CAP I WITH OGONEK */
+ case 0xC8: u=0x010C; break; /* LATIN CAP C WITH CARON */
+ case 0xCA: u=0x0118; break; /* LATIN CAP E WITH OGONEK */
+ case 0xCC: u=0x0116; break; /* LATIN CAP E WITH DOT ABOVE */
+ case 0xCF: u=0x012A; break; /* LATIN CAP I WITH MACRON */
+ case 0xD0: u=0x0110; break; /* LATIN CAP D WITH STROKE */
+ case 0xD1: u=0x0145; break; /* LATIN CAP N WITH CEDILLA */
+ case 0xD2: u=0x014C; break; /* LATIN CAP O WITH MACRON */
+ case 0xD3: u=0x0136; break; /* LATIN CAP K WITH CEDILLA */
+ case 0xD9: u=0x0172; break; /* LATIN CAP U WITH OGONEK */
+ case 0xDD: u=0x0168; break; /* LATIN CAP U WITH TILDE */
+ case 0xDE: u=0x016A; break; /* LATIN CAP U WITH MACRON */
+ case 0xE0: u=0x0101; break; /* LATIN SMALL A WITH MACRON */
+ case 0xE7: u=0x012F; break; /* LATIN SMALL I WITH OGONEK */
+ case 0xE8: u=0x010D; break; /* LATIN SMALL C WITH CARON */
+ case 0xEA: u=0x0119; break; /* LATIN SMALL E WITH OGONEK */
+ case 0xEC: u=0x0117; break; /* LATIN SMALL E WITH DOT ABOVE */
+ case 0xEF: u=0x012B; break; /* LATIN SMALL I WITH MACRON */
+ case 0xF0: u=0x0111; break; /* LATIN SMALL D WITH STROKE */
+ case 0xF1: u=0x0146; break; /* LATIN SMALL N WITH CEDILLA */
+ case 0xF2: u=0x014D; break; /* LATIN SMALL O WITH MACRON */
+ case 0xF3: u=0x0137; break; /* LATIN SMALL K WITH CEDILLA */
+ case 0xF9: u=0x0173; break; /* LATIN SMALL U WITH OGONEK */
+ case 0xFD: u=0x0169; break; /* LATIN SMALL U WITH TILDE */
+ case 0xFE: u=0x016B; break; /* LATIN SMALL U WITH MACRON */
+ case 0xFF: u=0x02D9; break; /* DOT ABOVE */
+} break;
+
+ case 5: /* ISO 8859-5: Cyrillic */
+
+switch(iso)
+{ case 0xA1: u=0x0401; break; /* CYRILLIC CAP IO */
+ case 0xA2: u=0x0402; break; /* CYRILLIC CAP DJE */
+ case 0xA3: u=0x0403; break; /* CYRILLIC CAP GJE */
+ case 0xA4: u=0x0404; break; /* CYRILLIC CAP UKRAINIAN IE */
+ case 0xA5: u=0x0405; break; /* CYRILLIC CAP DZE */
+ case 0xA6: u=0x0406; break; /* CYRILLIC CAP BYELORUSSIAN-UKRAINIAN I */
+ case 0xA7: u=0x0407; break; /* CYRILLIC CAP YI */
+ case 0xA8: u=0x0408; break; /* CYRILLIC CAP JE */
+ case 0xA9: u=0x0409; break; /* CYRILLIC CAP LJE */
+ case 0xAA: u=0x040A; break; /* CYRILLIC CAP NJE */
+ case 0xAB: u=0x040B; break; /* CYRILLIC CAP TSHE */
+ case 0xAC: u=0x040C; break; /* CYRILLIC CAP KJE */
+ case 0xAE: u=0x040E; break; /* CYRILLIC CAP SHORT U */
+ case 0xAF: u=0x040F; break; /* CYRILLIC CAP DZHE */
+ case 0xB0: u=0x0410; break; /* CYRILLIC CAP A */
+ case 0xB1: u=0x0411; break; /* CYRILLIC CAP BE */
+ case 0xB2: u=0x0412; break; /* CYRILLIC CAP VE */
+ case 0xB3: u=0x0413; break; /* CYRILLIC CAP GHE */
+ case 0xB4: u=0x0414; break; /* CYRILLIC CAP DE */
+ case 0xB5: u=0x0415; break; /* CYRILLIC CAP IE */
+ case 0xB6: u=0x0416; break; /* CYRILLIC CAP ZHE */
+ case 0xB7: u=0x0417; break; /* CYRILLIC CAP ZE */
+ case 0xB8: u=0x0418; break; /* CYRILLIC CAP I */
+ case 0xB9: u=0x0419; break; /* CYRILLIC CAP SHORT I */
+ case 0xBA: u=0x041A; break; /* CYRILLIC CAP KA */
+ case 0xBB: u=0x041B; break; /* CYRILLIC CAP EL */
+ case 0xBC: u=0x041C; break; /* CYRILLIC CAP EM */
+ case 0xBD: u=0x041D; break; /* CYRILLIC CAP EN */
+ case 0xBE: u=0x041E; break; /* CYRILLIC CAP O */
+ case 0xBF: u=0x041F; break; /* CYRILLIC CAP PE */
+ case 0xC0: u=0x0420; break; /* CYRILLIC CAP ER */
+ case 0xC1: u=0x0421; break; /* CYRILLIC CAP ES */
+ case 0xC2: u=0x0422; break; /* CYRILLIC CAP TE */
+ case 0xC3: u=0x0423; break; /* CYRILLIC CAP U */
+ case 0xC4: u=0x0424; break; /* CYRILLIC CAP EF */
+ case 0xC5: u=0x0425; break; /* CYRILLIC CAP HA */
+ case 0xC6: u=0x0426; break; /* CYRILLIC CAP TSE */
+ case 0xC7: u=0x0427; break; /* CYRILLIC CAP CHE */
+ case 0xC8: u=0x0428; break; /* CYRILLIC CAP SHA */
+ case 0xC9: u=0x0429; break; /* CYRILLIC CAP SHCHA */
+ case 0xCA: u=0x042A; break; /* CYRILLIC CAP HARD SIGN */
+ case 0xCB: u=0x042B; break; /* CYRILLIC CAP YERU */
+ case 0xCC: u=0x042C; break; /* CYRILLIC CAP SOFT SIGN */
+ case 0xCD: u=0x042D; break; /* CYRILLIC CAP E */
+ case 0xCE: u=0x042E; break; /* CYRILLIC CAP YU */
+ case 0xCF: u=0x042F; break; /* CYRILLIC CAP YA */
+ case 0xD0: u=0x0430; break; /* CYRILLIC SMALL A */
+ case 0xD1: u=0x0431; break; /* CYRILLIC SMALL BE */
+ case 0xD2: u=0x0432; break; /* CYRILLIC SMALL VE */
+ case 0xD3: u=0x0433; break; /* CYRILLIC SMALL GHE */
+ case 0xD4: u=0x0434; break; /* CYRILLIC SMALL DE */
+ case 0xD5: u=0x0435; break; /* CYRILLIC SMALL IE */
+ case 0xD6: u=0x0436; break; /* CYRILLIC SMALL ZHE */
+ case 0xD7: u=0x0437; break; /* CYRILLIC SMALL ZE */
+ case 0xD8: u=0x0438; break; /* CYRILLIC SMALL I */
+ case 0xD9: u=0x0439; break; /* CYRILLIC SMALL SHORT I */
+ case 0xDA: u=0x043A; break; /* CYRILLIC SMALL KA */
+ case 0xDB: u=0x043B; break; /* CYRILLIC SMALL EL */
+ case 0xDC: u=0x043C; break; /* CYRILLIC SMALL EM */
+ case 0xDD: u=0x043D; break; /* CYRILLIC SMALL EN */
+ case 0xDE: u=0x043E; break; /* CYRILLIC SMALL O */
+ case 0xDF: u=0x043F; break; /* CYRILLIC SMALL PE */
+ case 0xE0: u=0x0440; break; /* CYRILLIC SMALL ER */
+ case 0xE1: u=0x0441; break; /* CYRILLIC SMALL ES */
+ case 0xE2: u=0x0442; break; /* CYRILLIC SMALL TE */
+ case 0xE3: u=0x0443; break; /* CYRILLIC SMALL U */
+ case 0xE4: u=0x0444; break; /* CYRILLIC SMALL EF */
+ case 0xE5: u=0x0445; break; /* CYRILLIC SMALL HA */
+ case 0xE6: u=0x0446; break; /* CYRILLIC SMALL TSE */
+ case 0xE7: u=0x0447; break; /* CYRILLIC SMALL CHE */
+ case 0xE8: u=0x0448; break; /* CYRILLIC SMALL SHA */
+ case 0xE9: u=0x0449; break; /* CYRILLIC SMALL SHCHA */
+ case 0xEA: u=0x044A; break; /* CYRILLIC SMALL HARD SIGN */
+ case 0xEB: u=0x044B; break; /* CYRILLIC SMALL YERU */
+ case 0xEC: u=0x044C; break; /* CYRILLIC SMALL SOFT SIGN */
+ case 0xED: u=0x044D; break; /* CYRILLIC SMALL E */
+ case 0xEE: u=0x044E; break; /* CYRILLIC SMALL YU */
+ case 0xEF: u=0x044F; break; /* CYRILLIC SMALL YA */
+ case 0xF0: u=0x2116; break; /* NUMERO SIGN */
+ case 0xF1: u=0x0451; break; /* CYRILLIC SMALL IO */
+ case 0xF2: u=0x0452; break; /* CYRILLIC SMALL DJE */
+ case 0xF3: u=0x0453; break; /* CYRILLIC SMALL GJE */
+ case 0xF4: u=0x0454; break; /* CYRILLIC SMALL UKRAINIAN IE */
+ case 0xF5: u=0x0455; break; /* CYRILLIC SMALL DZE */
+ case 0xF6: u=0x0456; break; /* CYRILLIC SMALL BYELORUSSIAN-UKRAINIAN I */
+ case 0xF7: u=0x0457; break; /* CYRILLIC SMALL YI */
+ case 0xF8: u=0x0458; break; /* CYRILLIC SMALL JE */
+ case 0xF9: u=0x0459; break; /* CYRILLIC SMALL LJE */
+ case 0xFA: u=0x045A; break; /* CYRILLIC SMALL NJE */
+ case 0xFB: u=0x045B; break; /* CYRILLIC SMALL TSHE */
+ case 0xFC: u=0x045C; break; /* CYRILLIC SMALL KJE */
+ case 0xFD: u=0x00A7; break; /* SECTION SIGN */
+ case 0xFE: u=0x045E; break; /* CYRILLIC SMALL SHORT U */
+ case 0xFF: u=0x045F; break; /* CYRILLIC SMALL DZHE */
+} break;
+
+ case 6: /* ISO 8859-6: Arabic */
+
+switch(iso)
+{ case 0xAC: u=0x060C; break; /* ARABIC COMMA */
+ case 0xBB: u=0x061B; break; /* ARABIC SEMICOLON */
+ case 0xBF: u=0x061F; break; /* ARABIC QUESTION MARK */
+ case 0xC1: u=0x0621; break; /* ARABIC HAMZA */
+ case 0xC2: u=0x0622; break; /* ARABIC ALEF WITH MADDA ABOVE */
+ case 0xC3: u=0x0623; break; /* ARABIC ALEF WITH HAMZA ABOVE */
+ case 0xC4: u=0x0624; break; /* ARABIC WAW WITH HAMZA ABOVE */
+ case 0xC5: u=0x0625; break; /* ARABIC ALEF WITH HAMZA BELOW */
+ case 0xC6: u=0x0626; break; /* ARABIC YEH WITH HAMZA ABOVE */
+ case 0xC7: u=0x0627; break; /* ARABIC ALEF */
+ case 0xC8: u=0x0628; break; /* ARABIC BEH */
+ case 0xC9: u=0x0629; break; /* ARABIC TEH MARBUTA */
+ case 0xCA: u=0x062A; break; /* ARABIC TEH */
+ case 0xCB: u=0x062B; break; /* ARABIC THEH */
+ case 0xCC: u=0x062C; break; /* ARABIC JEEM */
+ case 0xCD: u=0x062D; break; /* ARABIC HAH */
+ case 0xCE: u=0x062E; break; /* ARABIC KHAH */
+ case 0xCF: u=0x062F; break; /* ARABIC DAL */
+ case 0xD0: u=0x0630; break; /* ARABIC THAL */
+ case 0xD1: u=0x0631; break; /* ARABIC REH */
+ case 0xD2: u=0x0632; break; /* ARABIC ZAIN */
+ case 0xD3: u=0x0633; break; /* ARABIC SEEN */
+ case 0xD4: u=0x0634; break; /* ARABIC SHEEN */
+ case 0xD5: u=0x0635; break; /* ARABIC SAD */
+ case 0xD6: u=0x0636; break; /* ARABIC DAD */
+ case 0xD7: u=0x0637; break; /* ARABIC TAH */
+ case 0xD8: u=0x0638; break; /* ARABIC ZAH */
+ case 0xD9: u=0x0639; break; /* ARABIC AIN */
+ case 0xDA: u=0x063A; break; /* ARABIC GHAIN */
+ case 0xE0: u=0x0640; break; /* ARABIC TATWEEL */
+ case 0xE1: u=0x0641; break; /* ARABIC FEH */
+ case 0xE2: u=0x0642; break; /* ARABIC QAF */
+ case 0xE3: u=0x0643; break; /* ARABIC KAF */
+ case 0xE4: u=0x0644; break; /* ARABIC LAM */
+ case 0xE5: u=0x0645; break; /* ARABIC MEEM */
+ case 0xE6: u=0x0646; break; /* ARABIC NOON */
+ case 0xE7: u=0x0647; break; /* ARABIC HEH */
+ case 0xE8: u=0x0648; break; /* ARABIC WAW */
+ case 0xE9: u=0x0649; break; /* ARABIC ALEF MAKSURA */
+ case 0xEA: u=0x064A; break; /* ARABIC YEH */
+ case 0xEB: u=0x064B; break; /* ARABIC FATHATAN */
+ case 0xEC: u=0x064C; break; /* ARABIC DAMMATAN */
+ case 0xED: u=0x064D; break; /* ARABIC KASRATAN */
+ case 0xEE: u=0x064E; break; /* ARABIC FATHA */
+ case 0xEF: u=0x064F; break; /* ARABIC DAMMA */
+ case 0xF0: u=0x0650; break; /* ARABIC KASRA */
+ case 0xF1: u=0x0651; break; /* ARABIC SHADDA */
+ case 0xF2: u=0x0652; break; /* ARABIC SUKUN */
+} break;
+
+ case 7: /* ISO 8859-7: Greek */
+
+switch(iso)
+{ case 0xA1: u=0x02BD; break; /* MODIFIER REVERSED COMMA */
+ case 0xA2: u=0x02BC; break; /* MODIFIER APOSTROPHE */
+ case 0xAF: u=0x2015; break; /* HORIZONTAL BAR */
+ case 0xB4: u=0x0384; break; /* GREEK TONOS */
+ case 0xB5: u=0x0385; break; /* GREEK DIALYTIKA TONOS */
+ case 0xB6: u=0x0386; break; /* GREEK CAP ALPHA WITH TONOS */
+ case 0xB8: u=0x0388; break; /* GREEK CAP EPSILON WITH TONOS */
+ case 0xB9: u=0x0389; break; /* GREEK CAP ETA WITH TONOS */
+ case 0xBA: u=0x038A; break; /* GREEK CAP IOTA WITH TONOS */
+ case 0xBC: u=0x038C; break; /* GREEK CAP OMICRON WITH TONOS */
+ case 0xBE: u=0x038E; break; /* GREEK CAP UPSILON WITH TONOS */
+ case 0xBF: u=0x038F; break; /* GREEK CAP OMEGA WITH TONOS */
+ case 0xC0: u=0x0390; break; /* GREEK SMALL IOTA WITH DIALYTIKA AND TONOS */
+ case 0xC1: u=0x0391; break; /* GREEK CAP ALPHA */
+ case 0xC2: u=0x0392; break; /* GREEK CAP BETA */
+ case 0xC3: u=0x0393; break; /* GREEK CAP GAMMA */
+ case 0xC4: u=0x0394; break; /* GREEK CAP DELTA */
+ case 0xC5: u=0x0395; break; /* GREEK CAP EPSILON */
+ case 0xC6: u=0x0396; break; /* GREEK CAP ZETA */
+ case 0xC7: u=0x0397; break; /* GREEK CAP ETA */
+ case 0xC8: u=0x0398; break; /* GREEK CAP THETA */
+ case 0xC9: u=0x0399; break; /* GREEK CAP IOTA */
+ case 0xCA: u=0x039A; break; /* GREEK CAP KAPPA */
+ case 0xCB: u=0x039B; break; /* GREEK CAP LAMDA */
+ case 0xCC: u=0x039C; break; /* GREEK CAP MU */
+ case 0xCD: u=0x039D; break; /* GREEK CAP NU */
+ case 0xCE: u=0x039E; break; /* GREEK CAP XI */
+ case 0xCF: u=0x039F; break; /* GREEK CAP OMICRON */
+ case 0xD0: u=0x03A0; break; /* GREEK CAP PI */
+ case 0xD1: u=0x03A1; break; /* GREEK CAP RHO */
+ case 0xD3: u=0x03A3; break; /* GREEK CAP SIGMA */
+ case 0xD4: u=0x03A4; break; /* GREEK CAP TAU */
+ case 0xD5: u=0x03A5; break; /* GREEK CAP UPSILON */
+ case 0xD6: u=0x03A6; break; /* GREEK CAP PHI */
+ case 0xD7: u=0x03A7; break; /* GREEK CAP CHI */
+ case 0xD8: u=0x03A8; break; /* GREEK CAP PSI */
+ case 0xD9: u=0x03A9; break; /* GREEK CAP OMEGA */
+ case 0xDA: u=0x03AA; break; /* GREEK CAP IOTA WITH DIALYTIKA */
+ case 0xDB: u=0x03AB; break; /* GREEK CAP UPSILON WITH DIALYTIKA */
+ case 0xDC: u=0x03AC; break; /* GREEK SMALL ALPHA WITH TONOS */
+ case 0xDD: u=0x03AD; break; /* GREEK SMALL EPSILON WITH TONOS */
+ case 0xDE: u=0x03AE; break; /* GREEK SMALL ETA WITH TONOS */
+ case 0xDF: u=0x03AF; break; /* GREEK SMALL IOTA WITH TONOS */
+ case 0xE0: u=0x03B0; break; /* GREEK SMALL UPSILON WITH DIALYTIKA AND TONOS */
+ case 0xE1: u=0x03B1; break; /* GREEK SMALL ALPHA */
+ case 0xE2: u=0x03B2; break; /* GREEK SMALL BETA */
+ case 0xE3: u=0x03B3; break; /* GREEK SMALL GAMMA */
+ case 0xE4: u=0x03B4; break; /* GREEK SMALL DELTA */
+ case 0xE5: u=0x03B5; break; /* GREEK SMALL EPSILON */
+ case 0xE6: u=0x03B6; break; /* GREEK SMALL ZETA */
+ case 0xE7: u=0x03B7; break; /* GREEK SMALL ETA */
+ case 0xE8: u=0x03B8; break; /* GREEK SMALL THETA */
+ case 0xE9: u=0x03B9; break; /* GREEK SMALL IOTA */
+ case 0xEA: u=0x03BA; break; /* GREEK SMALL KAPPA */
+ case 0xEB: u=0x03BB; break; /* GREEK SMALL LAMDA */
+ case 0xEC: u=0x03BC; break; /* GREEK SMALL MU */
+ case 0xED: u=0x03BD; break; /* GREEK SMALL NU */
+ case 0xEE: u=0x03BE; break; /* GREEK SMALL XI */
+ case 0xEF: u=0x03BF; break; /* GREEK SMALL OMICRON */
+ case 0xF0: u=0x03C0; break; /* GREEK SMALL PI */
+ case 0xF1: u=0x03C1; break; /* GREEK SMALL RHO */
+ case 0xF2: u=0x03C2; break; /* GREEK SMALL FINAL SIGMA */
+ case 0xF3: u=0x03C3; break; /* GREEK SMALL SIGMA */
+ case 0xF4: u=0x03C4; break; /* GREEK SMALL TAU */
+ case 0xF5: u=0x03C5; break; /* GREEK SMALL UPSILON */
+ case 0xF6: u=0x03C6; break; /* GREEK SMALL PHI */
+ case 0xF7: u=0x03C7; break; /* GREEK SMALL CHI */
+ case 0xF8: u=0x03C8; break; /* GREEK SMALL PSI */
+ case 0xF9: u=0x03C9; break; /* GREEK SMALL OMEGA */
+ case 0xFA: u=0x03CA; break; /* GREEK SMALL IOTA WITH DIALYTIKA */
+ case 0xFB: u=0x03CB; break; /* GREEK SMALL UPSILON WITH DIALYTIKA */
+ case 0xFC: u=0x03CC; break; /* GREEK SMALL OMICRON WITH TONOS */
+ case 0xFD: u=0x03CD; break; /* GREEK SMALL UPSILON WITH TONOS */
+ case 0xFE: u=0x03CE; break; /* GREEK SMALL OMEGA WITH TONOS */
+} break;
+
+ case 8: /* ISO 8859-8: Hebrew */
+
+switch(iso)
+{ case 0xAA: u=0x00D7; break; /* MULTIPLICATION SIGN */
+ case 0xAF: u=0x203E; break; /* OVERLINE */
+ case 0xBA: u=0x00F7; break; /* DIVISION SIGN */
+ case 0xDF: u=0x2017; break; /* DOUBLE LOW LINE */
+ case 0xE0: u=0x05D0; break; /* HEBREW ALEF */
+ case 0xE1: u=0x05D1; break; /* HEBREW BET */
+ case 0xE2: u=0x05D2; break; /* HEBREW GIMEL */
+ case 0xE3: u=0x05D3; break; /* HEBREW DALET */
+ case 0xE4: u=0x05D4; break; /* HEBREW HE */
+ case 0xE5: u=0x05D5; break; /* HEBREW VAV */
+ case 0xE6: u=0x05D6; break; /* HEBREW ZAYIN */
+ case 0xE7: u=0x05D7; break; /* HEBREW HET */
+ case 0xE8: u=0x05D8; break; /* HEBREW TET */
+ case 0xE9: u=0x05D9; break; /* HEBREW YOD */
+ case 0xEA: u=0x05DA; break; /* HEBREW FINAL KAF */
+ case 0xEB: u=0x05DB; break; /* HEBREW KAF */
+ case 0xEC: u=0x05DC; break; /* HEBREW LAMED */
+ case 0xED: u=0x05DD; break; /* HEBREW FINAL MEM */
+ case 0xEE: u=0x05DE; break; /* HEBREW MEM */
+ case 0xEF: u=0x05DF; break; /* HEBREW FINAL NUN */
+ case 0xF0: u=0x05E0; break; /* HEBREW NUN */
+ case 0xF1: u=0x05E1; break; /* HEBREW SAMEKH */
+ case 0xF2: u=0x05E2; break; /* HEBREW AYIN */
+ case 0xF3: u=0x05E3; break; /* HEBREW FINAL PE */
+ case 0xF4: u=0x05E4; break; /* HEBREW PE */
+ case 0xF5: u=0x05E5; break; /* HEBREW FINAL TSADI */
+ case 0xF6: u=0x05E6; break; /* HEBREW TSADI */
+ case 0xF7: u=0x05E7; break; /* HEBREW QOF */
+ case 0xF8: u=0x05E8; break; /* HEBREW RESH */
+ case 0xF9: u=0x05E9; break; /* HEBREW SHIN */
+ case 0xFA: u=0x05EA; break; /* HEBREW TAV */
+} break;
+
+ case 9: /* ISO 8859-9: Latin5: west European without Icelandic */
+
+switch(iso)
+{
+ case 0xD0: u=0x011E; break; /* LATIN CAP G WITH BREVE */
+ case 0xDD: u=0x0130; break; /* LATIN CAP I WITH DOT ABOVE */
+ case 0xDE: u=0x015e; break; /* LATIN CAP S WITH CEDILLA */
+ case 0xF0: u=0x011f; break; /* LATIN SMALL G WITH BREVE */
+ case 0xFD: u=0x0131; break; /* LATIN SMALL DOTLESS I */
+ case 0xFE: u=0x015f; break; /* LATIN SMALL S WITH CEDILLA */
+} break;
+
+ }
+ return u;
+}
+
+/* ------------------------------------------------------------------------- */
+/* (3) Unicode -> ZSCII and vice versa */
+/* */
+/* Need not be rapid, as the results are mostly cached. */
+/* Unicode chars which can't be fitted into ZSCII are converted to the */
+/* value 5 (the pad character used in the dictionary and elsewhere). */
+/* ------------------------------------------------------------------------- */
+
+int zscii_defn_modified, zscii_high_water_mark;
+
+int32 zscii_to_unicode_grid[0x61];
+
+static void zscii_unicode_map(int zscii, int32 unicode)
+{ if ((zscii < 155) || (zscii > 251))
+ { compiler_error("Attempted to map a Unicode character into the ZSCII \
+set at an illegal position");
+ return;
+ }
+ zscii_to_unicode_grid[zscii-155] = unicode;
+ zscii_defn_modified = TRUE;
+}
+
+int default_zscii_highset_sizes[] = { 69, 69, 81, 71, 82, 92, 48, 71, 27, 62 };
+
+int32 default_zscii_to_unicode_c01[]
+ = { /* (This ordering is important, unlike those for other char sets)
+ The 69 characters making up the default Unicode translation
+ table (see the Z-Machine Standard 1.0). */
+
+ 0xe4, /* a-diaeresis */ 0xf6, /* o-diaeresis */ 0xfc, /* u-diaeresis */
+ 0xc4, /* A-diaeresis */ 0xd6, /* O-diaeresis */ 0xdc, /* U-diaeresis */
+ 0xdf, /* sz-ligature */ 0xbb, /* >> */ 0xab, /* << */
+ 0xeb, /* e-diaeresis */ 0xef, /* i-diaeresis */ 0xff, /* y-diaeresis */
+ 0xcb, /* E-diaeresis */ 0xcf, /* I-diaeresis */ 0xe1, /* a-acute */
+ 0xe9, /* e-acute */ 0xed, /* i-acute */ 0xf3, /* o-acute */
+ 0xfa, /* u-acute */ 0xfd, /* y-acute */ 0xc1, /* A-acute */
+ 0xc9, /* E-acute */ 0xcd, /* I-acute */ 0xd3, /* O-acute */
+ 0xda, /* U-acute */ 0xdd, /* Y-acute */ 0xe0, /* a-grave */
+ 0xe8, /* e-grave */ 0xec, /* i-grave */ 0xf2, /* o-grave */
+ 0xf9, /* u-grave */ 0xc0, /* A-grave */ 0xc8, /* E-grave */
+ 0xcc, /* I-grave */ 0xd2, /* O-grave */ 0xd9, /* U-grave */
+ 0xe2, /* a-circumflex */ 0xea, /* e-circumflex */
+ 0xee, /* i-circumflex */ 0xf4, /* o-circumflex */
+ 0xfb, /* u-circumflex */ 0xc2, /* A-circumflex */
+ 0xca, /* E-circumflex */ 0xce, /* I-circumflex */
+ 0xd4, /* O-circumflex */ 0xdb, /* U-circumflex */
+ 0xe5, /* a-ring */ 0xc5, /* A-ring */
+ 0xf8, /* o-slash */ 0xd8, /* O-slash */
+ 0xe3, /* a-tilde */ 0xf1, /* n-tilde */ 0xf5, /* o-tilde */
+ 0xc3, /* A-tilde */ 0xd1, /* N-tilde */ 0xd5, /* O-tilde */
+ 0xe6, /* ae-ligature */ 0xc6, /* AE-ligature */
+ 0xe7, /* c-cedilla */ 0xc7, /* C-cedilla */
+ 0xfe, /* thorn */ 0xf0, /* eth */ 0xde, /* Thorn */ 0xd0, /* Eth */
+ 0xa3, /* pound symbol */
+ 0x0153, /* oe-ligature */ 0x0152, /* OE-ligature */
+ 0xa1, /* inverted ! */ 0xbf /* inverted ? */ };
+
+int32 default_zscii_to_unicode_c2[]
+ = { /* The 81 accented letters in Latin2 */
+ 0x0104, 0x0141, 0x013D, 0x015A, 0x0160, 0x015E, 0x0164, 0x0179,
+ 0x017D, 0x017B, 0x0154, 0x00C1, 0x00C2, 0x0102, 0x00C4, 0x0139,
+ 0x0106, 0x00C7, 0x010C, 0x00C9, 0x0118, 0x00CB, 0x011A, 0x00CD,
+ 0x00CE, 0x010E, 0x0110, 0x0143, 0x0147, 0x00D3, 0x00D4, 0x0150,
+ 0x00D6, 0x0158, 0x016E, 0x00DA, 0x0170, 0x00DC, 0x00DD, 0x0162,
+ 0x0105, 0x0142, 0x013E, 0x015B, 0x0161, 0x015F, 0x0165, 0x017A,
+ 0x017E, 0x017C, 0x00DF, 0x0155, 0x00E1, 0x00E2, 0x0103, 0x00E4,
+ 0x013A, 0x0107, 0x00E7, 0x010D, 0x00E9, 0x0119, 0x00EB, 0x011B,
+ 0x00ED, 0x00EE, 0x010F, 0x0111, 0x0144, 0x0148, 0x00F3, 0x00F4,
+ 0x0151, 0x00F6, 0x0159, 0x016F, 0x00FA, 0x0171, 0x00FC, 0x00FD,
+ 0x0163 };
+
+int32 default_zscii_to_unicode_c3[]
+ = { /* The 71 accented letters in Latin3 */
+ 0x0126, 0x0124, 0x0130, 0x015E, 0x011E, 0x0134, 0x017B, 0x0127,
+ 0x0125, 0x0131, 0x015F, 0x011F, 0x0135, 0x017C, 0x00C0, 0x00C1,
+ 0x00C2, 0x00C4, 0x010A, 0x0108, 0x00C7, 0x00C8, 0x00C9, 0x00CA,
+ 0x00CB, 0x00CC, 0x00CD, 0x00CE, 0x00CF, 0x00D1, 0x00D2, 0x00D3,
+ 0x00D4, 0x0120, 0x00D6, 0x011C, 0x00D9, 0x00DA, 0x00DB, 0x00DC,
+ 0x016C, 0x015C, 0x00DF, 0x00E0, 0x00E1, 0x00E2, 0x00E4, 0x010B,
+ 0x0109, 0x00E7, 0x00E8, 0x00E9, 0x00EA, 0x00EB, 0x00EC, 0x00ED,
+ 0x00EE, 0x00EF, 0x00F1, 0x00F2, 0x00F3, 0x00F4, 0x0121, 0x00F6,
+ 0x011D, 0x00F9, 0x00FA, 0x00FB, 0x00FC, 0x016D, 0x015D };
+
+int32 default_zscii_to_unicode_c4[]
+ = { /* The 82 accented letters in Latin4 */
+ 0x0104, 0x0138, 0x0156, 0x0128, 0x013B, 0x0160, 0x0112, 0x0122,
+ 0x0166, 0x017D, 0x0105, 0x0157, 0x0129, 0x013C, 0x0161, 0x0113,
+ 0x0123, 0x0167, 0x014A, 0x017E, 0x014B, 0x0100, 0x00C1, 0x00C2,
+ 0x00C3, 0x00C4, 0x00C5, 0x00C6, 0x012E, 0x010C, 0x00C9, 0x0118,
+ 0x00CB, 0x0116, 0x00CD, 0x00CE, 0x012A, 0x0110, 0x0145, 0x014C,
+ 0x0136, 0x00D4, 0x00D5, 0x00D6, 0x00D8, 0x0172, 0x00DA, 0x00DB,
+ 0x00DC, 0x0168, 0x016A, 0x00DF, 0x0101, 0x00E1, 0x00E2, 0x00E3,
+ 0x00E4, 0x00E5, 0x00E6, 0x012F, 0x010D, 0x00E9, 0x0119, 0x00EB,
+ 0x0117, 0x00ED, 0x00EE, 0x012B, 0x0111, 0x0146, 0x014D, 0x0137,
+ 0x00F4, 0x00F5, 0x00F6, 0x00F8, 0x0173, 0x00FA, 0x00FB, 0x00FC,
+ 0x0169, 0x016B };
+
+int32 default_zscii_to_unicode_c5[]
+ = { /* The 92 accented letters in Cyrillic */
+ 0x0401, 0x0402, 0x0403, 0x0404, 0x0405, 0x0406, 0x0407, 0x0408,
+ 0x0409, 0x040A, 0x040B, 0x040C, 0x040E, 0x040F, 0x0410, 0x0411,
+ 0x0412, 0x0413, 0x0414, 0x0415, 0x0416, 0x0417, 0x0418, 0x0419,
+ 0x041A, 0x041B, 0x041C, 0x041D, 0x041E, 0x041F, 0x0420, 0x0421,
+ 0x0422, 0x0423, 0x0424, 0x0425, 0x0426, 0x0427, 0x0428, 0x0429,
+ 0x042A, 0x042B, 0x042C, 0x042D, 0x042E, 0x042F, 0x0430, 0x0431,
+ 0x0432, 0x0433, 0x0434, 0x0435, 0x0436, 0x0437, 0x0438, 0x0439,
+ 0x043A, 0x043B, 0x043C, 0x043D, 0x043E, 0x043F, 0x0440, 0x0441,
+ 0x0442, 0x0443, 0x0444, 0x0445, 0x0446, 0x0447, 0x0448, 0x0449,
+ 0x044A, 0x044B, 0x044C, 0x044D, 0x044E, 0x044F, 0x0451, 0x0452,
+ 0x0453, 0x0454, 0x0455, 0x0456, 0x0457, 0x0458, 0x0459, 0x045A,
+ 0x045B, 0x045C, 0x045E, 0x045F };
+
+int32 default_zscii_to_unicode_c6[]
+ = { /* The 48 accented letters in Arabic */
+ 0x060C, 0x061B, 0x061F, 0x0621, 0x0622, 0x0623, 0x0624, 0x0625,
+ 0x0626, 0x0627, 0x0628, 0x0629, 0x062A, 0x062B, 0x062C, 0x062D,
+ 0x062E, 0x062F, 0x0630, 0x0631, 0x0632, 0x0633, 0x0634, 0x0635,
+ 0x0636, 0x0637, 0x0638, 0x0639, 0x063A, 0x0640, 0x0641, 0x0642,
+ 0x0643, 0x0644, 0x0645, 0x0646, 0x0647, 0x0648, 0x0649, 0x064A,
+ 0x064B, 0x064C, 0x064D, 0x064E, 0x064F, 0x0650, 0x0651, 0x0652 };
+
+int32 default_zscii_to_unicode_c7[]
+ = { /* The 71 accented letters in Greek */
+ 0x0384, 0x0385, 0x0386, 0x0388, 0x0389, 0x038A, 0x038C, 0x038E,
+ 0x038F, 0x0390, 0x0391, 0x0392, 0x0393, 0x0394, 0x0395, 0x0396,
+ 0x0397, 0x0398, 0x0399, 0x039A, 0x039B, 0x039C, 0x039D, 0x039E,
+ 0x039F, 0x03A0, 0x03A1, 0x03A3, 0x03A4, 0x03A5, 0x03A6, 0x03A7,
+ 0x03A8, 0x03A9, 0x03AA, 0x03AB, 0x03AC, 0x03AD, 0x03AE, 0x03AF,
+ 0x03B0, 0x03B1, 0x03B2, 0x03B3, 0x03B4, 0x03B5, 0x03B6, 0x03B7,
+ 0x03B8, 0x03B9, 0x03BA, 0x03BB, 0x03BC, 0x03BD, 0x03BE, 0x03BF,
+ 0x03C0, 0x03C1, 0x03C2, 0x03C3, 0x03C4, 0x03C5, 0x03C6, 0x03C7,
+ 0x03C8, 0x03C9, 0x03CA, 0x03CB, 0x03CC, 0x03CD, 0x03CE };
+
+int32 default_zscii_to_unicode_c8[]
+ = { /* The 27 accented letters in Hebrew */
+ 0x05D0, 0x05D1, 0x05D2, 0x05D3, 0x05D4, 0x05D5, 0x05D6, 0x05D7,
+ 0x05D8, 0x05D9, 0x05DA, 0x05DB, 0x05DC, 0x05DD, 0x05DE, 0x05DF,
+ 0x05E0, 0x05E1, 0x05E2, 0x05E3, 0x05E4, 0x05E5, 0x05E6, 0x05E7,
+ 0x05E8, 0x05E9, 0x05EA };
+
+int32 default_zscii_to_unicode_c9[]
+ = { /* The 62 accented letters in Latin5 */
+ 0x00C0, 0x00C1, 0x00C2, 0x00C3, 0x00C4, 0x00C5, 0x00C6, 0x00C7,
+ 0x00C8, 0x00C9, 0x00CA, 0x00CB, 0x00CC, 0x00CD, 0x00CE, 0x00CF,
+ 0x011E, 0x00D1, 0x00D2, 0x00D3, 0x00D4, 0x00D5, 0x00D6, 0x00D8,
+ 0x00D9, 0x00DA, 0x00DB, 0x00DC, 0x0130, 0x015E, 0x00DF, 0x00E0,
+ 0x00E1, 0x00E2, 0x00E3, 0x00E4, 0x00E5, 0x00E6, 0x00E7, 0x00E8,
+ 0x00E9, 0x00EA, 0x00EB, 0x00EC, 0x00ED, 0x00EE, 0x00EF, 0x011F,
+ 0x00F1, 0x00F2, 0x00F3, 0x00F4, 0x00F5, 0x00F6, 0x00F8, 0x00F9,
+ 0x00FA, 0x00FB, 0x00FC, 0x0131, 0x015F, 0x00FF };
+
+static void make_unicode_zscii_map(void)
+{ int i;
+
+ for (i=0; i<0x61; i++) zscii_to_unicode_grid[i] = '?';
+
+ zscii_high_water_mark
+ = default_zscii_highset_sizes[character_set_setting];
+
+ for (i=0; i<zscii_high_water_mark; i++)
+ { switch(character_set_setting)
+ { case 0:
+ case 1: zscii_unicode_map(i+155, default_zscii_to_unicode_c01[i]);
+ break;
+ case 2: zscii_unicode_map(i+155, default_zscii_to_unicode_c2[i]);
+ break;
+ case 3: zscii_unicode_map(i+155, default_zscii_to_unicode_c3[i]);
+ break;
+ case 4: zscii_unicode_map(i+155, default_zscii_to_unicode_c4[i]);
+ break;
+ case 5: zscii_unicode_map(i+155, default_zscii_to_unicode_c5[i]);
+ break;
+ case 6: zscii_unicode_map(i+155, default_zscii_to_unicode_c6[i]);
+ break;
+ case 7: zscii_unicode_map(i+155, default_zscii_to_unicode_c7[i]);
+ break;
+ case 8: zscii_unicode_map(i+155, default_zscii_to_unicode_c8[i]);
+ break;
+ case 9: zscii_unicode_map(i+155, default_zscii_to_unicode_c9[i]);
+ break;
+ }
+ }
+ if (character_set_setting < 2) zscii_defn_modified = FALSE;
+ make_iso_to_alphabet_grid();
+}
+
+extern void new_zscii_character(int32 u, int plus_flag)
+{
+ if (u < 0 || u > 0xFFFF)
+ error("Zcharacter table cannot contain Unicode characters beyond $FFFF");
+ if (plus_flag == FALSE)
+ zscii_high_water_mark = 0;
+ if (zscii_high_water_mark == 0x61)
+ error("No more room in the Zcharacter table");
+ else zscii_unicode_map(155 + zscii_high_water_mark++, u);
+}
+
+extern void new_zscii_finished(void)
+{ make_iso_to_alphabet_grid();
+}
+
+extern int unicode_to_zscii(int32 u)
+{ int i;
+ if (u < 0x7f) return u;
+ for (i=0; i<zscii_high_water_mark; i++)
+ if (zscii_to_unicode_grid[i] == u) return i+155;
+ return 5;
+}
+
+extern int32 zscii_to_unicode(int z)
+{ if (z < 0x80) return z;
+ if ((z >= 155) && (z <= 251)) return zscii_to_unicode_grid[z-155];
+ return '?';
+}
+
+/* ------------------------------------------------------------------------- */
+/* (4) Text -> Unicode */
+/* */
+/* This routine is not used for ordinary text compilation as it is too */
+/* slow, but it's useful for handling @ string escapes, or to avoid writing */
+/* special code when speed is not especially required. */
+/* Note that the two string escapes which can define Unicode are: */
+/* */
+/* @.. where .. is an accent */
+/* and @{...} where ... specifies a Unicode char in hexadecimal */
+/* (1 to 6 digits long) */
+/* */
+/* If either syntax is malformed, an error is generated */
+/* and the Unicode (= ISO = ASCII) character value of '?' is returned */
+/* */
+/* In Unicode mode (character_set_unicode is true), this handles UTF-8 */
+/* decoding as well as @-expansion. (So it's called when an '@' appears */
+/* *and* when a high-bit character appears.) */
+/* ------------------------------------------------------------------------- */
+
+int textual_form_length;
+
+extern int32 text_to_unicode(char *text)
+{ int i;
+
+ if (text[0] != '@')
+ { if (character_set_unicode)
+ { if (text[0] & 0x80) /* 8-bit */
+ { switch (text[0] & 0xF0)
+ { case 0xf0: /* 4-byte UTF-8 string */
+ textual_form_length = 4;
+ if ((text[0] & 0xf8) != 0xf0)
+ { error("Invalid 4-byte UTF-8 string.");
+ return '?';
+ }
+ if ((text[1] & 0xc0) != 0x80 || (text[2] & 0xc0) != 0x80 || (text[3] & 0xc0) != 0x80)
+ { error("Invalid 4-byte UTF-8 string.");
+ return '?';
+ }
+ return (text[0] & 0x07) << 18
+ | (text[1] & 0x3f) << 12
+ | (text[2] & 0x3f) << 6
+ | (text[3] & 0x3f);
+ break;
+ case 0xe0: /* 3-byte UTF-8 string */
+ textual_form_length = 3;
+ if ((text[1] & 0xc0) != 0x80 || (text[2] & 0xc0) != 0x80)
+ { error("Invalid 3-byte UTF-8 string.");
+ return '?';
+ }
+ return (text[0] & 0x0f) << 12
+ | (text[1] & 0x3f) << 6
+ | (text[2] & 0x3f);
+ break;
+ case 0xc0: /* 2-byte UTF-8 string */
+ case 0xd0:
+ textual_form_length = 2;
+ if ((text[1] & 0xc0) != 0x80)
+ { error("Invalid 2-byte UTF-8 string.");
+ return '?';
+ }
+ return (text[0] & 0x1f) << 6
+ | (text[1] & 0x3f);
+ break;
+ default: /* broken */
+ error("Invalid UTF-8 string.");
+ textual_form_length = 1;
+ return '?';
+ break;
+ }
+ }
+ else /* nice 7-bit */
+ { textual_form_length = 1;
+ return (uchar) text[0];
+ }
+ }
+ else
+ {
+ textual_form_length = 1;
+ return iso_to_unicode((uchar) text[0]);
+ }
+ }
+
+ if ((isdigit(text[1])) || (text[1] == '@'))
+ { ebf_error("'@' plus an accent code or '@{...}'", text);
+ textual_form_length = 1;
+ return '?';
+ }
+
+ if (text[1] != '{')
+ { for (i=0; accents[i] != 0; i+=2)
+ if ((text[1] == accents[i]) && (text[2] == accents[i+1]))
+ { textual_form_length = 3;
+ return default_zscii_to_unicode_c01[i/2];
+ }
+
+ { char uac[4];
+ uac[0]='@'; uac[1]=text[1]; uac[2]=text[2]; uac[3]=0;
+ error_named("No such accented character as", uac);
+ }
+ }
+ else
+ { int32 total = 0;
+ int d=0; i=1;
+ while (text[++i] != '}')
+ { if (text[i] == 0)
+ { error("'@{' without matching '}'");
+ total = '?'; break;
+ }
+ if (i == 8)
+ { error("At most six hexadecimal digits allowed in '@{...}'");
+ total = '?'; break;
+ }
+ d = character_digit_value[(uchar)text[i]];
+ if (d == 127)
+ { error("'@{...}' may only contain hexadecimal digits");
+ total = '?'; break;
+ }
+ total = total*16 + d;
+ }
+ while ((text[i] != '}') && (text[i] != 0)) i++;
+ if (text[i] == '}') i++;
+ textual_form_length = i;
+ return total;
+ }
+
+ textual_form_length = 1;
+ return '?';
+}
+
+/* ------------------------------------------------------------------------- */
+/* (5) Zscii -> Text */
+/* */
+/* Used for printing out dictionary contents into the text transcript file */
+/* or on-screen (in response to the Trace dictionary directive). */
+/* In either case, output uses the same ISO set as the source code. */
+/* ------------------------------------------------------------------------- */
+
+extern void zscii_to_text(char *text, int zscii)
+{ int i;
+ int32 unicode;
+
+ if ((zscii < 0x100) && (zscii_to_iso_grid[zscii] != 0))
+ { text[0] = zscii_to_iso_grid[zscii]; text[1] = 0; return;
+ }
+
+ unicode = zscii_to_unicode(zscii);
+ for (i=0;i<69;i++)
+ if (default_zscii_to_unicode_c01[i] == unicode)
+ { text[0] = '@';
+ text[1] = accents[2*i];
+ text[2] = accents[2*i+1];
+ text[3] = 0; return;
+ }
+ sprintf(text, "@{%x}", unicode);
+}
+
+/* ========================================================================= */
+
+extern char *name_of_iso_set(int s)
+{ switch(s)
+ { case 1: return "Latin1";
+ case 2: return "Latin2";
+ case 3: return "Latin3";
+ case 4: return "Latin4";
+ case 5: return "Cyrillic";
+ case 6: return "Arabic";
+ case 7: return "Greek";
+ case 8: return "Hebrew";
+ case 9: return "Latin5";
+ }
+ return "Plain ASCII";
+}
+
+extern void change_character_set(void)
+{ make_source_to_iso_grid();
+ make_unicode_zscii_map();
+}
+
+/* ------------------------------------------------------------------------- */
+/* Case translation of standard Roman letters within ISO */
+/* ------------------------------------------------------------------------- */
+
+extern void make_lower_case(char *str)
+{ int i;
+ for (i=0; str[i]!=0; i++)
+ if ((((uchar)str[i])<128) && (isupper(str[i]))) str[i]=tolower(str[i]);
+}
+
+extern void make_upper_case(char *str)
+{ int i;
+ for (i=0; str[i]!=0; i++)
+ if ((((uchar)str[i])<128) && (islower(str[i]))) str[i]=toupper(str[i]);
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_chars_vars(void)
+{ int n;
+ for (n=0; n<128; n++) character_digit_value[n] = 127;
+ character_digit_value['0'] = 0;
+ character_digit_value['1'] = 1;
+ character_digit_value['2'] = 2;
+ character_digit_value['3'] = 3;
+ character_digit_value['4'] = 4;
+ character_digit_value['5'] = 5;
+ character_digit_value['6'] = 6;
+ character_digit_value['7'] = 7;
+ character_digit_value['8'] = 8;
+ character_digit_value['9'] = 9;
+ character_digit_value['a'] = 10;
+ character_digit_value['b'] = 11;
+ character_digit_value['c'] = 12;
+ character_digit_value['d'] = 13;
+ character_digit_value['e'] = 14;
+ character_digit_value['f'] = 15;
+ character_digit_value['A'] = 10;
+ character_digit_value['B'] = 11;
+ character_digit_value['C'] = 12;
+ character_digit_value['D'] = 13;
+ character_digit_value['E'] = 14;
+ character_digit_value['F'] = 15;
+
+ strcpy((char *) alphabet[0], "abcdefghijklmnopqrstuvwxyz");
+ strcpy((char *) alphabet[1], "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
+ strcpy((char *) alphabet[2], " ^0123456789.,!?_#'~/\\-:()");
+
+ alphabet_modified = FALSE;
+
+ for (n=0; n<78; n++) alphabet_used[n] = 'N';
+
+ change_character_set();
+}
+
+extern void chars_begin_pass(void)
+{
+}
+
+extern void chars_allocate_arrays(void)
+{
+}
+
+extern void chars_free_arrays(void)
+{
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "directs" : Directives (# commands) */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+int no_routines, /* Number of routines compiled so far */
+ no_named_routines, /* Number not embedded in objects */
+ no_locals, /* Number of locals in current routine */
+ no_termcs; /* Number of terminating characters */
+int terminating_characters[32];
+
+brief_location routine_starts_line; /* Source code location where the current
+ routine starts. (Useful for reporting
+ "unused variable" warnings on the start
+ line rather than the end line.) */
+
+static int constant_made_yet; /* Have any constants been defined yet? */
+
+static int ifdef_stack[32], ifdef_sp;
+
+/* ------------------------------------------------------------------------- */
+
+static int ebf_error_recover(char *s1, char *s2)
+{
+ /* Display an "expected... but found..." error, then skim forward
+ to the next semicolon and return FALSE. This is such a common
+ case in parse_given_directive() that it's worth a utility
+ function. You will see many error paths that look like:
+ return ebf_error_recover(...);
+ */
+ ebf_error(s1, s2);
+ panic_mode_error_recovery();
+ return FALSE;
+}
+
+/* ------------------------------------------------------------------------- */
+
+extern int parse_given_directive(int internal_flag)
+{ /* Internal_flag is FALSE if the directive is encountered normally,
+ TRUE if encountered with a # prefix inside a routine or object
+ definition.
+
+ Returns: FALSE if program continues, TRUE if end of file reached. */
+
+ int *trace_level = NULL; int32 i, j, k, n, flag;
+ const char *constant_name;
+ debug_location_beginning beginning_debug_location;
+
+ switch(token_value)
+ {
+
+ /* --------------------------------------------------------------------- */
+ /* Abbreviate "string1" ["string2" ...] */
+ /* --------------------------------------------------------------------- */
+
+ case ABBREVIATE_CODE:
+
+ do
+ { get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ return FALSE;
+
+ /* Z-code has a 64-abbrev limit; Glulx doesn't. */
+ if (!glulx_mode && no_abbreviations==64)
+ { error("All 64 abbreviations already declared");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ if (no_abbreviations==MAX_ABBREVS)
+ memoryerror("MAX_ABBREVS", MAX_ABBREVS);
+
+ if (abbrevs_lookup_table_made)
+ { error("All abbreviations must be declared together");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ if (token_type != DQ_TT)
+ return ebf_error_recover("abbreviation string", token_text);
+ if (strlen(token_text)<2)
+ { error_named("It's not worth abbreviating", token_text);
+ continue;
+ }
+ /* Abbreviation string with null must fit in a MAX_ABBREV_LENGTH
+ array. */
+ if (strlen(token_text)>=MAX_ABBREV_LENGTH)
+ { error_named("Abbreviation too long", token_text);
+ continue;
+ }
+ make_abbreviation(token_text);
+ } while (TRUE);
+
+ /* --------------------------------------------------------------------- */
+ /* Array arrayname array... */
+ /* --------------------------------------------------------------------- */
+
+ case ARRAY_CODE: make_global(TRUE, FALSE); break; /* See "tables.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Attribute newname [alias oldname] */
+ /* --------------------------------------------------------------------- */
+
+ case ATTRIBUTE_CODE:
+ make_attribute(); break; /* See "objects.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Class classname ... */
+ /* --------------------------------------------------------------------- */
+
+ case CLASS_CODE:
+ if (internal_flag)
+ { error("Cannot nest #Class inside a routine or object");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ make_class(NULL); /* See "objects.c" */
+ return FALSE;
+
+ /* --------------------------------------------------------------------- */
+ /* Constant newname [[=] value] [, ...] */
+ /* --------------------------------------------------------------------- */
+
+ case CONSTANT_CODE:
+ constant_made_yet=TRUE;
+
+ ParseConstantSpec:
+ get_next_token(); i = token_value;
+ beginning_debug_location = get_token_location_beginning();
+
+ if ((token_type != SYMBOL_TT)
+ || (!(sflags[i] & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))))
+ { discard_token_location(beginning_debug_location);
+ return ebf_error_recover("new constant name", token_text);
+ }
+
+ assign_symbol(i, 0, CONSTANT_T);
+ constant_name = token_text;
+
+ get_next_token();
+
+ if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
+ { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
+ { debug_file_printf("<constant>");
+ debug_file_printf("<identifier>%s</identifier>", constant_name);
+ write_debug_symbol_optional_backpatch(i);
+ write_debug_locations(get_token_location_end(beginning_debug_location));
+ debug_file_printf("</constant>");
+ }
+ goto ParseConstantSpec;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
+ { debug_file_printf("<constant>");
+ debug_file_printf("<identifier>%s</identifier>", constant_name);
+ write_debug_symbol_optional_backpatch(i);
+ write_debug_locations(get_token_location_end(beginning_debug_location));
+ debug_file_printf("</constant>");
+ }
+ return FALSE;
+ }
+
+ if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
+ put_token_back();
+
+ { assembly_operand AO = parse_expression(CONSTANT_CONTEXT);
+ if (AO.marker != 0)
+ { assign_marked_symbol(i, AO.marker, AO.value,
+ CONSTANT_T);
+ sflags[i] |= CHANGE_SFLAG;
+ if (i == grammar_version_symbol)
+ error(
+ "Grammar__Version must be given an explicit constant value");
+ }
+ else
+ { assign_symbol(i, AO.value, CONSTANT_T);
+ if (i == grammar_version_symbol)
+ { if ((grammar_version_number != AO.value)
+ && (no_fake_actions > 0))
+ error(
+ "Once a fake action has been defined it is too late to \
+change the grammar version. (If you are using the library, move any \
+Fake_Action directives to a point after the inclusion of \"Parser\".)");
+ grammar_version_number = AO.value;
+ }
+ }
+ }
+
+ if (debugfile_switch && !(sflags[i] & REDEFINABLE_SFLAG))
+ { debug_file_printf("<constant>");
+ debug_file_printf("<identifier>%s</identifier>", constant_name);
+ write_debug_symbol_optional_backpatch(i);
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ debug_file_printf("</constant>");
+ }
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
+ goto ParseConstantSpec;
+ put_token_back();
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Default constantname integer */
+ /* --------------------------------------------------------------------- */
+
+ case DEFAULT_CODE:
+ if (module_switch)
+ { error("'Default' cannot be used in -M (Module) mode");
+ panic_mode_error_recovery(); return FALSE;
+ }
+
+ get_next_token();
+ if (token_type != SYMBOL_TT)
+ return ebf_error_recover("name", token_text);
+
+ i = -1;
+ if (sflags[token_value] & UNKNOWN_SFLAG)
+ { i = token_value;
+ sflags[i] |= DEFCON_SFLAG;
+ }
+
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SETEQUALS_SEP)))
+ put_token_back();
+
+ { assembly_operand AO;
+ AO = parse_expression(CONSTANT_CONTEXT);
+ if (i != -1)
+ { if (AO.marker != 0)
+ { assign_marked_symbol(i, AO.marker, AO.value,
+ CONSTANT_T);
+ sflags[i] |= CHANGE_SFLAG;
+ }
+ else assign_symbol(i, AO.value, CONSTANT_T);
+ }
+ }
+
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Dictionary 'word' */
+ /* Dictionary 'word' val1 */
+ /* Dictionary 'word' val1 val3 */
+ /* --------------------------------------------------------------------- */
+
+ case DICTIONARY_CODE:
+ /* In Inform 5, this directive had the form
+ Dictionary SYMBOL "word";
+ This was deprecated as of I6 (if not earlier), and is no longer
+ supported at all. The current form just creates a dictionary word,
+ with the given values for dict_par1 and dict_par3. If the word
+ already exists, the values are bit-or'd in with the existing
+ values.
+ (We don't offer a way to set dict_par2, because that is entirely
+ reserved for the verb number. Or'ing values into it would create
+ garbage.)
+ */
+ get_next_token();
+ if (token_type != SQ_TT && token_type != DQ_TT)
+ return ebf_error_recover("dictionary word", token_text);
+
+ {
+ char *wd = token_text;
+ int val1 = 0;
+ int val3 = 0;
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
+ put_token_back();
+ }
+ else {
+ assembly_operand AO;
+ put_token_back();
+ AO = parse_expression(CONSTANT_CONTEXT);
+ if (module_switch && (AO.marker != 0))
+ error("A definite value must be given as a Dictionary flag");
+ else
+ val1 = AO.value;
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
+ put_token_back();
+ }
+ else {
+ assembly_operand AO;
+ put_token_back();
+ AO = parse_expression(CONSTANT_CONTEXT);
+ if (module_switch && (AO.marker != 0))
+ error("A definite value must be given as a Dictionary flag");
+ else
+ val3 = AO.value;
+ }
+ }
+
+ if (!glulx_mode) {
+ if ((val1 & ~0xFF) || (val3 & ~0xFF)) {
+ warning("Dictionary flag values cannot exceed $FF in Z-code");
+ }
+ }
+ else {
+ if ((val1 & ~0xFFFF) || (val3 & ~0xFFFF)) {
+ warning("Dictionary flag values cannot exceed $FFFF in Glulx");
+ }
+ }
+
+ dictionary_add(wd, val1, 0, val3);
+ }
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* End */
+ /* --------------------------------------------------------------------- */
+
+ case END_CODE: return(TRUE);
+
+ case ENDIF_CODE:
+ if (ifdef_sp == 0) error("'Endif' without matching 'If...'");
+ else ifdef_sp--;
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Extend ... */
+ /* --------------------------------------------------------------------- */
+
+ case EXTEND_CODE: extend_verb(); return FALSE; /* see "tables.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Fake_Action name */
+ /* --------------------------------------------------------------------- */
+
+ case FAKE_ACTION_CODE:
+ make_fake_action(); break; /* see "verbs.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Global variable [= value / array...] */
+ /* --------------------------------------------------------------------- */
+
+ case GLOBAL_CODE: make_global(FALSE, FALSE); break; /* See "tables.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* If... */
+ /* */
+ /* Note that each time Inform tests an If... condition, it stacks the */
+ /* result (TRUE or FALSE) on ifdef_stack: thus, the top of this stack */
+ /* reveals what clause of the current If... is being compiled: */
+ /* */
+ /* If...; ... Ifnot; ... Endif; */
+ /* top of stack: TRUE FALSE */
+ /* */
+ /* This is used to detect "two Ifnots in same If" errors. */
+ /* --------------------------------------------------------------------- */
+
+ case IFDEF_CODE:
+ flag = TRUE;
+ goto DefCondition;
+ case IFNDEF_CODE:
+ flag = FALSE;
+
+ DefCondition:
+ get_next_token();
+ if (token_type != SYMBOL_TT)
+ return ebf_error_recover("symbol name", token_text);
+
+ if ((token_text[0] == 'V')
+ && (token_text[1] == 'N')
+ && (token_text[2] == '_')
+ && (strlen(token_text)==7))
+ { i = atoi(token_text+3);
+ if (VNUMBER < i) flag = (flag)?FALSE:TRUE;
+ goto HashIfCondition;
+ }
+
+ if (sflags[token_value] & UNKNOWN_SFLAG) flag = (flag)?FALSE:TRUE;
+ else sflags[token_value] |= USED_SFLAG;
+ goto HashIfCondition;
+
+ case IFNOT_CODE:
+ if (ifdef_sp == 0)
+ error("'Ifnot' without matching 'If...'");
+ else
+ if (!(ifdef_stack[ifdef_sp-1]))
+ error("Second 'Ifnot' for the same 'If...' condition");
+ else
+ { dont_enter_into_symbol_table = -2; n = 1;
+ directives.enabled = TRUE;
+ do
+ { get_next_token();
+ if (token_type == EOF_TT)
+ { error("End of file reached in code 'If...'d out");
+ directives.enabled = FALSE;
+ return TRUE;
+ }
+ if (token_type == DIRECTIVE_TT)
+ { switch(token_value)
+ { case ENDIF_CODE:
+ n--; break;
+ case IFV3_CODE:
+ case IFV5_CODE:
+ case IFDEF_CODE:
+ case IFNDEF_CODE:
+ case IFTRUE_CODE:
+ case IFFALSE_CODE:
+ n++; break;
+ case IFNOT_CODE:
+ if (n == 1)
+ { error(
+ "Second 'Ifnot' for the same 'If...' condition");
+ break;
+ }
+ }
+ }
+ } while (n > 0);
+ ifdef_sp--;
+ dont_enter_into_symbol_table = FALSE;
+ directives.enabled = FALSE;
+ }
+ break;
+
+ case IFV3_CODE:
+ flag = FALSE; if (version_number == 3) flag = TRUE;
+ goto HashIfCondition;
+
+ case IFV5_CODE:
+ flag = TRUE; if (version_number == 3) flag = FALSE;
+ goto HashIfCondition;
+
+ case IFTRUE_CODE:
+ { assembly_operand AO;
+ AO = parse_expression(CONSTANT_CONTEXT);
+ if (module_switch && (AO.marker != 0))
+ { error("This condition can't be determined");
+ flag = 0;
+ }
+ else flag = (AO.value != 0);
+ }
+ goto HashIfCondition;
+
+ case IFFALSE_CODE:
+ { assembly_operand AO;
+ AO = parse_expression(CONSTANT_CONTEXT);
+ if (module_switch && (AO.marker != 0))
+ { error("This condition can't be determined");
+ flag = 1;
+ }
+ else flag = (AO.value == 0);
+ }
+ goto HashIfCondition;
+
+ HashIfCondition:
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ return ebf_error_recover("semicolon after 'If...' condition", token_text);
+
+ if (flag)
+ { ifdef_stack[ifdef_sp++] = TRUE; return FALSE; }
+ else
+ { dont_enter_into_symbol_table = -2; n = 1;
+ directives.enabled = TRUE;
+ do
+ { get_next_token();
+ if (token_type == EOF_TT)
+ { error("End of file reached in code 'If...'d out");
+ directives.enabled = FALSE;
+ return TRUE;
+ }
+ if (token_type == DIRECTIVE_TT)
+ {
+ switch(token_value)
+ { case ENDIF_CODE:
+ n--; break;
+ case IFV3_CODE:
+ case IFV5_CODE:
+ case IFDEF_CODE:
+ case IFNDEF_CODE:
+ case IFTRUE_CODE:
+ case IFFALSE_CODE:
+ n++; break;
+ case IFNOT_CODE:
+ if (n == 1)
+ { ifdef_stack[ifdef_sp++] = FALSE;
+ n--; break;
+ }
+ }
+ }
+ } while (n > 0);
+ directives.enabled = FALSE;
+ dont_enter_into_symbol_table = FALSE;
+ }
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Import global <varname> [, ...] */
+ /* */
+ /* (Further imported goods may be allowed later.) */
+ /* --------------------------------------------------------------------- */
+
+ case IMPORT_CODE:
+ if (!module_switch)
+ { error("'Import' can only be used in -M (Module) mode");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ directives.enabled = TRUE;
+ do
+ { get_next_token();
+ if ((token_type == DIRECTIVE_TT) && (token_value == GLOBAL_CODE))
+ make_global(FALSE, TRUE);
+ else error_named("'Import' cannot import things of this type:",
+ token_text);
+ get_next_token();
+ } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
+ put_token_back();
+ directives.enabled = FALSE;
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Include "[>]filename" */
+ /* */
+ /* The ">" character means to load the file from the same directory as */
+ /* the current file, instead of relying on the include path. */
+ /* --------------------------------------------------------------------- */
+
+ case INCLUDE_CODE:
+ get_next_token();
+ if (token_type != DQ_TT)
+ return ebf_error_recover("filename in double-quotes", token_text);
+
+ { char *name = token_text;
+
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ ebf_error("semicolon ';' after Include filename", token_text);
+
+ if (strcmp(name, "language__") == 0)
+ load_sourcefile(Language_Name, 0);
+ else if (name[0] == '>')
+ load_sourcefile(name+1, 1);
+ else load_sourcefile(name, 0);
+ return FALSE;
+ }
+
+ /* --------------------------------------------------------------------- */
+ /* Link "filename" */
+ /* --------------------------------------------------------------------- */
+
+ case LINK_CODE:
+ get_next_token();
+ if (token_type != DQ_TT)
+ return ebf_error_recover("filename in double-quotes", token_text);
+ link_module(token_text); /* See "linker.c" */
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Lowstring constantname "text of string" */
+ /* --------------------------------------------------------------------- */
+ /* Unlike most constant creations, these do not require backpatching: */
+ /* the low strings always occupy a table at a fixed offset in the */
+ /* Z-machine (after the abbreviations table has finished, at 0x100). */
+ /* --------------------------------------------------------------------- */
+
+ case LOWSTRING_CODE:
+ if (module_switch)
+ { error("'LowString' cannot be used in -M (Module) mode");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ get_next_token(); i = token_value;
+ if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
+ return ebf_error_recover("new low string name", token_text);
+
+ get_next_token();
+ if (token_type != DQ_TT)
+ return ebf_error_recover("literal string in double-quotes", token_text);
+
+ assign_symbol(i, compile_string(token_text, TRUE, TRUE), CONSTANT_T);
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Message | "information" */
+ /* | error "error message" */
+ /* | fatalerror "fatal error message" */
+ /* | warning "warning message" */
+ /* --------------------------------------------------------------------- */
+
+ case MESSAGE_CODE:
+ directive_keywords.enabled = TRUE;
+ get_next_token();
+ directive_keywords.enabled = FALSE;
+ if (token_type == DQ_TT)
+ { int i;
+ if (hash_printed_since_newline) printf("\n");
+ for (i=0; token_text[i]!=0; i++)
+ { if (token_text[i] == '^') printf("\n");
+ else
+ if (token_text[i] == '~') printf("\"");
+ else printf("%c", token_text[i]);
+ }
+ printf("\n");
+ break;
+ }
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == ERROR_DK))
+ { get_next_token();
+ if (token_type != DQ_TT)
+ { return ebf_error_recover("error message in double-quotes", token_text);
+ }
+ error(token_text); break;
+ }
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == FATALERROR_DK))
+ { get_next_token();
+ if (token_type != DQ_TT)
+ { return ebf_error_recover("fatal error message in double-quotes", token_text);
+ }
+ fatalerror(token_text); break;
+ }
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == WARNING_DK))
+ { get_next_token();
+ if (token_type != DQ_TT)
+ { return ebf_error_recover("warning message in double-quotes", token_text);
+ }
+ warning(token_text); break;
+ }
+ return ebf_error_recover("a message in double-quotes, 'error', 'fatalerror' or 'warning'",
+ token_text);
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Nearby objname "short name" ... */
+ /* --------------------------------------------------------------------- */
+
+ case NEARBY_CODE:
+ if (internal_flag)
+ { error("Cannot nest #Nearby inside a routine or object");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ make_object(TRUE, NULL, -1, -1, -1);
+ return FALSE; /* See "objects.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Object objname "short name" ... */
+ /* --------------------------------------------------------------------- */
+
+ case OBJECT_CODE:
+ if (internal_flag)
+ { error("Cannot nest #Object inside a routine or object");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ make_object(FALSE, NULL, -1, -1, -1);
+ return FALSE; /* See "objects.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Origsource <file> */
+ /* Origsource <file> <line> */
+ /* Origsource <file> <line> <char> */
+ /* Origsource */
+ /* */
+ /* The first three forms declare that all following lines are derived */
+ /* from the named Inform 7 source file (with an optional line number */
+ /* and character number). This will be reported in error messages and */
+ /* in debug output. The declaration holds through the next Origsource */
+ /* directive (but does not apply to included files). */
+ /* */
+ /* The fourth form, with no arguments, clears the declaration. */
+ /* */
+ /* Unlike the Include directive, Origsource does not open the named */
+ /* file or even verify that it exists. The filename is treated as an */
+ /* opaque string. */
+ /* --------------------------------------------------------------------- */
+
+ case ORIGSOURCE_CODE:
+ {
+ char *origsource_file = NULL;
+ int32 origsource_line = 0;
+ int32 origsource_char = 0;
+
+ /* Parse some optional tokens followed by a mandatory semicolon. */
+
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
+ if (token_type != DQ_TT) {
+ return ebf_error_recover("a file name in double-quotes",
+ token_text);
+ }
+ origsource_file = token_text;
+
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
+ if (token_type != NUMBER_TT) {
+ return ebf_error_recover("a file line number",
+ token_text);
+ }
+ origsource_line = token_value;
+ if (origsource_line < 0)
+ origsource_line = 0;
+
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))) {
+ if (token_type != NUMBER_TT) {
+ return ebf_error_recover("a file line number",
+ token_text);
+ }
+ origsource_char = token_value;
+ if (origsource_char < 0)
+ origsource_char = 0;
+
+ get_next_token();
+ }
+ }
+ }
+
+ put_token_back();
+
+ set_origsource_location(origsource_file, origsource_line, origsource_char);
+ }
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Property [long] [additive] name [alias oldname] */
+ /* --------------------------------------------------------------------- */
+
+ case PROPERTY_CODE: make_property(); break; /* See "objects.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Release <number> */
+ /* --------------------------------------------------------------------- */
+
+ case RELEASE_CODE:
+ { assembly_operand AO;
+ AO = parse_expression(CONSTANT_CONTEXT);
+ if (module_switch && (AO.marker != 0))
+ error("A definite value must be given as release number");
+ else
+ release_number = AO.value;
+ }
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Replace routine [routinename] */
+ /* --------------------------------------------------------------------- */
+
+ case REPLACE_CODE:
+ /* You can also replace system functions normally implemented in */
+ /* the "hardware" of the Z-machine, like "random()": */
+
+ system_functions.enabled = TRUE;
+ directives.enabled = FALSE;
+ directive_keywords.enabled = FALSE;
+
+ /* Don't count the upcoming symbol as a top-level reference
+ *to* the function. */
+ df_dont_note_global_symbols = TRUE;
+ get_next_token();
+ df_dont_note_global_symbols = FALSE;
+ if (token_type == SYSFUN_TT)
+ { if (system_function_usage[token_value] == 1)
+ error("You can't 'Replace' a system function already used");
+ else system_function_usage[token_value] = 2;
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ {
+ error("You can't give a 'Replace'd system function a new name");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ return FALSE;
+ }
+
+ if (token_type != SYMBOL_TT)
+ return ebf_error_recover("name of routine to replace", token_text);
+ if (!(sflags[token_value] & UNKNOWN_SFLAG))
+ return ebf_error_recover("name of routine not yet defined", token_text);
+
+ sflags[token_value] |= REPLACE_SFLAG;
+
+ /* If a second symbol is provided, it will refer to the
+ original (replaced) definition of the routine. */
+ i = token_value;
+
+ system_functions.enabled = FALSE;
+ df_dont_note_global_symbols = TRUE;
+ get_next_token();
+ df_dont_note_global_symbols = FALSE;
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { return FALSE;
+ }
+
+ if (token_type != SYMBOL_TT || !(sflags[token_value] & UNKNOWN_SFLAG))
+ return ebf_error_recover("semicolon ';' or new routine name", token_text);
+
+ /* Define the original-form symbol as a zero constant. Its
+ value will be overwritten later, when we define the
+ replacement. */
+ assign_symbol(token_value, 0, CONSTANT_T);
+ add_symbol_replacement_mapping(i, token_value);
+
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Serial "yymmdd" */
+ /* --------------------------------------------------------------------- */
+
+ case SERIAL_CODE:
+ get_next_token();
+ if ((token_type != DQ_TT) || (strlen(token_text)!=6))
+ { error("The serial number must be a 6-digit date in double-quotes");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ for (i=0; i<6; i++) if (isdigit(token_text[i])==0)
+ { error("The serial number must be a 6-digit date in double-quotes");
+ panic_mode_error_recovery(); return FALSE;
+ }
+ strcpy(serial_code_buffer, token_text);
+ serial_code_given_in_program = TRUE;
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Statusline score/time */
+ /* --------------------------------------------------------------------- */
+
+ case STATUSLINE_CODE:
+ if (module_switch)
+ warning("This does not set the final game's statusline");
+
+ directive_keywords.enabled = TRUE;
+ get_next_token();
+ directive_keywords.enabled = FALSE;
+ if ((token_type != DIR_KEYWORD_TT)
+ || ((token_value != SCORE_DK) && (token_value != TIME_DK)))
+ return ebf_error_recover("'score' or 'time' after 'statusline'", token_text);
+ if (token_value == SCORE_DK) statusline_flag = SCORE_STYLE;
+ else statusline_flag = TIME_STYLE;
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Stub routinename number-of-locals */
+ /* --------------------------------------------------------------------- */
+
+ case STUB_CODE:
+ if (internal_flag)
+ { error("Cannot nest #Stub inside a routine or object");
+ panic_mode_error_recovery(); return FALSE;
+ }
+
+ /* The upcoming symbol is a definition; don't count it as a
+ top-level reference *to* the stub function. */
+ df_dont_note_global_symbols = TRUE;
+ get_next_token();
+ df_dont_note_global_symbols = FALSE;
+ if (token_type != SYMBOL_TT)
+ return ebf_error_recover("routine name to stub", token_text);
+
+ i = token_value; flag = FALSE;
+
+ if (sflags[i] & UNKNOWN_SFLAG)
+ { sflags[i] |= STUB_SFLAG;
+ flag = TRUE;
+ }
+
+ get_next_token(); k = token_value;
+ if (token_type != NUMBER_TT)
+ return ebf_error_recover("number of local variables", token_text);
+ if ((k>4) || (k<0))
+ { error("Must specify 0 to 4 local variables for 'Stub' routine");
+ k = 0;
+ }
+
+ if (flag)
+ {
+ /* Give these parameter-receiving local variables names
+ for the benefit of the debugging information file,
+ and for assembly tracing to look sensible. */
+
+ local_variable_texts[0] = "dummy1";
+ local_variable_texts[1] = "dummy2";
+ local_variable_texts[2] = "dummy3";
+ local_variable_texts[3] = "dummy4";
+
+ assign_symbol(i,
+ assemble_routine_header(k, FALSE, (char *) symbs[i], FALSE, i),
+ ROUTINE_T);
+
+ /* Ensure the return value of a stubbed routine is false,
+ since this is necessary to make the library work properly */
+
+ if (!glulx_mode)
+ assemblez_0(rfalse_zc);
+ else
+ assembleg_1(return_gc, zero_operand);
+
+ /* Inhibit "local variable unused" warnings */
+
+ for (i=1; i<=k; i++) variable_usage[i] = 1;
+ sequence_point_follows = FALSE;
+ assemble_routine_end(FALSE, get_token_locations());
+ }
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Switches switchblock */
+ /* (this directive is ignored if the -i switch was set at command line) */
+ /* --------------------------------------------------------------------- */
+
+ case SWITCHES_CODE:
+ dont_enter_into_symbol_table = TRUE;
+ get_next_token();
+ dont_enter_into_symbol_table = FALSE;
+ if (token_type != DQ_TT)
+ return ebf_error_recover("string of switches", token_text);
+ if (!ignore_switches_switch)
+ { if (constant_made_yet)
+ error("A 'Switches' directive must must come before \
+the first constant definition");
+ switches(token_text, 0); /* see "inform.c" */
+ }
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* System_file */
+ /* */
+ /* Some files are declared as "system files": this information is used */
+ /* by Inform only to skip the definition of a routine X if the designer */
+ /* has indicated his intention to Replace X. */
+ /* --------------------------------------------------------------------- */
+
+ case SYSTEM_CODE:
+ declare_systemfile(); break; /* see "files.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Trace dictionary */
+ /* objects */
+ /* symbols */
+ /* verbs */
+ /* [on/off] */
+ /* assembly [on/off] */
+ /* expressions [on/off] */
+ /* lines [on/off] */
+ /* --------------------------------------------------------------------- */
+
+ case TRACE_CODE:
+ directives.enabled = FALSE;
+ trace_keywords.enabled = TRUE;
+ get_next_token();
+ trace_keywords.enabled = FALSE;
+ directives.enabled = TRUE;
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { asm_trace_level = 1; return FALSE; }
+
+ if (token_type != TRACE_KEYWORD_TT)
+ return ebf_error_recover("debugging keyword", token_text);
+
+ trace_keywords.enabled = TRUE;
+
+ i = token_value; j = 0;
+ switch(i)
+ { case DICTIONARY_TK: break;
+ case OBJECTS_TK: break;
+ case VERBS_TK: break;
+ default:
+ switch(token_value)
+ { case ASSEMBLY_TK:
+ trace_level = &asm_trace_level; break;
+ case EXPRESSIONS_TK:
+ trace_level = &expr_trace_level; break;
+ case LINES_TK:
+ trace_level = &line_trace_level; break;
+ case TOKENS_TK:
+ trace_level = &tokens_trace_level; break;
+ case LINKER_TK:
+ trace_level = &linker_trace_level; break;
+ case SYMBOLS_TK:
+ trace_level = NULL; break;
+ default:
+ put_token_back();
+ trace_level = &asm_trace_level; break;
+ }
+ j = 1;
+ get_next_token();
+ if ((token_type == SEP_TT) &&
+ (token_value == SEMICOLON_SEP))
+ { put_token_back(); break;
+ }
+ if (token_type == NUMBER_TT)
+ { j = token_value; break; }
+ if ((token_type == TRACE_KEYWORD_TT) && (token_value == ON_TK))
+ { j = 1; break; }
+ if ((token_type == TRACE_KEYWORD_TT) && (token_value == OFF_TK))
+ { j = 0; break; }
+ put_token_back(); break;
+ }
+
+ switch(i)
+ { case DICTIONARY_TK: show_dictionary(); break;
+ case OBJECTS_TK: list_object_tree(); break;
+ case SYMBOLS_TK: list_symbols(j); break;
+ case VERBS_TK: list_verb_table(); break;
+ default:
+ *trace_level = j;
+ break;
+ }
+ trace_keywords.enabled = FALSE;
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Undef symbol */
+ /* --------------------------------------------------------------------- */
+
+ case UNDEF_CODE:
+ get_next_token();
+ if (token_type != SYMBOL_TT)
+ return ebf_error_recover("symbol name", token_text);
+
+ if (sflags[token_value] & UNKNOWN_SFLAG)
+ { break; /* undef'ing an undefined constant is okay */
+ }
+
+ if (stypes[token_value] != CONSTANT_T)
+ { error_named("Cannot Undef a symbol which is not a defined constant:", (char *)symbs[token_value]);
+ break;
+ }
+
+ if (debugfile_switch)
+ { write_debug_undef(token_value);
+ }
+ end_symbol_scope(token_value);
+ sflags[token_value] |= USED_SFLAG;
+ break;
+
+ /* --------------------------------------------------------------------- */
+ /* Verb ... */
+ /* --------------------------------------------------------------------- */
+
+ case VERB_CODE: make_verb(); return FALSE; /* see "tables.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Version <number> */
+ /* --------------------------------------------------------------------- */
+
+ case VERSION_CODE:
+
+ { assembly_operand AO;
+ AO = parse_expression(CONSTANT_CONTEXT);
+ /* If a version has already been set on the command line,
+ that overrides this. */
+ if (version_set_switch)
+ {
+ warning("The Version directive was overridden by a command-line argument.");
+ break;
+ }
+
+ if (module_switch && (AO.marker != 0))
+ error("A definite value must be given as version number");
+ else
+ if (glulx_mode)
+ {
+ warning("The Version directive does not work in Glulx. Use \
+-vX.Y.Z instead, as either a command-line argument or a header comment.");
+ break;
+ }
+ else
+ { i = AO.value;
+ if ((i<3) || (i>8))
+ { error("The version number must be in the range 3 to 8");
+ break;
+ }
+ select_version(i);
+ }
+ }
+ break; /* see "inform.c" */
+
+ /* --------------------------------------------------------------------- */
+ /* Zcharacter table <num> ... */
+ /* Zcharacter table + <num> ... */
+ /* Zcharacter <string> <string> <string> */
+ /* Zcharacter <char> */
+ /* --------------------------------------------------------------------- */
+
+ case ZCHARACTER_CODE:
+
+ if (glulx_mode) {
+ error("The Zcharacter directive has no meaning in Glulx.");
+ panic_mode_error_recovery(); return FALSE;
+ }
+
+ directive_keywords.enabled = TRUE;
+ get_next_token();
+ directive_keywords.enabled = FALSE;
+
+ switch(token_type)
+ { case DQ_TT:
+ new_alphabet(token_text, 0);
+ get_next_token();
+ if (token_type != DQ_TT)
+ return ebf_error_recover("double-quoted alphabet string", token_text);
+ new_alphabet(token_text, 1);
+ get_next_token();
+ if (token_type != DQ_TT)
+ return ebf_error_recover("double-quoted alphabet string", token_text);
+ new_alphabet(token_text, 2);
+ break;
+
+ case SQ_TT:
+ map_new_zchar(text_to_unicode(token_text));
+ if (token_text[textual_form_length] != 0)
+ return ebf_error_recover("single character value", token_text);
+ break;
+
+ case DIR_KEYWORD_TT:
+ switch(token_value)
+ { case TABLE_DK:
+ { int plus_flag = FALSE;
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == PLUS_SEP))
+ { plus_flag = TRUE;
+ get_next_token();
+ }
+ while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
+ { switch(token_type)
+ { case NUMBER_TT:
+ new_zscii_character(token_value, plus_flag);
+ plus_flag = TRUE; break;
+ case SQ_TT:
+ new_zscii_character(text_to_unicode(token_text),
+ plus_flag);
+ if (token_text[textual_form_length] != 0)
+ return ebf_error_recover("single character value",
+ token_text);
+ plus_flag = TRUE;
+ break;
+ default:
+ return ebf_error_recover("character or Unicode number",
+ token_text);
+ }
+ get_next_token();
+ }
+ if (plus_flag) new_zscii_finished();
+ put_token_back();
+ }
+ break;
+ case TERMINATING_DK:
+ get_next_token();
+ while ((token_type!=SEP_TT) || (token_value!=SEMICOLON_SEP))
+ { switch(token_type)
+ { case NUMBER_TT:
+ terminating_characters[no_termcs++]
+ = token_value;
+ break;
+ default:
+ return ebf_error_recover("ZSCII number",
+ token_text);
+ }
+ get_next_token();
+ }
+ put_token_back();
+ break;
+ default:
+ return ebf_error_recover("'table', 'terminating', \
+a string or a constant",
+ token_text);
+ }
+ break;
+ default:
+ return ebf_error_recover("three alphabet strings, \
+a 'table' or 'terminating' command or a single character", token_text);
+ }
+ break;
+
+ /* ===================================================================== */
+
+ }
+
+ /* We are now at the end of a syntactically valid directive. It
+ should be terminated by a semicolon. */
+
+ get_next_token();
+ if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+ { ebf_error("';'", token_text);
+ /* Put the non-semicolon back. We will continue parsing from
+ that point, in hope that it's the start of a new directive.
+ (This recovers cleanly from a missing semicolon at the end
+ of a directive. It's not so clean if the directive *does*
+ end with a semicolon, but there's extra garbage before it.) */
+ put_token_back();
+ }
+ return FALSE;
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_directs_vars(void)
+{
+}
+
+extern void directs_begin_pass(void)
+{ no_routines = 0;
+ no_named_routines = 0;
+ no_locals = 0;
+ no_termcs = 0;
+ constant_made_yet = FALSE;
+ ifdef_sp = 0;
+}
+
+extern void directs_allocate_arrays(void)
+{
+}
+
+extern void directs_free_arrays(void)
+{
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "errors" : Warnings, errors and fatal errors */
+/* (with error throwback code for RISC OS machines) */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+#define ERROR_BUFLEN (256)
+static char error_message_buff[ERROR_BUFLEN+4]; /* room for ellipsis */
+
+/* ------------------------------------------------------------------------- */
+/* Error preamble printing. */
+/* ------------------------------------------------------------------------- */
+
+ErrorPosition ErrorReport; /* Maintained by "lexer.c" */
+
+static void print_preamble(void)
+{
+ /* Only really prints the preamble to an error or warning message:
+
+ e.g. "jigsaw.apollo", line 24:
+
+ The format is controllable (from an ICL switch) since this assists
+ the working of some development environments. */
+
+ int j, with_extension_flag = FALSE; char *p;
+
+ j = ErrorReport.file_number;
+ if (j <= 0 || j > total_files) p = ErrorReport.source;
+ else p = InputFiles[j-1].filename;
+
+ if (!p) p = "";
+
+ switch(error_format)
+ {
+ case 0: /* RISC OS error message format */
+
+ if (!(ErrorReport.main_flag)) printf("\"%s\", ", p);
+ printf("line %d: ", ErrorReport.line_number);
+ if (ErrorReport.orig_file) {
+ char *op;
+ if (ErrorReport.orig_file <= 0 || ErrorReport.orig_file > total_files)
+ op = ErrorReport.orig_source;
+ else
+ op = InputFiles[ErrorReport.orig_file-1].filename;
+ printf("(\"%s\"", op);
+ if (ErrorReport.orig_line) {
+ printf(", %d", ErrorReport.orig_line);
+ if (ErrorReport.orig_char) {
+ printf(":%d", ErrorReport.orig_char);
+ }
+ }
+ printf("): ");
+ }
+ break;
+
+ case 1: /* Microsoft error message format */
+
+ for (j=0; p[j]!=0; j++)
+ { if (p[j] == FN_SEP) with_extension_flag = TRUE;
+ if (p[j] == '.') with_extension_flag = FALSE;
+ }
+ printf("%s", p);
+ if (with_extension_flag) printf("%s", Source_Extension);
+ printf("(%d): ", ErrorReport.line_number);
+ break;
+
+ case 2: /* Macintosh Programmer's Workshop error message format */
+
+ printf("File \"%s\"; Line %d\t# ", p, ErrorReport.line_number);
+ break;
+ }
+}
+
+static void ellipsize_error_message_buff(void)
+{
+ /* If the error buffer was actually filled up by a message, it was
+ probably truncated too. Add an ellipsis, for which we left
+ extra room. (Yes, yes; errors that are *exactly* 255 characters
+ long will suffer an unnecessary ellipsis.) */
+ if (strlen(error_message_buff) == ERROR_BUFLEN-1)
+ strcat(error_message_buff, "...");
+}
+
+/* ------------------------------------------------------------------------- */
+/* Fatal errors (which have style 0) */
+/* ------------------------------------------------------------------------- */
+
+extern void fatalerror(char *s)
+{ print_preamble();
+
+ printf("Fatal error: %s\n",s);
+ if (no_compiler_errors > 0) print_sorry_message();
+
+#ifdef ARC_THROWBACK
+ throwback(0, s);
+ throwback_end();
+#endif
+#ifdef MAC_FACE
+ close_all_source();
+ if (temporary_files_switch) remove_temp_files();
+ abort_transcript_file();
+ free_arrays();
+ if (store_the_text)
+ my_free(&all_text,"transcription text");
+ longjmp(g_fallback, 1);
+#endif
+ exit(1);
+}
+
+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)
+{ if (howmany == 1)
+ snprintf(error_message_buff, ERROR_BUFLEN,
+ "Run out of memory allocating %d bytes for %s", size, name);
+ else
+ snprintf(error_message_buff, ERROR_BUFLEN,
+ "Run out of memory allocating array of %dx%d bytes for %s",
+ howmany, size, name);
+ ellipsize_error_message_buff();
+ fatalerror(error_message_buff);
+}
+
+extern void memoryerror(char *s, int32 size)
+{
+ snprintf(error_message_buff, ERROR_BUFLEN,
+ "The memory setting %s (which is %ld at present) has been \
+exceeded. Try running Inform again with $%s=<some-larger-number> on the \
+command line.",s,(long int) size,s);
+ ellipsize_error_message_buff();
+ fatalerror(error_message_buff);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Survivable diagnostics: */
+/* compilation errors style 1 */
+/* warnings style 2 */
+/* linkage errors style 3 */
+/* compiler errors style 4 (these should never happen and */
+/* indicate a bug in Inform) */
+/* ------------------------------------------------------------------------- */
+
+static int errors[MAX_ERRORS];
+
+int no_errors, no_warnings, no_suppressed_warnings, no_link_errors,
+ no_compiler_errors;
+
+char *forerrors_buff;
+int forerrors_pointer;
+
+static void message(int style, char *s)
+{ int throw_style = style;
+ if (hash_printed_since_newline) printf("\n");
+ hash_printed_since_newline = FALSE;
+ print_preamble();
+ switch(style)
+ { case 1: printf("Error: "); no_errors++; break;
+ case 2: printf("Warning: "); no_warnings++; break;
+ case 3: printf("Error: [linking '%s'] ", current_module_filename);
+ no_link_errors++; no_errors++; throw_style=1; break;
+ case 4: printf("*** Compiler error: ");
+ no_compiler_errors++; throw_style=1; break;
+ }
+ printf(" %s\n", s);
+#ifdef ARC_THROWBACK
+ throwback(throw_style, s);
+#endif
+#ifdef MAC_FACE
+ ProcessEvents (&g_proc);
+ if (g_proc != true)
+ { free_arrays();
+ if (store_the_text)
+ my_free(&all_text,"transcription text");
+ close_all_source ();
+ if (temporary_files_switch) remove_temp_files();
+ abort_transcript_file();
+ longjmp (g_fallback, 1);
+ }
+#endif
+ if ((!concise_switch) && (forerrors_pointer > 0) && (style <= 2))
+ { forerrors_buff[forerrors_pointer] = 0;
+ sprintf(forerrors_buff+68," ...etc");
+ printf("> %s\n",forerrors_buff);
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Style 1: Error message routines */
+/* ------------------------------------------------------------------------- */
+
+extern void error(char *s)
+{ if (no_errors == MAX_ERRORS)
+ fatalerror("Too many errors: giving up");
+ errors[no_errors] = no_syntax_lines;
+ message(1,s);
+}
+
+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);
+}
+
+extern void error_numbered(char *s1, int val)
+{
+ snprintf(error_message_buff, ERROR_BUFLEN,"%s %d.",s1,val);
+ ellipsize_error_message_buff();
+ error(error_message_buff);
+}
+
+extern void error_named_at(char *s1, char *s2, brief_location report_line)
+{ int i;
+
+ ErrorPosition E = ErrorReport;
+ export_brief_location(report_line, &ErrorReport);
+
+ snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
+ ellipsize_error_message_buff();
+
+ i = concise_switch; concise_switch = TRUE;
+ error(error_message_buff);
+ ErrorReport = E; concise_switch = i;
+}
+
+extern void no_such_label(char *lname)
+{ error_named("No such label as",lname);
+}
+
+extern void ebf_error(char *s1, char *s2)
+{ snprintf(error_message_buff, ERROR_BUFLEN, "Expected %s but found %s", s1, s2);
+ ellipsize_error_message_buff();
+ error(error_message_buff);
+}
+
+extern void char_error(char *s, int ch)
+{ int32 uni;
+
+ uni = iso_to_unicode(ch);
+
+ if (character_set_unicode)
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s (unicode) $%04x", s, uni);
+ else if (uni >= 0x100)
+ { snprintf(error_message_buff, ERROR_BUFLEN,
+ "%s (unicode) $%04x = (ISO %s) $%02x", s, uni,
+ name_of_iso_set(character_set_setting), ch);
+ }
+ else
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s (ISO Latin1) $%02x", s, uni);
+
+ /* If the character set is set to Latin-1, and the char in question
+ is a printable Latin-1 character, we print it in the error message.
+ This conflates the source-text charset with the terminal charset,
+ really, but it's not a big deal. */
+
+ if (((uni>=32) && (uni<127))
+ || (((uni >= 0xa1) && (uni <= 0xff))
+ && (character_set_setting==1) && (!character_set_unicode)))
+ { int curlen = strlen(error_message_buff);
+ snprintf(error_message_buff+curlen, ERROR_BUFLEN-curlen,
+ ", i.e., '%c'", uni);
+ }
+
+ ellipsize_error_message_buff();
+ error(error_message_buff);
+}
+
+extern void unicode_char_error(char *s, int32 uni)
+{
+ if (uni >= 0x100)
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s (unicode) $%04x", s, uni);
+ else
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s (ISO Latin1) $%02x", s, uni);
+
+ /* See comment above. */
+
+ if (((uni>=32) && (uni<127))
+ || (((uni >= 0xa1) && (uni <= 0xff))
+ && (character_set_setting==1) && (!character_set_unicode)))
+ { int curlen = strlen(error_message_buff);
+ snprintf(error_message_buff+curlen, ERROR_BUFLEN-curlen,
+ ", i.e., '%c'", uni);
+ }
+
+ ellipsize_error_message_buff();
+ error(error_message_buff);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Style 2: Warning message routines */
+/* ------------------------------------------------------------------------- */
+
+extern void warning(char *s1)
+{ if (nowarnings_switch) { no_suppressed_warnings++; return; }
+ 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);
+ ellipsize_error_message_buff();
+ message(2,error_message_buff);
+}
+
+extern void warning_named(char *s1, char *s2)
+{
+ if (nowarnings_switch) { no_suppressed_warnings++; return; }
+ snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"", s1, s2);
+ ellipsize_error_message_buff();
+ message(2,error_message_buff);
+}
+
+extern void dbnu_warning(char *type, 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 \"%s\" declared but not used", type, name);
+ ellipsize_error_message_buff();
+ i = concise_switch; concise_switch = TRUE;
+ message(2,error_message_buff);
+ concise_switch = i;
+ ErrorReport = E;
+}
+
+extern void uncalled_routine_warning(char *type, char *name, brief_location report_line)
+{ int i;
+ /* This is called for functions which have been detected by the
+ track-unused-routines module. These will often (but not always)
+ be also caught by dbnu_warning(), which tracks symbols rather
+ than routine addresses. */
+ ErrorPosition E = ErrorReport;
+ if (nowarnings_switch) { no_suppressed_warnings++; return; }
+ export_brief_location(report_line, &ErrorReport);
+ if (OMIT_UNUSED_ROUTINES)
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\" unused and omitted", type, name);
+ else
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\" unused (not omitted)", type, name);
+ ellipsize_error_message_buff();
+ i = concise_switch; concise_switch = TRUE;
+ message(2,error_message_buff);
+ concise_switch = i;
+ ErrorReport = E;
+}
+
+extern void obsolete_warning(char *s1)
+{ if (is_systemfile()==1) return;
+ if (obsolete_switch || nowarnings_switch)
+ { no_suppressed_warnings++; return; }
+ snprintf(error_message_buff, ERROR_BUFLEN, "Obsolete usage: %s",s1);
+ ellipsize_error_message_buff();
+ message(2,error_message_buff);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Style 3: Link error message routines */
+/* ------------------------------------------------------------------------- */
+
+extern void link_error(char *s)
+{ if (no_errors==MAX_ERRORS) fatalerror("Too many errors: giving up");
+ errors[no_errors] = no_syntax_lines;
+ message(3,s);
+}
+
+extern void link_error_named(char *s1, char *s2)
+{ snprintf(error_message_buff, ERROR_BUFLEN,"%s \"%s\"",s1,s2);
+ ellipsize_error_message_buff();
+ link_error(error_message_buff);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Style 4: Compiler error message routines */
+/* ------------------------------------------------------------------------- */
+
+extern void print_sorry_message(void)
+{ printf(
+"***********************************************************************\n\
+* 'Compiler errors' should never occur if Inform is working properly. *\n\
+* This is version %d.%02d of Inform, dated %20s: so *\n\
+* if that was more than six months ago, there may be a more recent *\n\
+* version available, from which the problem may have been removed. *\n\
+* If not, please report this fault to: graham@gnelson.demon.co.uk *\n\
+* and if at all possible, please include your source code, as faults *\n\
+* such as these are rare and often difficult to reproduce. Sorry. *\n\
+***********************************************************************\n",
+ (RELEASE_NUMBER/100)%10, RELEASE_NUMBER%100, RELEASE_DATE);
+}
+
+extern int compiler_error(char *s)
+{ if (no_link_errors > 0) return FALSE;
+ if (no_errors > 0) return FALSE;
+ if (no_compiler_errors==MAX_ERRORS)
+ fatalerror("Too many compiler errors: giving up");
+ message(4,s);
+ return TRUE;
+}
+
+extern int compiler_error_named(char *s1, char *s2)
+{ if (no_link_errors > 0) return FALSE;
+ if (no_errors > 0) return FALSE;
+ snprintf(error_message_buff, ERROR_BUFLEN, "%s \"%s\"",s1,s2);
+ ellipsize_error_message_buff();
+ compiler_error(error_message_buff);
+ return TRUE;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Code for the Acorn RISC OS operating system, donated by Robin Watts, */
+/* to provide error throwback under the DDE environment */
+/* ------------------------------------------------------------------------- */
+
+#ifdef ARC_THROWBACK
+
+#define DDEUtils_ThrowbackStart 0x42587
+#define DDEUtils_ThrowbackSend 0x42588
+#define DDEUtils_ThrowbackEnd 0x42589
+
+#include "kernel.h"
+
+extern void throwback_start(void)
+{ _kernel_swi_regs regs;
+ if (throwback_switch)
+ _kernel_swi(DDEUtils_ThrowbackStart, ®s, ®s);
+}
+
+extern void throwback_end(void)
+{ _kernel_swi_regs regs;
+ if (throwback_switch)
+ _kernel_swi(DDEUtils_ThrowbackEnd, ®s, ®s);
+}
+
+int throwback_started = FALSE;
+
+extern void throwback(int severity, char * error)
+{ _kernel_swi_regs regs;
+ if (!throwback_started)
+ { throwback_started = TRUE;
+ throwback_start();
+ }
+ if (throwback_switch)
+ { regs.r[0] = 1;
+ if ((ErrorReport.file_number == -1)
+ || (ErrorReport.file_number == 0))
+ regs.r[2] = (int) (InputFiles[0].filename);
+ else regs.r[2] = (int) (InputFiles[ErrorReport.file_number-1].filename);
+ regs.r[3] = ErrorReport.line_number;
+ regs.r[4] = (2-severity);
+ regs.r[5] = (int) error;
+ _kernel_swi(DDEUtils_ThrowbackSend, ®s, ®s);
+ }
+}
+
+#endif
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_errors_vars(void)
+{ forerrors_buff = NULL;
+ no_errors = 0; no_warnings = 0; no_suppressed_warnings = 0;
+ no_compiler_errors = 0;
+}
+
+extern void errors_begin_pass(void)
+{ ErrorReport.line_number = 0;
+ ErrorReport.file_number = -1;
+ ErrorReport.source = "<no text read yet>";
+ ErrorReport.main_flag = FALSE;
+ ErrorReport.orig_source = NULL;
+ ErrorReport.orig_file = 0;
+ ErrorReport.orig_line = 0;
+ ErrorReport.orig_char = 0;
+}
+
+extern void errors_allocate_arrays(void)
+{ forerrors_buff = my_malloc(512, "errors buffer");
+}
+
+extern void errors_free_arrays(void)
+{ my_free(&forerrors_buff, "errors buffer");
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "expressc" : The expression code generator */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+int vivc_flag; /* TRUE if the last code-generated
+ expression produced a "value in void
+ context" error: used to help the syntax
+ analyser recover from unknown-keyword
+ errors, since unknown keywords are
+ treated as yet-to-be-defined constants
+ and thus as values in void context */
+
+/* These data structures are global, because they're too useful to be
+ static. */
+assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
+ temp_var4, zero_operand, one_operand, two_operand, three_operand,
+ four_operand, valueless_operand;
+
+static void make_operands(void)
+{
+ if (!glulx_mode) {
+ INITAOTV(&stack_pointer, VARIABLE_OT, 0);
+ INITAOTV(&temp_var1, VARIABLE_OT, 255);
+ INITAOTV(&temp_var2, VARIABLE_OT, 254);
+ INITAOTV(&temp_var3, VARIABLE_OT, 253);
+ INITAOTV(&temp_var4, VARIABLE_OT, 252);
+ INITAOTV(&zero_operand, SHORT_CONSTANT_OT, 0);
+ INITAOTV(&one_operand, SHORT_CONSTANT_OT, 1);
+ INITAOTV(&two_operand, SHORT_CONSTANT_OT, 2);
+ INITAOTV(&three_operand, SHORT_CONSTANT_OT, 3);
+ INITAOTV(&four_operand, SHORT_CONSTANT_OT, 4);
+ INITAOTV(&valueless_operand, OMITTED_OT, 0);
+ }
+ else {
+ INITAOTV(&stack_pointer, LOCALVAR_OT, 0);
+ INITAOTV(&temp_var1, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+0);
+ INITAOTV(&temp_var2, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+1);
+ INITAOTV(&temp_var3, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+2);
+ INITAOTV(&temp_var4, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+3);
+ INITAOTV(&zero_operand, ZEROCONSTANT_OT, 0);
+ INITAOTV(&one_operand, BYTECONSTANT_OT, 1);
+ INITAOTV(&two_operand, BYTECONSTANT_OT, 2);
+ INITAOTV(&three_operand, BYTECONSTANT_OT, 3);
+ INITAOTV(&four_operand, BYTECONSTANT_OT, 4);
+ INITAOTV(&valueless_operand, OMITTED_OT, 0);
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* The table of conditionals. (Only used in Glulx) */
+
+#define ZERO_CC (500)
+#define EQUAL_CC (502)
+#define LT_CC (504)
+#define GT_CC (506)
+#define HAS_CC (508)
+#define IN_CC (510)
+#define OFCLASS_CC (512)
+#define PROVIDES_CC (514)
+
+#define FIRST_CC (500)
+#define LAST_CC (515)
+
+typedef struct condclass_s {
+ int32 posform; /* Opcode for the conditional in its positive form. */
+ int32 negform; /* Opcode for the conditional in its negated form. */
+} condclass;
+
+condclass condclasses[] = {
+ { jz_gc, jnz_gc },
+ { jeq_gc, jne_gc },
+ { jlt_gc, jge_gc },
+ { jgt_gc, jle_gc },
+ { -1, -1 },
+ { -1, -1 },
+ { -1, -1 },
+ { -1, -1 }
+};
+
+/* ------------------------------------------------------------------------- */
+/* The table of operators.
+
+ The ordering in this table is not significant except that it must match
+ the #define's in "header.h" */
+
+operator operators[NUM_OPERATORS] =
+{
+ /* ------------------------ */
+ /* Level 0: , */
+ /* ------------------------ */
+
+ { 0, SEP_TT, COMMA_SEP, IN_U, L_A, 0, -1, -1, 0, 0, "comma" },
+
+ /* ------------------------ */
+ /* Level 1: = */
+ /* ------------------------ */
+
+ { 1, SEP_TT, SETEQUALS_SEP, IN_U, R_A, 1, -1, -1, 1, 0,
+ "assignment operator '='" },
+
+ /* ------------------------ */
+ /* Level 2: ~~ && || */
+ /* ------------------------ */
+
+ { 2, SEP_TT, LOGAND_SEP, IN_U, L_A, 0, -1, -1, 0, LOGOR_OP,
+ "logical conjunction '&&'" },
+ { 2, SEP_TT, LOGOR_SEP, IN_U, L_A, 0, -1, -1, 0, LOGAND_OP,
+ "logical disjunction '||'" },
+ { 2, SEP_TT, LOGNOT_SEP, PRE_U, R_A, 0, -1, -1, 0, LOGNOT_OP,
+ "logical negation '~~'" },
+
+ /* ------------------------ */
+ /* Level 3: == ~= */
+ /* > >= < <= */
+ /* has hasnt */
+ /* in notin */
+ /* provides */
+ /* ofclass */
+ /* ------------------------ */
+
+ { 3, -1, -1, -1, 0, 0, 400 + jz_zc, ZERO_CC+0, 0, NONZERO_OP,
+ "expression used as condition then negated" },
+ { 3, -1, -1, -1, 0, 0, 800 + jz_zc, ZERO_CC+1, 0, ZERO_OP,
+ "expression used as condition" },
+ { 3, SEP_TT, CONDEQUALS_SEP, IN_U, 0, 0, 400 + je_zc, EQUAL_CC+0, 0, NOTEQUAL_OP,
+ "'==' condition" },
+ { 3, SEP_TT, NOTEQUAL_SEP, IN_U, 0, 0, 800 + je_zc, EQUAL_CC+1, 0, CONDEQUALS_OP,
+ "'~=' condition" },
+ { 3, SEP_TT, GE_SEP, IN_U, 0, 0, 800 + jl_zc, LT_CC+1, 0, LESS_OP,
+ "'>=' condition" },
+ { 3, SEP_TT, GREATER_SEP, IN_U, 0, 0, 400 + jg_zc, GT_CC+0, 0, LE_OP,
+ "'>' condition" },
+ { 3, SEP_TT, LE_SEP, IN_U, 0, 0, 800 + jg_zc, GT_CC+1, 0, GREATER_OP,
+ "'<=' condition" },
+ { 3, SEP_TT, LESS_SEP, IN_U, 0, 0, 400 + jl_zc, LT_CC+0, 0, GE_OP,
+ "'<' condition" },
+ { 3, CND_TT, HAS_COND, IN_U, 0, 0, 400 + test_attr_zc, HAS_CC+0, 0, HASNT_OP,
+ "'has' condition" },
+ { 3, CND_TT, HASNT_COND, IN_U, 0, 0, 800 + test_attr_zc, HAS_CC+1, 0, HAS_OP,
+ "'hasnt' condition" },
+ { 3, CND_TT, IN_COND, IN_U, 0, 0, 400 + jin_zc, IN_CC+0, 0, NOTIN_OP,
+ "'in' condition" },
+ { 3, CND_TT, NOTIN_COND, IN_U, 0, 0, 800 + jin_zc, IN_CC+1, 0, IN_OP,
+ "'notin' condition" },
+ { 3, CND_TT, OFCLASS_COND, IN_U, 0, 0, 600, OFCLASS_CC+0, 0, NOTOFCLASS_OP,
+ "'ofclass' condition" },
+ { 3, CND_TT, PROVIDES_COND, IN_U, 0, 0, 601, PROVIDES_CC+0, 0, NOTPROVIDES_OP,
+ "'provides' condition" },
+ { 3, -1, -1, -1, 0, 0, 1000, OFCLASS_CC+1, 0, OFCLASS_OP,
+ "negated 'ofclass' condition" },
+ { 3, -1, -1, -1, 0, 0, 1001, PROVIDES_CC+1, 0, PROVIDES_OP,
+ "negated 'provides' condition" },
+
+ /* ------------------------ */
+ /* Level 4: or */
+ /* ------------------------ */
+
+ { 4, CND_TT, OR_COND, IN_U, L_A, 0, -1, -1, 0, 0, "'or'" },
+
+ /* ------------------------ */
+ /* Level 5: + binary - */
+ /* ------------------------ */
+
+ { 5, SEP_TT, PLUS_SEP, IN_U, L_A, 0, add_zc, add_gc, 0, 0, "'+'" },
+ { 5, SEP_TT, MINUS_SEP, IN_U, L_A, 0, sub_zc, sub_gc, 0, 0, "'-'" },
+
+ /* ------------------------ */
+ /* Level 6: * / % */
+ /* & | ~ */
+ /* ------------------------ */
+
+ { 6, SEP_TT, TIMES_SEP, IN_U, L_A, 0, mul_zc, mul_gc, 0, 0, "'*'" },
+ { 6, SEP_TT, DIVIDE_SEP, IN_U, L_A, 0, div_zc, div_gc, 0, 0, "'/'" },
+ { 6, SEP_TT, REMAINDER_SEP, IN_U, L_A, 0, mod_zc, mod_gc, 0, 0,
+ "remainder after division '%'" },
+ { 6, SEP_TT, ARTAND_SEP, IN_U, L_A, 0, and_zc, bitand_gc, 0, 0,
+ "bitwise AND '&'" },
+ { 6, SEP_TT, ARTOR_SEP, IN_U, L_A, 0, or_zc, bitor_gc, 0, 0,
+ "bitwise OR '|'" },
+ { 6, SEP_TT, ARTNOT_SEP, PRE_U, R_A, 0, -1, bitnot_gc, 0, 0,
+ "bitwise NOT '~'" },
+
+ /* ------------------------ */
+ /* Level 7: -> --> */
+ /* ------------------------ */
+
+ { 7, SEP_TT, ARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "byte array operator '->'" },
+ { 7, SEP_TT, DARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "word array operator '-->'" },
+
+ /* ------------------------ */
+ /* Level 8: unary - */
+ /* ------------------------ */
+
+ { 8, SEP_TT, UNARY_MINUS_SEP, PRE_U, R_A, 0, -1, neg_gc, 0, 0,
+ "unary minus" },
+
+ /* ------------------------ */
+ /* Level 9: ++ -- */
+ /* (prefix or postfix) */
+ /* ------------------------ */
+
+ { 9, SEP_TT, INC_SEP, PRE_U, R_A, 2, -1, -1, 1, 0,
+ "pre-increment operator '++'" },
+ { 9, SEP_TT, POST_INC_SEP, POST_U, R_A, 3, -1, -1, 1, 0,
+ "post-increment operator '++'" },
+ { 9, SEP_TT, DEC_SEP, PRE_U, R_A, 4, -1, -1, 1, 0,
+ "pre-decrement operator '--'" },
+ { 9, SEP_TT, POST_DEC_SEP, POST_U, R_A, 5, -1, -1, 1, 0,
+ "post-decrement operator '--'" },
+
+ /* ------------------------ */
+ /* Level 10: .& .# */
+ /* ..& ..# */
+ /* ------------------------ */
+
+ {10, SEP_TT, PROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "property address operator '.&'" },
+ {10, SEP_TT, PROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "property length operator '.#'" },
+ {10, SEP_TT, MPROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "individual property address operator '..&'" },
+ {10, SEP_TT, MPROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "individual property length operator '..#'" },
+
+ /* ------------------------ */
+ /* Level 11: function ( */
+ /* ------------------------ */
+
+ {11, SEP_TT, OPENB_SEP, IN_U, L_A, 0, -1, -1, 1, 0,
+ "function call" },
+
+ /* ------------------------ */
+ /* Level 12: . .. */
+ /* ------------------------ */
+
+ {12, SEP_TT, MESSAGE_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "individual property selector '..'" },
+ {12, SEP_TT, PROPERTY_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "property selector '.'" },
+
+ /* ------------------------ */
+ /* Level 13: :: */
+ /* ------------------------ */
+
+ {13, SEP_TT, SUPERCLASS_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
+ "superclass operator '::'" },
+
+ /* ------------------------ */
+ /* Miscellaneous operators */
+ /* generated at lvalue */
+ /* checking time */
+ /* ------------------------ */
+
+ { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> = */
+ "byte array entry assignment" },
+ { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> = */
+ "word array entry assignment" },
+ { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. = */
+ "individual property assignment" },
+ { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . = */
+ "common property assignment" },
+
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ -> */
+ "byte array entry preincrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ --> */
+ "word array entry preincrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ .. */
+ "individual property preincrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ . */
+ "common property preincrement" },
+
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- -> */
+ "byte array entry predecrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- --> */
+ "word array entry predecrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- .. */
+ "individual property predecrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- . */
+ "common property predecrement" },
+
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> ++ */
+ "byte array entry postincrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> ++ */
+ "word array entry postincrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. ++ */
+ "individual property postincrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . ++ */
+ "common property postincrement" },
+
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> -- */
+ "byte array entry postdecrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> -- */
+ "word array entry postdecrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. -- */
+ "individual property postdecrement" },
+ { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . -- */
+ "common property postdecrement" },
+
+ {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x.y(args) */
+ "call to common property" },
+ {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x..y(args) */
+ "call to individual property" },
+
+ /* ------------------------ */
+ /* And one Glulx-only op */
+ /* which just pushes its */
+ /* argument on the stack, */
+ /* unchanged. */
+ /* ------------------------ */
+
+ {14, -1, -1, -1, -1, 0, -1, -1, 1, 0,
+ "push on stack" }
+};
+
+/* --- Condition annotater ------------------------------------------------- */
+
+static void annotate_for_conditions(int n, int a, int b)
+{ int i, opnum = ET[n].operator_number;
+
+ ET[n].label_after = -1;
+ ET[n].to_expression = FALSE;
+ ET[n].true_label = a;
+ ET[n].false_label = b;
+
+ if (ET[n].down == -1) return;
+
+ if ((operators[opnum].precedence == 2)
+ || (operators[opnum].precedence == 3))
+ { if ((a == -1) && (b == -1))
+ { if (opnum == LOGAND_OP)
+ { b = next_label++;
+ ET[n].false_label = b;
+ ET[n].to_expression = TRUE;
+ }
+ else
+ { a = next_label++;
+ ET[n].true_label = a;
+ ET[n].to_expression = TRUE;
+ }
+ }
+ }
+
+ switch(opnum)
+ { case LOGAND_OP:
+ if (b == -1)
+ { b = next_label++;
+ ET[n].false_label = b;
+ ET[n].label_after = b;
+ }
+ annotate_for_conditions(ET[n].down, -1, b);
+ if (b == ET[n].label_after)
+ annotate_for_conditions(ET[ET[n].down].right, a, -1);
+ else annotate_for_conditions(ET[ET[n].down].right, a, b);
+ return;
+ case LOGOR_OP:
+ if (a == -1)
+ { a = next_label++;
+ ET[n].true_label = a;
+ ET[n].label_after = a;
+ }
+ annotate_for_conditions(ET[n].down, a, -1);
+ if (a == ET[n].label_after)
+ annotate_for_conditions(ET[ET[n].down].right, -1, b);
+ else annotate_for_conditions(ET[ET[n].down].right, a, b);
+ return;
+ }
+
+ i = ET[n].down;
+ while (i != -1)
+ { annotate_for_conditions(i, -1, -1); i = ET[i].right; }
+}
+
+/* --- Code generator ------------------------------------------------------ */
+
+static void value_in_void_context_z(assembly_operand AO)
+{ char *t;
+
+ ASSERT_ZCODE();
+
+ switch(AO.type)
+ { case LONG_CONSTANT_OT:
+ case SHORT_CONSTANT_OT:
+ t = "<constant>";
+ if (AO.marker == SYMBOL_MV)
+ t = (char *) (symbs[AO.value]);
+ break;
+ case VARIABLE_OT:
+ t = variable_name(AO.value);
+ break;
+ default:
+ compiler_error("Unable to print value in void context");
+ t = "<expression>";
+ break;
+ }
+ vivc_flag = TRUE;
+
+ if (strcmp(t, "print_paddr") == 0)
+ obsolete_warning("ignoring 'print_paddr': use 'print (string)' instead");
+ else
+ if (strcmp(t, "print_addr") == 0)
+ obsolete_warning("ignoring 'print_addr': use 'print (address)' instead");
+ else
+ if (strcmp(t, "print_char") == 0)
+ obsolete_warning("ignoring 'print_char': use 'print (char)' instead");
+ else
+ ebf_error("expression with side-effects", t);
+}
+
+static void write_result_z(assembly_operand to, assembly_operand from)
+{ if (to.value == from.value) return;
+ if (to.value == 0) assemblez_1(push_zc, from);
+ else assemblez_store(to, from);
+}
+
+static void pop_zm_stack(void)
+{ assembly_operand st;
+ if (version_number < 5) assemblez_0(pop_zc);
+ else
+ { INITAOTV(&st, VARIABLE_OT, 0);
+ assemblez_1_branch(jz_zc, st, -2, TRUE);
+ }
+}
+
+static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
+ assembly_operand AO3)
+{ int vr = 0;
+
+ assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
+ index_ao;
+ int x = 0, y = 0, byte_flag = FALSE, read_flag = FALSE, from_module = FALSE;
+
+ if (AO1.marker == ARRAY_MV)
+ {
+ INITAO(&zero_ao);
+
+ if ((oc == loadb_zc) || (oc == storeb_zc)) byte_flag=TRUE;
+ else byte_flag = FALSE;
+ if ((oc == loadb_zc) || (oc == loadw_zc)) read_flag=TRUE;
+ else read_flag = FALSE;
+
+ zero_ao.type = SHORT_CONSTANT_OT;
+ zero_ao.value = 0;
+
+ size_ao = zero_ao; size_ao.value = -1;
+ for (x=0; x<no_arrays; x++)
+ { if (AO1.value == svals[array_symbols[x]])
+ { size_ao.value = array_sizes[x]; y=x;
+ }
+ }
+ if (size_ao.value==-1)
+ from_module=TRUE;
+ else {
+ from_module=FALSE;
+ type_ao = zero_ao; type_ao.value = array_types[y];
+
+ if ((!is_systemfile()))
+ { if (byte_flag)
+ {
+ if ((array_types[y] == WORD_ARRAY)
+ || (array_types[y] == TABLE_ARRAY))
+ warning("Using '->' to access a --> or table array");
+ }
+ else
+ {
+ if ((array_types[y] == BYTE_ARRAY)
+ || (array_types[y] == STRING_ARRAY))
+ warning("Using '-->' to access a -> or string array");
+ }
+ }
+ }
+ }
+
+
+ if ((!runtime_error_checking_switch) || (veneer_mode))
+ { if ((oc == loadb_zc) || (oc == loadw_zc))
+ assemblez_2_to(oc, AO1, AO2, AO3);
+ else
+ assemblez_3(oc, AO1, AO2, AO3);
+ return;
+ }
+
+ /* If we recognise AO1 as arising textually from a declared
+ array, we can check bounds explicitly. */
+
+ if ((AO1.marker == ARRAY_MV) && (!from_module))
+ {
+ int passed_label = next_label++, failed_label = next_label++,
+ final_label = next_label++;
+ /* Calculate the largest permitted array entry + 1
+ Here "size_ao.value" = largest permitted entry of its own kind */
+ max_ao = size_ao;
+
+ if (byte_flag
+ && ((array_types[y] == WORD_ARRAY)
+ || (array_types[y] == TABLE_ARRAY)))
+ { max_ao.value = size_ao.value*2 + 1;
+ type_ao.value += 8;
+ }
+ if ((!byte_flag)
+ && ((array_types[y] == BYTE_ARRAY)
+ || (array_types[y] == STRING_ARRAY)
+ || (array_types[y] == BUFFER_ARRAY)))
+ { if ((size_ao.value % 2) == 0)
+ max_ao.value = size_ao.value/2 - 1;
+ else max_ao.value = (size_ao.value-1)/2;
+ type_ao.value += 16;
+ }
+ max_ao.value++;
+
+ if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
+ if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
+
+ /* Can't write to the size entry in a string or table */
+ if (((array_types[y] == STRING_ARRAY)
+ || (array_types[y] == TABLE_ARRAY))
+ && (!read_flag))
+ { if ((array_types[y] == TABLE_ARRAY) && byte_flag)
+ zero_ao.value = 2;
+ else zero_ao.value = 1;
+ }
+
+ en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
+ switch(oc) { case loadb_zc: en_ao.value = ABOUNDS_RTE; break;
+ case loadw_zc: en_ao.value = ABOUNDS_RTE+1; break;
+ case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
+ case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
+
+ index_ao = AO2;
+ if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
+ { assemblez_store(temp_var2, AO2);
+ assemblez_store(AO2, temp_var2);
+ index_ao = temp_var2;
+ }
+ assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
+ assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
+ assemble_label_no(failed_label);
+ an_ao = zero_ao; an_ao.value = y;
+ assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
+ index_ao, size_ao, type_ao, an_ao);
+
+ /* We have to clear any of AO1, AO2, AO3 off the stack if
+ present, so that we can achieve the same effect on the stack
+ that executing the opcode would have had */
+
+ if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
+ if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
+ if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
+ { if ((oc == loadb_zc) || (oc == loadw_zc))
+ { assemblez_store(AO3, zero_ao);
+ }
+ else pop_zm_stack();
+ }
+ assemblez_jump(final_label);
+
+ assemble_label_no(passed_label);
+ if ((oc == loadb_zc) || (oc == loadw_zc))
+ assemblez_2_to(oc, AO1, AO2, AO3);
+ else
+ assemblez_3(oc, AO1, AO2, AO3);
+ assemble_label_no(final_label);
+ return;
+ }
+
+ /* Otherwise, compile a call to the veneer which verifies that
+ the proposed read/write is within dynamic Z-machine memory. */
+
+ switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
+ case loadw_zc: vr = RT__ChLDW_VR; break;
+ case storeb_zc: vr = RT__ChSTB_VR; break;
+ case storew_zc: vr = RT__ChSTW_VR; break;
+ default: compiler_error("unknown array opcode");
+ }
+
+ if ((oc == loadb_zc) || (oc == loadw_zc))
+ assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
+ else
+ assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
+}
+
+static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
+ int error_label, int rte_number)
+{ assembly_operand AO2, AO3;
+ int check_sp = FALSE, passed_label, failed_label, last_label;
+ if (veneer_mode) return AO1;
+
+ /* Assemble to code to check that the operand AO1 is ofclass Object:
+ if it is, execution should continue and the stack should be
+ unchanged. Otherwise, call the veneer's run-time-error routine
+ with the given error number, and then: if the label isn't -1,
+ switch execution to this label, with the value popped from
+ the stack if it was on the stack in the first place;
+ if the label is -1, either replace the top of the stack with
+ the constant 2, or return the operand (short constant) 2.
+
+ The point of 2 is that object 2 is the class-object Object
+ and therefore has no parent, child or sibling, so that the
+ built-in tree functions will safely return 0 on this object. */
+
+ /* Sometimes we can already see that the object number is valid. */
+ if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
+ && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
+ return AO1;
+
+ passed_label = next_label++;
+ failed_label = next_label++;
+ INITAOTV(&AO2, LONG_CONSTANT_OT, actual_largest_object_SC);
+ AO2.marker = INCON_MV;
+ INITAOTV(&AO3, SHORT_CONSTANT_OT, 5);
+
+ if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
+ || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
+ || (rte_number == PROP_ADD_RTE))
+ { /* Allow classes */
+ AO3.value = 1;
+ if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
+ { /* That is, if AO1 is the stack pointer */
+ check_sp = TRUE;
+ assemblez_store(temp_var2, AO1);
+ assemblez_store(AO1, temp_var2);
+ assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
+ assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
+ }
+ else
+ { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
+ assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
+ }
+ }
+ else
+ { if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
+ { /* That is, if AO1 is the stack pointer */
+ check_sp = TRUE;
+ assemblez_store(temp_var2, AO1);
+ assemblez_store(AO1, temp_var2);
+ assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
+ assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
+ AO3.value = 1;
+ assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
+ }
+ else
+ { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
+ assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
+ AO3.value = 1;
+ assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
+ }
+ }
+
+ assemble_label_no(failed_label);
+ INITAOTV(&AO2, SHORT_CONSTANT_OT, rte_number);
+ if (version_number >= 5)
+ assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
+ else
+ assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
+
+ if (error_label != -1)
+ { /* Jump to the error label */
+ if (error_label == -3) assemblez_0(rfalse_zc);
+ else if (error_label == -4) assemblez_0(rtrue_zc);
+ else assemblez_jump(error_label);
+ }
+ else
+ { if (check_sp)
+ { /* Push the short constant 2 */
+ INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
+ assemblez_store(AO1, AO2);
+ }
+ else
+ { /* Store either short constant 2 or the operand's value in
+ the temporary variable */
+ INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
+ AO3 = temp_var2; assemblez_store(AO3, AO2);
+ last_label = next_label++;
+ assemblez_jump(last_label);
+ assemble_label_no(passed_label);
+ assemblez_store(AO3, AO1);
+ assemble_label_no(last_label);
+ return AO3;
+ }
+ }
+ assemble_label_no(passed_label);
+ return AO1;
+}
+
+static void compile_conditional_z(int oc,
+ assembly_operand AO1, assembly_operand AO2, int label, int flag)
+{ assembly_operand AO3; int the_zc, error_label = label,
+ va_flag = FALSE, va_label = 0;
+
+ ASSERT_ZCODE();
+
+ if (oc<200)
+ { if ((runtime_error_checking_switch) && (oc == jin_zc))
+ { if (flag) error_label = next_label++;
+ AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
+ }
+ if ((runtime_error_checking_switch) && (oc == test_attr_zc))
+ { if (flag) error_label = next_label++;
+ AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
+ switch(AO2.type)
+ { case SHORT_CONSTANT_OT:
+ case LONG_CONSTANT_OT:
+ if (AO2.marker == 0)
+ { if ((AO2.value < 0) || (AO2.value > 47))
+ error("'has'/'hasnt' applied to illegal attribute number");
+ break;
+ }
+ case VARIABLE_OT:
+ { int pa_label = next_label++, fa_label = next_label++;
+ assembly_operand en_ao, zero_ao, max_ao;
+ assemblez_store(temp_var1, AO1);
+ if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
+ assemblez_store(AO1, temp_var1);
+ assemblez_store(temp_var2, AO2);
+ if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
+ assemblez_store(AO2, temp_var2);
+ INITAOT(&zero_ao, SHORT_CONSTANT_OT);
+ zero_ao.value = 0;
+ max_ao = zero_ao; max_ao.value = 48;
+ assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
+ assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
+ assemble_label_no(fa_label);
+ en_ao = zero_ao; en_ao.value = 19;
+ assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
+ en_ao, temp_var1, temp_var2);
+ va_flag = TRUE; va_label = next_label++;
+ assemblez_jump(va_label);
+ assemble_label_no(pa_label);
+ }
+ }
+ }
+ assemblez_2_branch(oc, AO1, AO2, label, flag);
+ if (error_label != label) assemble_label_no(error_label);
+ if (va_flag) assemble_label_no(va_label);
+ return;
+ }
+
+ INITAOTV(&AO3, VARIABLE_OT, 0);
+
+ the_zc = (version_number == 3)?call_zc:call_vs_zc;
+ if (oc == 201)
+ assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
+ else
+ assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
+
+ assemblez_1_branch(jz_zc, AO3, label, !flag);
+}
+
+static void value_in_void_context_g(assembly_operand AO)
+{ char *t;
+
+ ASSERT_GLULX();
+
+ switch(AO.type)
+ { case CONSTANT_OT:
+ case HALFCONSTANT_OT:
+ case BYTECONSTANT_OT:
+ case ZEROCONSTANT_OT:
+ t = "<constant>";
+ if (AO.marker == SYMBOL_MV)
+ t = (char *) (symbs[AO.value]);
+ break;
+ case GLOBALVAR_OT:
+ case LOCALVAR_OT:
+ t = variable_name(AO.value);
+ break;
+ default:
+ compiler_error("Unable to print value in void context");
+ t = "<expression>";
+ break;
+ }
+ vivc_flag = TRUE;
+
+ ebf_error("expression with side-effects", t);
+}
+
+static void write_result_g(assembly_operand to, assembly_operand from)
+{ if (to.value == from.value && to.type == from.type) return;
+ assembleg_store(to, from);
+}
+
+static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
+ assembly_operand AO3)
+{ int vr = 0;
+ int data_len, read_flag;
+ assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
+ index_ao, five_ao;
+ int passed_label, failed_label, final_label, x = 0, y = 0;
+
+ if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
+ else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
+ else data_len = 4;
+
+ if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
+ read_flag = TRUE;
+ else
+ read_flag = FALSE;
+
+ if (AO1.marker == ARRAY_MV)
+ {
+ INITAO(&zero_ao);
+
+ size_ao = zero_ao; size_ao.value = -1;
+ for (x=0; x<no_arrays; x++)
+ { if (AO1.value == svals[array_symbols[x]])
+ { size_ao.value = array_sizes[x]; y=x;
+ }
+ }
+ if (size_ao.value==-1) compiler_error("Array size can't be found");
+
+ type_ao = zero_ao; type_ao.value = array_types[y];
+
+ if ((!is_systemfile()))
+ { if (data_len == 1)
+ {
+ if ((array_types[y] == WORD_ARRAY)
+ || (array_types[y] == TABLE_ARRAY))
+ warning("Using '->' to access a --> or table array");
+ }
+ else
+ {
+ if ((array_types[y] == BYTE_ARRAY)
+ || (array_types[y] == STRING_ARRAY))
+ warning("Using '-->' to access a -> or string array");
+ }
+ }
+ }
+
+
+ if ((!runtime_error_checking_switch) || (veneer_mode))
+ {
+ assembleg_3(oc, AO1, AO2, AO3);
+ return;
+ }
+
+ /* If we recognise AO1 as arising textually from a declared
+ array, we can check bounds explicitly. */
+
+ if (AO1.marker == ARRAY_MV)
+ {
+ /* Calculate the largest permitted array entry + 1
+ Here "size_ao.value" = largest permitted entry of its own kind */
+ max_ao = size_ao;
+ if (data_len == 1
+ && ((array_types[y] == WORD_ARRAY)
+ || (array_types[y] == TABLE_ARRAY)))
+ { max_ao.value = size_ao.value*4 + 3;
+ type_ao.value += 8;
+ }
+ if (data_len == 4
+ && ((array_types[y] == BYTE_ARRAY)
+ || (array_types[y] == STRING_ARRAY)
+ || (array_types[y] == BUFFER_ARRAY)))
+ { max_ao.value = (size_ao.value-3)/4;
+ type_ao.value += 16;
+ }
+ max_ao.value++;
+
+ /* Can't write to the size entry in a string or table */
+ if (((array_types[y] == STRING_ARRAY)
+ || (array_types[y] == TABLE_ARRAY))
+ && (!read_flag))
+ { if ((array_types[y] == TABLE_ARRAY) && data_len == 1)
+ zero_ao.value = 4;
+ else zero_ao.value = 1;
+ }
+
+ en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
+
+ switch(oc) { case aloadb_gc: en_ao.value = ABOUNDS_RTE; break;
+ case aload_gc: en_ao.value = ABOUNDS_RTE+1; break;
+ case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
+ case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
+
+ set_constant_ot(&zero_ao);
+ set_constant_ot(&size_ao);
+ set_constant_ot(&max_ao);
+ set_constant_ot(&type_ao);
+ set_constant_ot(&en_ao);
+
+ /* If we recognize A02 as a constant, we can do the test right
+ now. */
+ if (is_constant_ot(AO2.type) && AO2.marker == 0) {
+ if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
+ error("Array reference is out-of-bounds");
+ }
+ assembleg_3(oc, AO1, AO2, AO3);
+ return;
+ }
+
+ passed_label = next_label++;
+ failed_label = next_label++;
+ final_label = next_label++;
+
+ index_ao = AO2;
+ if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
+ { assembleg_store(temp_var2, AO2); /* ### could peek */
+ assembleg_store(AO2, temp_var2);
+ index_ao = temp_var2;
+ }
+ assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
+ assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
+ assemble_label_no(failed_label);
+
+ an_ao = zero_ao; an_ao.value = y;
+ set_constant_ot(&an_ao);
+ five_ao = zero_ao; five_ao.value = 5;
+ set_constant_ot(&five_ao);
+
+ /* Call the error veneer routine. */
+ assembleg_store(stack_pointer, an_ao);
+ assembleg_store(stack_pointer, type_ao);
+ assembleg_store(stack_pointer, size_ao);
+ assembleg_store(stack_pointer, index_ao);
+ assembleg_store(stack_pointer, en_ao);
+ assembleg_3(call_gc, veneer_routine(RT__Err_VR),
+ five_ao, zero_operand);
+
+ /* We have to clear any of AO1, AO2, AO3 off the stack if
+ present, so that we can achieve the same effect on the stack
+ that executing the opcode would have had */
+
+ if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
+ assembleg_2(copy_gc, stack_pointer, zero_operand);
+ if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
+ assembleg_2(copy_gc, stack_pointer, zero_operand);
+ if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
+ { if ((oc == aloadb_gc) || (oc == aload_gc))
+ { assembleg_store(AO3, zero_ao);
+ }
+ else assembleg_2(copy_gc, stack_pointer, zero_operand);
+ }
+ assembleg_jump(final_label);
+
+ assemble_label_no(passed_label);
+ assembleg_3(oc, AO1, AO2, AO3);
+ assemble_label_no(final_label);
+ return;
+ }
+
+ /* Otherwise, compile a call to the veneer which verifies that
+ the proposed read/write is within dynamic Z-machine memory. */
+
+ switch(oc) {
+ case aloadb_gc: vr = RT__ChLDB_VR; break;
+ case aload_gc: vr = RT__ChLDW_VR; break;
+ case astoreb_gc: vr = RT__ChSTB_VR; break;
+ case astore_gc: vr = RT__ChSTW_VR; break;
+ default: compiler_error("unknown array opcode");
+ }
+
+ if ((oc == aloadb_gc) || (oc == aload_gc))
+ assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
+ else
+ assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
+}
+
+static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
+ int error_label, int rte_number)
+{
+ assembly_operand AO, AO2, AO3;
+ int ln;
+ int check_sp = FALSE, passed_label, failed_label, last_label;
+
+ if (veneer_mode)
+ return AO1;
+
+ /* Assemble to code to check that the operand AO1 is ofclass Object:
+ if it is, execution should continue and the stack should be
+ unchanged. Otherwise, call the veneer's run-time-error routine
+ with the given error number, and then: if the label isn't -1,
+ switch execution to this label, with the value popped from
+ the stack if it was on the stack in the first place;
+ if the label is -1, either replace the top of the stack with
+ the constant symbol (class-object) Object.
+
+ The Object has no parent, child or sibling, so that the
+ built-in tree functions will safely return 0 on this object. */
+
+ /* Sometimes we can already see that the object number is valid. */
+ if (AO1.marker == OBJECT_MV &&
+ ((AO1.value >= 1) && (AO1.value <= no_objects))) {
+ return AO1;
+ }
+
+ passed_label = next_label++;
+ failed_label = next_label++;
+
+ if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
+ /* That is, if AO1 is the stack pointer */
+ check_sp = TRUE;
+ assembleg_store(temp_var2, stack_pointer);
+ assembleg_store(stack_pointer, temp_var2);
+ AO = temp_var2;
+ }
+ else {
+ AO = AO1;
+ }
+
+ if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
+ || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
+ || (rte_number == PROP_ADD_RTE)) {
+ /* Allow classes */
+ /* Test if zero... */
+ assembleg_1_branch(jz_gc, AO, failed_label);
+ /* Test if first byte is 0x70... */
+ assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
+ INITAO(&AO3);
+ AO3.value = 0x70; /* type byte -- object */
+ set_constant_ot(&AO3);
+ assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
+ }
+ else {
+ /* Test if zero... */
+ assembleg_1_branch(jz_gc, AO, failed_label);
+ /* Test if first byte is 0x70... */
+ assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
+ INITAO(&AO3);
+ AO3.value = 0x70; /* type byte -- object */
+ set_constant_ot(&AO3);
+ assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
+ /* 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 = svals[ln];
+ AO3.marker = OBJECT_MV;
+ AO3.type = CONSTANT_OT;
+ assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
+ }
+
+ assemble_label_no(failed_label);
+ INITAO(&AO2);
+ AO2.value = rte_number;
+ set_constant_ot(&AO2);
+ assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
+
+ if (error_label != -1) {
+ /* Jump to the error label */
+ if (error_label == -3) assembleg_1(return_gc, zero_operand);
+ else if (error_label == -4) assembleg_1(return_gc, one_operand);
+ else assembleg_jump(error_label);
+ }
+ else {
+ /* Build the symbol for "Object" */
+ ln = symbol_index("Object", -1);
+ AO2.value = svals[ln];
+ AO2.marker = OBJECT_MV;
+ AO2.type = CONSTANT_OT;
+ if (check_sp) {
+ /* Push "Object" */
+ assembleg_store(AO1, AO2);
+ }
+ else {
+ /* Store either "Object" or the operand's value in the temporary
+ variable. */
+ assembleg_store(temp_var2, AO2);
+ last_label = next_label++;
+ assembleg_jump(last_label);
+ assemble_label_no(passed_label);
+ assembleg_store(temp_var2, AO1);
+ assemble_label_no(last_label);
+ return temp_var2;
+ }
+ }
+
+ assemble_label_no(passed_label);
+ return AO1;
+}
+
+static void compile_conditional_g(condclass *cc,
+ assembly_operand AO1, assembly_operand AO2, int label, int flag)
+{ assembly_operand AO4;
+ int the_zc, error_label = label,
+ va_flag = FALSE, va_label = 0;
+
+ ASSERT_GLULX();
+
+ the_zc = (flag ? cc->posform : cc->negform);
+
+ if (the_zc == -1) {
+ switch ((cc-condclasses)*2 + 500) {
+
+ case HAS_CC:
+ if (runtime_error_checking_switch) {
+ if (flag)
+ error_label = next_label++;
+ AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
+ if (is_constant_ot(AO2.type) && AO2.marker == 0) {
+ if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
+ error("'has'/'hasnt' applied to illegal attribute number");
+ }
+ }
+ else {
+ int pa_label = next_label++, fa_label = next_label++;
+ assembly_operand en_ao, max_ao;
+
+ if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
+ if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
+ assembleg_2(stkpeek_gc, zero_operand, temp_var1);
+ assembleg_2(stkpeek_gc, one_operand, temp_var2);
+ }
+ else {
+ assembleg_2(stkpeek_gc, zero_operand, temp_var1);
+ assembleg_store(temp_var2, AO2);
+ }
+ }
+ else {
+ assembleg_store(temp_var1, AO1);
+ if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
+ assembleg_2(stkpeek_gc, zero_operand, temp_var2);
+ }
+ else {
+ assembleg_store(temp_var2, AO2);
+ }
+ }
+
+ INITAO(&max_ao);
+ max_ao.value = NUM_ATTR_BYTES*8;
+ set_constant_ot(&max_ao);
+ assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
+ assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
+ assemble_label_no(fa_label);
+ INITAO(&en_ao);
+ en_ao.value = 19; /* INVALIDATTR_RTE */
+ set_constant_ot(&en_ao);
+ assembleg_store(stack_pointer, temp_var2);
+ assembleg_store(stack_pointer, temp_var1);
+ assembleg_store(stack_pointer, en_ao);
+ assembleg_3(call_gc, veneer_routine(RT__Err_VR),
+ three_operand, zero_operand);
+ va_flag = TRUE;
+ va_label = next_label++;
+ assembleg_jump(va_label);
+ assemble_label_no(pa_label);
+ }
+ }
+ if (is_constant_ot(AO2.type) && AO2.marker == 0) {
+ AO2.value += 8;
+ set_constant_ot(&AO2);
+ }
+ else {
+ INITAO(&AO4);
+ AO4.value = 8;
+ AO4.type = BYTECONSTANT_OT;
+ if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
+ if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
+ assembleg_0(stkswap_gc);
+ assembleg_3(add_gc, AO2, AO4, stack_pointer);
+ assembleg_0(stkswap_gc);
+ }
+ else {
+ assembleg_3(add_gc, AO2, AO4, stack_pointer);
+ }
+ AO2 = stack_pointer;
+ }
+ assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
+ the_zc = (flag ? jnz_gc : jz_gc);
+ AO1 = stack_pointer;
+ break;
+
+ case IN_CC:
+ if (runtime_error_checking_switch) {
+ if (flag)
+ error_label = next_label++;
+ AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
+ }
+ INITAO(&AO4);
+ AO4.value = GOBJFIELD_PARENT();
+ AO4.type = BYTECONSTANT_OT;
+ assembleg_3(aload_gc, AO1, AO4, stack_pointer);
+ AO1 = stack_pointer;
+ the_zc = (flag ? jeq_gc : jne_gc);
+ break;
+
+ case OFCLASS_CC:
+ assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
+ the_zc = (flag ? jnz_gc : jz_gc);
+ AO1 = stack_pointer;
+ break;
+
+ case PROVIDES_CC:
+ assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
+ the_zc = (flag ? jnz_gc : jz_gc);
+ AO1 = stack_pointer;
+ break;
+
+ default:
+ error("condition not yet supported in Glulx");
+ return;
+ }
+ }
+
+ if (the_zc == jnz_gc || the_zc == jz_gc)
+ assembleg_1_branch(the_zc, AO1, label);
+ else
+ assembleg_2_branch(the_zc, AO1, AO2, label);
+ if (error_label != label) assemble_label_no(error_label);
+ if (va_flag) assemble_label_no(va_label);
+}
+
+static void value_in_void_context(assembly_operand AO)
+{
+ if (!glulx_mode)
+ value_in_void_context_z(AO);
+ else
+ value_in_void_context_g(AO);
+}
+
+
+extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
+ int error_label, int rte_number)
+{
+ if (!glulx_mode)
+ return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
+ else
+ return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
+}
+
+static void generate_code_from(int n, int void_flag)
+{
+ /* When void, this must not leave anything on the stack. */
+
+ int i, j, below, above, opnum, arity; assembly_operand Result;
+
+ below = ET[n].down; above = ET[n].up;
+ if (below == -1)
+ { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
+ value_in_void_context(ET[n].value);
+ return;
+ }
+
+ opnum = ET[n].operator_number;
+
+ if (opnum == COMMA_OP)
+ { generate_code_from(below, TRUE);
+ generate_code_from(ET[below].right, void_flag);
+ ET[n].value = ET[ET[below].right].value;
+ goto OperatorGenerated;
+ }
+
+ if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
+ { generate_code_from(below, FALSE);
+ generate_code_from(ET[below].right, FALSE);
+ goto OperatorGenerated;
+ }
+
+ if (opnum == -1)
+ {
+ /* Signifies a SETEQUALS_OP which has already been done */
+
+ ET[n].down = -1; return;
+ }
+
+ /* Note that (except in the cases of comma and logical and/or) it
+ is essential to code generate the operands right to left, because
+ of the peculiar way the Z-machine's stack works:
+
+ @sub sp sp -> a;
+
+ (for instance) pulls to the first operand, then the second. So
+
+ @mul a 2 -> sp;
+ @add b 7 -> sp;
+ @sub sp sp -> a;
+
+ calculates (b+7)-(a*2), not the other way around (as would be more
+ usual in stack machines evaluating expressions written in reverse
+ Polish notation). (Basically this is because the Z-machine was
+ designed to implement a LISP-like language naturally expressed
+ in forward Polish notation: (PLUS 3 4), for instance.) */
+
+ /* And the Glulx machine follows the Z-machine in this respect. */
+
+ i=below; arity = 0;
+ while (i != -1)
+ { i = ET[i].right; arity++;
+ }
+ for (j=arity;j>0;j--)
+ { int k = 1;
+ i = below;
+ while (k<j)
+ { k++; i = ET[i].right;
+ }
+ generate_code_from(i, FALSE);
+ }
+
+
+ /* Check this again, because code generation lower down may have
+ stubbed it into -1 */
+
+ if (ET[n].operator_number == -1)
+ { ET[n].down = -1; return;
+ }
+
+ if (!glulx_mode) {
+
+ if (operators[opnum].opcode_number_z >= 400)
+ {
+ /* Conditional terms such as '==': */
+
+ int a = ET[n].true_label, b = ET[n].false_label,
+ branch_away, branch_other,
+ make_jump_away = FALSE, make_branch_label = FALSE;
+ int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
+
+ if (oc >= 400) { oc = oc - 400; flag = FALSE; }
+
+ if ((oc == je_zc) && (arity == 2))
+ { i = ET[ET[n].down].right;
+ if ((ET[i].value.value == zero_operand.value)
+ && (ET[i].value.type == zero_operand.type))
+ oc = jz_zc;
+ }
+
+ /* If the condition has truth state flag, branch to
+ label a, and if not, to label b. Possibly one of a, b
+ equals -1, meaning "continue from this instruction".
+
+ branch_away is the label which is a branch away (the one
+ which isn't immediately after) and flag is the truth
+ state to branch there.
+
+ Note that when multiple instructions are needed (because
+ of the use of the 'or' operator) the branch_other label
+ is created if need be.
+ */
+
+ /* Reduce to the case where the branch_away label does exist: */
+
+ if (a == -1) { a = b; b = -1; flag = !flag; }
+
+ branch_away = a; branch_other = b;
+ if (branch_other != -1) make_jump_away = TRUE;
+
+ if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
+ {
+ /* In this case, we have an 'or' situation where multiple
+ instructions are needed and where the overall condition
+ is negated. That is, we have, e.g.
+
+ if not (A cond B or C or D) then branch_away
+
+ which we transform into
+
+ if (A cond B) then branch_other
+ if (A cond C) then branch_other
+ if not (A cond D) then branch_away
+ .branch_other */
+
+ if (branch_other == -1)
+ { branch_other = next_label++; make_branch_label = TRUE;
+ }
+ }
+
+ if (oc == jz_zc)
+ assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
+ else
+ { assembly_operand left_operand;
+
+ if (arity == 2)
+ compile_conditional_z(oc, ET[below].value,
+ ET[ET[below].right].value, branch_away, flag);
+ else
+ { /* The case of a condition using "or".
+ First: if the condition tests the stack pointer,
+ and it can't always be done in a single test, move
+ the value off the stack and into temporary variable
+ storage. */
+
+ if (((ET[below].value.type == VARIABLE_OT)
+ && (ET[below].value.value == 0))
+ && ((oc != je_zc) || (arity>4)) )
+ { INITAOTV(&left_operand, VARIABLE_OT, 255);
+ assemblez_store(left_operand, ET[below].value);
+ }
+ else left_operand = ET[below].value;
+ i = ET[below].right; arity--;
+
+ /* "left_operand" now holds the quantity to be tested;
+ "i" holds the right operand reached so far;
+ "arity" the number of right operands. */
+
+ while (i != -1)
+ { if ((oc == je_zc) && (arity>1))
+ {
+ /* je_zc is an especially good case since the
+ Z-machine implements "or" for up to three
+ right operands automatically, though it's an
+ especially bad case to generate code for! */
+
+ if (arity == 2)
+ { assemblez_3_branch(je_zc,
+ left_operand, ET[i].value,
+ ET[ET[i].right].value, branch_away, flag);
+ i = ET[i].right; arity--;
+ }
+ else
+ { if ((arity == 3) || flag)
+ assemblez_4_branch(je_zc, left_operand,
+ ET[i].value,
+ ET[ET[i].right].value,
+ ET[ET[ET[i].right].right].value,
+ branch_away, flag);
+ else
+ assemblez_4_branch(je_zc, left_operand,
+ ET[i].value,
+ ET[ET[i].right].value,
+ ET[ET[ET[i].right].right].value,
+ branch_other, !flag);
+ i = ET[ET[i].right].right; arity -= 2;
+ }
+ }
+ else
+ { /* Otherwise we can compare the left_operand with
+ only one right operand at the time. There are
+ two cases: it's the last right operand, or it
+ isn't. */
+
+ if ((arity == 1) || flag)
+ compile_conditional_z(oc, left_operand,
+ ET[i].value, branch_away, flag);
+ else
+ compile_conditional_z(oc, left_operand,
+ ET[i].value, branch_other, !flag);
+ }
+ i = ET[i].right; arity--;
+ }
+
+ }
+ }
+
+ /* NB: These two conditions cannot both occur, fortunately! */
+
+ if (make_branch_label) assemble_label_no(branch_other);
+ if (make_jump_away) assemblez_jump(branch_other);
+
+ goto OperatorGenerated;
+ }
+
+ }
+ else {
+ if (operators[opnum].opcode_number_g >= FIRST_CC
+ && operators[opnum].opcode_number_g <= LAST_CC) {
+ /* Conditional terms such as '==': */
+
+ int a = ET[n].true_label, b = ET[n].false_label;
+ int branch_away, branch_other, flag,
+ make_jump_away = FALSE, make_branch_label = FALSE;
+ int ccode = operators[opnum].opcode_number_g;
+ condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
+ flag = (ccode & 1) ? 0 : 1;
+
+ /* If the comparison is "equal to (constant) 0", change it
+ to the simple "zero" test. Unfortunately, this doesn't
+ work for the commutative form "(constant) 0 is equal to".
+ At least I don't think it does. */
+
+ if ((cc == &condclasses[1]) && (arity == 2)) {
+ i = ET[ET[n].down].right;
+ if ((ET[i].value.value == 0)
+ && (ET[i].value.marker == 0)
+ && is_constant_ot(ET[i].value.type)) {
+ cc = &condclasses[0];
+ }
+ }
+
+ /* If the condition has truth state flag, branch to
+ label a, and if not, to label b. Possibly one of a, b
+ equals -1, meaning "continue from this instruction".
+
+ branch_away is the label which is a branch away (the one
+ which isn't immediately after) and flag is the truth
+ state to branch there.
+
+ Note that when multiple instructions are needed (because
+ of the use of the 'or' operator) the branch_other label
+ is created if need be.
+ */
+
+ /* Reduce to the case where the branch_away label does exist: */
+
+ if (a == -1) { a = b; b = -1; flag = !flag; }
+
+ branch_away = a; branch_other = b;
+ if (branch_other != -1) make_jump_away = TRUE;
+
+ if ((arity > 2) && (flag == FALSE)) {
+ /* In this case, we have an 'or' situation where multiple
+ instructions are needed and where the overall condition
+ is negated. That is, we have, e.g.
+
+ if not (A cond B or C or D) then branch_away
+
+ which we transform into
+
+ if (A cond B) then branch_other
+ if (A cond C) then branch_other
+ if not (A cond D) then branch_away
+ .branch_other */
+
+ if (branch_other == -1) {
+ branch_other = next_label++; make_branch_label = TRUE;
+ }
+ }
+
+ if (cc == &condclasses[0]) {
+ assembleg_1_branch((flag ? cc->posform : cc->negform),
+ ET[below].value, branch_away);
+ }
+ else {
+ if (arity == 2) {
+ compile_conditional_g(cc, ET[below].value,
+ ET[ET[below].right].value, branch_away, flag);
+ }
+ else {
+ /* The case of a condition using "or".
+ First: if the condition tests the stack pointer,
+ and it can't always be done in a single test, move
+ the value off the stack and into temporary variable
+ storage. */
+
+ assembly_operand left_operand;
+ if (((ET[below].value.type == LOCALVAR_OT)
+ && (ET[below].value.value == 0))) {
+ assembleg_store(temp_var1, ET[below].value);
+ left_operand = temp_var1;
+ }
+ else {
+ left_operand = ET[below].value;
+ }
+ i = ET[below].right;
+ arity--;
+
+ /* "left_operand" now holds the quantity to be tested;
+ "i" holds the right operand reached so far;
+ "arity" the number of right operands. */
+
+ while (i != -1) {
+ /* We can compare the left_operand with
+ only one right operand at the time. There are
+ two cases: it's the last right operand, or it
+ isn't. */
+
+ if ((arity == 1) || flag)
+ compile_conditional_g(cc, left_operand,
+ ET[i].value, branch_away, flag);
+ else
+ compile_conditional_g(cc, left_operand,
+ ET[i].value, branch_other, !flag);
+
+ i = ET[i].right;
+ arity--;
+ }
+ }
+ }
+
+ /* NB: These two conditions cannot both occur, fortunately! */
+
+ if (make_branch_label) assemble_label_no(branch_other);
+ if (make_jump_away) assembleg_jump(branch_other);
+
+ goto OperatorGenerated;
+ }
+
+ }
+
+ /* The operator is now definitely one which produces a value */
+
+ if (void_flag && (!(operators[opnum].side_effect)))
+ error_named("Evaluating this has no effect:",
+ operators[opnum].description);
+
+ /* Where shall we put the resulting value? (In Glulx, this could
+ be smarter, and peg the result into ZEROCONSTANT.) */
+
+ if (void_flag) Result = temp_var1; /* Throw it away */
+ else
+ { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
+ {
+ /* If the node above is "set variable equal to", then
+ make that variable the place to put the result, and
+ delete the SETEQUALS_OP node since its effect has already
+ been accomplished. */
+
+ ET[above].operator_number = -1;
+ Result = ET[ET[above].down].value;
+ ET[above].value = Result;
+ }
+ else Result = stack_pointer; /* Otherwise, put it on the stack */
+ }
+
+ if (!glulx_mode) {
+
+ if (operators[opnum].opcode_number_z != -1)
+ {
+ /* Operators directly translatable into Z-code opcodes: infix ops
+ take two operands whereas pre/postfix operators take only one */
+
+ if (operators[opnum].usage == IN_U)
+ { int o_n = operators[opnum].opcode_number_z;
+ if (runtime_error_checking_switch && (!veneer_mode)
+ && ((o_n == div_zc) || (o_n == mod_zc)))
+ { assembly_operand by_ao, error_ao; int ln;
+ by_ao = ET[ET[below].right].value;
+ if ((by_ao.value != 0) && (by_ao.marker == 0)
+ && ((by_ao.type == SHORT_CONSTANT_OT)
+ || (by_ao.type == LONG_CONSTANT_OT)))
+ assemblez_2_to(o_n, ET[below].value,
+ by_ao, Result);
+ else
+ {
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, by_ao);
+ ln = next_label++;
+ assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
+ INITAOT(&error_ao, SHORT_CONSTANT_OT);
+ error_ao.value = DBYZERO_RTE;
+ assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
+ error_ao);
+ assemblez_inc(temp_var2);
+ assemble_label_no(ln);
+ assemblez_2_to(o_n, temp_var1, temp_var2, Result);
+ }
+ }
+ else {
+ assemblez_2_to(o_n, ET[below].value,
+ ET[ET[below].right].value, Result);
+ }
+ }
+ else
+ assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
+ Result);
+ }
+ else
+ switch(opnum)
+ { case ARROW_OP:
+ access_memory_z(loadb_zc, ET[below].value,
+ ET[ET[below].right].value, Result);
+ break;
+ case DARROW_OP:
+ access_memory_z(loadw_zc, ET[below].value,
+ ET[ET[below].right].value, Result);
+ break;
+ case UNARY_MINUS_OP:
+ assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
+ break;
+ case ARTNOT_OP:
+ assemblez_1_to(not_zc, ET[below].value, Result);
+ break;
+
+ case PROP_ADD_OP:
+ { assembly_operand AO = ET[below].value;
+ if (runtime_error_checking_switch && (!veneer_mode))
+ AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
+ assemblez_2_to(get_prop_addr_zc, AO,
+ ET[ET[below].right].value, temp_var1);
+ if (!void_flag) write_result_z(Result, temp_var1);
+ }
+ break;
+
+ case PROP_NUM_OP:
+ { assembly_operand AO = ET[below].value;
+ if (runtime_error_checking_switch && (!veneer_mode))
+ AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
+ assemblez_2_to(get_prop_addr_zc, AO,
+ ET[ET[below].right].value, temp_var1);
+ assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
+ assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
+ assemble_label_no(next_label-1);
+ if (!void_flag) write_result_z(Result, temp_var1);
+ }
+ break;
+
+ case PROPERTY_OP:
+ { assembly_operand AO = ET[below].value;
+
+ if (runtime_error_checking_switch && (!veneer_mode))
+ assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
+ AO, ET[ET[below].right].value, temp_var1);
+ else
+ assemblez_2_to(get_prop_zc, AO,
+ ET[ET[below].right].value, temp_var1);
+ if (!void_flag) write_result_z(Result, temp_var1);
+ }
+ break;
+
+ case MESSAGE_OP:
+ j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
+ goto GenFunctionCallZ;
+ case MPROP_ADD_OP:
+ j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
+ goto GenFunctionCallZ;
+ case MPROP_NUM_OP:
+ j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
+ goto GenFunctionCallZ;
+ case MESSAGE_SETEQUALS_OP:
+ j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
+ goto GenFunctionCallZ;
+ case MESSAGE_INC_OP:
+ j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
+ goto GenFunctionCallZ;
+ case MESSAGE_DEC_OP:
+ j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
+ goto GenFunctionCallZ;
+ case MESSAGE_POST_INC_OP:
+ j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
+ goto GenFunctionCallZ;
+ case MESSAGE_POST_DEC_OP:
+ j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
+ goto GenFunctionCallZ;
+ case SUPERCLASS_OP:
+ j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
+ goto GenFunctionCallZ;
+ case PROP_CALL_OP:
+ j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
+ goto GenFunctionCallZ;
+ case MESSAGE_CALL_OP:
+ j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
+ goto GenFunctionCallZ;
+
+
+ case FCALL_OP:
+ j = 0;
+
+ if ((ET[below].value.type == VARIABLE_OT)
+ && (ET[below].value.value >= 256))
+ { int sf_number = ET[below].value.value - 256;
+
+ i = ET[below].right;
+ if (i == -1)
+ { error("Argument to system function missing");
+ AI.operand[0] = one_operand;
+ AI.operand_count = 1;
+ }
+ else
+ { j=0;
+ while (i != -1) { j++; i = ET[i].right; }
+
+ if (((sf_number != INDIRECT_SYSF) &&
+ (sf_number != RANDOM_SYSF) && (j > 1))
+ || ((sf_number == INDIRECT_SYSF) && (j>7)))
+ { j=1;
+ error("System function given with too many arguments");
+ }
+ if (sf_number != RANDOM_SYSF)
+ { int jcount;
+ i = ET[below].right;
+ for (jcount = 0; jcount < j; jcount++)
+ { AI.operand[jcount] = ET[i].value;
+ i = ET[i].right;
+ }
+ AI.operand_count = j;
+ }
+ }
+ AI.store_variable_number = Result.value;
+ AI.branch_label_number = -1;
+
+ switch(sf_number)
+ { case RANDOM_SYSF:
+ if (j>1)
+ { assembly_operand AO, AO2; int arg_c, arg_et;
+ INITAOTV(&AO, SHORT_CONSTANT_OT, j);
+ INITAOT(&AO2, LONG_CONSTANT_OT);
+ AO2.value = begin_word_array();
+ AO2.marker = ARRAY_MV;
+
+ for (arg_c=0, arg_et = ET[below].right;arg_c<j;
+ arg_c++, arg_et = ET[arg_et].right)
+ { if (ET[arg_et].value.type == VARIABLE_OT)
+ error("Only constants can be used as possible 'random' results");
+ array_entry(arg_c, ET[arg_et].value);
+ }
+ finish_array(arg_c);
+
+ assemblez_1_to(random_zc, AO, temp_var1);
+ assemblez_dec(temp_var1);
+ assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
+ }
+ else
+ assemblez_1_to(random_zc,
+ ET[ET[below].right].value, Result);
+ break;
+
+ case PARENT_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ PARENT_RTE);
+ assemblez_1_to(get_parent_zc, AO, Result);
+ }
+ break;
+
+ case ELDEST_SYSF:
+ case CHILD_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
+ assemblez_objcode(get_child_zc,
+ AO, Result, -2, TRUE);
+ }
+ break;
+
+ case YOUNGER_SYSF:
+ case SIBLING_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ (sf_number==SIBLING_SYSF)
+ ?SIBLING_RTE:YOUNGER_RTE);
+ assemblez_objcode(get_sibling_zc,
+ AO, Result, -2, TRUE);
+ }
+ break;
+
+ case INDIRECT_SYSF:
+ j=0; i = ET[below].right;
+ goto IndirectFunctionCallZ;
+
+ case CHILDREN_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ CHILDREN_RTE);
+ assemblez_store(temp_var1, zero_operand);
+ assemblez_objcode(get_child_zc,
+ AO, stack_pointer, next_label+1, FALSE);
+ assemble_label_no(next_label);
+ assemblez_inc(temp_var1);
+ assemblez_objcode(get_sibling_zc,
+ stack_pointer, stack_pointer,
+ next_label, TRUE);
+ assemble_label_no(next_label+1);
+ assemblez_store(temp_var2, stack_pointer);
+ if (!void_flag) write_result_z(Result, temp_var1);
+ next_label += 2;
+ }
+ break;
+
+ case YOUNGEST_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ YOUNGEST_RTE);
+ assemblez_objcode(get_child_zc,
+ AO, temp_var1, next_label+1, FALSE);
+ assemblez_1(push_zc, temp_var1);
+ assemble_label_no(next_label);
+ assemblez_store(temp_var1, stack_pointer);
+ assemblez_objcode(get_sibling_zc,
+ temp_var1, stack_pointer, next_label, TRUE);
+ assemble_label_no(next_label+1);
+ if (!void_flag) write_result_z(Result, temp_var1);
+ next_label += 2;
+ }
+ break;
+
+ case ELDER_SYSF:
+ assemblez_store(temp_var1, ET[ET[below].right].value);
+ if (runtime_error_checking_switch)
+ check_nonzero_at_runtime(temp_var1, -1,
+ ELDER_RTE);
+ assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
+ assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
+ assemblez_store(temp_var2, temp_var3);
+ assemblez_store(temp_var3, zero_operand);
+ assemblez_objcode(get_child_zc,
+ temp_var2, temp_var2, next_label, TRUE);
+ assemble_label_no(next_label++);
+ assemblez_2_branch(je_zc, temp_var1, temp_var2,
+ next_label, TRUE);
+ assemblez_store(temp_var3, temp_var2);
+ assemblez_objcode(get_sibling_zc,
+ temp_var2, temp_var2, next_label - 1, TRUE);
+ assemble_label_no(next_label++);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ break;
+
+ case METACLASS_SYSF:
+ assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
+ veneer_routine(Metaclass_VR),
+ ET[ET[below].right].value, Result);
+ break;
+
+ case GLK_SYSF:
+ error("The glk() system function does not exist in Z-code");
+ break;
+ }
+ break;
+ }
+
+ GenFunctionCallZ:
+
+ i = below;
+
+ IndirectFunctionCallZ:
+
+ while ((i != -1) && (j<8))
+ { AI.operand[j++] = ET[i].value;
+ i = ET[i].right;
+ }
+
+ if ((j > 4) && (version_number == 3))
+ { error("A function may be called with at most 3 arguments");
+ j = 4;
+ }
+ if ((j==8) && (i != -1))
+ { error("A function may be called with at most 7 arguments");
+ }
+
+ AI.operand_count = j;
+
+ if ((void_flag) && (version_number >= 5))
+ { AI.store_variable_number = -1;
+ switch(j)
+ { case 1: AI.internal_number = call_1n_zc; break;
+ case 2: AI.internal_number = call_2n_zc; break;
+ case 3: case 4: AI.internal_number = call_vn_zc; break;
+ case 5: case 6: case 7: case 8:
+ AI.internal_number = call_vn2_zc; break;
+ }
+ }
+ else
+ { AI.store_variable_number = Result.value;
+ if (version_number == 3)
+ AI.internal_number = call_zc;
+ else
+ switch(j)
+ { case 1: AI.internal_number = call_1s_zc; break;
+ case 2: AI.internal_number = call_2s_zc; break;
+ case 3: case 4: AI.internal_number = call_vs_zc; break;
+ case 5: case 6: case 7: case 8:
+ AI.internal_number = call_vs2_zc; break;
+ }
+ }
+
+ AI.branch_label_number = -1;
+ assemblez_instruction(&AI);
+ break;
+
+ case SETEQUALS_OP:
+ assemblez_store(ET[below].value,
+ ET[ET[below].right].value);
+ if (!void_flag) write_result_z(Result, ET[below].value);
+ break;
+
+ case PROPERTY_SETEQUALS_OP:
+ if (!void_flag)
+ { if (runtime_error_checking_switch)
+ assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
+ ET[below].value, ET[ET[below].right].value,
+ ET[ET[ET[below].right].right].value, Result);
+ else
+ { assemblez_store(temp_var1,
+ ET[ET[ET[below].right].right].value);
+ assemblez_3(put_prop_zc, ET[below].value,
+ ET[ET[below].right].value,
+ temp_var1);
+ write_result_z(Result, temp_var1);
+ }
+ }
+ else
+ { if (runtime_error_checking_switch && (!veneer_mode))
+ assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
+ ET[below].value, ET[ET[below].right].value,
+ ET[ET[ET[below].right].right].value);
+ else assemblez_3(put_prop_zc, ET[below].value,
+ ET[ET[below].right].value,
+ ET[ET[ET[below].right].right].value);
+ }
+ break;
+ case ARROW_SETEQUALS_OP:
+ if (!void_flag)
+ { assemblez_store(temp_var1,
+ ET[ET[ET[below].right].right].value);
+ access_memory_z(storeb_zc, ET[below].value,
+ ET[ET[below].right].value,
+ temp_var1);
+ write_result_z(Result, temp_var1);
+ }
+ else access_memory_z(storeb_zc, ET[below].value,
+ ET[ET[below].right].value,
+ ET[ET[ET[below].right].right].value);
+ break;
+
+ case DARROW_SETEQUALS_OP:
+ if (!void_flag)
+ { assemblez_store(temp_var1,
+ ET[ET[ET[below].right].right].value);
+ access_memory_z(storew_zc, ET[below].value,
+ ET[ET[below].right].value,
+ temp_var1);
+ write_result_z(Result, temp_var1);
+ }
+ else
+ access_memory_z(storew_zc, ET[below].value,
+ ET[ET[below].right].value,
+ ET[ET[ET[below].right].right].value);
+ break;
+
+ case INC_OP:
+ assemblez_inc(ET[below].value);
+ if (!void_flag) write_result_z(Result, ET[below].value);
+ break;
+ case DEC_OP:
+ assemblez_dec(ET[below].value);
+ if (!void_flag) write_result_z(Result, ET[below].value);
+ break;
+ case POST_INC_OP:
+ if (!void_flag) write_result_z(Result, ET[below].value);
+ assemblez_inc(ET[below].value);
+ break;
+ case POST_DEC_OP:
+ if (!void_flag) write_result_z(Result, ET[below].value);
+ assemblez_dec(ET[below].value);
+ break;
+
+ case ARROW_INC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
+ assemblez_inc(temp_var3);
+ access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ break;
+
+ case ARROW_DEC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
+ assemblez_dec(temp_var3);
+ access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ break;
+
+ case ARROW_POST_INC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ assemblez_inc(temp_var3);
+ access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case ARROW_POST_DEC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ assemblez_dec(temp_var3);
+ access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case DARROW_INC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
+ assemblez_inc(temp_var3);
+ access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ break;
+
+ case DARROW_DEC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
+ assemblez_dec(temp_var3);
+ access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ break;
+
+ case DARROW_POST_INC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ assemblez_inc(temp_var3);
+ access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case DARROW_POST_DEC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ assemblez_dec(temp_var3);
+ access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case PROPERTY_INC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
+ assemblez_inc(temp_var3);
+ if (runtime_error_checking_switch && (!veneer_mode))
+ assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
+ temp_var1, temp_var2, temp_var3);
+ else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ break;
+
+ case PROPERTY_DEC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
+ assemblez_dec(temp_var3);
+ if (runtime_error_checking_switch && (!veneer_mode))
+ assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
+ temp_var1, temp_var2, temp_var3);
+ else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ break;
+
+ case PROPERTY_POST_INC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ assemblez_inc(temp_var3);
+ if (runtime_error_checking_switch && (!veneer_mode))
+ assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
+ temp_var1, temp_var2, temp_var3);
+ else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case PROPERTY_POST_DEC_OP:
+ assemblez_store(temp_var1, ET[below].value);
+ assemblez_store(temp_var2, ET[ET[below].right].value);
+ assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_z(Result, temp_var3);
+ assemblez_dec(temp_var3);
+ if (runtime_error_checking_switch && (!veneer_mode))
+ assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
+ temp_var1, temp_var2, temp_var3);
+ else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ default:
+ printf("** Trouble op = %d i.e. '%s' **\n",
+ opnum, operators[opnum].description);
+ compiler_error("Expr code gen: Can't generate yet");
+ }
+ }
+ else {
+ assembly_operand AO, AO2;
+ if (operators[opnum].opcode_number_g != -1)
+ {
+ /* Operators directly translatable into opcodes: infix ops
+ take two operands whereas pre/postfix operators take only one */
+
+ if (operators[opnum].usage == IN_U)
+ { int o_n = operators[opnum].opcode_number_g;
+ if (runtime_error_checking_switch && (!veneer_mode)
+ && ((o_n == div_gc) || (o_n == mod_gc)))
+ { assembly_operand by_ao, error_ao; int ln;
+ by_ao = ET[ET[below].right].value;
+ if ((by_ao.value != 0) && (by_ao.marker == 0)
+ && is_constant_ot(by_ao.type))
+ assembleg_3(o_n, ET[below].value,
+ by_ao, Result);
+ else
+ { assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, by_ao);
+ ln = next_label++;
+ assembleg_1_branch(jnz_gc, temp_var2, ln);
+ INITAO(&error_ao);
+ error_ao.value = DBYZERO_RTE;
+ set_constant_ot(&error_ao);
+ assembleg_call_1(veneer_routine(RT__Err_VR),
+ error_ao, zero_operand);
+ assembleg_store(temp_var2, one_operand);
+ assemble_label_no(ln);
+ assembleg_3(o_n, temp_var1, temp_var2, Result);
+ }
+ }
+ else
+ assembleg_3(o_n, ET[below].value,
+ ET[ET[below].right].value, Result);
+ }
+ else
+ assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
+ Result);
+ }
+ else
+ switch(opnum)
+ {
+
+ case PUSH_OP:
+ if (ET[below].value.type == Result.type
+ && ET[below].value.value == Result.value
+ && ET[below].value.marker == Result.marker)
+ break;
+ assembleg_2(copy_gc, ET[below].value, Result);
+ break;
+
+ case UNARY_MINUS_OP:
+ assembleg_2(neg_gc, ET[below].value, Result);
+ break;
+ case ARTNOT_OP:
+ assembleg_2(bitnot_gc, ET[below].value, Result);
+ break;
+
+ case ARROW_OP:
+ access_memory_g(aloadb_gc, ET[below].value,
+ ET[ET[below].right].value, Result);
+ break;
+ case DARROW_OP:
+ access_memory_g(aload_gc, ET[below].value,
+ ET[ET[below].right].value, Result);
+ break;
+
+ case SETEQUALS_OP:
+ assembleg_store(ET[below].value,
+ ET[ET[below].right].value);
+ if (!void_flag) write_result_g(Result, ET[below].value);
+ break;
+
+ case ARROW_SETEQUALS_OP:
+ if (!void_flag)
+ { assembleg_store(temp_var1,
+ ET[ET[ET[below].right].right].value);
+ access_memory_g(astoreb_gc, ET[below].value,
+ ET[ET[below].right].value,
+ temp_var1);
+ write_result_g(Result, temp_var1);
+ }
+ else access_memory_g(astoreb_gc, ET[below].value,
+ ET[ET[below].right].value,
+ ET[ET[ET[below].right].right].value);
+ break;
+
+ case DARROW_SETEQUALS_OP:
+ if (!void_flag)
+ { assembleg_store(temp_var1,
+ ET[ET[ET[below].right].right].value);
+ access_memory_g(astore_gc, ET[below].value,
+ ET[ET[below].right].value,
+ temp_var1);
+ write_result_g(Result, temp_var1);
+ }
+ else
+ access_memory_g(astore_gc, ET[below].value,
+ ET[ET[below].right].value,
+ ET[ET[ET[below].right].right].value);
+ break;
+
+ case INC_OP:
+ assembleg_inc(ET[below].value);
+ if (!void_flag) write_result_g(Result, ET[below].value);
+ break;
+ case DEC_OP:
+ assembleg_dec(ET[below].value);
+ if (!void_flag) write_result_g(Result, ET[below].value);
+ break;
+ case POST_INC_OP:
+ if (!void_flag) write_result_g(Result, ET[below].value);
+ assembleg_inc(ET[below].value);
+ break;
+ case POST_DEC_OP:
+ if (!void_flag) write_result_g(Result, ET[below].value);
+ assembleg_dec(ET[below].value);
+ break;
+
+ case ARROW_INC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
+ assembleg_inc(temp_var3);
+ access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ break;
+
+ case ARROW_DEC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
+ assembleg_dec(temp_var3);
+ access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ break;
+
+ case ARROW_POST_INC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ assembleg_inc(temp_var3);
+ access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case ARROW_POST_DEC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ assembleg_dec(temp_var3);
+ access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case DARROW_INC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
+ assembleg_inc(temp_var3);
+ access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ break;
+
+ case DARROW_DEC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
+ assembleg_dec(temp_var3);
+ access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ break;
+
+ case DARROW_POST_INC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ assembleg_inc(temp_var3);
+ access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case DARROW_POST_DEC_OP:
+ assembleg_store(temp_var1, ET[below].value);
+ assembleg_store(temp_var2, ET[ET[below].right].value);
+ access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
+ if (!void_flag) write_result_g(Result, temp_var3);
+ assembleg_dec(temp_var3);
+ access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
+ break;
+
+ case PROPERTY_OP:
+ case MESSAGE_OP:
+ AO = veneer_routine(RV__Pr_VR);
+ goto TwoArgFunctionCall;
+ case MPROP_ADD_OP:
+ case PROP_ADD_OP:
+ AO = veneer_routine(RA__Pr_VR);
+ goto TwoArgFunctionCall;
+ case MPROP_NUM_OP:
+ case PROP_NUM_OP:
+ AO = veneer_routine(RL__Pr_VR);
+ goto TwoArgFunctionCall;
+
+ case PROP_CALL_OP:
+ case MESSAGE_CALL_OP:
+ AO2 = veneer_routine(CA__Pr_VR);
+ i = below;
+ goto DoFunctionCall;
+
+ case MESSAGE_INC_OP:
+ case PROPERTY_INC_OP:
+ AO = veneer_routine(IB__Pr_VR);
+ goto TwoArgFunctionCall;
+ case MESSAGE_DEC_OP:
+ case PROPERTY_DEC_OP:
+ AO = veneer_routine(DB__Pr_VR);
+ goto TwoArgFunctionCall;
+ case MESSAGE_POST_INC_OP:
+ case PROPERTY_POST_INC_OP:
+ AO = veneer_routine(IA__Pr_VR);
+ goto TwoArgFunctionCall;
+ case MESSAGE_POST_DEC_OP:
+ case PROPERTY_POST_DEC_OP:
+ AO = veneer_routine(DA__Pr_VR);
+ goto TwoArgFunctionCall;
+ case SUPERCLASS_OP:
+ AO = veneer_routine(RA__Sc_VR);
+ goto TwoArgFunctionCall;
+
+ TwoArgFunctionCall:
+ {
+ assembly_operand AO2 = ET[below].value;
+ assembly_operand AO3 = ET[ET[below].right].value;
+ if (void_flag)
+ assembleg_call_2(AO, AO2, AO3, zero_operand);
+ else
+ assembleg_call_2(AO, AO2, AO3, Result);
+ }
+ break;
+
+ case PROPERTY_SETEQUALS_OP:
+ case MESSAGE_SETEQUALS_OP:
+ if (runtime_error_checking_switch && (!veneer_mode))
+ AO = veneer_routine(RT__ChPS_VR);
+ else
+ AO = veneer_routine(WV__Pr_VR);
+
+ {
+ assembly_operand AO2 = ET[below].value;
+ assembly_operand AO3 = ET[ET[below].right].value;
+ assembly_operand AO4 = ET[ET[ET[below].right].right].value;
+ if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
+ /* Rightmost is on the stack; reduce to previous case. */
+ if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
+ if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
+ /* both already on stack. */
+ }
+ else {
+ assembleg_store(stack_pointer, AO3);
+ assembleg_0(stkswap_gc);
+ }
+ }
+ else {
+ if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
+ assembleg_store(stack_pointer, AO2);
+ }
+ else {
+ assembleg_store(stack_pointer, AO3);
+ assembleg_store(stack_pointer, AO2);
+ }
+ }
+ }
+ else {
+ /* We have to get the rightmost on the stack, below the
+ others. */
+ if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
+ if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
+ assembleg_store(stack_pointer, AO4);
+ assembleg_2(stkroll_gc, three_operand, one_operand);
+ }
+ else {
+ assembleg_store(stack_pointer, AO4);
+ assembleg_0(stkswap_gc);
+ assembleg_store(stack_pointer, AO2);
+ }
+ }
+ else {
+ if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
+ assembleg_store(stack_pointer, AO4);
+ assembleg_store(stack_pointer, AO3);
+ assembleg_2(stkroll_gc, three_operand, two_operand);
+ }
+ else {
+ assembleg_store(stack_pointer, AO4);
+ assembleg_store(stack_pointer, AO3);
+ assembleg_store(stack_pointer, AO2);
+ }
+ }
+ }
+ if (void_flag)
+ assembleg_3(call_gc, AO, three_operand, zero_operand);
+ else
+ assembleg_3(call_gc, AO, three_operand, Result);
+ }
+ break;
+
+ case FCALL_OP:
+ j = 0;
+
+ if (ET[below].value.type == SYSFUN_OT)
+ { int sf_number = ET[below].value.value;
+
+ i = ET[below].right;
+ if (i == -1)
+ { error("Argument to system function missing");
+ AI.operand[0] = one_operand;
+ AI.operand_count = 1;
+ }
+ else
+ { j=0;
+ while (i != -1) { j++; i = ET[i].right; }
+
+ if (((sf_number != INDIRECT_SYSF) &&
+ (sf_number != GLK_SYSF) &&
+ (sf_number != RANDOM_SYSF) && (j > 1)))
+ { j=1;
+ error("System function given with too many arguments");
+ }
+ if (sf_number != RANDOM_SYSF)
+ { int jcount;
+ i = ET[below].right;
+ for (jcount = 0; jcount < j; jcount++)
+ { AI.operand[jcount] = ET[i].value;
+ i = ET[i].right;
+ }
+ AI.operand_count = j;
+ }
+ }
+
+ switch(sf_number)
+ {
+ case RANDOM_SYSF:
+ if (j>1)
+ { assembly_operand AO, AO2;
+ int arg_c, arg_et;
+ INITAO(&AO);
+ AO.value = j;
+ set_constant_ot(&AO);
+ INITAOTV(&AO2, CONSTANT_OT, begin_word_array());
+ AO2.marker = ARRAY_MV;
+
+ for (arg_c=0, arg_et = ET[below].right;arg_c<j;
+ arg_c++, arg_et = ET[arg_et].right)
+ { if (ET[arg_et].value.type == LOCALVAR_OT
+ || ET[arg_et].value.type == GLOBALVAR_OT)
+ error("Only constants can be used as possible 'random' results");
+ array_entry(arg_c, ET[arg_et].value);
+ }
+ finish_array(arg_c);
+
+ assembleg_2(random_gc, AO, stack_pointer);
+ assembleg_3(aload_gc, AO2, stack_pointer, Result);
+ }
+ else {
+ assembleg_2(random_gc,
+ ET[ET[below].right].value, stack_pointer);
+ assembleg_3(add_gc, stack_pointer, one_operand,
+ Result);
+ }
+ break;
+
+ case PARENT_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ PARENT_RTE);
+ INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
+ assembleg_3(aload_gc, AO, AO2, Result);
+ }
+ break;
+
+ case ELDEST_SYSF:
+ case CHILD_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
+ INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
+ assembleg_3(aload_gc, AO, AO2, Result);
+ }
+ break;
+
+ case YOUNGER_SYSF:
+ case SIBLING_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ (sf_number==SIBLING_SYSF)
+ ?SIBLING_RTE:YOUNGER_RTE);
+ INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
+ assembleg_3(aload_gc, AO, AO2, Result);
+ }
+ break;
+
+ case CHILDREN_SYSF:
+ { assembly_operand AO;
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ CHILDREN_RTE);
+ INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
+ assembleg_store(temp_var1, zero_operand);
+ assembleg_3(aload_gc, AO, AO2, temp_var2);
+ AO2.value = GOBJFIELD_SIBLING();
+ assemble_label_no(next_label);
+ assembleg_1_branch(jz_gc, temp_var2, next_label+1);
+ assembleg_3(add_gc, temp_var1, one_operand,
+ temp_var1);
+ assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
+ assembleg_0_branch(jump_gc, next_label);
+ assemble_label_no(next_label+1);
+ next_label += 2;
+ if (!void_flag)
+ write_result_g(Result, temp_var1);
+ }
+ break;
+
+ case INDIRECT_SYSF:
+ i = ET[below].right;
+ goto IndirectFunctionCallG;
+
+ case GLK_SYSF:
+ AO2 = veneer_routine(Glk__Wrap_VR);
+ i = ET[below].right;
+ goto DoFunctionCall;
+
+ case METACLASS_SYSF:
+ assembleg_call_1(veneer_routine(Metaclass_VR),
+ ET[ET[below].right].value, Result);
+ break;
+
+ case YOUNGEST_SYSF:
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ YOUNGEST_RTE);
+ INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_CHILD());
+ assembleg_3(aload_gc, AO, AO2, temp_var1);
+ AO2.value = GOBJFIELD_SIBLING();
+ assembleg_1_branch(jz_gc, temp_var1, next_label+1);
+ assemble_label_no(next_label);
+ assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
+ assembleg_1_branch(jz_gc, temp_var2, next_label+1);
+ assembleg_store(temp_var1, temp_var2);
+ assembleg_0_branch(jump_gc, next_label);
+ assemble_label_no(next_label+1);
+ if (!void_flag)
+ write_result_g(Result, temp_var1);
+ next_label += 2;
+ break;
+
+ case ELDER_SYSF:
+ AO = ET[ET[below].right].value;
+ if (runtime_error_checking_switch)
+ AO = check_nonzero_at_runtime(AO, -1,
+ YOUNGEST_RTE);
+ assembleg_store(temp_var3, AO);
+ INITAOTV(&AO2, BYTECONSTANT_OT, GOBJFIELD_PARENT());
+ assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
+ assembleg_1_branch(jz_gc, temp_var1, next_label+2);
+ AO2.value = GOBJFIELD_CHILD();
+ assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
+ assembleg_1_branch(jz_gc, temp_var1, next_label+2);
+ assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
+ next_label+1);
+ assemble_label_no(next_label);
+ AO2.value = GOBJFIELD_SIBLING();
+ assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
+ assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
+ next_label+2);
+ assembleg_store(temp_var1, temp_var2);
+ assembleg_0_branch(jump_gc, next_label);
+ assemble_label_no(next_label+1);
+ assembleg_store(temp_var1, zero_operand);
+ assemble_label_no(next_label+2);
+ if (!void_flag)
+ write_result_g(Result, temp_var1);
+ next_label += 3;
+ break;
+
+ default:
+ error("*** system function not implemented ***");
+ break;
+
+ }
+ break;
+ }
+
+ i = below;
+
+ IndirectFunctionCallG:
+
+ /* Get the function address. */
+ AO2 = ET[i].value;
+ i = ET[i].right;
+
+ DoFunctionCall:
+
+ {
+ /* If all the function arguments are in local/global
+ variables, we have to push them all on the stack.
+ If all of them are on the stack, we have to do nothing.
+ If some are and some aren't, we have a hopeless mess,
+ and we should throw a compiler error.
+ */
+
+ int onstack = 0;
+ int offstack = 0;
+
+ /* begin part of patch G03701 */
+ int nargs = 0;
+ j = i;
+ while (j != -1) {
+ nargs++;
+ j = ET[j].right;
+ }
+
+ if (nargs==0) {
+ assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
+ } else if (nargs==1) {
+ assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
+ } else if (nargs==2) {
+ assembly_operand o1 = ET[i].value;
+ assembly_operand o2 = ET[ET[i].right].value;
+ assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
+ } else if (nargs==3) {
+ assembly_operand o1 = ET[i].value;
+ assembly_operand o2 = ET[ET[i].right].value;
+ assembly_operand o3 = ET[ET[ET[i].right].right].value;
+ assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
+ } else {
+
+ j = 0;
+ while (i != -1) {
+ if (ET[i].value.type == LOCALVAR_OT
+ && ET[i].value.value == 0) {
+ onstack++;
+ }
+ else {
+ assembleg_store(stack_pointer, ET[i].value);
+ offstack++;
+ }
+ i = ET[i].right;
+ j++;
+ }
+
+ if (onstack && offstack)
+ error("*** Function call cannot be generated with mixed arguments ***");
+ if (offstack > 1)
+ error("*** Function call cannot be generated with more than one nonstack argument ***");
+
+ INITAO(&AO);
+ AO.value = j;
+ set_constant_ot(&AO);
+
+ if (void_flag)
+ assembleg_3(call_gc, AO2, AO, zero_operand);
+ else
+ assembleg_3(call_gc, AO2, AO, Result);
+
+ } /* else nargs>=4 */
+ } /* DoFunctionCall: */
+
+ break;
+
+ default:
+ printf("** Trouble op = %d i.e. '%s' **\n",
+ opnum, operators[opnum].description);
+ compiler_error("Expr code gen: Can't generate yet");
+ }
+ }
+
+ ET[n].value = Result;
+
+ OperatorGenerated:
+
+ if (!glulx_mode) {
+
+ if (ET[n].to_expression)
+ {
+ if (void_flag) {
+ warning("Logical expression has no side-effects");
+ if (ET[n].true_label != -1)
+ assemble_label_no(ET[n].true_label);
+ else
+ assemble_label_no(ET[n].false_label);
+ }
+ else if (ET[n].true_label != -1)
+ { assemblez_1(push_zc, zero_operand);
+ assemblez_jump(next_label++);
+ assemble_label_no(ET[n].true_label);
+ assemblez_1(push_zc, one_operand);
+ assemble_label_no(next_label-1);
+ }
+ else
+ { assemblez_1(push_zc, one_operand);
+ assemblez_jump(next_label++);
+ assemble_label_no(ET[n].false_label);
+ assemblez_1(push_zc, zero_operand);
+ assemble_label_no(next_label-1);
+ }
+ ET[n].value = stack_pointer;
+ }
+ else
+ if (ET[n].label_after != -1)
+ assemble_label_no(ET[n].label_after);
+
+ }
+ else {
+
+ if (ET[n].to_expression)
+ {
+ if (void_flag) {
+ warning("Logical expression has no side-effects");
+ if (ET[n].true_label != -1)
+ assemble_label_no(ET[n].true_label);
+ else
+ assemble_label_no(ET[n].false_label);
+ }
+ else if (ET[n].true_label != -1)
+ { assembleg_store(stack_pointer, zero_operand);
+ assembleg_jump(next_label++);
+ assemble_label_no(ET[n].true_label);
+ assembleg_store(stack_pointer, one_operand);
+ assemble_label_no(next_label-1);
+ }
+ else
+ { assembleg_store(stack_pointer, one_operand);
+ assembleg_jump(next_label++);
+ assemble_label_no(ET[n].false_label);
+ assembleg_store(stack_pointer, zero_operand);
+ assemble_label_no(next_label-1);
+ }
+ ET[n].value = stack_pointer;
+ }
+ else
+ if (ET[n].label_after != -1)
+ assemble_label_no(ET[n].label_after);
+
+ }
+
+ ET[n].down = -1;
+}
+
+assembly_operand code_generate(assembly_operand AO, int context, int label)
+{
+ /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
+ QUANTITY_CONTEXT.
+
+ If CONDITION_CONTEXT, then compile code branching to label number
+ "label" if the condition is false: there's no return value.
+ (Except that if label is -3 or -4 (internal codes for rfalse and
+ rtrue rather than branch) then this is for branching when the
+ condition is true. This is used for optimising code generation
+ for "if" statements.)
+
+ Otherwise return the assembly operand containing the result
+ (probably the stack pointer variable but not necessarily:
+ e.g. is would be short constant 2 from the expression "j++, 2") */
+
+ vivc_flag = FALSE;
+
+ if (AO.type != EXPRESSION_OT)
+ { switch(context)
+ { case VOID_CONTEXT:
+ value_in_void_context(AO);
+ AO.type = OMITTED_OT;
+ AO.value = 0;
+ break;
+ case CONDITION_CONTEXT:
+ if (!glulx_mode) {
+ if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
+ else assemblez_1_branch(jz_zc, AO, label, TRUE);
+ }
+ else {
+ if (label < -2)
+ assembleg_1_branch(jnz_gc, AO, label);
+ else
+ assembleg_1_branch(jz_gc, AO, label);
+ }
+ AO.type = OMITTED_OT;
+ AO.value = 0;
+ break;
+ }
+ return AO;
+ }
+
+ if (expr_trace_level >= 2)
+ { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
+ }
+
+ if (context == CONDITION_CONTEXT)
+ { if (label < -2) annotate_for_conditions(AO.value, label, -1);
+ else annotate_for_conditions(AO.value, -1, label);
+ }
+ else annotate_for_conditions(AO.value, -1, -1);
+
+ if (expr_trace_level >= 1)
+ { printf("Code generation for expression in ");
+ switch(context)
+ { case VOID_CONTEXT: printf("void"); break;
+ case CONDITION_CONTEXT: printf("condition"); break;
+ case QUANTITY_CONTEXT: printf("quantity"); break;
+ case ASSEMBLY_CONTEXT: printf("assembly"); break;
+ case ARRAY_CONTEXT: printf("array initialisation"); break;
+ default: printf("* ILLEGAL *"); break;
+ }
+ printf(" context with annotated tree:\n");
+ show_tree(AO, TRUE);
+ }
+
+ generate_code_from(AO.value, (context==VOID_CONTEXT));
+ return ET[AO.value].value;
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_expressc_vars(void)
+{ make_operands();
+}
+
+extern void expressc_begin_pass(void)
+{
+}
+
+extern void expressc_allocate_arrays(void)
+{
+}
+
+extern void expressc_free_arrays(void)
+{
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "expressp" : The expression parser */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+/* --- Interface to lexer -------------------------------------------------- */
+
+static char separators_to_operators[103];
+static char conditionals_to_operators[7];
+static char token_type_allowable[301];
+
+#define NOT_AN_OPERATOR (char) 0x7e
+
+static void make_lexical_interface_tables(void)
+{ int i;
+ for (i=0;i<103;i++)
+ separators_to_operators[i] = NOT_AN_OPERATOR;
+ for (i=0;i<NUM_OPERATORS;i++)
+ if (operators[i].token_type == SEP_TT)
+ separators_to_operators[operators[i].token_value] = i;
+
+ for (i=0;i<7;i++) /* 7 being the size of keyword_group "conditions" */
+ conditionals_to_operators[i] = NOT_AN_OPERATOR;
+ for (i=0;i<NUM_OPERATORS;i++)
+ if (operators[i].token_type == CND_TT)
+ conditionals_to_operators[operators[i].token_value] = i;
+
+ for (i=0;i<301;i++) token_type_allowable[i] = 0;
+
+ token_type_allowable[VARIABLE_TT] = 1;
+ token_type_allowable[SYSFUN_TT] = 1;
+ token_type_allowable[DQ_TT] = 1;
+ token_type_allowable[DICTWORD_TT] = 1;
+ token_type_allowable[SUBOPEN_TT] = 1;
+ token_type_allowable[SUBCLOSE_TT] = 1;
+ token_type_allowable[SMALL_NUMBER_TT] = 1;
+ token_type_allowable[LARGE_NUMBER_TT] = 1;
+ token_type_allowable[ACTION_TT] = 1;
+ token_type_allowable[SYSTEM_CONSTANT_TT] = 1;
+ token_type_allowable[OP_TT] = 1;
+}
+
+static token_data current_token, previous_token, heldback_token;
+
+static int comma_allowed, arrow_allowed, superclass_allowed,
+ bare_prop_allowed,
+ array_init_ambiguity, action_ambiguity,
+ etoken_count, inserting_token, bracket_level;
+
+extern int *variable_usage;
+
+int system_function_usage[32];
+
+static int get_next_etoken(void)
+{ int v, symbol = 0, mark_symbol_as_used = FALSE,
+ initial_bracket_level = bracket_level;
+
+ etoken_count++;
+
+ if (inserting_token)
+ { current_token = heldback_token;
+ inserting_token = FALSE;
+ }
+ else
+ { get_next_token();
+ current_token.text = token_text;
+ current_token.value = token_value;
+ current_token.type = token_type;
+ current_token.marker = 0;
+ current_token.symtype = 0;
+ current_token.symflags = -1;
+ }
+
+ switch(current_token.type)
+ { case LOCAL_VARIABLE_TT:
+ current_token.type = VARIABLE_TT;
+ variable_usage[current_token.value] = TRUE;
+ break;
+
+ case DQ_TT:
+ current_token.marker = STRING_MV;
+ break;
+
+ case SQ_TT:
+ { int32 unicode = text_to_unicode(token_text);
+ if (token_text[textual_form_length] == 0)
+ {
+ if (!glulx_mode) {
+ current_token.value = unicode_to_zscii(unicode);
+ if (current_token.value == 5)
+ { unicode_char_error("Character can be printed \
+but not used as a value:", unicode);
+ current_token.value = '?';
+ }
+ if (current_token.value >= 0x100)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ current_token.value = unicode;
+ if (current_token.value >= 0x8000
+ || current_token.value < -0x8000)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ }
+ else
+ { current_token.type = DICTWORD_TT;
+ current_token.marker = DWORD_MV;
+ }
+ }
+ break;
+
+ case SYMBOL_TT:
+ ReceiveSymbol:
+ symbol = current_token.value;
+
+ mark_symbol_as_used = TRUE;
+
+ v = svals[symbol];
+
+ current_token.symtype = stypes[symbol];
+ current_token.symflags = sflags[symbol];
+ switch(stypes[symbol])
+ { case ROUTINE_T:
+ /* Replaced functions must always be backpatched
+ because there could be another definition coming. */
+ if (sflags[symbol] & REPLACE_SFLAG)
+ { current_token.marker = SYMBOL_MV;
+ if (module_switch) import_symbol(symbol);
+ v = symbol;
+ break;
+ }
+ current_token.marker = IROUTINE_MV;
+ break;
+ case GLOBAL_VARIABLE_T:
+ current_token.marker = VARIABLE_MV;
+ break;
+ case OBJECT_T:
+ case CLASS_T:
+ /* All objects must be backpatched in Glulx. */
+ if (module_switch || glulx_mode)
+ current_token.marker = OBJECT_MV;
+ break;
+ case ARRAY_T:
+ current_token.marker = ARRAY_MV;
+ break;
+ case INDIVIDUAL_PROPERTY_T:
+ if (module_switch) current_token.marker = IDENT_MV;
+ break;
+ case CONSTANT_T:
+ if (sflags[symbol] & (UNKNOWN_SFLAG + CHANGE_SFLAG))
+ { current_token.marker = SYMBOL_MV;
+ if (module_switch) import_symbol(symbol);
+ v = symbol;
+ }
+ else current_token.marker = 0;
+ break;
+ case LABEL_T:
+ error_named("Label name used as value:", token_text);
+ break;
+ default:
+ current_token.marker = 0;
+ break;
+ }
+ if (sflags[symbol] & SYSTEM_SFLAG)
+ current_token.marker = 0;
+
+ current_token.value = v;
+
+ if (!glulx_mode) {
+ if (((current_token.marker != 0)
+ && (current_token.marker != VARIABLE_MV))
+ || (v < 0) || (v > 255))
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ if (((current_token.marker != 0)
+ && (current_token.marker != VARIABLE_MV))
+ || (v < -0x8000) || (v >= 0x8000))
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+
+ if (stypes[symbol] == GLOBAL_VARIABLE_T)
+ { current_token.type = VARIABLE_TT;
+ variable_usage[current_token.value] = TRUE;
+ }
+ break;
+
+ case NUMBER_TT:
+ if (!glulx_mode) {
+ if (current_token.value >= 256)
+ current_token.type = LARGE_NUMBER_TT;
+ else
+ current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ if (current_token.value < -0x8000
+ || current_token.value >= 0x8000)
+ current_token.type = LARGE_NUMBER_TT;
+ else
+ current_token.type = SMALL_NUMBER_TT;
+ }
+ break;
+
+ case SEP_TT:
+ switch(current_token.value)
+ { case ARROW_SEP:
+ if (!arrow_allowed)
+ current_token.type = ENDEXP_TT;
+ break;
+
+ case COMMA_SEP:
+ if ((bracket_level==0) && (!comma_allowed))
+ current_token.type = ENDEXP_TT;
+ break;
+
+ case SUPERCLASS_SEP:
+ if ((bracket_level==0) && (!superclass_allowed))
+ current_token.type = ENDEXP_TT;
+ break;
+
+ case GREATER_SEP:
+ get_next_token();
+ if ((token_type == SEP_TT)
+ &&((token_value == SEMICOLON_SEP)
+ || (token_value == GREATER_SEP)))
+ current_token.type = ENDEXP_TT;
+ put_token_back();
+ break;
+
+ case OPENB_SEP:
+ bracket_level++;
+ if (expr_trace_level>=3)
+ { printf("Previous token type = %d\n",previous_token.type);
+ printf("Previous token val = %d\n",previous_token.value);
+ }
+ if ((previous_token.type == OP_TT)
+ || (previous_token.type == SUBOPEN_TT)
+ || (previous_token.type == ENDEXP_TT)
+ || (array_init_ambiguity)
+ || ((bracket_level == 1) && (action_ambiguity)))
+ current_token.type = SUBOPEN_TT;
+ else
+ { inserting_token = TRUE;
+ heldback_token = current_token;
+ current_token.text = "<call>";
+ bracket_level--;
+ }
+ break;
+
+ case CLOSEB_SEP:
+ bracket_level--;
+ if (bracket_level < 0)
+ current_token.type = ENDEXP_TT;
+ else current_token.type = SUBCLOSE_TT;
+ break;
+
+ case SEMICOLON_SEP:
+ current_token.type = ENDEXP_TT; break;
+
+ case MINUS_SEP:
+ if ((previous_token.type == OP_TT)
+ || (previous_token.type == SUBOPEN_TT)
+ || (previous_token.type == ENDEXP_TT))
+ current_token.value = UNARY_MINUS_SEP; break;
+
+ case INC_SEP:
+ if ((previous_token.type == VARIABLE_TT)
+ || (previous_token.type == SUBCLOSE_TT)
+ || (previous_token.type == LARGE_NUMBER_TT)
+ || (previous_token.type == SMALL_NUMBER_TT))
+ current_token.value = POST_INC_SEP; break;
+
+ case DEC_SEP:
+ if ((previous_token.type == VARIABLE_TT)
+ || (previous_token.type == SUBCLOSE_TT)
+ || (previous_token.type == LARGE_NUMBER_TT)
+ || (previous_token.type == SMALL_NUMBER_TT))
+ current_token.value = POST_DEC_SEP; break;
+
+ case HASHHASH_SEP:
+ token_text = current_token.text + 2;
+
+ ActionUsedAsConstant:
+
+ current_token.type = ACTION_TT;
+ current_token.text = token_text;
+ current_token.value = 0;
+ current_token.marker = ACTION_MV;
+
+ break;
+
+ case HASHADOLLAR_SEP:
+ obsolete_warning("'#a$Act' is now superseded by '##Act'");
+ token_text = current_token.text + 3;
+ goto ActionUsedAsConstant;
+
+ case HASHGDOLLAR_SEP:
+
+ /* This form generates the position of a global variable
+ in the global variables array. So Glob is the same as
+ #globals_array --> #g$Glob */
+
+ current_token.text += 3;
+ current_token.type = SYMBOL_TT;
+ symbol = symbol_index(current_token.text, -1);
+ if (stypes[symbol] != GLOBAL_VARIABLE_T) {
+ ebf_error(
+ "global variable name after '#g$'",
+ current_token.text);
+ current_token.value = 0;
+ current_token.type = SMALL_NUMBER_TT;
+ current_token.marker = 0;
+ break;
+ }
+ mark_symbol_as_used = TRUE;
+ current_token.value = svals[symbol] - MAX_LOCAL_VARIABLES;
+ current_token.marker = 0;
+ if (!glulx_mode) {
+ if (current_token.value >= 0x100)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ else {
+ if (current_token.value >= 0x8000
+ || current_token.value < -0x8000)
+ current_token.type = LARGE_NUMBER_TT;
+ else current_token.type = SMALL_NUMBER_TT;
+ }
+ break;
+
+ case HASHNDOLLAR_SEP:
+
+ /* This form is still needed for constants like #n$a (the
+ dictionary address of the word "a"), since 'a' means
+ the ASCII value of 'a' */
+
+ if (strlen(token_text) > 4)
+ obsolete_warning(
+ "'#n$word' is now superseded by ''word''");
+ current_token.type = DICTWORD_TT;
+ current_token.value = 0;
+ current_token.text = token_text + 3;
+ current_token.marker = DWORD_MV;
+ break;
+
+ case HASHRDOLLAR_SEP:
+
+ /* This form -- #r$Routinename, to return the routine's */
+ /* packed address -- is needed far less often in Inform 6, */
+ /* where just giving the name Routine returns the packed */
+ /* address. But it's used in a lot of Inform 5 code. */
+
+ obsolete_warning(
+ "'#r$Routine' can now be written just 'Routine'");
+ current_token.text += 3;
+ current_token.type = SYMBOL_TT;
+ current_token.value = symbol_index(current_token.text, -1);
+ goto ReceiveSymbol;
+
+ case HASHWDOLLAR_SEP:
+ error("The obsolete '#w$word' construct has been removed");
+ break;
+
+ case HASH_SEP:
+ system_constants.enabled = TRUE;
+ get_next_token();
+ system_constants.enabled = FALSE;
+ if (token_type != SYSTEM_CONSTANT_TT)
+ { ebf_error(
+ "'r$', 'n$', 'g$' or internal Inform constant name after '#'",
+ token_text);
+ break;
+ }
+ else
+ { current_token.type = token_type;
+ current_token.value = token_value;
+ current_token.text = token_text;
+ current_token.marker = INCON_MV;
+ }
+ break;
+ }
+ break;
+
+ case CND_TT:
+ v = conditionals_to_operators[current_token.value];
+ if (v != NOT_AN_OPERATOR)
+ { current_token.type = OP_TT; current_token.value = v;
+ }
+ break;
+ }
+
+ if (current_token.type == SEP_TT)
+ { v = separators_to_operators[current_token.value];
+ if (v != NOT_AN_OPERATOR)
+ { if ((veneer_mode)
+ || ((v!=MESSAGE_OP) && (v!=MPROP_NUM_OP) && (v!=MPROP_NUM_OP)))
+ { current_token.type = OP_TT; current_token.value = v;
+ if (array_init_ambiguity &&
+ ((v==MINUS_OP) || (v==UNARY_MINUS_OP)) &&
+ (initial_bracket_level == 0) &&
+ (etoken_count != 1))
+ warning("Without bracketing, the minus sign '-' is ambiguous");
+ }
+ }
+ }
+
+ /* A feature of Inform making it annoyingly hard to parse left-to-right
+ is that there is no clear delimiter for expressions; that is, the
+ legal syntax often includes sequences of expressions with no
+ intervening markers such as commas. We therefore need to use some
+ internal context to determine whether an end is in sight... */
+
+ if (token_type_allowable[current_token.type]==0)
+ { if (expr_trace_level >= 3)
+ { printf("Discarding as not allowable: '%s' ", current_token.text);
+ describe_token(current_token);
+ printf("\n");
+ }
+ current_token.type = ENDEXP_TT;
+ }
+ else
+ if ((!((initial_bracket_level > 0)
+ || (previous_token.type == ENDEXP_TT)
+ || ((previous_token.type == OP_TT)
+ && (operators[previous_token.value].usage != POST_U))
+ || (previous_token.type == SYSFUN_TT)))
+ && ((current_token.type != OP_TT)
+ || (operators[current_token.value].usage == PRE_U)))
+ { if (expr_trace_level >= 3)
+ { printf("Discarding as no longer part: '%s' ", current_token.text);
+ describe_token(current_token);
+ printf("\n");
+ }
+ current_token.type = ENDEXP_TT;
+ }
+ else
+ { if (mark_symbol_as_used) sflags[symbol] |= USED_SFLAG;
+ if (expr_trace_level >= 3)
+ { printf("Expr token = '%s' ", current_token.text);
+ describe_token(current_token);
+ printf("\n");
+ }
+ }
+
+ if ((previous_token.type == ENDEXP_TT)
+ && (current_token.type == ENDEXP_TT)) return FALSE;
+
+ previous_token = current_token;
+
+ return TRUE;
+}
+
+/* --- Operator precedences ------------------------------------------------ */
+
+#define LOWER_P 101
+#define EQUAL_P 102
+#define GREATER_P 103
+
+#define e1 1 /* Missing operand error */
+#define e2 2 /* Unexpected close bracket */
+#define e3 3 /* Missing operator error */
+#define e4 4 /* Expression ends with an open bracket */
+#define e5 5 /* Associativity illegal error */
+
+const int prec_table[] = {
+
+/* a .......... ( ) end op term */
+
+/* b ( */ LOWER_P, e3, LOWER_P, LOWER_P, e3,
+/* . ) */ EQUAL_P, GREATER_P, e2, GREATER_P, GREATER_P,
+/* . end */ e4, GREATER_P, e1, GREATER_P, GREATER_P,
+/* . op */ LOWER_P, GREATER_P, LOWER_P, -1, GREATER_P,
+/* . term */ LOWER_P, e3, LOWER_P, LOWER_P, e3
+
+};
+
+static int find_prec(token_data a, token_data b)
+{
+ /* We are comparing the precedence of tokens a and b
+ (where a occurs to the left of b). If the expression is correct,
+ the only possible values are GREATER_P, LOWER_P or EQUAL_P;
+ if it is malformed then one of e1 to e5 results.
+
+ Note that this routine is not symmetrical and that the relation
+ is not trichotomous.
+
+ If a and b are equal (and aren't brackets), then
+
+ a LOWER_P a if a right-associative
+ a GREATER_P a if a left-associative
+ */
+
+ int i, j, l1, l2;
+
+ switch(a.type)
+ { case SUBOPEN_TT: i=0; break;
+ case SUBCLOSE_TT: i=1; break;
+ case ENDEXP_TT: i=2; break;
+ case OP_TT: i=3; break;
+ default: i=4; break;
+ }
+ switch(b.type)
+ { case SUBOPEN_TT: i+=0; break;
+ case SUBCLOSE_TT: i+=5; break;
+ case ENDEXP_TT: i+=10; break;
+ case OP_TT: i+=15; break;
+ default: i+=20; break;
+ }
+
+ j = prec_table[i]; if (j != -1) return j;
+
+ l1 = operators[a.value].precedence;
+ l2 = operators[b.value].precedence;
+ if (operators[b.value].usage == PRE_U) return LOWER_P;
+ if (operators[a.value].usage == POST_U) return GREATER_P;
+
+ /* Anomalous rule to resolve the function call precedence, which is
+ different on the right from on the left, e.g., in:
+
+ alpha.beta(gamma)
+ beta(gamma).alpha
+ */
+
+ if ((l1 == 11) && (l2 > 11)) return GREATER_P;
+
+ if (l1 < l2) return LOWER_P;
+ if (l1 > l2) return GREATER_P;
+ switch(operators[a.value].associativity)
+ { case L_A: return GREATER_P;
+ case R_A: return LOWER_P;
+ case 0: return e5;
+ }
+ return GREATER_P;
+}
+
+/* --- Converting token to operand ----------------------------------------- */
+
+/* Must match the switch statement below */
+int z_system_constant_list[] =
+ { adjectives_table_SC,
+ actions_table_SC,
+ classes_table_SC,
+ identifiers_table_SC,
+ preactions_table_SC,
+ largest_object_SC,
+ strings_offset_SC,
+ code_offset_SC,
+ actual_largest_object_SC,
+ static_memory_offset_SC,
+ array_names_offset_SC,
+ readable_memory_offset_SC,
+ cpv__start_SC,
+ cpv__end_SC,
+ ipv__start_SC,
+ ipv__end_SC,
+ array__start_SC,
+ array__end_SC,
+ highest_attribute_number_SC,
+ attribute_names_array_SC,
+ highest_property_number_SC,
+ property_names_array_SC,
+ highest_action_number_SC,
+ action_names_array_SC,
+ highest_fake_action_number_SC,
+ fake_action_names_array_SC,
+ highest_routine_number_SC,
+ routine_names_array_SC,
+ routines_array_SC,
+ routine_flags_array_SC,
+ highest_global_number_SC,
+ global_names_array_SC,
+ globals_array_SC,
+ global_flags_array_SC,
+ highest_array_number_SC,
+ array_names_array_SC,
+ array_flags_array_SC,
+ highest_constant_number_SC,
+ constant_names_array_SC,
+ highest_class_number_SC,
+ class_objects_array_SC,
+ highest_object_number_SC,
+ -1 };
+
+static int32 value_of_system_constant_z(int t)
+{ switch(t)
+ { case adjectives_table_SC:
+ return adjectives_offset;
+ case actions_table_SC:
+ return actions_offset;
+ case classes_table_SC:
+ return class_numbers_offset;
+ case identifiers_table_SC:
+ return identifier_names_offset;
+ case preactions_table_SC:
+ return preactions_offset;
+ case largest_object_SC:
+ return 256 + no_objects - 1;
+ case strings_offset_SC:
+ return strings_offset/scale_factor;
+ case code_offset_SC:
+ return code_offset/scale_factor;
+ case actual_largest_object_SC:
+ return no_objects;
+ case static_memory_offset_SC:
+ return static_memory_offset;
+ case array_names_offset_SC:
+ return array_names_offset;
+ case readable_memory_offset_SC:
+ return Write_Code_At;
+ case cpv__start_SC:
+ return prop_values_offset;
+ case cpv__end_SC:
+ return class_numbers_offset;
+ case ipv__start_SC:
+ return individuals_offset;
+ case ipv__end_SC:
+ return variables_offset;
+ case array__start_SC:
+ return variables_offset + (MAX_GLOBAL_VARIABLES*WORDSIZE);
+ case array__end_SC:
+ return static_memory_offset;
+
+ case highest_attribute_number_SC:
+ return no_attributes-1;
+ case attribute_names_array_SC:
+ return attribute_names_offset;
+
+ case highest_property_number_SC:
+ return no_individual_properties-1;
+ case property_names_array_SC:
+ return identifier_names_offset + 2;
+
+ case highest_action_number_SC:
+ return no_actions-1;
+ case action_names_array_SC:
+ return action_names_offset;
+
+ case highest_fake_action_number_SC:
+ return ((grammar_version_number==1)?256:4096) + no_fake_actions-1;
+ case fake_action_names_array_SC:
+ return fake_action_names_offset;
+
+ case highest_routine_number_SC:
+ return no_named_routines-1;
+ case routine_names_array_SC:
+ return routine_names_offset;
+ case routines_array_SC:
+ return routines_array_offset;
+ case routine_flags_array_SC:
+ return routine_flags_array_offset;
+ case highest_global_number_SC:
+ return 16 + no_globals-1;
+ case global_names_array_SC:
+ return global_names_offset;
+ case globals_array_SC:
+ return variables_offset;
+ case global_flags_array_SC:
+ return global_flags_array_offset;
+ case highest_array_number_SC:
+ return no_arrays-1;
+ case array_names_array_SC:
+ return array_names_offset;
+ case array_flags_array_SC:
+ return array_flags_array_offset;
+ case highest_constant_number_SC:
+ return no_named_constants-1;
+ case constant_names_array_SC:
+ return constant_names_offset;
+ case highest_class_number_SC:
+ return no_classes-1;
+ case class_objects_array_SC:
+ return class_numbers_offset;
+ case highest_object_number_SC:
+ return no_objects-1;
+ }
+
+ error_named("System constant not implemented in Z-code",
+ system_constants.keywords[t]);
+
+ return(0);
+}
+
+/* Must match the switch statement below */
+int glulx_system_constant_list[] =
+ { classes_table_SC,
+ identifiers_table_SC,
+ array_names_offset_SC,
+ cpv__start_SC,
+ cpv__end_SC,
+ dictionary_table_SC,
+ dynam_string_table_SC,
+ grammar_table_SC,
+ actions_table_SC,
+ globals_array_SC,
+ highest_class_number_SC,
+ highest_object_number_SC,
+ -1 };
+
+static int32 value_of_system_constant_g(int t)
+{
+ switch (t) {
+ case classes_table_SC:
+ return Write_RAM_At + class_numbers_offset;
+ case identifiers_table_SC:
+ return Write_RAM_At + identifier_names_offset;
+ case array_names_offset_SC:
+ return Write_RAM_At + array_names_offset;
+ case cpv__start_SC:
+ return prop_defaults_offset;
+ case cpv__end_SC:
+ return Write_RAM_At + class_numbers_offset;
+ case dictionary_table_SC:
+ return dictionary_offset;
+ case dynam_string_table_SC:
+ return abbreviations_offset;
+ case grammar_table_SC:
+ return grammar_table_offset;
+ case actions_table_SC:
+ return actions_offset;
+ case globals_array_SC:
+ return variables_offset;
+ case highest_class_number_SC:
+ return no_classes-1;
+ case highest_object_number_SC:
+ return no_objects-1;
+ }
+
+ error_named("System constant not implemented in Glulx",
+ system_constants.keywords[t]);
+
+ return 0;
+}
+
+extern int32 value_of_system_constant(int t)
+{
+ if (!glulx_mode)
+ return value_of_system_constant_z(t);
+ else
+ return value_of_system_constant_g(t);
+}
+
+static int evaluate_term(token_data t, assembly_operand *o)
+{
+ /* If the given token is a constant, evaluate it into the operand.
+ For now, the identifiers are considered variables.
+
+ Returns FALSE if it fails to understand type. */
+
+ int32 v;
+
+ o->marker = t.marker;
+ o->symtype = t.symtype;
+ o->symflags = t.symflags;
+
+ switch(t.type)
+ { case LARGE_NUMBER_TT:
+ v = t.value;
+ if (!glulx_mode) {
+ if (v < 0) v = v + 0x10000;
+ o->type = LONG_CONSTANT_OT;
+ o->value = v;
+ }
+ else {
+ o->value = v;
+ o->type = CONSTANT_OT;
+ }
+ return(TRUE);
+ case SMALL_NUMBER_TT:
+ v = t.value;
+ if (!glulx_mode) {
+ if (v < 0) v = v + 0x10000;
+ o->type = SHORT_CONSTANT_OT;
+ o->value = v;
+ }
+ else {
+ o->value = v;
+ set_constant_ot(o);
+ }
+ return(TRUE);
+ case DICTWORD_TT:
+ /* Find the dictionary address, adding to dictionary if absent */
+ if (!glulx_mode)
+ o->type = LONG_CONSTANT_OT;
+ else
+ o->type = CONSTANT_OT;
+ o->value = dictionary_add(t.text, 0x80, 0, 0);
+ return(TRUE);
+ case DQ_TT:
+ /* Create as a static string */
+ if (!glulx_mode)
+ o->type = LONG_CONSTANT_OT;
+ else
+ o->type = CONSTANT_OT;
+ o->value = compile_string(t.text, FALSE, FALSE);
+ return(TRUE);
+ case VARIABLE_TT:
+ if (!glulx_mode) {
+ o->type = VARIABLE_OT;
+ }
+ else {
+ if (t.value >= MAX_LOCAL_VARIABLES) {
+ o->type = GLOBALVAR_OT;
+ }
+ else {
+ /* This includes "local variable zero", which is really
+ the stack-pointer magic variable. */
+ o->type = LOCALVAR_OT;
+ }
+ }
+ o->value = t.value;
+ return(TRUE);
+ case SYSFUN_TT:
+ if (!glulx_mode) {
+ o->type = VARIABLE_OT;
+ o->value = t.value + 256;
+ }
+ else {
+ o->type = SYSFUN_OT;
+ o->value = t.value;
+ }
+ system_function_usage[t.value] = 1;
+ return(TRUE);
+ case ACTION_TT:
+ *o = action_of_name(t.text);
+ return(TRUE);
+ case SYSTEM_CONSTANT_TT:
+ /* Certain system constants depend only on the
+ version number and need no backpatching, as they
+ are known in advance. We can therefore evaluate
+ them immediately. */
+ if (!glulx_mode) {
+ o->type = LONG_CONSTANT_OT;
+ switch(t.value)
+ {
+ case version_number_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = version_number; break;
+ case dict_par1_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = (version_number==3)?4:6; break;
+ case dict_par2_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = (version_number==3)?5:7; break;
+ case dict_par3_SC:
+ o->type = SHORT_CONSTANT_OT;
+ o->marker = 0;
+ v = (version_number==3)?6:8; break;
+ case lowest_attribute_number_SC:
+ case lowest_action_number_SC:
+ case lowest_routine_number_SC:
+ case lowest_array_number_SC:
+ case lowest_constant_number_SC:
+ case lowest_class_number_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 0; break;
+ case lowest_object_number_SC:
+ case lowest_property_number_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 1; break;
+ case lowest_global_number_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 16; break;
+ case lowest_fake_action_number_SC:
+ o->type = LONG_CONSTANT_OT; o->marker = 0;
+ v = ((grammar_version_number==1)?256:4096); break;
+ case oddeven_packing_SC:
+ o->type = SHORT_CONSTANT_OT; o->marker = 0;
+ v = oddeven_packing_switch; break;
+ default:
+ v = t.value;
+ o->marker = INCON_MV;
+ break;
+ }
+ o->value = v;
+ }
+ else {
+ o->type = CONSTANT_OT;
+ switch(t.value)
+ {
+ /* The three dict_par flags point at the lower byte
+ of the flag field, because the library is written
+ to expect one-byte fields, even though the compiler
+ generates a dictionary with room for two. */
+ case dict_par1_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = DICT_ENTRY_FLAG_POS+1;
+ break;
+ case dict_par2_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = DICT_ENTRY_FLAG_POS+3;
+ break;
+ case dict_par3_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = DICT_ENTRY_FLAG_POS+5;
+ break;
+
+ case lowest_attribute_number_SC:
+ case lowest_action_number_SC:
+ case lowest_routine_number_SC:
+ case lowest_array_number_SC:
+ case lowest_constant_number_SC:
+ case lowest_class_number_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = 0;
+ break;
+ case lowest_object_number_SC:
+ case lowest_property_number_SC:
+ o->type = BYTECONSTANT_OT;
+ o->marker = 0;
+ v = 1;
+ break;
+
+ /* ###fix: need to fill more of these in! */
+
+ default:
+ v = t.value;
+ o->marker = INCON_MV;
+ break;
+ }
+ o->value = v;
+ }
+ return(TRUE);
+ default:
+ return(FALSE);
+ }
+}
+
+/* --- Emitter ------------------------------------------------------------- */
+
+expression_tree_node *ET;
+static int ET_used;
+
+extern void clear_expression_space(void)
+{ ET_used = 0;
+}
+
+static assembly_operand *emitter_stack;
+static int *emitter_markers;
+static int *emitter_bracket_counts;
+
+#define FUNCTION_VALUE_MARKER 1
+#define ARGUMENT_VALUE_MARKER 2
+#define OR_VALUE_MARKER 3
+
+static int emitter_sp;
+
+static int is_property_t(int symbol_type)
+{ return ((symbol_type == PROPERTY_T) || (symbol_type == INDIVIDUAL_PROPERTY_T));
+}
+
+static void mark_top_of_emitter_stack(int marker, token_data t)
+{ if (emitter_sp < 1)
+ { compiler_error("SR error: Attempt to add a marker to the top of an empty emitter stack");
+ return;
+ }
+ if (expr_trace_level >= 2)
+ { printf("Marking top of emitter stack (which is ");
+ print_operand(emitter_stack[emitter_sp-1]);
+ printf(") as ");
+ switch(marker)
+ {
+ case FUNCTION_VALUE_MARKER:
+ printf("FUNCTION");
+ break;
+ case ARGUMENT_VALUE_MARKER:
+ printf("ARGUMENT");
+ break;
+ case OR_VALUE_MARKER:
+ printf("OR_VALUE");
+ break;
+ default:
+ printf("UNKNOWN");
+ break;
+ }
+ printf("\n");
+ }
+ if (emitter_markers[emitter_sp-1])
+ { if (marker == ARGUMENT_VALUE_MARKER)
+ {
+ warning("Ignoring spurious leading comma");
+ return;
+ }
+ error_named("Missing operand for", t.text);
+ if (emitter_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+ emitter_stack[emitter_sp] = zero_operand;
+ emitter_sp++;
+ }
+ emitter_markers[emitter_sp-1] = marker;
+}
+
+static void add_bracket_layer_to_emitter_stack(int depth)
+{ /* There's no point in tracking bracket layers that don't fence off any values. */
+ if (emitter_sp < depth + 1) return;
+ if (expr_trace_level >= 2)
+ printf("Adding bracket layer\n");
+ ++emitter_bracket_counts[emitter_sp-depth-1];
+}
+
+static void remove_bracket_layer_from_emitter_stack()
+{ /* Bracket layers that don't fence off any values will not have been tracked. */
+ if (emitter_sp < 2) return;
+ if (expr_trace_level >= 2)
+ printf("Removing bracket layer\n");
+ if (emitter_bracket_counts[emitter_sp-2] <= 0)
+ { compiler_error("SR error: Attempt to remove a nonexistent bracket layer from the emitter stack");
+ return;
+ }
+ --emitter_bracket_counts[emitter_sp-2];
+}
+
+static void emit_token(token_data t)
+{ assembly_operand o1, o2; int arity, stack_size, i;
+ int op_node_number, operand_node_number, previous_node_number;
+ int32 x = 0;
+
+ if (expr_trace_level >= 2)
+ { printf("Output: %-19s%21s ", t.text, "");
+ for (i=0; i<emitter_sp; i++)
+ { print_operand(emitter_stack[i]); printf(" ");
+ if (emitter_markers[i] == FUNCTION_VALUE_MARKER) printf(":FUNCTION ");
+ if (emitter_markers[i] == ARGUMENT_VALUE_MARKER) printf(":ARGUMENT ");
+ if (emitter_markers[i] == OR_VALUE_MARKER) printf(":OR ");
+ if (emitter_bracket_counts[i]) printf(":BRACKETS(%d) ", emitter_bracket_counts[i]);
+ }
+ printf("\n");
+ }
+
+ if (t.type == SUBOPEN_TT) return;
+
+ stack_size = 0;
+ while ((stack_size < emitter_sp) &&
+ !emitter_markers[emitter_sp-stack_size-1] &&
+ !emitter_bracket_counts[emitter_sp-stack_size-1])
+ stack_size++;
+
+ if (t.type == SUBCLOSE_TT)
+ { if (stack_size < emitter_sp && emitter_bracket_counts[emitter_sp-stack_size-1])
+ { if (stack_size == 0)
+ { error("No expression between brackets '(' and ')'");
+ emitter_stack[emitter_sp] = zero_operand;
+ emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+ ++emitter_sp;
+ }
+ else if (stack_size < 1)
+ compiler_error("SR error: emitter stack empty in subexpression");
+ else if (stack_size > 1)
+ compiler_error("SR error: emitter stack overfull in subexpression");
+ remove_bracket_layer_from_emitter_stack();
+ }
+ return;
+ }
+
+ if (t.type != OP_TT)
+ { emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+
+ if (emitter_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ if (!evaluate_term(t, &(emitter_stack[emitter_sp++])))
+ compiler_error_named("Emit token error:", t.text);
+ return;
+ }
+
+ /* A comma is argument-separating if it follows an argument (or a function
+ call, since we ignore spurious leading commas in function argument lists)
+ with no intervening brackets. Function calls are variadic, so we don't
+ apply argument-separating commas. */
+ if (t.value == COMMA_OP &&
+ stack_size < emitter_sp &&
+ (emitter_markers[emitter_sp-stack_size-1] == ARGUMENT_VALUE_MARKER ||
+ emitter_markers[emitter_sp-stack_size-1] == FUNCTION_VALUE_MARKER) &&
+ !emitter_bracket_counts[emitter_sp-stack_size-1])
+ { if (expr_trace_level >= 2)
+ printf("Treating comma as argument-separating\n");
+ return;
+ }
+
+ if (t.value == OR_OP)
+ return;
+
+ arity = 1;
+ if (t.value == FCALL_OP)
+ { if (expr_trace_level >= 3)
+ { printf("FCALL_OP finds marker stack: ");
+ for (x=0; x<emitter_sp; x++) printf("%d ", emitter_markers[x]);
+ printf("\n");
+ }
+ if (emitter_markers[emitter_sp-1] == ARGUMENT_VALUE_MARKER)
+ warning("Ignoring spurious trailing comma");
+ while (emitter_markers[emitter_sp-arity] != FUNCTION_VALUE_MARKER)
+ {
+ if ((glulx_mode &&
+ emitter_stack[emitter_sp-arity].type == SYSFUN_OT) ||
+ (!glulx_mode &&
+ emitter_stack[emitter_sp-arity].type == VARIABLE_OT &&
+ emitter_stack[emitter_sp-arity].value >= 256 &&
+ emitter_stack[emitter_sp-arity].value < 288))
+ { int index = emitter_stack[emitter_sp-arity].value;
+ if(!glulx_mode)
+ index -= 256;
+ if(index >= 0 && index < NUMBER_SYSTEM_FUNCTIONS)
+ error_named("System function name used as a value:", system_functions.keywords[index]);
+ else
+ compiler_error("Found unnamed system function used as a value");
+ emitter_stack[emitter_sp-arity] = zero_operand;
+ }
+ ++arity;
+ }
+ }
+ else
+ { arity = 1;
+ if (operators[t.value].usage == IN_U) arity = 2;
+
+ if (operators[t.value].precedence == 3)
+ { arity = 2;
+ x = emitter_sp-1;
+ if(!emitter_markers[x] && !emitter_bracket_counts[x])
+ { for (--x; emitter_markers[x] == OR_VALUE_MARKER && !emitter_bracket_counts[x]; --x)
+ { ++arity;
+ ++stack_size;
+ }
+ for (;x >= 0 && !emitter_markers[x] && !emitter_bracket_counts[x]; --x)
+ ++stack_size;
+ }
+ }
+
+ if (arity > stack_size)
+ { error_named("Missing operand for", t.text);
+ while (arity > stack_size)
+ { if (emitter_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ emitter_markers[emitter_sp] = 0;
+ emitter_bracket_counts[emitter_sp] = 0;
+ emitter_stack[emitter_sp] = zero_operand;
+ emitter_sp++;
+ stack_size++;
+ }
+ }
+ }
+
+ /* pseudo-typecheck in 6.30 */
+ for (i = 1; i <= arity; i++)
+ {
+ o1 = emitter_stack[emitter_sp - i];
+ if (is_property_t(o1.symtype) ) {
+ switch(t.value)
+ {
+ case FCALL_OP:
+ case SETEQUALS_OP: case NOTEQUAL_OP:
+ case CONDEQUALS_OP:
+ case PROVIDES_OP: case NOTPROVIDES_OP:
+ case PROP_ADD_OP: case PROP_NUM_OP:
+ case SUPERCLASS_OP:
+ case MPROP_ADD_OP: case MESSAGE_OP:
+ case PROPERTY_OP:
+ if (i < arity) break;
+ case GE_OP: case LE_OP:
+ if ((i < arity) && (o1.symflags & STAR_SFLAG)) break;
+ default:
+ warning("Property name in expression is not qualified by object");
+ }
+ } /* if (is_property_t */
+ }
+
+ switch(arity)
+ { case 1:
+ o1 = emitter_stack[emitter_sp - 1];
+ if ((o1.marker == 0) && is_constant_ot(o1.type))
+ { switch(t.value)
+ { case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
+ case ARTNOT_OP:
+ if (!glulx_mode)
+ x = (~o1.value) & 0xffff;
+ else
+ x = (~o1.value) & 0xffffffff;
+ goto FoldConstant;
+ case LOGNOT_OP:
+ if (o1.value != 0) x=0; else x=1;
+ goto FoldConstant;
+ }
+ }
+ break;
+
+ case 2:
+ o1 = emitter_stack[emitter_sp - 2];
+ o2 = emitter_stack[emitter_sp - 1];
+
+ if ((o1.marker == 0) && (o2.marker == 0)
+ && is_constant_ot(o1.type) && is_constant_ot(o2.type))
+ {
+ int32 ov1, ov2;
+ if (glulx_mode)
+ { ov1 = o1.value;
+ ov2 = o2.value;
+ }
+ else
+ { ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
+ ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
+ }
+
+ switch(t.value)
+ {
+ case PLUS_OP: x = ov1 + ov2; goto FoldConstantC;
+ case MINUS_OP: x = ov1 - ov2; goto FoldConstantC;
+ case TIMES_OP: x = ov1 * ov2; goto FoldConstantC;
+ case DIVIDE_OP:
+ case REMAINDER_OP:
+ if (ov2 == 0)
+ error("Division of constant by zero");
+ else
+ if (t.value == DIVIDE_OP) {
+ if (ov2 < 0) {
+ ov1 = -ov1;
+ ov2 = -ov2;
+ }
+ if (ov1 >= 0)
+ x = ov1 / ov2;
+ else
+ x = -((-ov1) / ov2);
+ }
+ else {
+ if (ov2 < 0) {
+ ov2 = -ov2;
+ }
+ if (ov1 >= 0)
+ x = ov1 % ov2;
+ else
+ x = -((-ov1) % ov2);
+ }
+ goto FoldConstant;
+ case ARTAND_OP: x = o1.value & o2.value; goto FoldConstant;
+ case ARTOR_OP: x = o1.value | o2.value; goto FoldConstant;
+ case CONDEQUALS_OP:
+ if (o1.value == o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case NOTEQUAL_OP:
+ if (o1.value != o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case GE_OP:
+ if (o1.value >= o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case GREATER_OP:
+ if (o1.value > o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case LE_OP:
+ if (o1.value <= o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case LESS_OP:
+ if (o1.value < o2.value) x = 1; else x = 0;
+ goto FoldConstant;
+ case LOGAND_OP:
+ if ((o1.value != 0) && (o2.value != 0)) x=1; else x=0;
+ goto FoldConstant;
+ case LOGOR_OP:
+ if ((o1.value != 0) || (o2.value != 0)) x=1; else x=0;
+ goto FoldConstant;
+ }
+
+ }
+ }
+
+ op_node_number = ET_used++;
+ if (op_node_number == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+
+ ET[op_node_number].operator_number = t.value;
+ ET[op_node_number].up = -1;
+ ET[op_node_number].down = -1;
+ ET[op_node_number].right = -1;
+
+ /* This statement is redundant, but prevents compilers from wrongly
+ issuing a "used before it was assigned a value" error: */
+ previous_node_number = 0;
+
+ for (i = emitter_sp-arity; i != emitter_sp; i++)
+ {
+ if (expr_trace_level >= 3)
+ printf("i=%d, emitter_sp=%d, arity=%d, ETU=%d\n",
+ i, emitter_sp, arity, ET_used);
+ if (emitter_stack[i].type == EXPRESSION_OT)
+ operand_node_number = emitter_stack[i].value;
+ else
+ { operand_node_number = ET_used++;
+ if (operand_node_number == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[operand_node_number].down = -1;
+ ET[operand_node_number].value = emitter_stack[i];
+ }
+ ET[operand_node_number].up = op_node_number;
+ ET[operand_node_number].right = -1;
+ if (i == emitter_sp - arity)
+ { ET[op_node_number].down = operand_node_number;
+ }
+ else
+ { ET[previous_node_number].right = operand_node_number;
+ }
+ previous_node_number = operand_node_number;
+ }
+
+ emitter_sp = emitter_sp - arity + 1;
+
+ emitter_stack[emitter_sp - 1].type = EXPRESSION_OT;
+ emitter_stack[emitter_sp - 1].value = op_node_number;
+ emitter_stack[emitter_sp - 1].marker = 0;
+ emitter_markers[emitter_sp - 1] = 0;
+ emitter_bracket_counts[emitter_sp - 1] = 0;
+ /* Remove the marker for the brackets implied by operator precedence */
+ remove_bracket_layer_from_emitter_stack();
+
+ return;
+
+ FoldConstantC:
+
+ /* In Glulx, skip this test; we can't check out-of-range errors
+ for 32-bit arithmetic. */
+
+ if (!glulx_mode && ((x<-32768) || (x > 32767)))
+ { char folding_error[40];
+ int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
+ int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
+ switch(t.value)
+ {
+ case PLUS_OP:
+ sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
+ break;
+ case MINUS_OP:
+ sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
+ break;
+ case TIMES_OP:
+ sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
+ break;
+ }
+ error_named("Signed arithmetic on compile-time constants overflowed \
+the range -32768 to +32767:", folding_error);
+ }
+
+ FoldConstant:
+
+ if (!glulx_mode) {
+ while (x < 0) x = x + 0x10000;
+ x = x & 0xffff;
+ }
+ else {
+ x = x & 0xffffffff;
+ }
+
+ emitter_sp = emitter_sp - arity + 1;
+
+ if (!glulx_mode) {
+ if (x<256)
+ emitter_stack[emitter_sp - 1].type = SHORT_CONSTANT_OT;
+ else emitter_stack[emitter_sp - 1].type = LONG_CONSTANT_OT;
+ }
+ else {
+ if (x == 0)
+ emitter_stack[emitter_sp - 1].type = ZEROCONSTANT_OT;
+ else if (x >= -128 && x <= 127)
+ emitter_stack[emitter_sp - 1].type = BYTECONSTANT_OT;
+ else if (x >= -32768 && x <= 32767)
+ emitter_stack[emitter_sp - 1].type = HALFCONSTANT_OT;
+ else
+ emitter_stack[emitter_sp - 1].type = CONSTANT_OT;
+ }
+
+ emitter_stack[emitter_sp - 1].value = x;
+ emitter_stack[emitter_sp - 1].marker = 0;
+ emitter_markers[emitter_sp - 1] = 0;
+ emitter_bracket_counts[emitter_sp - 1] = 0;
+
+ if (expr_trace_level >= 2)
+ { printf("Folding constant to: ");
+ print_operand(emitter_stack[emitter_sp - 1]);
+ printf("\n");
+ }
+
+ /* Remove the marker for the brackets implied by operator precedence */
+ remove_bracket_layer_from_emitter_stack();
+ return;
+}
+
+/* --- Pretty printing ----------------------------------------------------- */
+
+static void show_node(int n, int depth, int annotate)
+{ int j;
+ for (j=0; j<2*depth+2; j++) printf(" ");
+
+ if (ET[n].down == -1)
+ { print_operand(ET[n].value);
+ if (annotate && (ET[n].value.marker != 0))
+ printf(" [%s]", describe_mv(ET[n].value.marker));
+ printf("\n");
+ }
+ else
+ { printf("%s ", operators[ET[n].operator_number].description);
+ j = operators[ET[n].operator_number].precedence;
+ if ((annotate) && ((j==2) || (j==3)))
+ { printf(" %d|%d ", ET[n].true_label, ET[n].false_label);
+ if (ET[n].label_after != -1) printf(" def %d after ",
+ ET[n].label_after);
+ if (ET[n].to_expression) printf(" con to expr ");
+ }
+ printf("\n");
+ show_node(ET[n].down, depth+1, annotate);
+ }
+
+ if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
+}
+
+extern void show_tree(assembly_operand AO, int annotate)
+{ if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
+ else
+ { printf("Constant: "); print_operand(AO);
+ if (annotate && (AO.marker != 0))
+ printf(" [%s]", describe_mv(AO.marker));
+ printf("\n");
+ }
+}
+
+/* --- Lvalue transformations ---------------------------------------------- */
+
+/* This only gets called in Z-code, since Glulx doesn't distinguish
+ individual property operators from general ones. */
+static void check_property_operator(int from_node)
+{ int below = ET[from_node].down;
+ int opnum = ET[from_node].operator_number;
+
+ ASSERT_ZCODE();
+
+ if (veneer_mode) return;
+
+ if ((below != -1) && (ET[below].right != -1))
+ { int n = ET[below].right, flag = FALSE;
+
+ if ((ET[n].down == -1)
+ && ((ET[n].value.type == LONG_CONSTANT_OT)
+ || (ET[n].value.type == SHORT_CONSTANT_OT))
+ && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
+ && ((!module_switch) || (ET[n].value.marker == 0)))
+ flag = TRUE;
+
+ if (!flag)
+ { switch(opnum)
+ { case PROPERTY_OP: opnum = MESSAGE_OP; break;
+ case PROP_ADD_OP: opnum = MPROP_ADD_OP; break;
+ case PROP_NUM_OP: opnum = MPROP_NUM_OP; break;
+ }
+ }
+
+ ET[from_node].operator_number = opnum;
+ }
+
+ if (below != -1)
+ check_property_operator(below);
+ if (ET[from_node].right != -1)
+ check_property_operator(ET[from_node].right);
+}
+
+static void check_lvalues(int from_node)
+{ int below = ET[from_node].down;
+ int opnum = ET[from_node].operator_number, opnum_below;
+ int lvalue_form, i, j = 0;
+
+ if (below != -1)
+ {
+ if ((opnum == FCALL_OP) && (ET[below].down != -1))
+ { opnum_below = ET[below].operator_number;
+ if ((opnum_below == PROPERTY_OP) || (opnum_below == MESSAGE_OP))
+ { i = ET[ET[from_node].down].right;
+ ET[from_node].down = ET[below].down;
+ ET[ET[below].down].up = from_node;
+ ET[ET[ET[below].down].right].up = from_node;
+ ET[ET[ET[below].down].right].right = i;
+ opnum = PROP_CALL_OP;
+ ET[from_node].operator_number = opnum;
+ }
+ }
+
+ if (operators[opnum].requires_lvalue)
+ { opnum_below = ET[below].operator_number;
+
+ if (ET[below].down == -1)
+ { if (!is_variable_ot(ET[below].value.type))
+ { error("'=' applied to undeclared variable");
+ goto LvalueError;
+ }
+ }
+ else
+ { lvalue_form=0;
+ switch(opnum)
+ { case SETEQUALS_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_SETEQUALS_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_SETEQUALS_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_SETEQUALS_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_SETEQUALS_OP; break;
+ }
+ break;
+ case INC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_INC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_INC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_INC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_INC_OP; break;
+ }
+ break;
+ case POST_INC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_POST_INC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_POST_INC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_POST_INC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_POST_INC_OP; break;
+ }
+ break;
+ case DEC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_DEC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_DEC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_DEC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_DEC_OP; break;
+ }
+ break;
+ case POST_DEC_OP:
+ switch(opnum_below)
+ { case ARROW_OP: lvalue_form = ARROW_POST_DEC_OP; break;
+ case DARROW_OP: lvalue_form = DARROW_POST_DEC_OP; break;
+ case MESSAGE_OP: lvalue_form = MESSAGE_POST_DEC_OP; break;
+ case PROPERTY_OP: lvalue_form = PROPERTY_POST_DEC_OP; break;
+ }
+ break;
+ }
+ if (lvalue_form == 0)
+ { error_named("'=' applied to",
+ (char *) operators[opnum_below].description);
+ goto LvalueError;
+ }
+
+ /* Transform from_node from_node
+ | \ | \\\ \
+ below value to value
+ | \\\
+ */
+
+ ET[from_node].operator_number = lvalue_form;
+ i = ET[below].down;
+ ET[from_node].down = i;
+ while (i != -1)
+ { ET[i].up = from_node;
+ j = i;
+ i = ET[i].right;
+ }
+ ET[j].right = ET[below].right;
+ }
+ }
+ check_lvalues(below);
+ }
+ if (ET[from_node].right != -1)
+ check_lvalues(ET[from_node].right);
+ return;
+
+ LvalueError:
+ ET[from_node].down = -1;
+ ET[from_node].value = zero_operand;
+ if (ET[from_node].right != -1)
+ check_lvalues(ET[from_node].right);
+}
+
+/* --- Tree surgery for conditionals --------------------------------------- */
+
+static void negate_condition(int n)
+{ int i;
+
+ if (ET[n].right != -1) negate_condition(ET[n].right);
+ if (ET[n].down == -1) return;
+ i = operators[ET[n].operator_number].negation;
+ if (i!=0) ET[n].operator_number = i;
+ if (operators[i].precedence==2) negate_condition(ET[n].down);
+}
+
+static void delete_negations(int n, int context)
+{
+ /* Recursively apply
+
+ ~~(x && y) = ~~x || ~~y
+ ~~(x || y) = ~~x && ~~y
+ ~~(x == y) = x ~= y
+
+ (etc) to delete the ~~ operator from the tree. Since this is
+ depth first, the ~~ being deleted has no ~~s beneath it, which
+ is important to make "negate_condition" work. */
+
+ int i;
+
+ if (ET[n].right != -1) delete_negations(ET[n].right, context);
+ if (ET[n].down == -1) return;
+ delete_negations(ET[n].down, context);
+
+ if (ET[n].operator_number == LOGNOT_OP)
+ { negate_condition(ET[n].down);
+ ET[n].operator_number
+ = ET[ET[n].down].operator_number;
+ ET[n].down = ET[ET[n].down].down;
+ i = ET[n].down;
+ while(i != -1) { ET[i].up = n; i = ET[i].right; }
+ }
+}
+
+static void insert_exp_to_cond(int n, int context)
+{
+ /* Insert a ~= test when an expression is used as a condition.
+
+ Check for possible confusion over = and ==, e.g. "if (a = 1) ..." */
+
+ int new, i;
+
+ if (ET[n].right != -1) insert_exp_to_cond(ET[n].right, context);
+
+ if (ET[n].down == -1)
+ { if (context==CONDITION_CONTEXT)
+ { new = ET_used++;
+ if (new == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[new] = ET[n];
+ ET[n].down = new; ET[n].operator_number = NONZERO_OP;
+ ET[new].up = n; ET[new].right = -1;
+ }
+ return;
+ }
+
+ switch(operators[ET[n].operator_number].precedence)
+ { case 3: /* Conditionals have level 3 */
+ context = QUANTITY_CONTEXT;
+ break;
+ case 2: /* Logical operators level 2 */
+ context = CONDITION_CONTEXT;
+ break;
+ case 1: /* Forms of '=' have level 1 */
+ if (context == CONDITION_CONTEXT)
+ warning("'=' used as condition: '==' intended?");
+ default:
+ if (context != CONDITION_CONTEXT) break;
+
+ new = ET_used++;
+ if (new == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[new] = ET[n];
+ ET[n].down = new; ET[n].operator_number = NONZERO_OP;
+ ET[new].up = n; ET[new].right = -1;
+
+ i = ET[new].down;
+ while (i!= -1) { ET[i].up = new; i = ET[i].right; }
+ context = QUANTITY_CONTEXT; n = new;
+ }
+
+ insert_exp_to_cond(ET[n].down, context);
+}
+
+static unsigned int etoken_num_children(int n)
+{
+ int count = 0;
+ int i;
+ i = ET[n].down;
+ if (i == -1) { return 0; }
+ do {
+ count++;
+ i = ET[i].right;
+ } while (i!=-1);
+ return count;
+}
+
+static void func_args_on_stack(int n, int context)
+{
+ /* Make sure that the arguments of every function-call expression
+ are stored to the stack. If any aren't (ie, if any arguments are
+ constants or variables), cover them with push operators.
+ (The very first argument does not need to be so treated, because
+ it's the function address, not a function argument. We also
+ skip the treatment for most system functions.) */
+
+ int new, pn, fnaddr, opnum;
+
+ ASSERT_GLULX();
+
+ if (ET[n].right != -1)
+ func_args_on_stack(ET[n].right, context);
+ if (ET[n].down == -1) {
+ pn = ET[n].up;
+ if (pn != -1) {
+ opnum = ET[pn].operator_number;
+ if (opnum == FCALL_OP
+ || opnum == MESSAGE_CALL_OP
+ || opnum == PROP_CALL_OP) {
+ /* If it's an FCALL, get the operand which contains the function
+ address (or system-function number) */
+ if (opnum == MESSAGE_CALL_OP
+ || opnum == PROP_CALL_OP
+ || ((fnaddr=ET[pn].down) != n
+ && (ET[fnaddr].value.type != SYSFUN_OT
+ || ET[fnaddr].value.value == INDIRECT_SYSF
+ || ET[fnaddr].value.value == GLK_SYSF))) {
+ if (etoken_num_children(pn) > (unsigned int)(opnum == FCALL_OP ? 4:3)) {
+ new = ET_used++;
+ if (new == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[new] = ET[n];
+ ET[n].down = new;
+ ET[n].operator_number = PUSH_OP;
+ ET[new].up = n;
+ ET[new].right = -1;
+ }
+ }
+ }
+ }
+ return;
+ }
+
+ func_args_on_stack(ET[n].down, context);
+}
+
+static assembly_operand check_conditions(assembly_operand AO, int context)
+{ int n;
+
+ if (AO.type != EXPRESSION_OT)
+ { if (context != CONDITION_CONTEXT) return AO;
+ n = ET_used++;
+ if (n == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ ET[n].down = -1;
+ ET[n].up = -1;
+ ET[n].right = -1;
+ ET[n].value = AO;
+ INITAOT(&AO, EXPRESSION_OT);
+ AO.value = n;
+ }
+
+ insert_exp_to_cond(AO.value, context);
+ delete_negations(AO.value, context);
+
+ if (glulx_mode)
+ func_args_on_stack(AO.value, context);
+
+ return AO;
+}
+
+/* --- Shift-reduce parser ------------------------------------------------- */
+
+static int sr_sp;
+static token_data *sr_stack;
+
+extern assembly_operand parse_expression(int context)
+{
+ /* Parses an expression, evaluating it as a constant if possible.
+
+ Possible contexts are:
+
+ VOID_CONTEXT the expression is used as a statement, so that
+ its value will be thrown away and it only
+ needs to exist for any resulting side-effects
+ (function calls and assignments)
+
+ CONDITION_CONTEXT the result must be a condition
+
+ CONSTANT_CONTEXT there is required to be a constant result
+ (so that, for instance, comma becomes illegal)
+
+ QUANTITY_CONTEXT the default: a quantity is to be specified
+
+ ACTION_Q_CONTEXT like QUANTITY_CONTEXT, but postfixed brackets
+ at the top level do not indicate function call:
+ used for e.g.
+ <Insert button (random(pocket1, pocket2))>
+
+ RETURN_Q_CONTEXT like QUANTITY_CONTEXT, but a single property
+ name does not generate a warning
+
+ ASSEMBLY_CONTEXT a quantity which cannot use the '->' operator
+ (needed for assembly language to indicate
+ store destinations)
+
+ FORINIT_CONTEXT a quantity which cannot use an (unbracketed)
+ '::' operator
+
+ ARRAY_CONTEXT like CONSTANT_CONTEXT, but where an unbracketed
+ minus sign is ambiguous, and brackets always
+ indicate subexpressions, not function calls
+
+ Return value: an assembly operand.
+
+ If the type is OMITTED_OT, then the expression has no resulting value.
+
+ If the type is EXPRESSION_OT, then the value will need to be
+ calculated at run-time by code compiled from the expression tree
+ whose root node-number is the operand value.
+
+ Otherwise the assembly operand is the value of the expression, which
+ is constant and thus known at compile time.
+
+ If an error has occurred in the expression, which recovery from was
+ not possible, then the return is (short constant) 0. This should
+ minimise the chance of a cascade of further error messages.
+ */
+
+ token_data a, b, pop; int i;
+ assembly_operand AO;
+
+ superclass_allowed = (context != FORINIT_CONTEXT);
+ if (context == FORINIT_CONTEXT) context = VOID_CONTEXT;
+
+ comma_allowed = (context == VOID_CONTEXT);
+ arrow_allowed = (context != ASSEMBLY_CONTEXT);
+ bare_prop_allowed = (context == RETURN_Q_CONTEXT);
+ array_init_ambiguity = ((context == ARRAY_CONTEXT) ||
+ (context == ASSEMBLY_CONTEXT));
+
+ action_ambiguity = (context == ACTION_Q_CONTEXT);
+
+ if (context == ASSEMBLY_CONTEXT) context = QUANTITY_CONTEXT;
+ if (context == ACTION_Q_CONTEXT) context = QUANTITY_CONTEXT;
+ if (context == RETURN_Q_CONTEXT) context = QUANTITY_CONTEXT;
+ if (context == ARRAY_CONTEXT) context = CONSTANT_CONTEXT;
+
+ etoken_count = 0;
+ inserting_token = FALSE;
+
+ emitter_sp = 0;
+ bracket_level = 0;
+
+ previous_token.text = "$";
+ previous_token.type = ENDEXP_TT;
+ previous_token.value = 0;
+
+ sr_sp = 1;
+ sr_stack[0] = previous_token;
+
+ AO = zero_operand;
+
+ statements.enabled = FALSE;
+ directives.enabled = FALSE;
+
+ if (get_next_etoken() == FALSE)
+ { ebf_error("expression", token_text);
+ return AO;
+ }
+
+ do
+ { if (expr_trace_level >= 2)
+ { printf("Input: %-20s", current_token.text);
+ for (i=0; i<sr_sp; i++) printf("%s ", sr_stack[i].text);
+ printf("\n");
+ }
+ if (expr_trace_level >= 3) printf("ET_used = %d\n", ET_used);
+
+ if (sr_sp == 0)
+ { compiler_error("SR error: stack empty");
+ return(AO);
+ }
+
+ a = sr_stack[sr_sp-1]; b = current_token;
+
+ if ((a.type == ENDEXP_TT) && (b.type == ENDEXP_TT))
+ { if (emitter_sp == 0)
+ { error("No expression between brackets '(' and ')'");
+ put_token_back();
+ return AO;
+ }
+ if (emitter_sp > 1)
+ { compiler_error("SR error: emitter stack overfull");
+ return AO;
+ }
+
+ AO = emitter_stack[0];
+ if (AO.type == EXPRESSION_OT)
+ { if (expr_trace_level >= 3)
+ { printf("Tree before lvalue checking:\n");
+ show_tree(AO, FALSE);
+ }
+ if (!glulx_mode)
+ check_property_operator(AO.value);
+ check_lvalues(AO.value);
+ ET[AO.value].up = -1;
+ }
+ else {
+ if ((context != CONSTANT_CONTEXT) && is_property_t(AO.symtype)
+ && (arrow_allowed) && (!bare_prop_allowed))
+ warning("Bare property name found. \"self.prop\" intended?");
+ }
+
+ check_conditions(AO, context);
+
+ if (context == CONSTANT_CONTEXT)
+ if (!is_constant_ot(AO.type))
+ { AO = zero_operand;
+ ebf_error("constant", "<expression>");
+ }
+ put_token_back();
+
+ return(AO);
+ }
+
+ switch(find_prec(a,b))
+ {
+ case e5: /* Associativity error */
+ error_named("Brackets mandatory to clarify order of:",
+ a.text);
+
+ case LOWER_P:
+ case EQUAL_P:
+ if (sr_sp == MAX_EXPRESSION_NODES)
+ memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
+ sr_stack[sr_sp++] = b;
+ switch(b.type)
+ {
+ case SUBOPEN_TT:
+ if (sr_sp >= 2 && sr_stack[sr_sp-2].type == OP_TT && sr_stack[sr_sp-2].value == FCALL_OP)
+ mark_top_of_emitter_stack(FUNCTION_VALUE_MARKER, b);
+ else
+ add_bracket_layer_to_emitter_stack(0);
+ break;
+ case OP_TT:
+ switch(b.value){
+ case OR_OP:
+ if (sr_stack[sr_sp-2].type == OP_TT &&
+ operators[sr_stack[sr_sp-2].value].precedence == 3)
+ mark_top_of_emitter_stack(OR_VALUE_MARKER, b);
+ else
+ { error("'or' not between values to the right of a condition");
+ /* Convert to + for error recovery purposes */
+ sr_stack[sr_sp-1].value = PLUS_OP;
+ }
+ break;
+ case COMMA_OP:
+ {
+ /* A comma separates arguments only if the shallowest open bracket belongs to a function call. */
+ int shallowest_open_bracket_index = sr_sp - 2;
+ while (shallowest_open_bracket_index > 0 && sr_stack[shallowest_open_bracket_index].type != SUBOPEN_TT)
+ --shallowest_open_bracket_index;
+ if (shallowest_open_bracket_index > 0 &&
+ sr_stack[shallowest_open_bracket_index-1].type == OP_TT &&
+ sr_stack[shallowest_open_bracket_index-1].value == FCALL_OP)
+ { mark_top_of_emitter_stack(ARGUMENT_VALUE_MARKER, b);
+ break;
+ }
+ /* Non-argument-separating commas get treated like any other operator; we fall through to the default case. */
+ }
+ default:
+ {
+ /* Add a marker for the brackets implied by operator precedence */
+ int operands_on_left = (operators[b.value].usage == PRE_U) ? 0 : 1;
+ add_bracket_layer_to_emitter_stack(operands_on_left);
+ }
+ }
+ }
+ get_next_etoken();
+ break;
+ case GREATER_P:
+ do
+ { pop = sr_stack[sr_sp - 1];
+ emit_token(pop);
+ sr_sp--;
+ } while (find_prec(sr_stack[sr_sp-1], pop) != LOWER_P);
+ break;
+
+ case e1: /* Missing operand error */
+ error_named("Missing operand after", a.text);
+ put_token_back();
+ current_token.type = NUMBER_TT;
+ current_token.value = 0;
+ current_token.marker = 0;
+ current_token.text = "0";
+ break;
+
+ case e2: /* Unexpected close bracket */
+ error("Found '(' without matching ')'");
+ get_next_etoken();
+ break;
+
+ case e3: /* Missing operator error */
+ error("Missing operator: inserting '+'");
+ put_token_back();
+ current_token.type = OP_TT;
+ current_token.value = PLUS_OP;
+ current_token.marker = 0;
+ current_token.text = "+";
+ break;
+
+ case e4: /* Expression ends with an open bracket */
+ error("Found '(' without matching ')'");
+ sr_sp--;
+ break;
+
+ }
+ }
+ while (TRUE);
+}
+
+/* --- Test for simple ++ or -- usage: used to optimise "for" loop code ---- */
+
+extern int test_for_incdec(assembly_operand AO)
+{ int s = 0;
+ if (AO.type != EXPRESSION_OT) return 0;
+ if (ET[AO.value].down == -1) return 0;
+ switch(ET[AO.value].operator_number)
+ { case INC_OP: s = 1; break;
+ case POST_INC_OP: s = 1; break;
+ case DEC_OP: s = -1; break;
+ case POST_DEC_OP: s = -1; break;
+ }
+ if (s==0) return 0;
+ if (ET[ET[AO.value].down].down != -1) return 0;
+ if (!is_variable_ot(ET[ET[AO.value].down].value.type)) return 0;
+ return s*(ET[ET[AO.value].down].value.value);
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_expressp_vars(void)
+{ int i;
+ /* make_operands(); */
+ make_lexical_interface_tables();
+ for (i=0;i<32;i++) system_function_usage[i] = 0;
+}
+
+extern void expressp_begin_pass(void)
+{
+}
+
+extern void expressp_allocate_arrays(void)
+{ ET = my_calloc(sizeof(expression_tree_node), MAX_EXPRESSION_NODES,
+ "expression parse trees");
+ emitter_markers = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
+ "emitter markers");
+ emitter_bracket_counts = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
+ "emitter bracket layer counts");
+ emitter_stack = my_calloc(sizeof(assembly_operand), MAX_EXPRESSION_NODES,
+ "emitter stack");
+ sr_stack = my_calloc(sizeof(token_data), MAX_EXPRESSION_NODES,
+ "shift-reduce parser stack");
+}
+
+extern void expressp_free_arrays(void)
+{ my_free(&ET, "expression parse trees");
+ my_free(&emitter_markers, "emitter markers");
+ my_free(&emitter_bracket_counts, "emitter bracket layer counts");
+ my_free(&emitter_stack, "emitter stack");
+ my_free(&sr_stack, "shift-reduce parser stack");
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "files" : File handling for source code, the transcript file and the */
+/* debugging information file; file handling and splicing of */
+/* the output file. */
+/* */
+/* Note that filenaming conventions are left to the top-level */
+/* routines in "inform.c", since they are tied up with ICL */
+/* settings and are very host OS-dependent. */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+int total_files; /* Number of files so far, including
+ #include and #origsource files */
+int total_input_files; /* Number of source files so far
+ (excludes #origsource) */
+int current_input_file; /* Most recently-opened source file */
+static int current_origsource_file; /* Most recently-used #origsource */
+
+int32 total_chars_read; /* Characters read in (from all
+ source files put together) */
+
+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 int checksum_count; /* similarly */
+
+/* ------------------------------------------------------------------------- */
+/* Most of the information about source files is kept by "lexer.c"; this */
+/* level is only concerned with file names and handles. */
+/* ------------------------------------------------------------------------- */
+
+FileId *InputFiles=NULL; /* Ids for all the source files */
+static char *filename_storage, /* Translated filenames */
+ *filename_storage_p;
+static int filename_storage_left;
+
+/* ------------------------------------------------------------------------- */
+/* When emitting debug information, we won't have addresses of routines, */
+/* sequence points, Glulx objects (addresses of Z-machine objects aren't */
+/* needed), globals, arrays, or grammar lines. We only have their */
+/* offsets from base addresses, which won't be known until the end of */
+/* compilation. Since everything else in the relevant debug records is */
+/* known much earlier and is less convenient to store up, we emit the */
+/* debug records with a placeholder value and then backpatch these */
+/* placeholders. The following structs each store either an offset or a */
+/* symbol index and the point in the debug information file where the */
+/* corresponding address should be written once the base address is known. */
+/* ------------------------------------------------------------------------- */
+
+#define INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION 65536
+
+typedef struct value_and_backpatch_position_struct
+{ int32 value;
+ fpos_t backpatch_position;
+} value_and_backpatch_position;
+
+typedef struct debug_backpatch_accumulator_struct
+{ int32 number_of_values_to_backpatch;
+ int32 number_of_available_backpatches;
+ value_and_backpatch_position *values_and_backpatch_positions;
+ int32 (* backpatching_function)(int32);
+} debug_backpatch_accumulator;
+
+static debug_backpatch_accumulator object_backpatch_accumulator;
+static debug_backpatch_accumulator packed_code_backpatch_accumulator;
+static debug_backpatch_accumulator code_backpatch_accumulator;
+static debug_backpatch_accumulator global_backpatch_accumulator;
+static debug_backpatch_accumulator array_backpatch_accumulator;
+static debug_backpatch_accumulator grammar_backpatch_accumulator;
+
+/* ------------------------------------------------------------------------- */
+/* File handles and names for temporary files. */
+/* ------------------------------------------------------------------------- */
+
+FILE *Temp1_fp=NULL, *Temp2_fp=NULL, *Temp3_fp=NULL;
+char Temp1_Name[PATHLEN], Temp2_Name[PATHLEN], Temp3_Name[PATHLEN];
+
+/* ------------------------------------------------------------------------- */
+/* Opening and closing source code files */
+/* ------------------------------------------------------------------------- */
+
+#if defined(PC_WIN32) && defined(HAS_REALPATH)
+#include <windows.h>
+char *realpath(const char *path, char *resolved_path)
+{
+ return GetFullPathNameA(path,PATHLEN,resolved_path,NULL) != 0 ? resolved_path : 0;
+}
+#endif
+
+extern void load_sourcefile(char *filename_given, int same_directory_flag)
+{
+ /* Meaning: open a new file of Inform source. (The lexer picks up on
+ this by noticing that input_file has increased.) */
+
+ char name[PATHLEN];
+#ifdef HAS_REALPATH
+ char absolute_name[PATHLEN];
+#endif
+ int x = 0;
+ FILE *handle;
+
+ if (total_files == MAX_SOURCE_FILES)
+ memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
+
+ do
+ { x = translate_in_filename(x, name, filename_given, same_directory_flag,
+ (total_files==0)?1:0);
+ handle = fopen(name,"r");
+ } while ((handle == NULL) && (x != 0));
+
+ if (filename_storage_left <= (int)strlen(name))
+ memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
+
+ filename_storage_left -= strlen(name)+1;
+ strcpy(filename_storage_p, name);
+ InputFiles[total_files].filename = filename_storage_p;
+
+ filename_storage_p += strlen(name)+1;
+
+ if (debugfile_switch)
+ { debug_file_printf("<source index=\"%d\">", total_files);
+ debug_file_printf("<given-path>");
+ debug_file_print_with_entities(filename_given);
+ debug_file_printf("</given-path>");
+#ifdef HAS_REALPATH
+ if (realpath(name, absolute_name))
+ { debug_file_printf("<resolved-path>");
+ debug_file_print_with_entities(absolute_name);
+ debug_file_printf("</resolved-path>");
+ }
+#endif
+ debug_file_printf("<language>Inform 6</language>");
+ debug_file_printf("</source>");
+ }
+
+ InputFiles[total_files].handle = handle;
+ if (InputFiles[total_files].handle==NULL)
+ fatalerror_named("Couldn't open source file", name);
+
+ InputFiles[total_files].is_input = TRUE;
+
+ if (line_trace_level > 0) printf("\nOpening file \"%s\"\n",name);
+
+ total_files++;
+ total_input_files++;
+ current_input_file = total_files;
+}
+
+static void close_sourcefile(int file_number)
+{
+ if (InputFiles[file_number-1].handle == NULL) return;
+
+ /* Close this file. */
+
+ if (ferror(InputFiles[file_number-1].handle))
+ fatalerror_named("I/O failure: couldn't read from source file",
+ InputFiles[file_number-1].filename);
+
+ fclose(InputFiles[file_number-1].handle);
+
+ InputFiles[file_number-1].handle = NULL;
+
+ if (line_trace_level > 0) printf("\nClosing file\n");
+}
+
+extern void close_all_source(void)
+{ int i;
+ for (i=0; i<total_files; i++) close_sourcefile(i+1);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Register an #origsource filename. This goes in the InputFiles table, */
+/* but we do not open the file or advance current_input_file. */
+/* ------------------------------------------------------------------------- */
+
+extern int register_orig_sourcefile(char *filename)
+{
+ int ix;
+
+ /* If the filename has already been used as an origsource filename,
+ return that entry. We check the most-recently-used file first, and
+ then search the list. */
+ if (current_origsource_file > 0 && current_origsource_file <= total_files) {
+ if (!strcmp(filename, InputFiles[current_origsource_file-1].filename))
+ return current_origsource_file;
+ }
+
+ for (ix=0; ix<total_files; ix++) {
+ if (InputFiles[ix].is_input)
+ continue;
+ if (!strcmp(filename, InputFiles[ix].filename)) {
+ current_origsource_file = ix+1;
+ return current_origsource_file;
+ }
+ }
+
+ /* This filename has never been used before. Allocate a new InputFiles
+ entry. */
+
+ char *name = filename; /* no translation */
+
+ if (total_files == MAX_SOURCE_FILES)
+ memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
+
+ if (filename_storage_left <= (int)strlen(name))
+ memoryerror("MAX_SOURCE_FILES", MAX_SOURCE_FILES);
+
+ filename_storage_left -= strlen(name)+1;
+ strcpy(filename_storage_p, name);
+ InputFiles[total_files].filename = filename_storage_p;
+
+ filename_storage_p += strlen(name)+1;
+
+ if (debugfile_switch)
+ { debug_file_printf("<source index=\"%d\">", total_files);
+ debug_file_printf("<given-path>");
+ debug_file_print_with_entities(filename);
+ debug_file_printf("</given-path>");
+ debug_file_printf("<language>Inform 7</language>");
+ debug_file_printf("</source>");
+ }
+
+ InputFiles[total_files].handle = NULL;
+ InputFiles[total_files].is_input = FALSE;
+
+ total_files++;
+ current_origsource_file = total_files;
+ return current_origsource_file;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Feeding source code up into the lexical analyser's buffer */
+/* (see "lexer.c" for its specification) */
+/* ------------------------------------------------------------------------- */
+
+extern int file_load_chars(int file_number, char *buffer, int length)
+{
+ int read_in; FILE *handle;
+
+ if (file_number-1 > total_files)
+ { buffer[0] = 0; return 1; }
+
+ handle = InputFiles[file_number-1].handle;
+ if (handle == NULL)
+ { buffer[0] = 0; return 1; }
+
+ read_in = fread(buffer, 1, length, handle);
+ total_chars_read += read_in;
+
+ if (read_in == length) return length;
+
+ close_sourcefile(file_number);
+
+ if (file_number == 1)
+ { buffer[read_in] = 0;
+ buffer[read_in+1] = 0;
+ buffer[read_in+2] = 0;
+ buffer[read_in+3] = 0;
+ }
+ else
+ { buffer[read_in] = '\n';
+ buffer[read_in+1] = ' ';
+ buffer[read_in+2] = ' ';
+ buffer[read_in+3] = ' ';
+ }
+
+ return(-(read_in+4));
+}
+
+/* ------------------------------------------------------------------------- */
+/* Final assembly and output of the story file/module. */
+/* ------------------------------------------------------------------------- */
+
+FILE *sf_handle;
+
+static void sf_put(int c)
+{
+ if (!glulx_mode) {
+
+ /* The checksum is the unsigned sum mod 65536 of the bytes in the
+ story file from 0x0040 (first byte after header) to the end.
+
+ The link data does not contribute to the checksum of a module. */
+
+ checksum_low_byte += c;
+ if (checksum_low_byte>=256)
+ { checksum_low_byte-=256;
+ if (++checksum_high_byte==256) checksum_high_byte=0;
+ }
+
+ }
+ else {
+
+ /* The checksum is the unsigned 32-bit sum of the entire story file,
+ considered as a list of 32-bit words, with the checksum field
+ being zero. */
+
+ switch (checksum_count) {
+ case 0:
+ checksum_long += (((int32)(c & 0xFF)) << 24);
+ break;
+ case 1:
+ checksum_long += (((int32)(c & 0xFF)) << 16);
+ break;
+ case 2:
+ checksum_long += (((int32)(c & 0xFF)) << 8);
+ break;
+ case 3:
+ checksum_long += ((int32)(c & 0xFF));
+ break;
+ }
+
+ checksum_count = (checksum_count+1) & 3;
+
+ }
+
+ fputc(c, sf_handle);
+}
+
+/* Recursive procedure to generate the Glulx compression table. */
+
+static void output_compression(int entnum, int32 *size, int *count)
+{
+ huffentity_t *ent = &(huff_entities[entnum]);
+ int32 val;
+ char *cx;
+
+ sf_put(ent->type);
+ (*size)++;
+ (*count)++;
+
+ switch (ent->type) {
+ case 0:
+ val = Write_Strings_At + huff_entities[ent->u.branch[0]].addr;
+ sf_put((val >> 24) & 0xFF);
+ sf_put((val >> 16) & 0xFF);
+ sf_put((val >> 8) & 0xFF);
+ sf_put((val) & 0xFF);
+ (*size) += 4;
+ val = Write_Strings_At + huff_entities[ent->u.branch[1]].addr;
+ sf_put((val >> 24) & 0xFF);
+ sf_put((val >> 16) & 0xFF);
+ sf_put((val >> 8) & 0xFF);
+ sf_put((val) & 0xFF);
+ (*size) += 4;
+ output_compression(ent->u.branch[0], size, count);
+ output_compression(ent->u.branch[1], size, count);
+ break;
+ case 1:
+ /* no data */
+ break;
+ case 2:
+ sf_put(ent->u.ch);
+ (*size) += 1;
+ break;
+ case 3:
+ cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
+ while (*cx) {
+ sf_put(*cx);
+ cx++;
+ (*size) += 1;
+ }
+ sf_put('\0');
+ (*size) += 1;
+ break;
+ case 4:
+ val = unicode_usage_entries[ent->u.val].ch;
+ sf_put((val >> 24) & 0xFF);
+ sf_put((val >> 16) & 0xFF);
+ sf_put((val >> 8) & 0xFF);
+ sf_put((val) & 0xFF);
+ (*size) += 4;
+ break;
+ case 9:
+ val = abbreviations_offset + 4 + ent->u.val*4;
+ sf_put((val >> 24) & 0xFF);
+ sf_put((val >> 16) & 0xFF);
+ sf_put((val >> 8) & 0xFF);
+ sf_put((val) & 0xFF);
+ (*size) += 4;
+ break;
+ }
+}
+
+static void output_file_z(void)
+{ FILE *fin=NULL; char new_name[PATHLEN];
+ int32 length, blanks=0, size, i, j, offset;
+ uint32 code_length, size_before_code, next_cons_check;
+ int use_function;
+
+ ASSERT_ZCODE();
+
+ /* At this point, construct_storyfile() has just been called. */
+
+ /* Enter the length information into the header. */
+
+ length=((int32) Write_Strings_At) + static_strings_extent;
+ if (module_switch) length += link_data_size +
+ zcode_backpatch_size +
+ zmachine_backpatch_size;
+
+ while ((length%length_scale_factor)!=0) { length++; blanks++; }
+ length=length/length_scale_factor;
+ zmachine_paged_memory[26]=(length & 0xff00)/0x100;
+ zmachine_paged_memory[27]=(length & 0xff);
+
+ /* To assist interpreters running a paged virtual memory system, Inform
+ writes files which are padded with zeros to the next multiple of
+ 0.5K. This calculates the number of bytes of padding needed: */
+
+ while (((length_scale_factor*length)+blanks-1)%512 != 511) blanks++;
+
+ translate_out_filename(new_name, Code_Name);
+
+ sf_handle = fopen(new_name,"wb");
+ if (sf_handle == NULL)
+ fatalerror_named("Couldn't open output file", new_name);
+
+#ifdef MAC_MPW
+ /* Set the type and creator to Andrew Plotkin's MaxZip, a popular
+ Z-code interpreter on the Macintosh */
+
+ if (!module_switch) fsetfileinfo(new_name, 'mxZR', 'ZCOD');
+#endif
+
+ /* (1) Output the paged memory. */
+
+ for (i=0;i<64;i++)
+ fputc(zmachine_paged_memory[i], sf_handle);
+ size = 64;
+ checksum_low_byte = 0;
+ checksum_high_byte = 0;
+
+ for (i=64; i<Write_Code_At; i++)
+ { sf_put(zmachine_paged_memory[i]); size++;
+ }
+
+ /* (2) Output the compiled code area. */
+
+ if (temporary_files_switch)
+ { fclose(Temp2_fp);
+ Temp2_fp = NULL;
+ fin=fopen(Temp2_Name,"rb");
+ if (fin==NULL)
+ fatalerror("I/O failure: couldn't reopen temporary file 2");
+ }
+
+ if (!OMIT_UNUSED_ROUTINES) {
+ /* This is the old-fashioned case, which is easy. All of zcode_area
+ (zmachine_pc bytes) will be output. next_cons_check will be
+ ignored, because j will never reach it. */
+ code_length = zmachine_pc;
+ use_function = TRUE;
+ next_cons_check = code_length+1;
+ }
+ else {
+ /* With dead function stripping, life is more complicated.
+ j will run from 0 to zmachine_pc, but only code_length of
+ those should be output. next_cons_check is the location of
+ the next function break; that's where we check whether
+ we're in a live function or a dead one.
+ (This logic is simplified by the assumption that a backpatch
+ marker will never straddle a function break.) */
+ if (zmachine_pc != df_total_size_before_stripping)
+ compiler_error("Code size does not match (zmachine_pc and df_total_size).");
+ code_length = df_total_size_after_stripping;
+ use_function = TRUE;
+ next_cons_check = 0;
+ df_prepare_function_iterate();
+ }
+ size_before_code = size;
+
+ j=0;
+ if (!module_switch)
+ for (i=0; i<zcode_backpatch_size; i=i+3)
+ { int long_flag = TRUE;
+ offset
+ = 256*read_byte_from_memory_block(&zcode_backpatch_table, i+1)
+ + read_byte_from_memory_block(&zcode_backpatch_table, i+2);
+ backpatch_error_flag = FALSE;
+ backpatch_marker
+ = read_byte_from_memory_block(&zcode_backpatch_table, i);
+ if (backpatch_marker >= 0x80) long_flag = FALSE;
+ backpatch_marker &= 0x7f;
+ offset = offset + (backpatch_marker/32)*0x10000;
+ while (offset+0x30000 < j) {
+ offset += 0x40000;
+ long_flag = !long_flag;
+ }
+ backpatch_marker &= 0x1f;
+
+ /* All code up until the next backpatch marker gets flushed out
+ as-is. (Unless we're in a stripped-out function.) */
+ while (j<offset) {
+ if (!use_function) {
+ while (j<offset && j<next_cons_check) {
+ /* get dummy value */
+ ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ else {
+ while (j<offset && j<next_cons_check) {
+ size++;
+ sf_put((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ if (j == next_cons_check)
+ next_cons_check = df_next_function_iterate(&use_function);
+ }
+
+ if (long_flag)
+ { int32 v = (temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j);
+ v = 256*v + ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j+1));
+ j += 2;
+ if (use_function) {
+ v = backpatch_value(v);
+ sf_put(v/256); sf_put(v%256);
+ size += 2;
+ }
+ }
+ else
+ { int32 v = (temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j);
+ j++;
+ if (use_function) {
+ v = backpatch_value(v);
+ sf_put(v);
+ size++;
+ }
+ }
+
+ if (j > next_cons_check)
+ compiler_error("Backpatch appears to straddle function break");
+
+ if (backpatch_error_flag)
+ { printf("*** %s zcode offset=%08lx backpatch offset=%08lx ***\n",
+ (long_flag)?"long":"short", (long int) j, (long int) i);
+ }
+ }
+
+ /* Flush out the last bit of zcode_area, after the last backpatch
+ marker. */
+ offset = zmachine_pc;
+ while (j<offset) {
+ if (!use_function) {
+ while (j<offset && j<next_cons_check) {
+ /* get dummy value */
+ ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ else {
+ while (j<offset && j<next_cons_check) {
+ size++;
+ sf_put((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ if (j == next_cons_check)
+ next_cons_check = df_next_function_iterate(&use_function);
+ }
+
+ if (temporary_files_switch)
+ { if (ferror(fin))
+ fatalerror("I/O failure: couldn't read from temporary file 2");
+ fclose(fin);
+ fin = NULL;
+ }
+
+ if (size_before_code + code_length != size)
+ compiler_error("Code output length did not match");
+
+ /* (3) Output any null bytes (required to reach a packed address)
+ before the strings area. */
+
+ while (size<Write_Strings_At) { sf_put(0); size++; }
+
+ /* (4) Output the static strings area. */
+
+ if (temporary_files_switch)
+ { fclose(Temp1_fp);
+ Temp1_fp = NULL;
+ fin=fopen(Temp1_Name,"rb");
+ if (fin==NULL)
+ fatalerror("I/O failure: couldn't reopen temporary file 1");
+ for (i=0; i<static_strings_extent; i++) sf_put(fgetc(fin));
+ if (ferror(fin))
+ fatalerror("I/O failure: couldn't read from temporary file 1");
+ fclose(fin);
+ fin = NULL;
+ remove(Temp1_Name); remove(Temp2_Name);
+ }
+ else
+ for (i=0; i<static_strings_extent; i++) {
+ sf_put(read_byte_from_memory_block(&static_strings_area,i));
+ size++;
+ }
+
+ /* (5) Output the linking data table (in the case of a module). */
+
+ if (temporary_files_switch)
+ { if (module_switch)
+ { fclose(Temp3_fp);
+ Temp3_fp = NULL;
+ fin=fopen(Temp3_Name,"rb");
+ if (fin==NULL)
+ fatalerror("I/O failure: couldn't reopen temporary file 3");
+ for (j=0; j<link_data_size; j++) sf_put(fgetc(fin));
+ if (ferror(fin))
+ fatalerror("I/O failure: couldn't read from temporary file 3");
+ fclose(fin);
+ fin = NULL;
+ remove(Temp3_Name);
+ }
+ }
+ else
+ if (module_switch)
+ for (i=0; i<link_data_size; i++)
+ sf_put(read_byte_from_memory_block(&link_data_area,i));
+
+ if (module_switch)
+ { for (i=0; i<zcode_backpatch_size; i++)
+ sf_put(read_byte_from_memory_block(&zcode_backpatch_table, i));
+ for (i=0; i<zmachine_backpatch_size; i++)
+ sf_put(read_byte_from_memory_block(&zmachine_backpatch_table, i));
+ }
+
+ /* (6) Output null bytes to reach a multiple of 0.5K. */
+
+ while (blanks>0) { sf_put(0); blanks--; }
+
+ if (ferror(sf_handle))
+ fatalerror("I/O failure: couldn't write to story file");
+
+ fseek(sf_handle, 28, SEEK_SET);
+ fputc(checksum_high_byte, sf_handle);
+ fputc(checksum_low_byte, sf_handle);
+
+ if (ferror(sf_handle))
+ fatalerror("I/O failure: couldn't backtrack on story file for checksum");
+
+ fclose(sf_handle);
+
+ /* Write a copy of the header into the debugging information file
+ (mainly so that it can be used to identify which story file matches
+ with which debugging info file). */
+
+ if (debugfile_switch)
+ { debug_file_printf("<story-file-prefix>");
+ for (i = 0; i < 63; i += 3)
+ { if (i == 27)
+ { debug_file_print_base_64_triple
+ (zmachine_paged_memory[27],
+ checksum_high_byte,
+ checksum_low_byte);
+ } else
+ { debug_file_print_base_64_triple
+ (zmachine_paged_memory[i],
+ zmachine_paged_memory[i + 1],
+ zmachine_paged_memory[i + 2]);
+ }
+ }
+ debug_file_print_base_64_single(zmachine_paged_memory[63]);
+ debug_file_printf("</story-file-prefix>");
+ }
+
+#ifdef ARCHIMEDES
+ { char settype_command[PATHLEN];
+ sprintf(settype_command, "settype %s %s",
+ new_name, riscos_file_type());
+ system(settype_command);
+ }
+#endif
+#ifdef MAC_FACE
+ if (module_switch)
+ InformFiletypes (new_name, INF_MODULE_TYPE);
+ else
+ InformFiletypes (new_name, INF_ZCODE_TYPE);
+#endif
+}
+
+static void output_file_g(void)
+{ FILE *fin=NULL; 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;
+
+ ASSERT_GLULX();
+
+ /* At this point, construct_storyfile() has just been called. */
+
+ translate_out_filename(new_name, Code_Name);
+
+ sf_handle = fopen(new_name,"wb+");
+ if (sf_handle == NULL)
+ fatalerror_named("Couldn't open output file", new_name);
+
+#ifdef MAC_MPW
+ /* Set the type and creator to Andrew Plotkin's MaxZip, a popular
+ Z-code interpreter on the Macintosh */
+
+ if (!module_switch) fsetfileinfo(new_name, 'mxZR', 'ZCOD');
+#endif
+
+ checksum_long = 0;
+ checksum_count = 0;
+
+ /* Determine the version number. */
+
+ VersionNum = 0x00020000;
+
+ /* Increase for various features the game may have used. */
+ if (no_unicode_chars != 0 || (uses_unicode_features)) {
+ VersionNum = 0x00030000;
+ }
+ if (uses_memheap_features) {
+ VersionNum = 0x00030100;
+ }
+ if (uses_acceleration_features) {
+ VersionNum = 0x00030101;
+ }
+ if (uses_float_features) {
+ VersionNum = 0x00030102;
+ }
+
+ /* 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);
+ }
+ else {
+ VersionNum = requested_glulx_version;
+ }
+ }
+
+ /* (1) Output the header. We use sf_put here, instead of fputc,
+ because the header is included in the checksum. */
+
+ /* Magic number */
+ sf_put('G');
+ sf_put('l');
+ sf_put('u');
+ sf_put('l');
+ /* Version number. */
+ sf_put((VersionNum >> 24));
+ sf_put((VersionNum >> 16));
+ sf_put((VersionNum >> 8));
+ sf_put((VersionNum));
+ /* RAMSTART */
+ sf_put((Write_RAM_At >> 24));
+ sf_put((Write_RAM_At >> 16));
+ sf_put((Write_RAM_At >> 8));
+ sf_put((Write_RAM_At));
+ /* EXTSTART, or game file size */
+ sf_put((Out_Size >> 24));
+ sf_put((Out_Size >> 16));
+ sf_put((Out_Size >> 8));
+ sf_put((Out_Size));
+ /* ENDMEM, which the game file size plus MEMORY_MAP_EXTENSION */
+ i = Out_Size + MEMORY_MAP_EXTENSION;
+ sf_put((i >> 24));
+ sf_put((i >> 16));
+ sf_put((i >> 8));
+ sf_put((i));
+ /* STACKSIZE */
+ sf_put((MAX_STACK_SIZE >> 24));
+ sf_put((MAX_STACK_SIZE >> 16));
+ sf_put((MAX_STACK_SIZE >> 8));
+ sf_put((MAX_STACK_SIZE));
+ /* Initial function to call. Inform sets things up so that this
+ is the start of the executable-code area. */
+ sf_put((Write_Code_At >> 24));
+ sf_put((Write_Code_At >> 16));
+ sf_put((Write_Code_At >> 8));
+ sf_put((Write_Code_At));
+ /* String-encoding table. */
+ sf_put((Write_Strings_At >> 24));
+ sf_put((Write_Strings_At >> 16));
+ sf_put((Write_Strings_At >> 8));
+ sf_put((Write_Strings_At));
+ /* Checksum -- zero for the moment. */
+ sf_put(0x00);
+ sf_put(0x00);
+ sf_put(0x00);
+ sf_put(0x00);
+
+ size = GLULX_HEADER_SIZE;
+
+ /* (1a) Output the eight-byte memory layout identifier. */
+
+ sf_put('I'); sf_put('n'); sf_put('f'); sf_put('o');
+ sf_put(0); sf_put(1); sf_put(0); sf_put(0);
+
+ /* (1b) Output the rest of the Inform-specific data. */
+
+ /* Inform version number */
+ sf_put('0' + ((RELEASE_NUMBER/100)%10));
+ sf_put('.');
+ sf_put('0' + ((RELEASE_NUMBER/10)%10));
+ sf_put('0' + RELEASE_NUMBER%10);
+ /* Glulx back-end version number */
+ sf_put('0' + ((GLULX_RELEASE_NUMBER/100)%10));
+ sf_put('.');
+ sf_put('0' + ((GLULX_RELEASE_NUMBER/10)%10));
+ sf_put('0' + GLULX_RELEASE_NUMBER%10);
+ /* Game release number */
+ sf_put((release_number>>8) & 0xFF);
+ sf_put(release_number & 0xFF);
+ /* Game serial number */
+ {
+ char serialnum[8];
+ write_serial_number(serialnum);
+ for (i=0; i<6; i++)
+ sf_put(serialnum[i]);
+ }
+ size += GLULX_STATIC_ROM_SIZE;
+
+ /* (2) Output the compiled code area. */
+
+ if (temporary_files_switch)
+ { fclose(Temp2_fp);
+ Temp2_fp = NULL;
+ fin=fopen(Temp2_Name,"rb");
+ if (fin==NULL)
+ fatalerror("I/O failure: couldn't reopen temporary file 2");
+ }
+
+ if (!OMIT_UNUSED_ROUTINES) {
+ /* This is the old-fashioned case, which is easy. All of zcode_area
+ (zmachine_pc bytes) will be output. next_cons_check will be
+ ignored, because j will never reach it. */
+ code_length = zmachine_pc;
+ use_function = TRUE;
+ next_cons_check = code_length+1;
+ }
+ else {
+ /* With dead function stripping, life is more complicated.
+ j will run from 0 to zmachine_pc, but only code_length of
+ those should be output. next_cons_check is the location of
+ the next function break; that's where we check whether
+ we're in a live function or a dead one.
+ (This logic is simplified by the assumption that a backpatch
+ marker will never straddle a function break.) */
+ if (zmachine_pc != df_total_size_before_stripping)
+ compiler_error("Code size does not match (zmachine_pc and df_total_size).");
+ code_length = df_total_size_after_stripping;
+ use_function = TRUE;
+ next_cons_check = 0;
+ df_prepare_function_iterate();
+ }
+ size_before_code = size;
+
+ j=0;
+ if (!module_switch)
+ for (i=0; i<zcode_backpatch_size; i=i+6) {
+ int data_len;
+ int32 v;
+ offset =
+ (read_byte_from_memory_block(&zcode_backpatch_table, i+2) << 24)
+ | (read_byte_from_memory_block(&zcode_backpatch_table, i+3) << 16)
+ | (read_byte_from_memory_block(&zcode_backpatch_table, i+4) << 8)
+ | (read_byte_from_memory_block(&zcode_backpatch_table, i+5));
+ backpatch_error_flag = FALSE;
+ backpatch_marker =
+ read_byte_from_memory_block(&zcode_backpatch_table, i);
+ data_len =
+ read_byte_from_memory_block(&zcode_backpatch_table, i+1);
+
+ /* All code up until the next backpatch marker gets flushed out
+ as-is. (Unless we're in a stripped-out function.) */
+ while (j<offset) {
+ if (!use_function) {
+ while (j<offset && j<next_cons_check) {
+ /* get dummy value */
+ ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ else {
+ while (j<offset && j<next_cons_check) {
+ size++;
+ sf_put((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ if (j == next_cons_check)
+ next_cons_check = df_next_function_iterate(&use_function);
+ }
+
+ /* Write out the converted value of the backpatch marker.
+ (Unless we're in a stripped-out function.) */
+ switch (data_len) {
+
+ case 4:
+ v = ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j+1));
+ v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j+2));
+ v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j+3));
+ j += 4;
+ if (!use_function)
+ break;
+ v = backpatch_value(v);
+ sf_put((v >> 24) & 0xFF);
+ sf_put((v >> 16) & 0xFF);
+ sf_put((v >> 8) & 0xFF);
+ sf_put((v) & 0xFF);
+ size += 4;
+ break;
+
+ case 2:
+ v = ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ v = (v << 8) | ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j+1));
+ j += 2;
+ if (!use_function)
+ break;
+ v = backpatch_value(v);
+ if (v >= 0x10000) {
+ printf("*** backpatch value does not fit ***\n");
+ backpatch_error_flag = TRUE;
+ }
+ sf_put((v >> 8) & 0xFF);
+ sf_put((v) & 0xFF);
+ size += 2;
+ break;
+
+ case 1:
+ v = ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j += 1;
+ if (!use_function)
+ break;
+ v = backpatch_value(v);
+ if (v >= 0x100) {
+ printf("*** backpatch value does not fit ***\n");
+ backpatch_error_flag = TRUE;
+ }
+ sf_put((v) & 0xFF);
+ size += 1;
+ break;
+
+ default:
+ printf("*** unknown backpatch data len = %d ***\n",
+ data_len);
+ backpatch_error_flag = TRUE;
+ }
+
+ if (j > next_cons_check)
+ compiler_error("Backpatch appears to straddle function break");
+
+ if (backpatch_error_flag) {
+ printf("*** %d bytes zcode offset=%08lx backpatch offset=%08lx ***\n",
+ data_len, (long int) j, (long int) i);
+ }
+ }
+
+ /* Flush out the last bit of zcode_area, after the last backpatch
+ marker. */
+ offset = zmachine_pc;
+ while (j<offset) {
+ if (!use_function) {
+ while (j<offset && j<next_cons_check) {
+ /* get dummy value */
+ ((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ else {
+ while (j<offset && j<next_cons_check) {
+ size++;
+ sf_put((temporary_files_switch)?fgetc(fin):
+ read_byte_from_memory_block(&zcode_area, j));
+ j++;
+ }
+ }
+ if (j == next_cons_check)
+ next_cons_check = df_next_function_iterate(&use_function);
+ }
+
+ if (temporary_files_switch)
+ { if (ferror(fin))
+ fatalerror("I/O failure: couldn't read from temporary file 2");
+ fclose(fin);
+ fin = NULL;
+ }
+
+ if (size_before_code + code_length != size)
+ compiler_error("Code output length did not match");
+
+ /* (4) Output the static strings area. */
+
+ if (temporary_files_switch) {
+ fseek(Temp1_fp, 0, SEEK_SET);
+ }
+ {
+ int32 ix, lx;
+ int ch, jx, curbyte, bx;
+ int depth, checkcount;
+ huffbitlist_t *bits;
+ int32 origsize;
+
+ origsize = size;
+
+ if (compression_switch) {
+
+ /* The 12-byte table header. */
+ lx = compression_table_size;
+ sf_put((lx >> 24) & 0xFF);
+ sf_put((lx >> 16) & 0xFF);
+ sf_put((lx >> 8) & 0xFF);
+ sf_put((lx) & 0xFF);
+ size += 4;
+ sf_put((no_huff_entities >> 24) & 0xFF);
+ sf_put((no_huff_entities >> 16) & 0xFF);
+ sf_put((no_huff_entities >> 8) & 0xFF);
+ sf_put((no_huff_entities) & 0xFF);
+ size += 4;
+ lx = Write_Strings_At + 12;
+ sf_put((lx >> 24) & 0xFF);
+ sf_put((lx >> 16) & 0xFF);
+ sf_put((lx >> 8) & 0xFF);
+ sf_put((lx) & 0xFF);
+ size += 4;
+
+ checkcount = 0;
+ output_compression(huff_entity_root, &size, &checkcount);
+ if (checkcount != no_huff_entities)
+ compiler_error("Compression table count mismatch.");
+ }
+
+ if (size - origsize != compression_table_size)
+ compiler_error("Compression table size mismatch.");
+
+ origsize = size;
+
+ for (lx=0, ix=0; lx<no_strings; lx++) {
+ int escapelen=0, escapetype=0;
+ int done=FALSE;
+ int32 escapeval=0;
+ if (compression_switch)
+ sf_put(0xE1); /* type byte -- compressed string */
+ else
+ sf_put(0xE0); /* type byte -- non-compressed string */
+ size++;
+ jx = 0;
+ curbyte = 0;
+ while (!done) {
+ if (temporary_files_switch)
+ ch = fgetc(Temp1_fp);
+ else
+ ch = read_byte_from_memory_block(&static_strings_area, ix);
+ ix++;
+ if (ix > static_strings_extent || ch < 0)
+ compiler_error("Read too much not-yet-compressed text.");
+
+ if (escapelen == -1) {
+ escapelen = 0;
+ if (ch == '@') {
+ ch = '@';
+ }
+ else if (ch == '0') {
+ ch = '\0';
+ }
+ else if (ch == 'A' || ch == 'D' || ch == 'U') {
+ escapelen = 4;
+ escapetype = ch;
+ escapeval = 0;
+ continue;
+ }
+ else {
+ compiler_error("Strange @ escape in processed text.");
+ }
+ }
+ else if (escapelen) {
+ escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
+ escapelen--;
+ if (escapelen == 0) {
+ if (escapetype == 'A') {
+ ch = huff_abbrev_start+escapeval;
+ }
+ else if (escapetype == 'D') {
+ ch = huff_dynam_start+escapeval;
+ }
+ else if (escapetype == 'U') {
+ ch = huff_unicode_start+escapeval;
+ }
+ else {
+ compiler_error("Strange @ escape in processed text.");
+ }
+ }
+ else
+ continue;
+ }
+ else {
+ if (ch == '@') {
+ escapelen = -1;
+ continue;
+ }
+ if (ch == 0) {
+ ch = 256;
+ done = TRUE;
+ }
+ }
+
+ if (compression_switch) {
+ bits = &(huff_entities[ch].bits);
+ depth = huff_entities[ch].depth;
+ for (bx=0; bx<depth; bx++) {
+ if (bits->b[bx / 8] & (1 << (bx % 8)))
+ curbyte |= (1 << jx);
+ jx++;
+ if (jx == 8) {
+ sf_put(curbyte);
+ size++;
+ curbyte = 0;
+ jx = 0;
+ }
+ }
+ }
+ else {
+ if (ch >= huff_dynam_start) {
+ sf_put(' '); sf_put(' '); sf_put(' ');
+ size += 3;
+ }
+ else if (ch >= huff_abbrev_start) {
+ /* nothing */
+ }
+ else {
+ /* 256, the string terminator, comes out as zero */
+ sf_put(ch & 0xFF);
+ size++;
+ }
+ }
+ }
+ if (compression_switch && jx) {
+ sf_put(curbyte);
+ size++;
+ }
+ }
+
+ if (size - origsize != compression_string_size)
+ compiler_error("Compression string size mismatch.");
+
+ }
+
+ /* (4.5) Output any null bytes (required to reach a GPAGESIZE address)
+ before RAMSTART. */
+
+ while (size % GPAGESIZE) { sf_put(0); size++; }
+
+ /* (5) Output RAM. */
+
+ for (i=0; i<RAM_Size; i++)
+ { sf_put(zmachine_paged_memory[i]); size++;
+ }
+
+ if (ferror(sf_handle))
+ fatalerror("I/O failure: couldn't write to story file");
+
+ fseek(sf_handle, 32, SEEK_SET);
+ fputc((checksum_long >> 24) & 0xFF, sf_handle);
+ fputc((checksum_long >> 16) & 0xFF, sf_handle);
+ fputc((checksum_long >> 8) & 0xFF, sf_handle);
+ fputc((checksum_long) & 0xFF, sf_handle);
+
+ if (ferror(sf_handle))
+ fatalerror("I/O failure: couldn't backtrack on story file for checksum");
+
+ /* Write a copy of the first 64 bytes into the debugging information file
+ (mainly so that it can be used to identify which story file matches with
+ which debugging info file). */
+
+ if (debugfile_switch)
+ { fseek(sf_handle, 0L, SEEK_SET);
+ debug_file_printf("<story-file-prefix>");
+ for (i = 0; i < 63; i += 3)
+ { first_byte_of_triple = fgetc(sf_handle);
+ second_byte_of_triple = fgetc(sf_handle);
+ third_byte_of_triple = fgetc(sf_handle);
+ debug_file_print_base_64_triple
+ (first_byte_of_triple,
+ second_byte_of_triple,
+ third_byte_of_triple);
+ }
+ debug_file_print_base_64_single(fgetc(sf_handle));
+ debug_file_printf("</story-file-prefix>");
+ }
+
+ fclose(sf_handle);
+
+#ifdef ARCHIMEDES
+ { char settype_command[PATHLEN];
+ sprintf(settype_command, "settype %s %s",
+ new_name, riscos_file_type());
+ system(settype_command);
+ }
+#endif
+#ifdef MAC_FACE
+ if (module_switch)
+ InformFiletypes (new_name, INF_MODULE_TYPE);
+ else
+ InformFiletypes (new_name, INF_ZCODE_TYPE);
+#endif
+}
+
+extern void output_file(void)
+{
+ if (!glulx_mode)
+ output_file_z();
+ else
+ output_file_g();
+}
+
+/* ------------------------------------------------------------------------- */
+/* Output the text transcript file (only called if there is to be one). */
+/* ------------------------------------------------------------------------- */
+
+FILE *transcript_file_handle; int transcript_open;
+
+extern void write_to_transcript_file(char *text)
+{ fputs(text, transcript_file_handle);
+ fputc('\n', transcript_file_handle);
+}
+
+extern void open_transcript_file(char *what_of)
+{ char topline_buffer[256];
+
+ transcript_file_handle = fopen(Transcript_Name,"w");
+ if (transcript_file_handle==NULL)
+ fatalerror_named("Couldn't open transcript file",
+ Transcript_Name);
+
+ transcript_open = TRUE;
+
+ sprintf(topline_buffer, "Transcript of the text of \"%s\"\n\
+[From %s]\n", what_of, banner_line);
+ write_to_transcript_file(topline_buffer);
+}
+
+extern void abort_transcript_file(void)
+{ if (transcript_switch && transcript_open)
+ fclose(transcript_file_handle);
+ transcript_open = FALSE;
+}
+
+extern void close_transcript_file(void)
+{ char botline_buffer[256];
+ char sn_buffer[7];
+
+ write_serial_number(sn_buffer);
+ sprintf(botline_buffer, "\n[End of transcript: release %d.%s]\n",
+ release_number, sn_buffer);
+ write_to_transcript_file(botline_buffer);
+
+ if (ferror(transcript_file_handle))
+ fatalerror("I/O failure: couldn't write to transcript file");
+ fclose(transcript_file_handle);
+ transcript_open = FALSE;
+
+#ifdef ARCHIMEDES
+ { char settype_command[PATHLEN];
+ sprintf(settype_command, "settype %s text",
+ Transcript_Name);
+ system(settype_command);
+ }
+#endif
+#ifdef MAC_FACE
+ InformFiletypes (Transcript_Name, INF_TEXT_TYPE);
+#endif
+}
+
+/* ------------------------------------------------------------------------- */
+/* Access to the debugging information file. */
+/* ------------------------------------------------------------------------- */
+
+static FILE *Debug_fp; /* Handle of debugging info file */
+
+static void open_debug_file(void)
+{ Debug_fp=fopen(Debugging_Name,"wb");
+ if (Debug_fp==NULL)
+ fatalerror_named("Couldn't open debugging information file",
+ Debugging_Name);
+}
+
+extern void nullify_debug_file_position(maybe_file_position *position) {
+ position->valid = 0;
+}
+
+static void close_debug_file(void)
+{ fclose(Debug_fp);
+#ifdef MAC_FACE
+ InformFiletypes (Debugging_Name, INF_DEBUG_TYPE);
+#endif
+}
+
+extern void begin_debug_file(void)
+{ open_debug_file();
+
+ debug_file_printf("<?xml version=\"1.0\" encoding=\"UTF-8\"?>");
+ debug_file_printf("<inform-story-file version=\"1.0\" ");
+ debug_file_printf("content-creator=\"Inform\" ");
+ debug_file_printf
+ ("content-creator-version=\"%d.%d%d\">",
+ (VNUMBER / 100) % 10,
+ (VNUMBER / 10) % 10,
+ VNUMBER % 10);
+}
+
+extern void debug_file_printf(const char*format, ...)
+{ va_list argument_pointer;
+ va_start(argument_pointer, format);
+ vfprintf(Debug_fp, format, argument_pointer);
+ va_end(argument_pointer);
+ if (ferror(Debug_fp))
+ { fatalerror("I/O failure: can't write to debugging information file");
+ }
+}
+
+extern void debug_file_print_with_entities(const char*string)
+{ int index = 0;
+ char character;
+ for (character = string[index]; character; character = string[++index])
+ { switch(character)
+ { case '"':
+ debug_file_printf(""");
+ break;
+ case '&':
+ debug_file_printf("&");
+ break;
+ case '\'':
+ debug_file_printf("'");
+ break;
+ case '<':
+ debug_file_printf("<");
+ break;
+ case '>':
+ debug_file_printf(">");
+ break;
+ default:
+ debug_file_printf("%c", character);
+ break;
+ }
+ }
+}
+
+static char base_64_digits[] =
+ { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd',
+ 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
+ 't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', '+', '/' };
+
+extern void debug_file_print_base_64_triple
+ (uchar first, uchar second, uchar third)
+{ debug_file_printf
+ ("%c%c%c%c",
+ base_64_digits[first >> 2],
+ base_64_digits[((first & 3) << 4) | (second >> 4)],
+ base_64_digits[((second & 15) << 2) | (third >> 6)],
+ base_64_digits[third & 63]);
+}
+
+extern void debug_file_print_base_64_pair(uchar first, uchar second)
+{ debug_file_printf
+ ("%c%c%c=",
+ base_64_digits[first >> 2],
+ base_64_digits[((first & 3) << 4) | (second >> 4)],
+ base_64_digits[(second & 15) << 2]);
+}
+
+extern void debug_file_print_base_64_single(uchar first)
+{ debug_file_printf
+ ("%c%c==",
+ base_64_digits[first >> 2],
+ base_64_digits[(first & 3) << 4]);
+}
+
+static void write_debug_location_internals(debug_location location)
+{ debug_file_printf("<file-index>%d</file-index>", location.file_index - 1);
+ debug_file_printf
+ ("<file-position>%d</file-position>", location.beginning_byte_index);
+ debug_file_printf
+ ("<line>%d</line>", location.beginning_line_number);
+ debug_file_printf
+ ("<character>%d</character>", location.beginning_character_number);
+ if (location.beginning_byte_index != location.end_byte_index ||
+ location.beginning_line_number != location.end_line_number ||
+ location.beginning_character_number != location.end_character_number)
+ { debug_file_printf
+ ("<end-file-position>%d</end-file-position>",
+ location.end_byte_index);
+ debug_file_printf
+ ("<end-line>%d</end-line>", location.end_line_number);
+ debug_file_printf
+ ("<end-character>%d</end-character>",
+ location.end_character_number);
+ }
+}
+
+static void write_debug_location_origsource_internals(debug_location location)
+{ debug_file_printf
+ ("<file-index>%d</file-index>", location.orig_file_index - 1);
+ if (location.orig_beg_line_number)
+ debug_file_printf
+ ("<line>%d</line>", location.orig_beg_line_number);
+ if (location.orig_beg_char_number)
+ debug_file_printf
+ ("<character>%d</character>", location.orig_beg_char_number);
+}
+
+extern void write_debug_location(debug_location location)
+{ if (location.file_index && location.file_index != 255)
+ { debug_file_printf("<source-code-location>");
+ write_debug_location_internals(location);
+ debug_file_printf("</source-code-location>");
+ }
+ if (location.orig_file_index)
+ { debug_file_printf("<source-code-location>");
+ write_debug_location_origsource_internals(location);
+ debug_file_printf("</source-code-location>");
+ }
+}
+
+extern void write_debug_locations(debug_locations locations)
+{ if (locations.next)
+ { const debug_locations*current = &locations;
+ unsigned int index = 0;
+ for (; current; current = current->next, ++index)
+ { debug_file_printf("<source-code-location index=\"%d\">", index);
+ write_debug_location_internals(current->location);
+ debug_file_printf("</source-code-location>");
+ }
+ if (locations.location.orig_file_index)
+ { debug_file_printf("<source-code-location>");
+ write_debug_location_origsource_internals(locations.location);
+ debug_file_printf("</source-code-location>");
+ }
+ }
+ else
+ { write_debug_location(locations.location);
+ }
+}
+
+extern void write_debug_optional_identifier(int32 symbol_index)
+{ if (stypes[symbol_index] != ROUTINE_T)
+ { compiler_error
+ ("Attempt to write a replaceable identifier for a non-routine");
+ }
+ if (replacement_debug_backpatch_positions[symbol_index].valid)
+ { if (fsetpos
+ (Debug_fp,
+ &replacement_debug_backpatch_positions[symbol_index].position))
+ { fatalerror("I/O failure: can't seek in debugging information file");
+ }
+ debug_file_printf
+ ("<identifier artificial=\"true\">%s "
+ "(superseded replacement)</identifier>",
+ symbs[symbol_index]);
+ if (fseek(Debug_fp, 0L, SEEK_END))
+ { fatalerror("I/O failure: can't seek in debugging information file");
+ }
+ }
+ fgetpos
+ (Debug_fp, &replacement_debug_backpatch_positions[symbol_index].position);
+ replacement_debug_backpatch_positions[symbol_index].valid = TRUE;
+ debug_file_printf("<identifier>%s</identifier>", symbs[symbol_index]);
+ /* Space for: artificial="true" (superseded replacement) */
+ debug_file_printf(" ");
+}
+
+extern void write_debug_symbol_backpatch(int32 symbol_index)
+{ if (symbol_debug_backpatch_positions[symbol_index].valid) {
+ compiler_error("Symbol entry incorrectly reused in debug information "
+ "file backpatching");
+ }
+ fgetpos(Debug_fp, &symbol_debug_backpatch_positions[symbol_index].position);
+ symbol_debug_backpatch_positions[symbol_index].valid = TRUE;
+ /* Reserve space for up to 10 digits plus a negative sign. */
+ debug_file_printf("*BACKPATCH*");
+}
+
+extern void write_debug_symbol_optional_backpatch(int32 symbol_index)
+{ if (symbol_debug_backpatch_positions[symbol_index].valid) {
+ compiler_error("Symbol entry incorrectly reused in debug information "
+ "file backpatching");
+ }
+ /* Reserve space for open and close value tags and up to 10 digits plus a
+ negative sign, but take the backpatch position just inside the element,
+ so that we'll be in the same case as above if the symbol is eventually
+ defined. */
+ debug_file_printf("<value>");
+ fgetpos(Debug_fp, &symbol_debug_backpatch_positions[symbol_index].position);
+ symbol_debug_backpatch_positions[symbol_index].valid = TRUE;
+ debug_file_printf("*BACKPATCH*</value>");
+}
+
+static void write_debug_backpatch
+ (debug_backpatch_accumulator *accumulator, int32 value)
+{ if (accumulator->number_of_values_to_backpatch ==
+ accumulator->number_of_available_backpatches)
+ { my_realloc(&accumulator->values_and_backpatch_positions,
+ sizeof(value_and_backpatch_position) *
+ accumulator->number_of_available_backpatches,
+ 2 * sizeof(value_and_backpatch_position) *
+ accumulator->number_of_available_backpatches,
+ "values and debug information backpatch positions");
+ accumulator->number_of_available_backpatches *= 2;
+ }
+ accumulator->values_and_backpatch_positions
+ [accumulator->number_of_values_to_backpatch].value = value;
+ fgetpos
+ (Debug_fp,
+ &accumulator->values_and_backpatch_positions
+ [accumulator->number_of_values_to_backpatch].backpatch_position);
+ ++(accumulator->number_of_values_to_backpatch);
+ /* Reserve space for up to 10 digits plus a negative sign. */
+ debug_file_printf("*BACKPATCH*");
+}
+
+extern void write_debug_object_backpatch(int32 object_number)
+{ if (glulx_mode)
+ { write_debug_backpatch(&object_backpatch_accumulator, object_number - 1);
+ }
+ else
+ { debug_file_printf("%d", object_number);
+ }
+}
+
+static int32 backpatch_object_address(int32 index)
+{ return object_tree_offset + OBJECT_BYTE_LENGTH * index;
+}
+
+extern void write_debug_packed_code_backpatch(int32 offset)
+{ write_debug_backpatch(&packed_code_backpatch_accumulator, offset);
+}
+
+static int32 backpatch_packed_code_address(int32 offset)
+{
+ if (OMIT_UNUSED_ROUTINES) {
+ int stripped;
+ offset = df_stripped_offset_for_code_offset(offset, &stripped);
+ if (stripped)
+ return 0;
+ }
+ return (code_offset + offset) / scale_factor;
+}
+
+extern void write_debug_code_backpatch(int32 offset)
+{ write_debug_backpatch(&code_backpatch_accumulator, offset);
+}
+
+static int32 backpatch_code_address(int32 offset)
+{
+ if (OMIT_UNUSED_ROUTINES) {
+ int stripped;
+ offset = df_stripped_offset_for_code_offset(offset, &stripped);
+ if (stripped)
+ return 0;
+ }
+ return code_offset + offset;
+}
+
+extern void write_debug_global_backpatch(int32 offset)
+{ write_debug_backpatch(&global_backpatch_accumulator, offset);
+}
+
+static int32 backpatch_global_address(int32 offset)
+{ return variables_offset + WORDSIZE * (offset - MAX_LOCAL_VARIABLES);
+}
+
+extern void write_debug_array_backpatch(int32 offset)
+{ write_debug_backpatch(&array_backpatch_accumulator, offset);
+}
+
+static int32 backpatch_array_address(int32 offset)
+{ return (glulx_mode ? arrays_offset : variables_offset) + offset;
+}
+
+extern void write_debug_grammar_backpatch(int32 offset)
+{ write_debug_backpatch(&grammar_backpatch_accumulator, offset);
+}
+
+static int32 backpatch_grammar_address(int32 offset)
+{ return grammar_table_offset + offset;
+}
+
+extern void begin_writing_debug_sections()
+{ debug_file_printf("<story-file-section>");
+ debug_file_printf("<type>header</type>");
+ debug_file_printf("<address>0</address>");
+}
+
+extern void write_debug_section(const char*name, int32 beginning_address)
+{ debug_file_printf("<end-address>%d</end-address>", beginning_address);
+ debug_file_printf("</story-file-section>");
+ debug_file_printf("<story-file-section>");
+ debug_file_printf("<type>");
+ debug_file_print_with_entities(name);
+ debug_file_printf("</type>");
+ debug_file_printf("<address>%d</address>", beginning_address);
+}
+
+extern void end_writing_debug_sections(int32 end_address)
+{ debug_file_printf("<end-address>%d</end-address>", end_address);
+ debug_file_printf("</story-file-section>");
+}
+
+extern void write_debug_undef(int32 symbol_index)
+{ if (!symbol_debug_backpatch_positions[symbol_index].valid)
+ { compiler_error
+ ("Attempt to erase debugging information never written or since "
+ "erased");
+ }
+ if (stypes[symbol_index] != CONSTANT_T)
+ { compiler_error
+ ("Attempt to erase debugging information for a non-constant "
+ "because of an #undef");
+ }
+ if (fsetpos
+ (Debug_fp, &symbol_debug_backpatch_positions[symbol_index].position))
+ { fatalerror("I/O failure: can't seek in debugging information file");
+ }
+ /* There are 7 characters in ``<value>''. */
+ if (fseek(Debug_fp, -7L, SEEK_CUR))
+ { fatalerror("I/O failure: can't seek in debugging information file");
+ }
+ /* Overwrite: <value>*BACKPATCH*</value> */
+ debug_file_printf(" ");
+ nullify_debug_file_position
+ (&symbol_debug_backpatch_positions[symbol_index]);
+ if (fseek(Debug_fp, 0L, SEEK_END))
+ { fatalerror("I/O failure: can't seek in debugging information file");
+ }
+}
+
+static void apply_debug_information_backpatches
+ (debug_backpatch_accumulator *accumulator)
+{ int32 backpatch_index, backpatch_value;
+ for (backpatch_index = accumulator->number_of_values_to_backpatch;
+ backpatch_index--;)
+ { if (fsetpos
+ (Debug_fp,
+ &accumulator->values_and_backpatch_positions
+ [backpatch_index].backpatch_position))
+ { fatalerror
+ ("I/O failure: can't seek in debugging information file");
+ }
+ backpatch_value =
+ (*accumulator->backpatching_function)
+ (accumulator->values_and_backpatch_positions
+ [backpatch_index].value);
+ debug_file_printf
+ ("%11d", /* Space for up to 10 digits plus a negative sign. */
+ backpatch_value);
+ }
+}
+
+static void apply_debug_information_symbol_backpatches()
+{ int backpatch_symbol;
+ for (backpatch_symbol = no_symbols; backpatch_symbol--;)
+ { if (symbol_debug_backpatch_positions[backpatch_symbol].valid)
+ { if (fsetpos(Debug_fp,
+ &symbol_debug_backpatch_positions
+ [backpatch_symbol].position))
+ { fatalerror
+ ("I/O failure: can't seek in debugging information file");
+ }
+ debug_file_printf("%11d", svals[backpatch_symbol]);
+ }
+ }
+}
+
+static void write_debug_system_constants()
+{ int *system_constant_list =
+ glulx_mode ? glulx_system_constant_list : z_system_constant_list;
+ int system_constant_index = 0;
+
+ /* Store system constants. */
+ for (; system_constant_list[system_constant_index] != -1;
+ ++system_constant_index)
+ { int system_constant = system_constant_list[system_constant_index];
+ debug_file_printf("<constant>");
+ debug_file_printf
+ ("<identifier>#%s</identifier>",
+ system_constants.keywords[system_constant]);
+ debug_file_printf
+ ("<value>%d</value>",
+ value_of_system_constant(system_constant));
+ debug_file_printf("</constant>");
+ }
+}
+
+extern void end_debug_file()
+{ write_debug_system_constants();
+ debug_file_printf("</inform-story-file>\n");
+
+ if (glulx_mode)
+ { apply_debug_information_backpatches(&object_backpatch_accumulator);
+ } else
+ { apply_debug_information_backpatches(&packed_code_backpatch_accumulator);
+ }
+ apply_debug_information_backpatches(&code_backpatch_accumulator);
+ apply_debug_information_backpatches(&global_backpatch_accumulator);
+ apply_debug_information_backpatches(&array_backpatch_accumulator);
+ apply_debug_information_backpatches(&grammar_backpatch_accumulator);
+
+ apply_debug_information_symbol_backpatches();
+
+ close_debug_file();
+}
+
+/* ------------------------------------------------------------------------- */
+/* Temporary storage files: */
+/* */
+/* Temp file 1 is used to hold the static strings area, as compiled */
+/* 2 to hold compiled routines of Z-code */
+/* 3 to hold the link data table (but only for modules) */
+/* */
+/* (Though annoying, this procedure typically saves about 200K of memory, */
+/* an important point for Amiga and sub-386 PC users of Inform) */
+/* ------------------------------------------------------------------------- */
+
+extern void open_temporary_files(void)
+{ translate_temp_filename(1);
+ Temp1_fp=fopen(Temp1_Name,"wb");
+ if (Temp1_fp==NULL) fatalerror_named("Couldn't open temporary file 1",
+ Temp1_Name);
+ translate_temp_filename(2);
+ Temp2_fp=fopen(Temp2_Name,"wb");
+ if (Temp2_fp==NULL) fatalerror_named("Couldn't open temporary file 2",
+ Temp2_Name);
+
+ if (!module_switch) return;
+ translate_temp_filename(3);
+ Temp3_fp=fopen(Temp3_Name,"wb");
+ if (Temp3_fp==NULL) fatalerror_named("Couldn't open temporary file 3",
+ Temp3_Name);
+}
+
+extern void check_temp_files(void)
+{
+ if (ferror(Temp1_fp))
+ fatalerror("I/O failure: couldn't write to temporary file 1");
+ if (ferror(Temp2_fp))
+ fatalerror("I/O failure: couldn't write to temporary file 2");
+ if (module_switch && ferror(Temp3_fp))
+ fatalerror("I/O failure: couldn't write to temporary file 3");
+}
+
+extern void remove_temp_files(void)
+{ if (Temp1_fp != NULL) fclose(Temp1_fp);
+ Temp1_fp = NULL;
+ if (Temp2_fp != NULL) fclose(Temp2_fp);
+ Temp2_fp = NULL;
+ remove(Temp1_Name); remove(Temp2_Name);
+ if (module_switch)
+ { if (Temp3_fp != NULL) fclose(Temp3_fp);
+ Temp3_fp = NULL;
+ remove(Temp3_Name);
+ }
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_files_vars(void)
+{ malloced_bytes = 0;
+ checksum_low_byte = 0; /* Z-code */
+ checksum_high_byte = 0;
+ checksum_long = 0; /* Glulx */
+ checksum_count = 0;
+ transcript_open = FALSE;
+}
+
+extern void files_begin_prepass(void)
+{
+ total_files = 0;
+ total_input_files = 0;
+ current_input_file = 0;
+ current_origsource_file = 0;
+}
+
+extern void files_begin_pass(void)
+{ total_chars_read=0;
+ if (temporary_files_switch)
+ open_temporary_files();
+}
+
+static void initialise_accumulator
+ (debug_backpatch_accumulator *accumulator,
+ int32 (* backpatching_function)(int32))
+{ accumulator->number_of_values_to_backpatch = 0;
+ accumulator->number_of_available_backpatches =
+ INITIAL_DEBUG_INFORMATION_BACKPATCH_ALLOCATION;
+ accumulator->values_and_backpatch_positions =
+ my_malloc
+ (sizeof(value_and_backpatch_position) *
+ accumulator->number_of_available_backpatches,
+ "values and debug information backpatch positions");
+ accumulator->backpatching_function = backpatching_function;
+}
+
+extern void files_allocate_arrays(void)
+{ filename_storage = my_malloc(MAX_SOURCE_FILES*64, "filename storage");
+ filename_storage_p = filename_storage;
+ filename_storage_left = MAX_SOURCE_FILES*64;
+ InputFiles = my_malloc(MAX_SOURCE_FILES*sizeof(FileId),
+ "input file storage");
+ if (debugfile_switch)
+ { if (glulx_mode)
+ { initialise_accumulator
+ (&object_backpatch_accumulator, &backpatch_object_address);
+ } else
+ { initialise_accumulator
+ (&packed_code_backpatch_accumulator,
+ &backpatch_packed_code_address);
+ }
+ initialise_accumulator
+ (&code_backpatch_accumulator, &backpatch_code_address);
+ initialise_accumulator
+ (&global_backpatch_accumulator, &backpatch_global_address);
+ initialise_accumulator
+ (&array_backpatch_accumulator, &backpatch_array_address);
+ initialise_accumulator
+ (&grammar_backpatch_accumulator, &backpatch_grammar_address);
+ }
+}
+
+static void tear_down_accumulator(debug_backpatch_accumulator *accumulator)
+{ my_free
+ (&(accumulator->values_and_backpatch_positions),
+ "values and debug information backpatch positions");
+}
+
+extern void files_free_arrays(void)
+{ my_free(&filename_storage, "filename storage");
+ my_free(&InputFiles, "input file storage");
+ if (debugfile_switch)
+ { if (!glulx_mode)
+ { tear_down_accumulator(&object_backpatch_accumulator);
+ } else
+ { tear_down_accumulator(&packed_code_backpatch_accumulator);
+ }
+ tear_down_accumulator(&code_backpatch_accumulator);
+ tear_down_accumulator(&global_backpatch_accumulator);
+ tear_down_accumulator(&array_backpatch_accumulator);
+ tear_down_accumulator(&grammar_backpatch_accumulator);
+ }
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* Header file for Inform: Z-machine ("Infocom" format) compiler */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* *** To compile this program in one of the existing ports, you must */
+/* at least change the machine definition (on the next page). */
+/* In most cases no other work will be needed. *** */
+/* */
+/* Contents: */
+/* */
+/* Machine/host OS definitions (in alphabetical order) */
+/* Default definitions */
+/* Standard ANSI inclusions, macro definitions, structures */
+/* Definitions of internal code numbers */
+/* Extern declarations for linkage (in alphabetical order of file) */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#define RELEASE_DATE "28th June 2018"
+#define RELEASE_NUMBER 1634
+#define GLULX_RELEASE_NUMBER 38
+#define MODULE_VERSION_NUMBER 1
+#define VNUMBER RELEASE_NUMBER
+
+/* N indicates an intermediate release for Inform 7 */
+/*#define RELEASE_SUFFIX "N"*/
+
+/* ------------------------------------------------------------------------- */
+/* Our host machine or OS for today is... */
+/* */
+/* [ Inform should compile (possibly with warnings) and work safely */
+/* if you just: */
+/* */
+/* #define AMIGA - for the Commodore Amiga under SAS/C */
+/* #define ARCHIMEDES - for Acorn RISC OS machines under Norcroft C */
+/* #define ATARIST - for the Atari ST */
+/* #define BEOS - for the BeBox */
+/* #define LINUX - for Linux under gcc (essentially as Unix) */
+/* #define MACOS - for the Apple Mac with OS X (another Unix) */
+/* #define MAC_CLASSIC - for the Apple Mac under Think C or Codewarrior */
+/* #define MAC_MPW - for MPW under Codewarrior (and maybe Think C) */
+/* #define OS2 - for OS/2 32-bit mode under IBM's C Set++ */
+/* #define PC - for 386+ IBM PCs, eg. Microsoft Visual C/C++ */
+/* #define PC_QUICKC - for small IBM PCs under QuickC */
+/* #define PC_WIN32 - for Borland C++ or Microsoft Visual C++ */
+/* #define UNIX - for Unix under gcc (or big IBM PC under djgpp) */
+/* #define VMS - for VAX or ALPHA under DEC C, but not VAX C */
+/* */
+/* In most cases executables are already available at */
+/* http://www.ifarchive.org/, and these are sometimes enhanced with */
+/* e.g. windowed interfaces whose source is not archived with the */
+/* main Inform source.] */
+/* */
+/* (If no machine is defined, then cautious #defines will be made. In */
+/* most cases, porting to a new machine is a matter of carefully filling */
+/* out a block of definitions like those below.) */
+/* ------------------------------------------------------------------------- */
+
+/* #define UNIX */
+
+/* ------------------------------------------------------------------------- */
+/* The first task is to include the ANSI header files, and typedef */
+/* suitable 32-bit integer types. */
+/* ------------------------------------------------------------------------- */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <ctype.h>
+#include <string.h>
+#include <time.h>
+#include <limits.h>
+#include <math.h>
+
+#ifndef VAX
+#if SCHAR_MAX >= 0x7FFFFFFFL && SCHAR_MIN <= -0x7FFFFFFFL
+ typedef signed char int32;
+ typedef unsigned char uint32;
+#elif SHRT_MAX >= 0x7FFFFFFFL && SHRT_MIN <= -0x7FFFFFFFL
+ typedef signed short int int32;
+ typedef unsigned short int uint32;
+#elif INT_MAX >= 0x7FFFFFFFL && INT_MIN <= -0x7FFFFFFFL
+ typedef signed int int32;
+ typedef unsigned int uint32;
+#elif LONG_MAX >= 0x7FFFFFFFL && LONG_MIN <= -0x7FFFFFFFL
+ typedef signed long int int32;
+ typedef unsigned long int uint32;
+#else
+#error No type large enough to support 32-bit integers.
+#endif
+#else
+ /* VAX C does not provide these limit constants, contrary to ANSI */
+ typedef int int32;
+ typedef unsigned int uint32;
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* The next part of this file contains blocks of definitions, one for */
+/* each port, of machine or OS-dependent constants needed by Inform. */
+/* */
+/* 1. MACHINE_STRING should be set to the name of the machine or OS. */
+/* */
+/* 2. Some miscellaneous #define options (set if the constant is */
+/* defined, otherwise not set): */
+/* */
+/* USE_TEMPORARY_FILES - use scratch files for workspace, not memory, */
+/* by default */
+/* PROMPT_INPUT - prompt input (don't use Unix-style command line) */
+/* TIME_UNAVAILABLE - don't use ANSI time routines to work out today's */
+/* date */
+/* CHAR_IS_UNSIGNED - if on your compiler the type "char" is unsigned */
+/* by default, you should define this */
+/* HAS_REALPATH - the POSIX realpath() function is available to */
+/* find the absolute path to a file */
+/* */
+/* 3. An estimate of the typical amount of memory likely to be free */
+/* should be given in DEFAULT_MEMORY_SIZE. */
+/* For most modern machines, HUGE_SIZE is the appropriate setting, but */
+/* some older micros may benefit from SMALL_SIZE. */
+/* ------------------------------------------------------------------------- */
+
+#define LARGE_SIZE 1
+#define SMALL_SIZE 2
+#define HUGE_SIZE 3
+
+/* ------------------------------------------------------------------------- */
+/* 4. Filenaming definitions: */
+/* */
+/* It's assumed that the host OS has the concept of subdirectories and */
+/* has "pathnames", that is, filenames giving a chain of subdirectories */
+/* divided by the FN_SEP (filename separator) character: e.g. for Unix */
+/* FN_SEP is defined below as '/' and a typical name is */
+/* "users/graham/jigsaw.z5". */
+/* White space is not allowed in filenames, and nor is the special */
+/* character FN_ALT, which unless defined here will be a comma and will */
+/* be used to separate alternative locations in a path variable. */
+/* */
+/* If NO_FILE_EXTENSIONS is undefined then the OS allows "file extensions" */
+/* of 1 to 3 alphanumeric characters like ".txt" (for text files), ".z5" */
+/* (for game files), etc., to indicate the file's type (and, crucially, */
+/* regards the same filename but with different extensions -- e.g., */
+/* "frog.amp" and "frog.lil" -- as being different names). */
+/* (The file extensions defined below are widely accepted, so please use */
+/* them unless there's a good reason why not.) */
+/* */
+/* You should then define STANDARD_DIRECTORIES (you can define it anyway) */
+/* in which case Inform will expect by default that files are sorted out */
+/* by being put into suitable directories (e.g., a "games" directory for */
+/* story files). */
+/* */
+/* If it's convenient for your port you can alter the detailed definitions */
+/* which these broad settings make. Be careful if NO_FILE_EXTENSIONS */
+/* is set without STANDARD_DIRECTORIES, as then Inform may */
+/* overwrite its source with object code. */
+/* */
+/* 5. Filenames (or code related to filenames) for the three temporary */
+/* files. These only exist during compilation (and only if -F1 is set). */
+/* Temporary_Name is the body of a filename to use */
+/* (if you don't set this, it becomes "Inftemp") and Temporary_Directory */
+/* is the directory path for the files to go in (which can be altered on */
+/* the command line). On some multi-tasking OSs these filenames ought to */
+/* include a number uniquely identifying the process: to indicate this, */
+/* define INCLUDE_TASK_ID and provide some code... */
+/* */
+/* #define INCLUDE_TASK_ID */
+/* #ifdef INFORM_FILE */
+/* static int32 unique_task_id(void) */
+/* { ...some code returning your task ID... */
+/* } */
+/* #endif */
+/* */
+/* 6. Any other definitions specific to the OS or machine. */
+/* (In particular DEFAULT_ERROR_FORMAT is 0 on most machines and 1 on PCs; */
+/* it controls the style of error messages, which is important for some */
+/* error-throwback debugging tools.) */
+/* ------------------------------------------------------------------------- */
+
+/* ========================================================================= */
+/* The blocks now follow in alphabetical order. */
+/* ------------------------------------------------------------------------- */
+/* AMIGA block */
+/* ------------------------------------------------------------------------- */
+#ifdef AMIGA
+/* 1 */
+#define MACHINE_STRING "Amiga"
+/* 3 */
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+/* 5 */
+#define __USE_SYSBASE
+#include <proto/exec.h>
+#define INCLUDE_TASK_ID
+#define Temporary_Directory "T:"
+#ifdef MAIN_INFORM_FILE
+static int32 unique_task_id(void)
+{ return (int32)FindTask(NULL);
+}
+#endif
+#endif
+/* ------------------------------------------------------------------------- */
+/* ARCHIMEDES block: Acorn/RISC OS settings */
+/* ------------------------------------------------------------------------- */
+#ifdef ARCHIMEDES
+/* 1 */
+#define MACHINE_STRING "RISC OS"
+/* 2 */
+#define CHAR_IS_UNSIGNED
+/* 3 */
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+/* 4 */
+#define FN_SEP '.'
+#define STANDARD_DIRECTORIES
+#define NO_FILE_EXTENSIONS
+#define Source_Directory "inform"
+#define ICL_Directory "ICL"
+/* 5 */
+#define ENABLE_TEMPORARY_PATH
+#define Temporary_Directory "ram:"
+/* 6 */
+#define ARC_THROWBACK
+#endif
+/* ------------------------------------------------------------------------- */
+/* Atari ST block */
+/* ------------------------------------------------------------------------- */
+#ifdef ATARIST
+/* 1 */
+#define MACHINE_STRING "Atari ST"
+/* 3 */
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+/* 5 */
+#ifndef TOSFS
+#define Temporary_Directory "/tmp"
+#define INCLUDE_TASK_ID
+#ifdef MAIN_INFORM_FILE
+static int32 unique_task_id(void)
+{ return (int32)getpid();
+}
+#endif
+#endif
+#endif
+/* ------------------------------------------------------------------------- */
+/* BEOS block */
+/* ------------------------------------------------------------------------- */
+#ifdef BEOS
+/* 1 */
+#define MACHINE_STRING "BeOS"
+/* 3 */
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+#define FILE_EXTENSIONS
+/* 5 */
+#define Temporary_Directory "/tmp"
+#endif
+/* ------------------------------------------------------------------------- */
+/* LINUX block */
+/* ------------------------------------------------------------------------- */
+#ifdef LINUX
+/* 1 */
+#define MACHINE_STRING "Linux"
+/* 2 */
+#define HAS_REALPATH
+/* 3 */
+#define DEFAULT_MEMORY_SIZE HUGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+/* 5 */
+#define Temporary_Directory "/tmp"
+/* 6 */
+#define PATHLEN 8192
+#endif
+/* ------------------------------------------------------------------------- */
+/* Macintosh block */
+/* ------------------------------------------------------------------------- */
+#ifdef MAC_MPW
+#define MAC_CLASSIC
+#endif
+
+#ifdef MAC_CLASSIC
+/* 1 */
+#ifdef MAC_MPW
+#define MACHINE_STRING "Macintosh Programmer's Workshop"
+#else
+#define MACHINE_STRING "Macintosh"
+#endif
+/* 2 */
+#ifdef MAC_FACE
+#define EXTERNAL_SHELL
+#endif
+#ifndef MAC_FACE
+#ifndef MAC_MPW
+#define PROMPT_INPUT
+#endif
+#endif
+/* 3 */
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+/* 4 */
+#define FN_SEP ':'
+#ifdef MAC_MPW
+#define Include_Extension ".h"
+#endif
+/* 6 */
+#ifdef MAC_FACE
+#include "TB Inform.h"
+#endif
+#ifdef MAC_MPW
+#include <CursorCtl.h>
+#define DEFAULT_ERROR_FORMAT 2
+#endif
+#endif
+/* ------------------------------------------------------------------------- */
+/* OS/2 block */
+/* ------------------------------------------------------------------------- */
+#ifdef OS2
+/* 1 */
+#define MACHINE_STRING "OS/2"
+/* 2 */
+#define CHAR_IS_UNSIGNED
+/* 3 */
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+#endif
+/* ------------------------------------------------------------------------- */
+/* MACOS block */
+/* ------------------------------------------------------------------------- */
+#ifdef MACOS
+/* 1 */
+#define MACHINE_STRING "MacOS"
+/* 2 */
+#define HAS_REALPATH
+/* 3 */
+#define DEFAULT_MEMORY_SIZE HUGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+/* 5 */
+#define Temporary_Directory "/tmp"
+#define INCLUDE_TASK_ID
+#define _POSIX_C_SOURCE 199506L
+#define _XOPEN_SOURCE 500
+#ifdef MAIN_INFORM_FILE
+#include <sys/types.h>
+#include <unistd.h>
+static int32 unique_task_id(void)
+{ return (int32)getpid();
+}
+#endif
+/* 6 */
+#define PATHLEN 8192
+#endif
+/* ------------------------------------------------------------------------- */
+/* PC and PC_QUICKC block */
+/* ------------------------------------------------------------------------- */
+#ifdef PC_QUICKC
+#define PC
+#endif
+
+#ifdef PC
+/* 1 */
+#define MACHINE_STRING "PC"
+/* 2 */
+#define USE_TEMPORARY_FILES
+/* 3 */
+#ifdef PC_QUICKC
+#define DEFAULT_MEMORY_SIZE SMALL_SIZE
+#else
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+#endif
+/* 4 */
+#define FN_SEP '\\'
+/* 6 */
+#define DEFAULT_ERROR_FORMAT 1
+#endif
+/* ------------------------------------------------------------------------- */
+/* PC_WIN32 block */
+/* ------------------------------------------------------------------------- */
+#ifdef PC_WIN32
+/* 1 */
+#define MACHINE_STRING "Win32"
+/* 2 */
+#define HAS_REALPATH
+/* 3 */
+#define DEFAULT_MEMORY_SIZE HUGE_SIZE
+/* 4 */
+#define FN_SEP '\\'
+/* 6 */
+#define DEFAULT_ERROR_FORMAT 1
+#define PATHLEN 512
+#ifdef _MSC_VER /* Microsoft Visual C++ */
+#define snprintf _snprintf
+#define isnan _isnan
+#define isinf(x) (!_isnan(x) && !_finite(x))
+#endif
+#endif
+/* ------------------------------------------------------------------------- */
+/* UNIX block */
+/* ------------------------------------------------------------------------- */
+#ifdef UNIX
+/* 1 */
+#ifndef MACHINE_STRING
+#define MACHINE_STRING "Unix"
+#endif
+/* 2 */
+#define HAS_REALPATH
+/* 3 */
+#define DEFAULT_MEMORY_SIZE HUGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+/* 5 */
+#define PATHLEN 512
+#define Temporary_Directory "/tmp"
+#define INCLUDE_TASK_ID
+#ifdef MAIN_INFORM_FILE
+#include <unistd.h>
+static int32 unique_task_id(void)
+{ return (int32)getpid();
+}
+#endif
+#endif
+/* ------------------------------------------------------------------------- */
+/* VMS (Dec VAX and Alpha) block */
+/* ------------------------------------------------------------------------- */
+#ifdef __VMS
+#define VMS
+#endif
+
+#ifdef VMS
+/* 1 */
+#ifdef __ALPHA
+#define MACHINE_STRING "Alpha/VMS"
+#else
+#define MACHINE_STRING "VAX/VMS"
+#endif
+/* 2 */
+#define CHAR_IS_UNSIGNED
+/* 3 */
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+/* 4 */
+#define FN_SEP '/'
+#define Code_Extension ".zip"
+#define V4Code_Extension ".zip"
+#define V5Code_Extension ".zip"
+#define V6Code_Extension ".zip"
+#define V7Code_Extension ".zip"
+#define V8Code_Extension ".zip"
+#endif
+/* ========================================================================= */
+/* Default settings: */
+/* ------------------------------------------------------------------------- */
+
+#ifndef NO_FILE_EXTENSIONS
+#define FILE_EXTENSIONS
+#endif
+
+#ifndef Transcript_File
+#ifdef FILE_EXTENSIONS
+#define Transcript_File "gametext.txt"
+#else
+#define Transcript_File "gametext"
+#endif
+#endif
+#ifndef Debugging_File
+#ifdef FILE_EXTENSIONS
+#define Debugging_File "gameinfo.dbg"
+#else
+#define Debugging_File "gamedebug"
+#endif
+#endif
+
+#ifdef FILE_EXTENSIONS
+#ifndef Source_Extension
+#define Source_Extension ".inf"
+#endif
+#ifndef Include_Extension
+#define Include_Extension ".h"
+#endif
+#ifndef Code_Extension
+#define Code_Extension ".z3"
+#endif
+#ifndef V4Code_Extension
+#define V4Code_Extension ".z4"
+#endif
+#ifndef V5Code_Extension
+#define V5Code_Extension ".z5"
+#endif
+#ifndef V6Code_Extension
+#define V6Code_Extension ".z6"
+#endif
+#ifndef V7Code_Extension
+#define V7Code_Extension ".z7"
+#endif
+#ifndef V8Code_Extension
+#define V8Code_Extension ".z8"
+#endif
+#ifndef GlulxCode_Extension
+#define GlulxCode_Extension ".ulx"
+#endif
+#ifndef Module_Extension
+#define Module_Extension ".m5"
+#endif
+#ifndef ICL_Extension
+#define ICL_Extension ".icl"
+#endif
+
+#else
+
+#define Source_Extension ""
+#define Include_Extension ""
+#define Code_Extension ""
+#define V4Code_Extension ""
+#define V5Code_Extension ""
+#define V6Code_Extension ""
+#define V7Code_Extension ""
+#define V8Code_Extension ""
+#define GlulxCode_Extension ""
+#define Module_Extension ""
+#define ICL_Extension ""
+#endif
+
+#ifdef STANDARD_DIRECTORIES
+#ifndef Source_Directory
+#define Source_Directory "source"
+#endif
+#ifndef Include_Directory
+#define Include_Directory "library"
+#endif
+#ifndef Code_Directory
+#define Code_Directory "games"
+#endif
+#ifndef Module_Directory
+#define Module_Directory "modules"
+#endif
+#ifndef Temporary_Directory
+#define Temporary_Directory ""
+#endif
+#ifndef ICL_Directory
+#define ICL_Directory ""
+#endif
+
+#else
+
+#ifndef Source_Directory
+#define Source_Directory ""
+#endif
+#ifndef Include_Directory
+#define Include_Directory ""
+#endif
+#ifndef Code_Directory
+#define Code_Directory ""
+#endif
+#ifndef Module_Directory
+#define Module_Directory ""
+#endif
+#ifndef Temporary_Directory
+#define Temporary_Directory ""
+#endif
+#ifndef ICL_Directory
+#define ICL_Directory ""
+#endif
+#endif
+
+#ifndef FN_SEP
+#define FN_SEP '/'
+#endif
+
+#ifndef FN_ALT
+#define FN_ALT ','
+#endif
+
+#ifndef PATHLEN
+#define PATHLEN 128
+#endif
+
+#ifndef Temporary_File
+#define Temporary_File "Inftemp"
+#endif
+
+#ifndef DEFAULT_ERROR_FORMAT
+#define DEFAULT_ERROR_FORMAT 0
+#endif
+
+#ifndef DEFAULT_MEMORY_SIZE
+#define DEFAULT_MEMORY_SIZE LARGE_SIZE
+#endif
+
+#ifndef CHAR_IS_UNSIGNED
+ typedef unsigned char uchar;
+#else
+ typedef char uchar;
+#endif
+
+#if defined(__GNUC__) || defined(__clang__)
+#define NORETURN __attribute__((__noreturn__))
+#endif /* defined(__GNUC__) || defined(__clang__) */
+
+#ifndef NORETURN
+#define NORETURN
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* A macro (rather than constant) definition: */
+/* ------------------------------------------------------------------------- */
+
+#ifdef PC_QUICKC
+ void _huge * halloc(long, size_t);
+ void hfree(void *);
+#define subtract_pointers(p1,p2) (long)((char _huge *)p1-(char _huge *)p2)
+#else
+#define subtract_pointers(p1,p2) (((char *) p1)-((char *) p2))
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* SEEK_SET is a constant which should be defined in the ANSI header files */
+/* but which is not present in some implementations: it's used as a */
+/* parameter for "fseek", defined in "stdio". In pre-ANSI C, the value */
+/* 0 was used as a parameter instead, hence the definition below. */
+/* ------------------------------------------------------------------------- */
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* A large block of #define'd constant values follows. */
+/* ------------------------------------------------------------------------- */
+
+#define TRUE -1
+#define FALSE 0
+
+/* These checked the glulx_mode global during development, but are no
+ longer needed. */
+#define ASSERT_ZCODE() (0)
+#define ASSERT_GLULX() (0)
+
+
+#define ReadInt32(ptr) \
+ ( (((int32)(((uchar *)(ptr))[0])) << 24) \
+ | (((int32)(((uchar *)(ptr))[1])) << 16) \
+ | (((int32)(((uchar *)(ptr))[2])) << 8) \
+ | (((int32)(((uchar *)(ptr))[3])) ) )
+
+#define ReadInt16(ptr) \
+ ( (((int32)(((uchar *)(ptr))[0])) << 8) \
+ | (((int32)(((uchar *)(ptr))[1])) ) )
+
+#define WriteInt32(ptr, val) \
+ ((ptr)[0] = (uchar)(((int32)(val)) >> 24), \
+ (ptr)[1] = (uchar)(((int32)(val)) >> 16), \
+ (ptr)[2] = (uchar)(((int32)(val)) >> 8), \
+ (ptr)[3] = (uchar)(((int32)(val)) ) )
+
+#define WriteInt16(ptr, val) \
+ ((ptr)[0] = (uchar)(((int32)(val)) >> 8), \
+ (ptr)[1] = (uchar)(((int32)(val)) ) )
+
+/* ------------------------------------------------------------------------- */
+/* If your compiler doesn't recognise \t, and you use ASCII, you could */
+/* define T_C as (char) 9; failing that, it _must_ be defined as ' ' */
+/* (space) and is _not_ allowed to be 0 or any recognisable character. */
+/* ------------------------------------------------------------------------- */
+
+#define TAB_CHARACTER '\t'
+
+/* ------------------------------------------------------------------------- */
+/* Maxima. */
+/* ------------------------------------------------------------------------- */
+
+#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
+
+#define VENEER_CONSTRAINT_ON_CLASSES_Z 256
+#define VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_Z 128
+#define VENEER_CONSTRAINT_ON_CLASSES_G 32768
+#define VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_G 32768
+#define VENEER_CONSTRAINT_ON_CLASSES \
+ (glulx_mode ? VENEER_CONSTRAINT_ON_CLASSES_G \
+ : VENEER_CONSTRAINT_ON_CLASSES_Z)
+#define VENEER_CONSTRAINT_ON_IP_TABLE_SIZE \
+ (glulx_mode ? VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_G \
+ : VENEER_CONSTRAINT_ON_IP_TABLE_SIZE_Z)
+
+#define GLULX_HEADER_SIZE 36
+/* Number of bytes in the header. */
+#define GLULX_STATIC_ROM_SIZE 24
+/* Number of bytes in the Inform-specific block right after the header. */
+#define GPAGESIZE 256
+/* All Glulx memory boundaries must be multiples of GPAGESIZE. */
+
+/* ------------------------------------------------------------------------- */
+/* Structure definitions (there are a few others local to files) */
+/* ------------------------------------------------------------------------- */
+
+typedef struct assembly_operand_t
+{ int type;
+ int32 value;
+ int symtype; /* 6.30 */
+ int symflags; /* 6.30 */
+ int marker;
+} assembly_operand;
+
+#define INITAOTV(aop, typ, val) ((aop)->type=(typ), (aop)->value=(val), (aop)->marker=0, (aop)->symtype=0, (aop)->symflags=0)
+#define INITAOT(aop, typ) INITAOTV(aop, typ, 0)
+#define INITAO(aop) INITAOTV(aop, 0, 0)
+
+#define MAX_LINES_PER_VERB 32
+typedef struct verbt {
+ int lines;
+ int l[MAX_LINES_PER_VERB];
+} verbt;
+
+typedef struct prop {
+ uchar l, num;
+ assembly_operand ao[32];
+} prop;
+
+/* Only one of this object. */
+typedef struct fpropt {
+ uchar atts[6];
+ int l;
+ prop pp[64];
+} fpropt;
+
+typedef struct objecttz {
+ uchar atts[6];
+ int parent, next, child;
+ int propsize;
+} objecttz;
+
+typedef struct propg {
+ int num;
+ int continuation;
+ int flags;
+ int32 datastart;
+ int32 datalen;
+} propg;
+
+/* Only one of this object. */
+typedef struct fproptg {
+ uchar atts[MAX_NUM_ATTR_BYTES];
+ int numprops;
+ propg *props;
+ int propdatasize;
+ assembly_operand *propdata;
+ int32 finalpropaddr;
+} fproptg;
+
+typedef struct objecttg {
+ /* attributes are stored in a separate array */
+ int32 shortname;
+ int32 parent, next, child;
+ int32 propaddr;
+ int32 propsize;
+} objecttg;
+
+typedef struct maybe_file_position_S
+{ int valid;
+ fpos_t position;
+} maybe_file_position;
+
+typedef struct debug_location_s
+{ int32 file_index;
+ int32 beginning_byte_index;
+ int32 end_byte_index;
+ int32 beginning_line_number;
+ int32 end_line_number;
+ int32 beginning_character_number;
+ int32 end_character_number;
+ int32 orig_file_index;
+ int32 orig_beg_line_number;
+ int32 orig_beg_char_number;
+ /* We only track the beginning #origsource location, not the end. */
+} debug_location;
+
+typedef struct debug_locations_s
+{ debug_location location;
+ struct debug_locations_s *next;
+ 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;
+ int32 beginning_line_number;
+ int32 beginning_character_number;
+ int32 orig_file_index;
+ int32 orig_beg_line_number;
+ int32 orig_beg_char_number;
+} debug_location_beginning;
+
+typedef struct keyword_group_s
+{ char *keywords[120];
+ int change_token_type;
+ int enabled;
+ int case_sensitive;
+} keyword_group;
+
+typedef struct token_data_s
+{ char *text;
+ int32 value; /* ###-long */
+ int type;
+ int symtype; /* 6.30 */
+ int symflags; /* 6.30 */
+ int marker;
+ debug_location location;
+} token_data;
+
+typedef struct FileId_s /* Source code file identifier: */
+{ char *filename; /* The filename (after translation) */
+ FILE *handle; /* Handle of file (when open), or
+ NULL when closed */
+ int is_input; /* Is this a source file that we are
+ parsing? If not, this is an
+ origsource filename (and handle
+ is NULL). */
+} FileId;
+
+typedef struct ErrorPosition_s
+{ int file_number;
+ char *source;
+ int line_number;
+ int main_flag;
+ int orig_file;
+ char *orig_source;
+ int32 orig_line;
+ int32 orig_char;
+} ErrorPosition;
+
+/* A memory block can hold at most ALLOC_CHUNK_SIZE * 72: */
+
+extern int ALLOC_CHUNK_SIZE;
+
+typedef struct memory_block_s
+{ int chunks;
+ int extent_of_last;
+ uchar *chunk[72];
+ int write_pos;
+} memory_block;
+
+/* This serves for both Z-code and Glulx instructions. Glulx doesn't use
+ the text, store_variable_number, branch_label_number, or branch_flag
+ fields. */
+typedef struct assembly_instruction_t
+{ int internal_number;
+ int store_variable_number;
+ int32 branch_label_number;
+ int branch_flag;
+ char *text;
+ int operand_count;
+ assembly_operand operand[8];
+} assembly_instruction;
+
+typedef struct expression_tree_node_s
+{
+ /* Data used in tree construction */
+
+ int up, down, right;
+ int operator_number; /* Only meaningful for non-leaves */
+ assembly_operand value; /* Only meaningful for leaves */
+
+ /* Attributes synthesised during code generation */
+
+ int must_produce_value; /* e.g. FALSE in a void context */
+
+ int label_after; /* -1, or "put this label after code" */
+ int to_expression; /* TRUE if a condition used as numeric val */
+ int true_label; /* On condition "true", jump to this (or keep
+ going if -1) */
+ int false_label; /* Likewise if the condition is "false". */
+
+} expression_tree_node;
+
+typedef struct operator_s
+{ int precedence; /* Level 0 to 13 (13 is highest) */
+ int token_type; /* Lexical token type */
+ int token_value; /* Lexical token value */
+ int usage; /* Infix (IN_U), prefix or postfix */
+ int associativity; /* Left (L_A), right (R_A)
+ or 0 for "it is an error to
+ implicitly associate this" */
+ int requires_lvalue; /* TRUE if the first operand must
+ be an "lvalue" (the name of some
+ storage object, such as a variable
+ or an array entry) */
+ int opcode_number_z; /* Translation number (see below) */
+ int opcode_number_g; /* Translation number (see below) */
+ int side_effect; /* TRUE if evaluating the operator
+ has potential side-effects in
+ terms of changing the Z-machine */
+ int negation; /* 0 for an unconditional operator,
+ otherwise the negation operator */
+ char *description; /* Text describing the operator
+ for error messages and tracing */
+} operator;
+
+/* The translation number of an operator is as follows:
+
+ Z-code:
+ an internal opcode number if the operator can be translated
+ directly to a single Z-machine opcode;
+ 400+n if it can be translated to branch opcode n;
+ 800+n if to the negated form of branch opcode n;
+ (using n = 200, 201 for two conditions requiring special
+ translation)
+ -1 otherwise
+ Glulx:
+ an internal opcode number if the operator can be translated
+ directly to a single Glulx opcode;
+ FIRST_CC to LAST_CC if it is a condition;
+ -1 otherwise */
+
+/* ------------------------------------------------------------------------- */
+/* Assembly operand types. */
+/* ------------------------------------------------------------------------- */
+
+/* For Z-machine... */
+
+#define LONG_CONSTANT_OT 0 /* General constant */
+#define SHORT_CONSTANT_OT 1 /* Constant in range 0 to 255 */
+#define VARIABLE_OT 2 /* Variable (global, local or sp) */
+#define OMITTED_OT 3 /* Value used in type field to indicate
+ that no operand is supplied */
+#define EXPRESSION_OT 4 /* Meaning: to determine this value, run code
+ equivalent to the expression tree whose
+ root node-number is the value given */
+
+/* For Glulx... */
+
+/* #define OMITTED_OT 3 */ /* Same as above */
+/* #define EXPRESSION_OT 4 */ /* Same as above */
+#define CONSTANT_OT 5 /* Four-byte constant */
+#define HALFCONSTANT_OT 6 /* Two-byte constant */
+#define BYTECONSTANT_OT 7 /* One-byte constant */
+#define ZEROCONSTANT_OT 8 /* Constant zero (no bytes of data) */
+#define SYSFUN_OT 9 /* System function value */
+#define DEREFERENCE_OT 10 /* Value at this address */
+#define GLOBALVAR_OT 11 /* Global variable */
+#define LOCALVAR_OT 12 /* Local variable or sp */
+
+/* ------------------------------------------------------------------------- */
+/* Internal numbers representing assemble-able Z-opcodes */
+/* ------------------------------------------------------------------------- */
+
+#define je_zc 0
+#define jl_zc 1
+#define jg_zc 2
+#define dec_chk_zc 3
+#define inc_chk_zc 4
+#define jin_zc 5
+#define test_zc 6
+#define or_zc 7
+#define and_zc 8
+#define test_attr_zc 9
+#define set_attr_zc 10
+#define clear_attr_zc 11
+#define store_zc 12
+#define insert_obj_zc 13
+#define loadw_zc 14
+#define loadb_zc 15
+#define get_prop_zc 16
+#define get_prop_addr_zc 17
+#define get_next_prop_zc 18
+#define add_zc 19
+#define sub_zc 20
+#define mul_zc 21
+#define div_zc 22
+#define mod_zc 23
+#define call_zc 24
+#define storew_zc 25
+#define storeb_zc 26
+#define put_prop_zc 27
+#define sread_zc 28
+#define print_char_zc 29
+#define print_num_zc 30
+#define random_zc 31
+#define push_zc 32
+#define pull_zc 33
+#define split_window_zc 34
+#define set_window_zc 35
+#define output_stream_zc 36
+#define input_stream_zc 37
+#define sound_effect_zc 38
+#define jz_zc 39
+#define get_sibling_zc 40
+#define get_child_zc 41
+#define get_parent_zc 42
+#define get_prop_len_zc 43
+#define inc_zc 44
+#define dec_zc 45
+#define print_addr_zc 46
+#define remove_obj_zc 47
+#define print_obj_zc 48
+#define ret_zc 49
+#define jump_zc 50
+#define print_paddr_zc 51
+#define load_zc 52
+#define not_zc 53
+#define rtrue_zc 54
+#define rfalse_zc 55
+#define print_zc 56
+#define print_ret_zc 57
+#define nop_zc 58
+#define save_zc 59
+#define restore_zc 60
+#define restart_zc 61
+#define ret_popped_zc 62
+#define pop_zc 63
+#define quit_zc 64
+#define new_line_zc 65
+#define show_status_zc 66
+#define verify_zc 67
+#define call_2s_zc 68
+#define call_vs_zc 69
+#define aread_zc 70
+#define call_vs2_zc 71
+#define erase_window_zc 72
+#define erase_line_zc 73
+#define set_cursor_zc 74
+#define get_cursor_zc 75
+#define set_text_style_zc 76
+#define buffer_mode_zc 77
+#define read_char_zc 78
+#define scan_table_zc 79
+#define call_1s_zc 80
+#define call_2n_zc 81
+#define set_colour_zc 82
+#define throw_zc 83
+#define call_vn_zc 84
+#define call_vn2_zc 85
+#define tokenise_zc 86
+#define encode_text_zc 87
+#define copy_table_zc 88
+#define print_table_zc 89
+#define check_arg_count_zc 90
+#define call_1n_zc 91
+#define catch_zc 92
+#define piracy_zc 93
+#define log_shift_zc 94
+#define art_shift_zc 95
+#define set_font_zc 96
+#define save_undo_zc 97
+#define restore_undo_zc 98
+#define draw_picture_zc 99
+#define picture_data_zc 100
+#define erase_picture_zc 101
+#define set_margins_zc 102
+#define move_window_zc 103
+#define window_size_zc 104
+#define window_style_zc 105
+#define get_wind_prop_zc 106
+#define scroll_window_zc 107
+#define pop_stack_zc 108
+#define read_mouse_zc 109
+#define mouse_window_zc 110
+#define push_stack_zc 111
+#define put_wind_prop_zc 112
+#define print_form_zc 113
+#define make_menu_zc 114
+#define picture_table_zc 115
+#define print_unicode_zc 116
+#define check_unicode_zc 117
+
+
+/* ------------------------------------------------------------------------- */
+/* Internal numbers representing assemble-able Glulx opcodes */
+/* ------------------------------------------------------------------------- */
+
+#define nop_gc 0
+#define add_gc 1
+#define sub_gc 2
+#define mul_gc 3
+#define div_gc 4
+#define mod_gc 5
+#define neg_gc 6
+#define bitand_gc 7
+#define bitor_gc 8
+#define bitxor_gc 9
+#define bitnot_gc 10
+#define shiftl_gc 11
+#define sshiftr_gc 12
+#define ushiftr_gc 13
+#define jump_gc 14
+#define jz_gc 15
+#define jnz_gc 16
+#define jeq_gc 17
+#define jne_gc 18
+#define jlt_gc 19
+#define jge_gc 20
+#define jgt_gc 21
+#define jle_gc 22
+#define jltu_gc 23
+#define jgeu_gc 24
+#define jgtu_gc 25
+#define jleu_gc 26
+#define call_gc 27
+#define return_gc 28
+#define catch_gc 29
+#define throw_gc 30
+#define tailcall_gc 31
+#define copy_gc 32
+#define copys_gc 33
+#define copyb_gc 34
+#define sexs_gc 35
+#define sexb_gc 36
+#define aload_gc 37
+#define aloads_gc 38
+#define aloadb_gc 39
+#define aloadbit_gc 40
+#define astore_gc 41
+#define astores_gc 42
+#define astoreb_gc 43
+#define astorebit_gc 44
+#define stkcount_gc 45
+#define stkpeek_gc 46
+#define stkswap_gc 47
+#define stkroll_gc 48
+#define stkcopy_gc 49
+#define streamchar_gc 50
+#define streamnum_gc 51
+#define streamstr_gc 52
+#define gestalt_gc 53
+#define debugtrap_gc 54
+#define getmemsize_gc 55
+#define setmemsize_gc 56
+#define jumpabs_gc 57
+#define random_gc 58
+#define setrandom_gc 59
+#define quit_gc 60
+#define verify_gc 61
+#define restart_gc 62
+#define save_gc 63
+#define restore_gc 64
+#define saveundo_gc 65
+#define restoreundo_gc 66
+#define protect_gc 67
+#define glk_gc 68
+#define getstringtbl_gc 69
+#define setstringtbl_gc 70
+#define getiosys_gc 71
+#define setiosys_gc 72
+#define linearsearch_gc 73
+#define binarysearch_gc 74
+#define linkedsearch_gc 75
+#define callf_gc 76
+#define callfi_gc 77
+#define callfii_gc 78
+#define callfiii_gc 79
+#define streamunichar_gc 80
+#define mzero_gc 81
+#define mcopy_gc 82
+#define malloc_gc 83
+#define mfree_gc 84
+#define accelfunc_gc 85
+#define accelparam_gc 86
+#define numtof_gc 87
+#define ftonumz_gc 88
+#define ftonumn_gc 89
+#define ceil_gc 90
+#define floor_gc 91
+#define fadd_gc 92
+#define fsub_gc 93
+#define fmul_gc 94
+#define fdiv_gc 95
+#define fmod_gc 96
+#define sqrt_gc 97
+#define exp_gc 98
+#define log_gc 99
+#define pow_gc 100
+#define sin_gc 101
+#define cos_gc 102
+#define tan_gc 103
+#define asin_gc 104
+#define acos_gc 105
+#define atan_gc 106
+#define atan2_gc 107
+#define jfeq_gc 108
+#define jfne_gc 109
+#define jflt_gc 110
+#define jfle_gc 111
+#define jfgt_gc 112
+#define jfge_gc 113
+#define jisnan_gc 114
+#define jisinf_gc 115
+
+/* ------------------------------------------------------------------------- */
+/* Index numbers into the keyword group "opcode_macros_g" (see "lexer.c") */
+/* ------------------------------------------------------------------------- */
+
+#define pull_gm 0
+#define push_gm 1
+
+
+#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 STATEMENT_TT 100 /* a statement keyword */
+#define SEGMENT_MARKER_TT 101 /* with/has/class etc. */
+#define DIRECTIVE_TT 102 /* a directive keyword */
+#define CND_TT 103 /* in/has/etc. */
+#define SYSFUN_TT 105 /* built-in function */
+#define LOCAL_VARIABLE_TT 106 /* local variable */
+#define OPCODE_NAME_TT 107 /* opcode name */
+#define MISC_KEYWORD_TT 108 /* keyword like "char" used in
+ syntax for a statement */
+#define DIR_KEYWORD_TT 109 /* keyword like "meta" used in
+ syntax for a directive */
+#define TRACE_KEYWORD_TT 110 /* keyword used in debugging */
+#define SYSTEM_CONSTANT_TT 111 /* such as "code_offset" */
+#define OPCODE_MACRO_TT 112 /* fake opcode for compatibility */
+
+#define OP_TT 200 /* value = operator no */
+#define ENDEXP_TT 201 /* no value */
+#define SUBOPEN_TT 202 /* ( used for subexpr */
+#define SUBCLOSE_TT 203 /* ) used to close subexp */
+#define LARGE_NUMBER_TT 204 /* constant not in range 0-255 */
+#define SMALL_NUMBER_TT 205 /* constant in range 0-255 */
+/* In Glulx, that's the range -0x8000 to 0x7fff instead. */
+#define VARIABLE_TT 206 /* variable name */
+#define DICTWORD_TT 207 /* literal 'word' */
+#define ACTION_TT 208 /* action name */
+
+#define VOID_CONTEXT 1
+#define CONDITION_CONTEXT 2
+#define CONSTANT_CONTEXT 3
+#define QUANTITY_CONTEXT 4
+#define ACTION_Q_CONTEXT 5
+#define ASSEMBLY_CONTEXT 6
+#define ARRAY_CONTEXT 7
+#define FORINIT_CONTEXT 8
+#define RETURN_Q_CONTEXT 9
+
+#define LOWEST_SYSTEM_VAR_NUMBER 249 /* globals 249 to 255 are used
+ in compiled code (Z-code
+ only; in Glulx, the range can
+ change) */
+
+/* ------------------------------------------------------------------------- */
+/* 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 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
+
+/* ------------------------------------------------------------------------- */
+/* Symbol type definitions */
+/* ------------------------------------------------------------------------- */
+
+#define ROUTINE_T 1
+#define LABEL_T 2
+#define GLOBAL_VARIABLE_T 3
+#define ARRAY_T 4
+#define CONSTANT_T 5
+#define ATTRIBUTE_T 6
+#define PROPERTY_T 7
+#define INDIVIDUAL_PROPERTY_T 8
+#define OBJECT_T 9
+#define CLASS_T 10
+#define FAKE_ACTION_T 11
+
+/* ------------------------------------------------------------------------- */
+/* Statusline_flag values */
+/* ------------------------------------------------------------------------- */
+
+#define SCORE_STYLE 0
+#define TIME_STYLE 1
+
+/* ------------------------------------------------------------------------- */
+/* Inform keyword definitions */
+/* ------------------------------------------------------------------------- */
+
+/* Index numbers into the keyword group "directives" (see "lexer.c") */
+
+#define ABBREVIATE_CODE 0
+#define ARRAY_CODE 1
+#define ATTRIBUTE_CODE 2
+#define CLASS_CODE 3
+#define CONSTANT_CODE 4
+#define DEFAULT_CODE 5
+#define DICTIONARY_CODE 6
+#define END_CODE 7
+#define ENDIF_CODE 8
+#define EXTEND_CODE 9
+#define FAKE_ACTION_CODE 10
+#define GLOBAL_CODE 11
+#define IFDEF_CODE 12
+#define IFNDEF_CODE 13
+#define IFNOT_CODE 14
+#define IFV3_CODE 15
+#define IFV5_CODE 16
+#define IFTRUE_CODE 17
+#define IFFALSE_CODE 18
+#define IMPORT_CODE 19
+#define INCLUDE_CODE 20
+#define LINK_CODE 21
+#define LOWSTRING_CODE 22
+#define MESSAGE_CODE 23
+#define NEARBY_CODE 24
+#define OBJECT_CODE 25
+#define ORIGSOURCE_CODE 26
+#define PROPERTY_CODE 27
+#define RELEASE_CODE 28
+#define REPLACE_CODE 29
+#define SERIAL_CODE 30
+#define SWITCHES_CODE 31
+#define STATUSLINE_CODE 32
+#define STUB_CODE 33
+#define SYSTEM_CODE 34
+#define TRACE_CODE 35
+#define UNDEF_CODE 36
+#define VERB_CODE 37
+#define VERSION_CODE 38
+#define ZCHARACTER_CODE 39
+
+#define OPENBLOCK_CODE 100
+#define CLOSEBLOCK_CODE 101
+
+/* Index numbers into the keyword group "statements" (see "lexer.c") */
+
+#define BOX_CODE 0
+#define BREAK_CODE 1
+#define CONTINUE_CODE 2
+#define SDEFAULT_CODE 3
+#define DO_CODE 4
+#define ELSE_CODE 5
+#define FONT_CODE 6
+#define FOR_CODE 7
+#define GIVE_CODE 8
+#define IF_CODE 9
+#define INVERSION_CODE 10
+#define JUMP_CODE 11
+#define MOVE_CODE 12
+#define NEW_LINE_CODE 13
+#define OBJECTLOOP_CODE 14
+#define PRINT_CODE 15
+#define PRINT_RET_CODE 16
+#define QUIT_CODE 17
+#define READ_CODE 18
+#define REMOVE_CODE 19
+#define RESTORE_CODE 20
+#define RETURN_CODE 21
+#define RFALSE_CODE 22
+#define RTRUE_CODE 23
+#define SAVE_CODE 24
+#define SPACES_CODE 25
+#define STRING_CODE 26
+#define STYLE_CODE 27
+#define SWITCH_CODE 28
+#define UNTIL_CODE 29
+#define WHILE_CODE 30
+
+#define ASSIGNMENT_CODE 100
+#define FUNCTION_CODE 101
+
+/* Index numbers into the keyword group "conditions" (see "lexer.c") */
+
+#define HAS_COND 0
+#define HASNT_COND 1
+#define IN_COND 2
+#define NOTIN_COND 3
+#define OFCLASS_COND 4
+#define OR_COND 5
+#define PROVIDES_COND 6
+
+/* Index numbers into the keyword group "segment_markers" (see "lexer.c") */
+
+#define CLASS_SEGMENT 0
+#define HAS_SEGMENT 1
+#define PRIVATE_SEGMENT 2
+#define WITH_SEGMENT 3
+
+/* Index numbers into the keyword group "misc_keywords" (see "lexer.c") */
+
+#define CHAR_MK 0
+#define NAME_MK 1
+#define THE_MK 2
+#define A_MK 3
+#define AN_MK 4
+#define CAP_THE_MK 5
+#define NUMBER_MK 6
+#define ROMAN_MK 7
+#define REVERSE_MK 8
+#define BOLD_MK 9
+#define UNDERLINE_MK 10
+#define FIXED_MK 11
+#define ON_MK 12
+#define OFF_MK 13
+#define TO_MK 14
+#define ADDRESS_MK 15
+#define STRING_MK 16
+#define OBJECT_MK 17
+#define NEAR_MK 18
+#define FROM_MK 19
+#define PROPERTY_MK 20
+#define CAP_A_MK 21
+
+/* Index numbers into the keyword group "directive_keywords" (see "lexer.c") */
+
+#define ALIAS_DK 0
+#define LONG_DK 1
+#define ADDITIVE_DK 2
+#define SCORE_DK 3
+#define TIME_DK 4
+#define NOUN_DK 5
+#define HELD_DK 6
+#define MULTI_DK 7
+#define MULTIHELD_DK 8
+#define MULTIEXCEPT_DK 9
+#define MULTIINSIDE_DK 10
+#define CREATURE_DK 11
+#define SPECIAL_DK 12
+#define NUMBER_DK 13
+#define SCOPE_DK 14
+#define TOPIC_DK 15
+#define REVERSE_DK 16
+#define META_DK 17
+#define ONLY_DK 18
+#define REPLACE_DK 19
+#define FIRST_DK 20
+#define LAST_DK 21
+#define STRING_DK 22
+#define TABLE_DK 23
+#define BUFFER_DK 24
+#define DATA_DK 25
+#define INITIAL_DK 26
+#define INITSTR_DK 27
+#define WITH_DK 28
+#define PRIVATE_DK 29
+#define HAS_DK 30
+#define CLASS_DK 31
+#define ERROR_DK 32
+#define FATALERROR_DK 33
+#define WARNING_DK 34
+#define TERMINATING_DK 35
+
+/* Index numbers into the keyword group "trace_keywords" (see "lexer.c") */
+
+#define DICTIONARY_TK 0
+#define SYMBOLS_TK 1
+#define OBJECTS_TK 2
+#define VERBS_TK 3
+#define ASSEMBLY_TK 4
+#define EXPRESSIONS_TK 5
+#define LINES_TK 6
+#define TOKENS_TK 7
+#define LINKER_TK 8
+#define ON_TK 9
+#define OFF_TK 10
+
+/* Index numbers into the keyword group "system_constants" (see "lexer.c") */
+
+#define NO_SYSTEM_CONSTANTS 62
+
+#define adjectives_table_SC 0
+#define actions_table_SC 1
+#define classes_table_SC 2
+#define identifiers_table_SC 3
+#define preactions_table_SC 4
+#define version_number_SC 5
+#define largest_object_SC 6
+#define strings_offset_SC 7
+#define code_offset_SC 8
+#define dict_par1_SC 9
+#define dict_par2_SC 10
+#define dict_par3_SC 11
+#define actual_largest_object_SC 12
+#define static_memory_offset_SC 13
+#define array_names_offset_SC 14
+#define readable_memory_offset_SC 15
+#define cpv__start_SC 16
+#define cpv__end_SC 17
+#define ipv__start_SC 18
+#define ipv__end_SC 19
+#define array__start_SC 20
+#define array__end_SC 21
+
+#define lowest_attribute_number_SC 22
+#define highest_attribute_number_SC 23
+#define attribute_names_array_SC 24
+
+#define lowest_property_number_SC 25
+#define highest_property_number_SC 26
+#define property_names_array_SC 27
+
+#define lowest_action_number_SC 28
+#define highest_action_number_SC 29
+#define action_names_array_SC 30
+
+#define lowest_fake_action_number_SC 31
+#define highest_fake_action_number_SC 32
+#define fake_action_names_array_SC 33
+
+#define lowest_routine_number_SC 34
+#define highest_routine_number_SC 35
+#define routines_array_SC 36
+#define routine_names_array_SC 37
+#define routine_flags_array_SC 38
+
+#define lowest_global_number_SC 39
+#define highest_global_number_SC 40
+#define globals_array_SC 41
+#define global_names_array_SC 42
+#define global_flags_array_SC 43
+
+#define lowest_array_number_SC 44
+#define highest_array_number_SC 45
+#define arrays_array_SC 46
+#define array_names_array_SC 47
+#define array_flags_array_SC 48
+
+#define lowest_constant_number_SC 49
+#define highest_constant_number_SC 50
+#define constants_array_SC 51
+#define constant_names_array_SC 52
+
+#define lowest_class_number_SC 53
+#define highest_class_number_SC 54
+#define class_objects_array_SC 55
+
+#define lowest_object_number_SC 56
+#define highest_object_number_SC 57
+
+#define oddeven_packing_SC 58
+
+#define grammar_table_SC 59 /* Glulx-only */
+#define dictionary_table_SC 60 /* Glulx-only */
+#define dynam_string_table_SC 61 /* Glulx-only */
+
+
+/* Index numbers into the keyword group "system_functions" (see "lexer.c") */
+
+#define NUMBER_SYSTEM_FUNCTIONS 12
+
+#define CHILD_SYSF 0
+#define CHILDREN_SYSF 1
+#define ELDER_SYSF 2
+#define ELDEST_SYSF 3
+#define INDIRECT_SYSF 4
+#define PARENT_SYSF 5
+#define RANDOM_SYSF 6
+#define SIBLING_SYSF 7
+#define YOUNGER_SYSF 8
+#define YOUNGEST_SYSF 9
+#define METACLASS_SYSF 10
+#define GLK_SYSF 11 /* Glulx-only */
+
+/* Index numbers into the operators group "separators" (see "lexer.c") */
+
+#define NUMBER_SEPARATORS 49
+
+#define ARROW_SEP 0
+#define DARROW_SEP 1
+#define DEC_SEP 2
+#define MINUS_SEP 3
+#define INC_SEP 4
+#define PLUS_SEP 5
+#define TIMES_SEP 6
+#define DIVIDE_SEP 7
+#define REMAINDER_SEP 8
+#define LOGOR_SEP 9
+#define ARTOR_SEP 10
+#define LOGAND_SEP 11
+#define ARTAND_SEP 12
+#define LOGNOT_SEP 13
+#define NOTEQUAL_SEP 14
+#define ARTNOT_SEP 15
+#define CONDEQUALS_SEP 16
+#define SETEQUALS_SEP 17
+#define GE_SEP 18
+#define GREATER_SEP 19
+#define LE_SEP 20
+#define LESS_SEP 21
+#define OPENB_SEP 22
+#define CLOSEB_SEP 23
+#define COMMA_SEP 24
+#define PROPADD_SEP 25
+#define PROPNUM_SEP 26
+#define MPROPADD_SEP 27
+#define MPROPNUM_SEP 28
+#define MESSAGE_SEP 29
+#define PROPERTY_SEP 30
+#define SUPERCLASS_SEP 31
+#define COLON_SEP 32
+#define AT_SEP 33
+#define SEMICOLON_SEP 34
+#define OPEN_SQUARE_SEP 35
+#define CLOSE_SQUARE_SEP 36
+#define OPEN_BRACE_SEP 37
+#define CLOSE_BRACE_SEP 38
+#define DOLLAR_SEP 39
+#define NBRANCH_SEP 40
+#define BRANCH_SEP 41
+#define HASHADOLLAR_SEP 42
+#define HASHGDOLLAR_SEP 43
+#define HASHNDOLLAR_SEP 44
+#define HASHRDOLLAR_SEP 45
+#define HASHWDOLLAR_SEP 46
+#define HASHHASH_SEP 47
+#define HASH_SEP 48
+
+#define UNARY_MINUS_SEP 100
+#define POST_INC_SEP 101
+#define POST_DEC_SEP 102
+
+/* ------------------------------------------------------------------------- */
+/* Internal numbers used to refer to operators (in expressions) */
+/* (must correspond to entries in the operators table in "express.c") */
+/* ------------------------------------------------------------------------- */
+
+#define NUM_OPERATORS 68
+
+#define PRE_U 1
+#define IN_U 2
+#define POST_U 3
+
+#define R_A 1
+#define L_A 2
+
+#define COMMA_OP 0
+#define SETEQUALS_OP 1
+#define LOGAND_OP 2
+#define LOGOR_OP 3
+#define LOGNOT_OP 4
+
+#define ZERO_OP 5
+#define NONZERO_OP 6
+#define CONDEQUALS_OP 7
+#define NOTEQUAL_OP 8
+#define GE_OP 9
+#define GREATER_OP 10
+#define LE_OP 11
+#define LESS_OP 12
+#define HAS_OP 13
+#define HASNT_OP 14
+#define IN_OP 15
+#define NOTIN_OP 16
+#define OFCLASS_OP 17
+#define PROVIDES_OP 18
+#define NOTOFCLASS_OP 19
+#define NOTPROVIDES_OP 20
+#define OR_OP 21
+
+#define PLUS_OP 22
+#define MINUS_OP 23
+#define TIMES_OP 24
+#define DIVIDE_OP 25
+#define REMAINDER_OP 26
+#define ARTAND_OP 27
+#define ARTOR_OP 28
+#define ARTNOT_OP 29
+#define ARROW_OP 30
+#define DARROW_OP 31
+#define UNARY_MINUS_OP 32
+#define INC_OP 33
+#define POST_INC_OP 34
+#define DEC_OP 35
+#define POST_DEC_OP 36
+#define PROP_ADD_OP 37
+#define PROP_NUM_OP 38
+#define MPROP_ADD_OP 39
+#define MPROP_NUM_OP 40
+#define FCALL_OP 41
+#define MESSAGE_OP 42
+#define PROPERTY_OP 43
+#define SUPERCLASS_OP 44
+
+#define ARROW_SETEQUALS_OP 45
+#define DARROW_SETEQUALS_OP 46
+#define MESSAGE_SETEQUALS_OP 47
+#define PROPERTY_SETEQUALS_OP 48
+
+#define ARROW_INC_OP 49
+#define DARROW_INC_OP 50
+#define MESSAGE_INC_OP 51
+#define PROPERTY_INC_OP 52
+
+#define ARROW_DEC_OP 53
+#define DARROW_DEC_OP 54
+#define MESSAGE_DEC_OP 55
+#define PROPERTY_DEC_OP 56
+
+#define ARROW_POST_INC_OP 57
+#define DARROW_POST_INC_OP 58
+#define MESSAGE_POST_INC_OP 59
+#define PROPERTY_POST_INC_OP 60
+
+#define ARROW_POST_DEC_OP 61
+#define DARROW_POST_DEC_OP 62
+#define MESSAGE_POST_DEC_OP 63
+#define PROPERTY_POST_DEC_OP 64
+
+#define PROP_CALL_OP 65
+#define MESSAGE_CALL_OP 66
+
+#define PUSH_OP 67 /* Glulx only */
+
+/* ------------------------------------------------------------------------- */
+/* The five types of compiled array */
+/* ------------------------------------------------------------------------- */
+
+#define BYTE_ARRAY 0
+#define WORD_ARRAY 1
+#define STRING_ARRAY 2
+#define TABLE_ARRAY 3
+#define BUFFER_ARRAY 4
+
+/* ------------------------------------------------------------------------- */
+/* Internal numbers used to refer to veneer routines */
+/* (must correspond to entries in the table in "veneer.c") */
+/* ------------------------------------------------------------------------- */
+
+#define VENEER_ROUTINES 48
+
+#define Box__Routine_VR 0
+
+#define R_Process_VR 1
+#define DefArt_VR 2
+#define InDefArt_VR 3
+#define CDefArt_VR 4
+#define CInDefArt_VR 5
+#define PrintShortName_VR 6
+#define EnglishNumber_VR 7
+#define Print__Pname_VR 8
+
+#define WV__Pr_VR 9
+#define RV__Pr_VR 10
+#define CA__Pr_VR 11
+#define IB__Pr_VR 12
+#define IA__Pr_VR 13
+#define DB__Pr_VR 14
+#define DA__Pr_VR 15
+#define RA__Pr_VR 16
+#define RL__Pr_VR 17
+#define RA__Sc_VR 18
+#define OP__Pr_VR 19
+#define OC__Cl_VR 20
+
+#define Copy__Primitive_VR 21
+#define RT__Err_VR 22
+#define Z__Region_VR 23
+#define Unsigned__Compare_VR 24
+#define Metaclass_VR 25
+#define CP__Tab_VR 26
+#define Cl__Ms_VR 27
+#define RT__ChT_VR 28
+#define RT__ChR_VR 29
+#define RT__ChG_VR 30
+#define RT__ChGt_VR 31
+#define RT__ChPS_VR 32
+#define RT__ChPR_VR 33
+#define RT__TrPS_VR 34
+#define RT__ChLDB_VR 35
+#define RT__ChLDW_VR 36
+#define RT__ChSTB_VR 37
+#define RT__ChSTW_VR 38
+#define RT__ChPrintC_VR 39
+#define RT__ChPrintA_VR 40
+#define RT__ChPrintS_VR 41
+#define RT__ChPrintO_VR 42
+
+/* Glulx-only veneer routines */
+#define OB__Move_VR 43
+#define OB__Remove_VR 44
+#define Print__Addr_VR 45
+#define Glk__Wrap_VR 46
+#define Dynam__String_VR 47
+
+/* ------------------------------------------------------------------------- */
+/* Run-time-error numbers (must correspond with RT__Err code in veneer) */
+/* ------------------------------------------------------------------------- */
+
+#define IN_RTE 2
+#define HAS_RTE 3
+#define PARENT_RTE 4
+#define ELDEST_RTE 5
+#define CHILD_RTE 6
+#define YOUNGER_RTE 7
+#define SIBLING_RTE 8
+#define CHILDREN_RTE 9
+#define YOUNGEST_RTE 10
+#define ELDER_RTE 11
+#define OBJECTLOOP_RTE 12
+#define OBJECTLOOP2_RTE 13
+#define GIVE_RTE 14
+#define REMOVE_RTE 15
+#define MOVE1_RTE 16
+#define MOVE2_RTE 17
+/* 18 = creating a loop in object tree */
+/* 19 = giving a non-existent attribute */
+#define DBYZERO_RTE 20
+#define PROP_ADD_RTE 21
+#define PROP_NUM_RTE 22
+#define PROPERTY_RTE 23
+/* 24 = reading with -> out of range */
+/* 25 = reading with --> out of range */
+/* 26 = writing with -> out of range */
+/* 27 = writing with --> out of range */
+#define ABOUNDS_RTE 28
+/* similarly 29, 30, 31 */
+#define OBJECTLOOP_BROKEN_RTE 32
+/* 33 = print (char) out of range */
+/* 34 = print (address) out of range */
+/* 35 = print (string) out of range */
+/* 36 = print (object) out of range */
+
+/* ------------------------------------------------------------------------- */
+/* Z-region areas (used to refer to module positions in markers) */
+/* ------------------------------------------------------------------------- */
+
+#define LOW_STRINGS_ZA 1
+#define PROP_DEFAULTS_ZA 2
+#define OBJECT_TREE_ZA 3
+#define PROP_ZA 4
+#define CLASS_NUMBERS_ZA 5
+#define INDIVIDUAL_PROP_ZA 6
+#define DYNAMIC_ARRAY_ZA 7 /* Z-code only */
+#define GRAMMAR_ZA 8
+#define ACTIONS_ZA 9
+#define PREACTIONS_ZA 10
+#define ADJECTIVES_ZA 11
+#define DICTIONARY_ZA 12
+#define ZCODE_ZA 13
+#define STATIC_STRINGS_ZA 14
+#define LINK_DATA_ZA 15
+
+#define SYMBOLS_ZA 16
+
+#define ARRAY_ZA 17 /* Glulx only */
+#define GLOBALVAR_ZA 18 /* Glulx only */
+
+/* ------------------------------------------------------------------------- */
+/* "Marker values", used for backpatching and linkage */
+/* ------------------------------------------------------------------------- */
+
+#define NULL_MV 0 /* Null */
+
+/* Marker values used in backpatch areas: */
+
+#define DWORD_MV 1 /* Dictionary word address */
+#define STRING_MV 2 /* Static string */
+#define INCON_MV 3 /* "Hardware" constant (table address) */
+#define IROUTINE_MV 4 /* Call to internal routine */
+#define VROUTINE_MV 5 /* Call to veneer routine */
+#define ARRAY_MV 6 /* Ref to internal array address */
+#define NO_OBJS_MV 7 /* Ref to number of game objects */
+#define INHERIT_MV 8 /* Inherited property value */
+#define INHERIT_INDIV_MV 9 /* Inherited indiv property value */
+#define MAIN_MV 10 /* "Main" routine */
+#define SYMBOL_MV 11 /* Forward ref to unassigned symbol */
+
+/* Additional marker values used in module backpatch areas: */
+/* (In Glulx, OBJECT_MV and VARIABLE_MV are used in backpatching, even
+ without modules.) */
+
+#define VARIABLE_MV 12 /* Global variable */
+#define IDENT_MV 13 /* Property identifier number */
+#define INDIVPT_MV 14 /* Individual prop table address */
+#define ACTION_MV 15 /* Action number */
+#define OBJECT_MV 16 /* Ref to internal object number */
+
+#define LARGEST_BPATCH_MV 16 /* Larger marker values are never written
+ to backpatch tables */
+
+/* Value indicating an imported symbol record: */
+
+#define IMPORT_MV 32
+
+/* Values indicating an exported symbol record: */
+
+#define EXPORT_MV 33 /* Defined ordinarily */
+#define EXPORTSF_MV 34 /* Defined in a system file */
+#define EXPORTAC_MV 35 /* Action name */
+
+/* Values used only in branch backpatching: */
+/* ###-I've rearranged these, so that BRANCH_MV can be last; Glulx uses the
+ whole range from BRANCH_MV to BRANCHMAX_MV. */
+
+#define LABEL_MV 36 /* Ditto: marks "jump" operands */
+#define DELETED_MV 37 /* Ditto: marks bytes deleted from code */
+#define BRANCH_MV 38 /* Used in "asm.c" for routine coding */
+#define BRANCHMAX_MV 58 /* In fact, the range BRANCH_MV to
+ BRANCHMAX_MV all means the same thing.
+ The position within the range means
+ how far back from the label to go
+ to find the opmode byte to modify. */
+
+/* ========================================================================= */
+/* Initialisation extern definitions */
+/* */
+/* Note that each subsystem in Inform provides four routines to keep */
+/* track of variables and data structures: */
+/* */
+/* init_*_vars should set variables to initial values (they must */
+/* not be initialised directly in their declarations */
+/* as Inform may need to compile several times in a */
+/* row) */
+/* */
+/* *_begin_pass any variable/array initialisation that needs to */
+/* happen at the start of the pass through the source */
+/* */
+/* *_allocate_arrays should use my_malloc/my_calloc (see memory.c) */
+/* to allocate any arrays or workspace needed */
+/* */
+/* *_free_arrays should use my_free to free all memory allocated */
+/* (with one exception in "text.c") */
+/* */
+/* ========================================================================= */
+
+ /* > READ INFORM SOURCE */
+
+ /* My Source Book */
+
+extern void init_arrays_vars(void); /* arrays: construct tableaux */
+extern void init_asm_vars(void); /* asm: assemble even rare or v6 codes */
+extern void init_bpatch_vars(void); /* bpatch: backpatches code */
+extern void init_chars_vars(void); /* chars: translate character sets */
+extern void init_directs_vars(void); /* directs: ponder directives */
+extern void init_errors_vars(void); /* errors: issue diagnostics */
+extern void init_expressc_vars(void); /* expressc: compile expressions */
+extern void init_expressp_vars(void); /* expressp: parse expressions */
+extern void init_files_vars(void); /* files: handle files */
+ /* void init_vars(void); inform: decide what to do */
+extern void init_lexer_vars(void); /* lexer: lexically analyse source */
+extern void init_linker_vars(void); /* linker: link in pre-compiled module */
+extern void init_memory_vars(void); /* memory: manage memory settings */
+extern void init_objects_vars(void); /* objects: cultivate object tree */
+extern void init_states_vars(void); /* states: translate statements to code*/
+extern void init_symbols_vars(void); /* symbols: construct symbols table */
+extern void init_syntax_vars(void); /* syntax: parse the program */
+extern void init_tables_vars(void); /* tables: glue tables into the output */
+extern void init_text_vars(void); /* text: encode text and dictionary */
+extern void init_veneer_vars(void); /* veneer: compile a layer of code */
+extern void init_verbs_vars(void); /* verbs: lay out grammar */
+
+extern void files_begin_prepass(void); /* These routines initialise just */
+extern void lexer_begin_prepass(void); /* enough to begin loading source */
+
+extern void arrays_begin_pass(void);
+extern void asm_begin_pass(void);
+extern void bpatch_begin_pass(void);
+extern void chars_begin_pass(void);
+extern void directs_begin_pass(void);
+extern void errors_begin_pass(void);
+extern void expressc_begin_pass(void);
+extern void expressp_begin_pass(void);
+extern void files_begin_pass(void);
+ /* void begin_pass(void); */
+extern void lexer_begin_pass(void);
+extern void linker_begin_pass(void);
+extern void memory_begin_pass(void);
+extern void objects_begin_pass(void);
+extern void states_begin_pass(void);
+extern void symbols_begin_pass(void);
+extern void syntax_begin_pass(void);
+extern void tables_begin_pass(void);
+extern void text_begin_pass(void);
+extern void veneer_begin_pass(void);
+extern void verbs_begin_pass(void);
+
+extern void lexer_endpass(void);
+extern void linker_endpass(void);
+
+extern void arrays_allocate_arrays(void);
+extern void asm_allocate_arrays(void);
+extern void bpatch_allocate_arrays(void);
+extern void chars_allocate_arrays(void);
+extern void directs_allocate_arrays(void);
+extern void errors_allocate_arrays(void);
+extern void expressc_allocate_arrays(void);
+extern void expressp_allocate_arrays(void);
+extern void files_allocate_arrays(void);
+ /* void allocate_arrays(void); */
+extern void lexer_allocate_arrays(void);
+extern void linker_allocate_arrays(void);
+extern void memory_allocate_arrays(void);
+extern void objects_allocate_arrays(void);
+extern void states_allocate_arrays(void);
+extern void symbols_allocate_arrays(void);
+extern void syntax_allocate_arrays(void);
+extern void tables_allocate_arrays(void);
+extern void text_allocate_arrays(void);
+extern void veneer_allocate_arrays(void);
+extern void verbs_allocate_arrays(void);
+
+extern void arrays_free_arrays(void);
+extern void asm_free_arrays(void);
+extern void bpatch_free_arrays(void);
+extern void chars_free_arrays(void);
+extern void directs_free_arrays(void);
+extern void errors_free_arrays(void);
+extern void expressc_free_arrays(void);
+extern void expressp_free_arrays(void);
+extern void files_free_arrays(void);
+ /* void free_arrays(void); */
+extern void lexer_free_arrays(void);
+extern void linker_free_arrays(void);
+extern void memory_free_arrays(void);
+extern void objects_free_arrays(void);
+extern void states_free_arrays(void);
+extern void symbols_free_arrays(void);
+extern void syntax_free_arrays(void);
+extern void tables_free_arrays(void);
+extern void text_free_arrays(void);
+extern void veneer_free_arrays(void);
+extern void verbs_free_arrays(void);
+
+/* ========================================================================= */
+/* Remaining extern definitions are given by file in alphabetical order */
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "arrays" */
+/* ------------------------------------------------------------------------- */
+
+extern int no_globals, no_arrays;
+extern int dynamic_array_area_size;
+extern int *dynamic_array_area;
+extern int32 *global_initial_value;
+extern int32 *array_symbols;
+extern int *array_sizes, *array_types;
+
+extern void make_global(int array_flag, int name_only);
+extern void set_variable_value(int i, int32 v);
+extern void check_globals(void);
+extern int32 begin_table_array(void);
+extern int32 begin_word_array(void);
+extern void array_entry(int32 i, assembly_operand VAL);
+extern void finish_array(int32 i);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "asm" */
+/* ------------------------------------------------------------------------- */
+
+extern memory_block zcode_area;
+extern int32 zmachine_pc;
+
+extern int32 no_instructions;
+extern int sequence_point_follows;
+extern int uses_unicode_features, uses_memheap_features,
+ uses_acceleration_features, uses_float_features;
+extern debug_location statement_debug_location;
+extern int execution_never_reaches_here;
+extern int *variable_usage;
+extern int next_label, no_sequence_points;
+extern int32 *variable_tokens;
+extern assembly_instruction AI;
+extern int32 *named_routine_symbols;
+
+extern void print_operand(assembly_operand o);
+extern char *variable_name(int32 i);
+extern void set_constant_ot(assembly_operand *AO);
+extern int is_constant_ot(int otval);
+extern int is_variable_ot(int otval);
+extern void assemblez_instruction(assembly_instruction *a);
+extern void assembleg_instruction(assembly_instruction *a);
+extern void assemble_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,
+ char *name, int embedded_flag, int the_symbol);
+extern void assemble_routine_end(int embedded_flag, debug_locations locations);
+
+extern void assemblez_0(int internal_number);
+extern void assemblez_0_to(int internal_number, assembly_operand o1);
+extern void assemblez_0_branch(int internal_number, int label, int flag);
+extern void assemblez_1(int internal_number, assembly_operand o1);
+extern void assemblez_1_to(int internal_number,
+ assembly_operand o1, assembly_operand st);
+extern void assemblez_1_branch(int internal_number,
+ assembly_operand o1, int label, int flag);
+extern void assemblez_objcode(int internal_number,
+ assembly_operand o1, assembly_operand st,
+ int label, int flag);
+extern void assemblez_2(int internal_number,
+ assembly_operand o1, assembly_operand o2);
+extern void assemblez_2_to(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand st);
+extern void assemblez_2_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ int label, int flag);
+extern void assemblez_3(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3);
+extern void assemblez_3_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, int label, int flag);
+extern void assemblez_3_to(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, assembly_operand st);
+extern void assemblez_4(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, assembly_operand o4);
+extern void assemblez_5(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, assembly_operand o4,
+ assembly_operand o5);
+extern void assemblez_6(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, assembly_operand o4,
+ assembly_operand o5, assembly_operand o6);
+extern void assemblez_4_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, assembly_operand o4,
+ int label, int flag);
+extern void assemblez_4_to(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, assembly_operand o4,
+ assembly_operand st);
+extern void assemblez_5_to(int internal_number,
+ assembly_operand o1, assembly_operand o2,
+ assembly_operand o3, assembly_operand o4,
+ assembly_operand o5, assembly_operand st);
+
+extern void assemblez_inc(assembly_operand o1);
+extern void assemblez_dec(assembly_operand o1);
+extern void assemblez_store(assembly_operand o1, assembly_operand o2);
+extern void assemblez_jump(int n);
+
+extern void assembleg_0(int internal_number);
+extern void assembleg_1(int internal_number, assembly_operand o1);
+extern void assembleg_2(int internal_number, assembly_operand o1,
+ assembly_operand o2);
+extern void assembleg_3(int internal_number, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3);
+extern void assembleg_4(int internal_number, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3, assembly_operand o4);
+extern void assembleg_5(int internal_number, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3, assembly_operand o4,
+ assembly_operand o5);
+extern void assembleg_0_branch(int internal_number,
+ int label);
+extern void assembleg_1_branch(int internal_number,
+ assembly_operand o1, int label);
+extern void assembleg_2_branch(int internal_number,
+ assembly_operand o1, assembly_operand o2, int label);
+extern void assembleg_call_1(assembly_operand oaddr, assembly_operand o1,
+ assembly_operand odest);
+extern void assembleg_call_2(assembly_operand oaddr, assembly_operand o1,
+ assembly_operand o2, assembly_operand odest);
+extern void assembleg_call_3(assembly_operand oaddr, assembly_operand o1,
+ assembly_operand o2, assembly_operand o3, assembly_operand odest);
+extern void assembleg_inc(assembly_operand o1);
+extern void assembleg_dec(assembly_operand o1);
+extern void assembleg_store(assembly_operand o1, assembly_operand o2);
+extern void assembleg_jump(int n);
+
+extern void parse_assembly(void);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "bpatch" */
+/* ------------------------------------------------------------------------- */
+
+extern memory_block zcode_backpatch_table, zmachine_backpatch_table;
+extern int32 zcode_backpatch_size, zmachine_backpatch_size;
+extern int backpatch_marker, backpatch_error_flag;
+
+extern int32 backpatch_value(int32 value);
+extern void backpatch_zmachine_image_z(void);
+extern void backpatch_zmachine_image_g(void);
+extern void backpatch_zmachine(int mv, int zmachine_area, int32 offset);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "chars" */
+/* ------------------------------------------------------------------------- */
+
+extern uchar source_to_iso_grid[];
+extern int32 iso_to_unicode_grid[];
+extern int character_digit_value[];
+extern uchar alphabet[3][27];
+extern int alphabet_modified;
+extern int zscii_defn_modified;
+extern int zscii_high_water_mark;
+extern char alphabet_used[];
+extern int iso_to_alphabet_grid[];
+extern int zscii_to_alphabet_grid[];
+extern int textual_form_length;
+
+extern int iso_to_unicode(int iso);
+extern int unicode_to_zscii(int32 u);
+extern int32 zscii_to_unicode(int z);
+extern int32 text_to_unicode(char *text);
+extern void zscii_to_text(char *text, int zscii);
+extern char *name_of_iso_set(int s);
+extern void change_character_set(void);
+extern void new_alphabet(char *text, int alphabet);
+extern void new_zscii_character(int32 unicode, int plus_flag);
+extern void new_zscii_finished(void);
+extern void map_new_zchar(int32 unicode);
+extern void make_lower_case(char *str);
+extern void make_upper_case(char *str);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "directs" */
+/* ------------------------------------------------------------------------- */
+
+extern brief_location routine_starts_line;
+
+extern int no_routines, no_named_routines, no_locals, no_termcs;
+extern int terminating_characters[];
+
+extern int parse_given_directive(int internal_flag);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "errors" */
+/* ------------------------------------------------------------------------- */
+
+extern char *forerrors_buff;
+extern int forerrors_pointer;
+extern int no_errors, no_warnings, no_suppressed_warnings,
+ no_link_errors, no_compiler_errors;
+
+extern ErrorPosition ErrorReport;
+
+extern void fatalerror(char *s) NORETURN;
+extern void fatalerror_named(char *s1, char *s2) NORETURN;
+extern void memory_out_error(int32 size, int32 howmany, char *name) NORETURN;
+extern void memoryerror(char *s, int32 size) NORETURN;
+extern void error(char *s);
+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 char_error(char *s, int ch);
+extern void unicode_char_error(char *s, int32 uni);
+extern void no_such_label(char *lname);
+extern void warning(char *s);
+extern void warning_numbered(char *s1, int val);
+extern void warning_named(char *s1, char *s2);
+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 void link_error(char *s);
+extern void link_error_named(char *s1, char *s2);
+extern int compiler_error(char *s);
+extern int compiler_error_named(char *s1, char *s2);
+extern void print_sorry_message(void);
+
+#ifdef ARC_THROWBACK
+extern int throwback_switch;
+
+extern void throwback(int severity, char * error);
+extern void throwback_start(void);
+extern void throwback_end(void);
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "expressc" */
+/* ------------------------------------------------------------------------- */
+
+extern int vivc_flag;
+extern operator operators[];
+
+extern assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
+ temp_var4, zero_operand, one_operand, two_operand, three_operand,
+ four_operand, valueless_operand;
+
+assembly_operand code_generate(assembly_operand AO, int context, int label);
+assembly_operand check_nonzero_at_runtime(assembly_operand AO1, int label,
+ int rte_number);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "expressp" */
+/* ------------------------------------------------------------------------- */
+
+extern int system_function_usage[];
+extern expression_tree_node *ET;
+
+extern int z_system_constant_list[];
+extern int glulx_system_constant_list[];
+
+extern int32 value_of_system_constant(int t);
+extern void clear_expression_space(void);
+extern void show_tree(assembly_operand AO, int annotate);
+extern assembly_operand parse_expression(int context);
+extern int test_for_incdec(assembly_operand AO);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "files" */
+/* ------------------------------------------------------------------------- */
+
+extern int total_files;
+extern int current_input_file;
+extern int total_input_files;
+extern FileId *InputFiles;
+
+extern FILE *Temp1_fp, *Temp2_fp, *Temp3_fp;
+extern char Temp1_Name[], Temp2_Name[], Temp3_Name[];
+extern int32 total_chars_read;
+
+extern void open_temporary_files(void);
+extern void check_temp_files(void);
+extern void remove_temp_files(void);
+
+extern void open_transcript_file(char *what_of);
+extern void write_to_transcript_file(char *text);
+extern void close_transcript_file(void);
+extern void abort_transcript_file(void);
+
+extern void nullify_debug_file_position(maybe_file_position *position);
+
+extern void begin_debug_file(void);
+
+extern void debug_file_printf(const char*format, ...);
+extern void debug_file_print_with_entities(const char*string);
+extern void debug_file_print_base_64_triple
+ (uchar first, uchar second, uchar third);
+extern void debug_file_print_base_64_pair(uchar first, uchar second);
+extern void debug_file_print_base_64_single(uchar first);
+
+extern void write_debug_location(debug_location location);
+extern void write_debug_locations(debug_locations locations);
+extern void write_debug_optional_identifier(int32 symbol_index);
+extern void write_debug_symbol_backpatch(int32 symbol_index);
+extern void write_debug_symbol_optional_backpatch(int32 symbol_index);
+extern void write_debug_object_backpatch(int32 object_number);
+extern void write_debug_packed_code_backpatch(int32 offset);
+extern void write_debug_code_backpatch(int32 offset);
+extern void write_debug_global_backpatch(int32 offset);
+extern void write_debug_array_backpatch(int32 offset);
+extern void write_debug_grammar_backpatch(int32 offset);
+
+extern void begin_writing_debug_sections(void);
+extern void write_debug_section(const char*name, int32 beginning_address);
+extern void end_writing_debug_sections(int32 end_address);
+
+extern void write_debug_undef(int32 symbol_index);
+
+extern void end_debug_file(void);
+
+extern void add_to_checksum(void *address);
+
+extern void load_sourcefile(char *story_name, int style);
+extern int file_load_chars(int file_number, char *buffer, int length);
+extern void close_all_source(void);
+extern int register_orig_sourcefile(char *filename);
+
+extern void output_file(void);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "inform" */
+/* ------------------------------------------------------------------------- */
+
+extern char Code_Name[];
+extern int endofpass_flag;
+
+extern int version_number, instruction_set_number, extend_memory_map;
+extern int32 scale_factor, length_scale_factor;
+
+extern int WORDSIZE, INDIV_PROP_START,
+ OBJECT_BYTE_LENGTH, DICT_ENTRY_BYTE_LENGTH, DICT_ENTRY_FLAG_POS;
+extern int32 MAXINTWORD;
+
+extern int asm_trace_level, line_trace_level, expr_trace_level,
+ linker_trace_level, tokens_trace_level;
+
+extern int
+ bothpasses_switch, concise_switch,
+ economy_switch, frequencies_switch,
+ ignore_switches_switch, listobjects_switch, debugfile_switch,
+ listing_switch, memout_switch, printprops_switch,
+ offsets_switch, percentages_switch, obsolete_switch,
+ transcript_switch, statistics_switch, optimise_switch,
+ version_set_switch, nowarnings_switch, hash_switch,
+ memory_map_switch, module_switch, temporary_files_switch,
+ define_DEBUG_switch, define_USE_MODULES_switch, define_INFIX_switch,
+ runtime_error_checking_switch;
+
+extern int oddeven_packing_switch;
+
+extern int glulx_mode, compression_switch;
+extern int32 requested_glulx_version;
+
+extern int error_format, store_the_text, asm_trace_setting,
+ double_space_setting, trace_fns_setting, character_set_setting,
+ character_set_unicode;
+
+extern char Debugging_Name[];
+extern char Transcript_Name[];
+extern char Language_Name[];
+extern char Charset_Map[];
+
+extern char banner_line[];
+
+extern void select_version(int vn);
+extern void switches(char *, int);
+extern int translate_in_filename(int last_value, char *new_name, char *old_name,
+ int same_directory_flag, int command_line_flag);
+extern void translate_out_filename(char *new_name, char *old_name);
+extern int translate_link_filename(int last_value,
+ char *new_name, char *old_name);
+extern void translate_temp_filename(int i);
+
+#ifdef ARCHIMEDES
+extern char *riscos_file_type(void);
+#endif
+
+/* For the benefit of the MAC_FACE port these are declared extern, though
+ unused outside "inform" in the compiler itself */
+
+extern void allocate_arrays(void);
+extern void free_arrays(void);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "lexer" */
+/* ------------------------------------------------------------------------- */
+
+extern int hash_printed_since_newline;
+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 char **local_variable_texts;
+
+extern int32 token_value;
+extern int token_type;
+extern char *token_text;
+
+extern debug_location get_token_location(void);
+extern debug_locations get_token_locations(void);
+extern debug_location_beginning get_token_location_beginning(void);
+extern void discard_token_location(debug_location_beginning beginning);
+extern debug_locations get_token_location_end(debug_location_beginning beginning);
+
+extern void describe_token(token_data t);
+
+extern void construct_local_variable_tables(void);
+extern void declare_systemfile(void);
+extern int is_systemfile(void);
+extern void report_errors_at_current_line(void);
+extern debug_location get_current_debug_location(void);
+extern debug_location get_error_report_debug_location(void);
+extern int32 get_current_line_start(void);
+extern void set_origsource_location(char *source, int32 line, int32 charnum);
+extern brief_location get_brief_location(ErrorPosition *errpos);
+extern void export_brief_location(brief_location loc, ErrorPosition *errpos);
+extern brief_location blank_brief_location;
+
+extern void put_token_back(void);
+extern void get_next_token(void);
+extern void restart_lexer(char *lexical_source, char *name);
+
+extern keyword_group directives, statements, segment_markers,
+ conditions, system_functions, local_variables, opcode_names,
+ misc_keywords, directive_keywords, trace_keywords, system_constants,
+ opcode_macros;
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "linker" */
+/* ------------------------------------------------------------------------- */
+
+extern memory_block link_data_area;
+extern int32 link_data_size;
+extern char current_module_filename[];
+
+extern char *describe_mv(int mval);
+extern void write_link_marker(int zmachine_area, int32 offset,
+ assembly_operand op);
+extern void flush_link_data(void);
+extern void import_symbol(int32 symbol_number);
+extern void export_symbol(int32 symbol_number);
+extern void export_symbol_name(int32 i);
+extern void link_module(char *filename);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "memory" */
+/* ------------------------------------------------------------------------- */
+
+extern int32 malloced_bytes;
+
+extern int MAX_QTEXT_SIZE, MAX_SYMBOLS, HASH_TAB_SIZE, MAX_DICT_ENTRIES,
+ MAX_OBJECTS, MAX_ACTIONS, MAX_ADJECTIVES, MAX_ABBREVS,
+ MAX_STATIC_DATA, MAX_PROP_TABLE_SIZE, SYMBOLS_CHUNK_SIZE,
+ MAX_EXPRESSION_NODES, MAX_LABELS, MAX_LINESPACE,
+ MAX_LOW_STRINGS, MAX_CLASSES, MAX_VERBS,
+ MAX_VERBSPACE, MAX_ARRAYS, MAX_INCLUSION_DEPTH,
+ MAX_SOURCE_FILES;
+
+extern int32 MAX_STATIC_STRINGS, MAX_ZCODE_SIZE, MAX_LINK_DATA_SIZE,
+ MAX_TRANSCRIPT_SIZE, MAX_INDIV_PROP_TABLE_SIZE,
+ MAX_NUM_STATIC_STRINGS, MAX_UNICODE_CHARS,
+ MAX_STACK_SIZE, MEMORY_MAP_EXTENSION;
+
+extern int32 MAX_OBJ_PROP_COUNT, MAX_OBJ_PROP_TABLE_SIZE;
+extern int MAX_LOCAL_VARIABLES, MAX_GLOBAL_VARIABLES;
+extern int DICT_WORD_SIZE, DICT_CHAR_SIZE, DICT_WORD_BYTES;
+extern int ZCODE_HEADER_EXT_WORDS, ZCODE_HEADER_FLAGS_3;
+extern int NUM_ATTR_BYTES, GLULX_OBJECT_EXT_BYTES;
+extern int WARN_UNUSED_ROUTINES, OMIT_UNUSED_ROUTINES;
+
+/* These macros define offsets that depend on the value of NUM_ATTR_BYTES.
+ (Meaningful only for Glulx.) */
+/* GOBJFIELD: word offsets of various elements in the object structure. */
+#define GOBJFIELD_CHAIN() (1+((NUM_ATTR_BYTES)/4))
+#define GOBJFIELD_NAME() (2+((NUM_ATTR_BYTES)/4))
+#define GOBJFIELD_PROPTAB() (3+((NUM_ATTR_BYTES)/4))
+#define GOBJFIELD_PARENT() (4+((NUM_ATTR_BYTES)/4))
+#define GOBJFIELD_SIBLING() (5+((NUM_ATTR_BYTES)/4))
+#define GOBJFIELD_CHILD() (6+((NUM_ATTR_BYTES)/4))
+
+extern void *my_malloc(int32 size, char *whatfor);
+extern void my_realloc(void *pointer, int32 oldsize, int32 size,
+ char *whatfor);
+extern void *my_calloc(int32 size, int32 howmany, char *whatfor);
+extern void my_recalloc(void *pointer, int32 size, int32 oldhowmany,
+ int32 howmany, char *whatfor);
+extern void my_free(void *pointer, char *whatitwas);
+
+extern void set_memory_sizes(int size_flag);
+extern void adjust_memory_sizes(void);
+extern void memory_command(char *command);
+extern void print_memory_usage(void);
+
+extern void initialise_memory_block(memory_block *MB);
+extern void deallocate_memory_block(memory_block *MB);
+extern int read_byte_from_memory_block(memory_block *MB, int32 index);
+extern void write_byte_to_memory_block(memory_block *MB,
+ int32 index, int value);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "objects" */
+/* ------------------------------------------------------------------------- */
+
+extern int no_attributes, no_properties;
+extern int no_individual_properties;
+extern int individuals_length;
+extern uchar *individuals_table;
+extern int no_classes, no_objects;
+extern objecttz *objectsz;
+extern objecttg *objectsg;
+extern uchar *objectatts;
+extern int *class_object_numbers;
+extern int32 *class_begins_at;
+
+extern int32 *prop_default_value;
+extern int *prop_is_long;
+extern int *prop_is_additive;
+extern char *properties_table;
+extern int properties_table_size;
+
+extern void make_attribute(void);
+extern void make_property(void);
+extern void make_object(int nearby_flag,
+ char *textual_name, int specified_parent, int specified_class,
+ int instance_of);
+extern void make_class(char *metaclass_name);
+extern int object_provides(int obj, int id);
+extern void list_object_tree(void);
+extern void write_the_identifier_names(void);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "symbols" */
+/* ------------------------------------------------------------------------- */
+
+extern int no_named_constants;
+extern int no_symbols;
+extern int32 **symbs;
+extern int32 *svals;
+extern int *smarks;
+extern brief_location *slines;
+extern int *sflags;
+#ifdef VAX
+ extern char *stypes;
+#else
+ extern signed char *stypes;
+#endif
+extern maybe_file_position *symbol_debug_backpatch_positions;
+extern maybe_file_position *replacement_debug_backpatch_positions;
+extern int32 *individual_name_strings;
+extern int32 *attribute_name_strings;
+extern int32 *action_name_strings;
+extern int32 *array_name_strings;
+extern int track_unused_routines;
+extern int df_dont_note_global_symbols;
+extern uint32 df_total_size_before_stripping;
+extern uint32 df_total_size_after_stripping;
+
+extern char *typename(int type);
+extern int hash_code_from_string(char *p);
+extern int strcmpcis(char *p, char *q);
+extern int symbol_index(char *lexeme_text, int hashcode);
+extern void end_symbol_scope(int k);
+extern void describe_symbol(int k);
+extern void list_symbols(int level);
+extern void assign_marked_symbol(int index, int marker, int32 value, int type);
+extern void assign_symbol(int index, int32 value, int type);
+extern void issue_unused_warnings(void);
+extern void add_symbol_replacement_mapping(int original, int renamed);
+extern int find_symbol_replacement(int *value);
+extern void df_note_function_start(char *name, uint32 address,
+ int embedded_flag, brief_location source_line);
+extern void df_note_function_end(uint32 endaddress);
+extern void df_note_function_symbol(int symbol);
+extern void locate_dead_functions(void);
+extern uint32 df_stripped_address_for_address(uint32);
+extern uint32 df_stripped_offset_for_code_offset(uint32, int *);
+extern void df_prepare_function_iterate(void);
+extern uint32 df_next_function_iterate(int *);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "syntax" */
+/* ------------------------------------------------------------------------- */
+
+extern int no_syntax_lines;
+
+extern void panic_mode_error_recovery(void);
+extern void get_next_token_with_directives(void);
+extern int parse_directive(int internal_flag);
+extern void parse_program(char *source);
+extern int32 parse_routine(char *source, int embedded_flag, char *name,
+ int veneer_flag, int r_symbol);
+extern void parse_code_block(int break_label, int continue_label,
+ int switch_rule);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "states" */
+/* ------------------------------------------------------------------------- */
+
+extern void match_close_bracket(void);
+extern void parse_statement(int break_label, int continue_label);
+extern int parse_label(void);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "tables" */
+/* ------------------------------------------------------------------------- */
+
+extern uchar *zmachine_paged_memory;
+extern int32
+ code_offset, actions_offset, preactions_offset,
+ dictionary_offset, strings_offset, adjectives_offset,
+ variables_offset, class_numbers_offset, individuals_offset,
+ identifier_names_offset, prop_defaults_offset, prop_values_offset,
+ static_memory_offset, array_names_offset, attribute_names_offset,
+ action_names_offset, fake_action_names_offset,
+ routine_names_offset, routines_array_offset, routine_flags_array_offset,
+ global_names_offset, global_flags_array_offset,
+ array_flags_array_offset, constant_names_offset, constants_array_offset;
+extern int32
+ arrays_offset, object_tree_offset, grammar_table_offset,
+ abbreviations_offset; /* For Glulx */
+
+extern int32 Out_Size, Write_Code_At, Write_Strings_At;
+extern int32 RAM_Size, Write_RAM_At; /* For Glulx */
+
+extern int release_number, statusline_flag;
+extern int flags2_requirements[];
+extern int serial_code_given_in_program;
+extern char serial_code_buffer[];
+
+extern void construct_storyfile(void);
+extern void write_serial_number(char *buffer);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "text" */
+/* ------------------------------------------------------------------------- */
+
+extern uchar *low_strings, *low_strings_top;
+extern char *all_text, *all_text_top;
+
+extern int no_abbreviations;
+extern int abbrevs_lookup_table_made, is_abbreviation;
+extern uchar *abbreviations_at;
+extern int *abbrev_values;
+extern int *abbrev_quality;
+extern int *abbrev_freqs;
+
+extern int32 total_chars_trans, total_bytes_trans,
+ zchars_trans_in_last_string;
+extern int put_strings_in_low_memory;
+extern int dict_entries;
+extern uchar *dictionary, *dictionary_top;
+extern int *final_dict_order;
+
+extern memory_block static_strings_area;
+extern int32 static_strings_extent;
+
+/* And now, a great many declarations for dealing with Glulx string
+ compression. */
+
+extern int32 no_strings, no_dynamic_strings;
+extern int no_unicode_chars;
+
+#define MAX_DYNAMIC_STRINGS (64)
+
+typedef struct unicode_usage_s unicode_usage_t;
+struct unicode_usage_s {
+ int32 ch;
+ unicode_usage_t *next;
+};
+
+extern unicode_usage_t *unicode_usage_entries;
+
+/* This is the maximum number of (8-bit) bytes that can encode a single
+ Huffman entity. Four should be plenty, unless someone starts encoding
+ an ideographic language. */
+#define MAXHUFFBYTES (4)
+
+typedef struct huffbitlist_struct {
+ uchar b[MAXHUFFBYTES];
+} huffbitlist_t;
+typedef struct huffentity_struct {
+ int count;
+ int type;
+ union {
+ int branch[2];
+ unsigned char ch;
+ int val;
+ } u;
+ int depth;
+ int32 addr;
+ huffbitlist_t bits;
+} huffentity_t;
+
+extern huffentity_t *huff_entities;
+
+extern int32 compression_table_size, compression_string_size;
+extern int32 *compressed_offsets;
+extern int no_huff_entities;
+extern int huff_abbrev_start, huff_dynam_start, huff_unicode_start;
+extern int huff_entity_root;
+
+extern void compress_game_text(void);
+
+/* end of the Glulx string compression stuff */
+
+extern void ao_free_arrays(void);
+extern int32 compile_string(char *b, int in_low_memory, int is_abbrev);
+extern uchar *translate_text(uchar *p, uchar *p_limit, char *s_text);
+extern void optimise_abbreviations(void);
+extern void make_abbreviation(char *text);
+extern void show_dictionary(void);
+extern void word_to_ascii(uchar *p, char *result);
+extern void write_dictionary_to_transcript(void);
+extern void sort_dictionary(void);
+extern void dictionary_prepare(char *dword, uchar *optresult);
+extern int dictionary_add(char *dword, int x, int y, int z);
+extern void dictionary_set_verb_number(char *dword, int to);
+extern int compare_sorts(uchar *d1, uchar *d2);
+extern void copy_sorts(uchar *d1, uchar *d2);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "veneer" */
+/* ------------------------------------------------------------------------- */
+
+extern int veneer_mode;
+extern int32 veneer_routine_address[];
+
+extern void compile_initial_routine(void);
+extern assembly_operand veneer_routine(int code);
+extern void compile_veneer(void);
+
+/* ------------------------------------------------------------------------- */
+/* Extern definitions for "verbs" */
+/* ------------------------------------------------------------------------- */
+
+extern int no_adjectives, no_Inform_verbs, no_grammar_token_routines,
+ no_fake_actions, no_actions, no_grammar_lines, no_grammar_tokens,
+ grammar_version_number;
+extern int32 grammar_version_symbol;
+extern verbt *Inform_verbs;
+extern uchar *grammar_lines;
+extern int32 grammar_lines_top;
+extern int32 *action_byte_offset,
+ *grammar_token_routine,
+ *adjectives;
+
+extern void find_the_actions(void);
+extern void make_fake_action(void);
+extern assembly_operand action_of_name(char *name);
+extern void make_verb(void);
+extern void extend_verb(void);
+extern void list_verb_table(void);
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "inform" : The top level of Inform: switches, pathnames, filenaming */
+/* conventions, ICL (Inform Command Line) files, main */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#define MAIN_INFORM_FILE
+#include "header.h"
+
+/* ------------------------------------------------------------------------- */
+/* Compiler progress */
+/* ------------------------------------------------------------------------- */
+
+static int no_compilations;
+
+int endofpass_flag; /* set to TRUE when an "end" directive is reached
+ (the inputs routines insert one into the stream
+ if necessary) */
+
+/* ------------------------------------------------------------------------- */
+/* Version control */
+/* ------------------------------------------------------------------------- */
+
+int version_number, /* 3 to 8 (Z-code) */
+ instruction_set_number,
+ /* 3 to 6: versions 7 and 8 use instruction set of
+ version 5 */
+ extend_memory_map; /* extend using function- and string-offsets */
+int32 scale_factor, /* packed address multiplier */
+ length_scale_factor; /* length-in-header multiplier */
+
+int32 requested_glulx_version;
+
+extern void select_version(int vn)
+{ version_number = vn;
+ extend_memory_map = FALSE;
+ if ((version_number==6)||(version_number==7)) extend_memory_map = TRUE;
+
+ scale_factor = 4;
+ if (version_number==3) scale_factor = 2;
+ if (version_number==8) scale_factor = 8;
+
+ length_scale_factor = scale_factor;
+ if ((version_number==6)||(version_number==7)) length_scale_factor = 8;
+
+ instruction_set_number = version_number;
+ if ((version_number==7)||(version_number==8)) instruction_set_number = 5;
+}
+
+static int select_glulx_version(char *str)
+{
+ /* Parse an "X.Y.Z" style version number, and store it for later use. */
+ char *cx = str;
+ int major=0, minor=0, patch=0;
+
+ while (isdigit(*cx))
+ major = major*10 + ((*cx++)-'0');
+ if (*cx == '.') {
+ cx++;
+ while (isdigit(*cx))
+ minor = minor*10 + ((*cx++)-'0');
+ if (*cx == '.') {
+ cx++;
+ while (isdigit(*cx))
+ patch = patch*10 + ((*cx++)-'0');
+ }
+ }
+
+ requested_glulx_version = ((major & 0x7FFF) << 16)
+ + ((minor & 0xFF) << 8)
+ + (patch & 0xFF);
+ return (cx - str);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Target: variables which vary between the Z-machine and Glulx */
+/* ------------------------------------------------------------------------- */
+
+int WORDSIZE; /* Size of a machine word: 2 or 4 */
+int32 MAXINTWORD; /* 0x7FFF or 0x7FFFFFFF */
+
+/* The first property number which is an individual property. The
+ eight class-system i-props (create, recreate, ... print_to_array)
+ are numbered from INDIV_PROP_START to INDIV_PROP_START+7.
+*/
+int INDIV_PROP_START;
+
+/* The length of an object, as written in tables.c. It's easier to define
+ it here than to repeat the same expression all over the source code.
+ Not used in Z-code.
+*/
+int OBJECT_BYTE_LENGTH;
+/* The total length of a dict entry, in bytes. Not used in Z-code.
+*/
+int DICT_ENTRY_BYTE_LENGTH;
+/* The position in a dict entry that the flag values begin.
+ Not used in Z-code.
+*/
+int DICT_ENTRY_FLAG_POS;
+
+static void select_target(int targ)
+{
+ if (!targ) {
+ /* Z-machine */
+ WORDSIZE = 2;
+ MAXINTWORD = 0x7FFF;
+
+ if (INDIV_PROP_START != 64) {
+ INDIV_PROP_START = 64;
+ fatalerror("You cannot change INDIV_PROP_START in Z-code");
+ }
+ if (DICT_WORD_SIZE != 6) {
+ DICT_WORD_SIZE = 6;
+ fatalerror("You cannot change DICT_WORD_SIZE in Z-code");
+ }
+ if (DICT_CHAR_SIZE != 1) {
+ DICT_CHAR_SIZE = 1;
+ fatalerror("You cannot change DICT_CHAR_SIZE in Z-code");
+ }
+ if (NUM_ATTR_BYTES != 6) {
+ NUM_ATTR_BYTES = 6;
+ fatalerror("You cannot change NUM_ATTR_BYTES in Z-code");
+ }
+ if (MAX_LOCAL_VARIABLES != 16) {
+ MAX_LOCAL_VARIABLES = 16;
+ fatalerror("You cannot change MAX_LOCAL_VARIABLES in Z-code");
+ }
+ if (MAX_GLOBAL_VARIABLES != 240) {
+ MAX_GLOBAL_VARIABLES = 240;
+ fatalerror("You cannot change MAX_GLOBAL_VARIABLES in Z-code");
+ }
+ if (MAX_VERBS > 255) {
+ MAX_VERBS = 255;
+ fatalerror("MAX_VERBS can only go above 255 when Glulx is used");
+ }
+ }
+ else {
+ /* Glulx */
+ WORDSIZE = 4;
+ MAXINTWORD = 0x7FFFFFFF;
+ scale_factor = 0; /* It should never even get used in Glulx */
+
+ 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);
+ }
+
+ 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);
+ }
+
+ 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);
+ }
+ }
+
+ if (MAX_LOCAL_VARIABLES >= 120) {
+ MAX_LOCAL_VARIABLES = 119;
+ warning("MAX_LOCAL_VARIABLES cannot exceed 119; resetting to 119");
+ /* This is because the keyword table in the lexer only has 120
+ entries. */
+ }
+ 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",
+ MAX_NUM_ATTR_BYTES);
+ /* MAX_NUM_ATTR_BYTES can be increased in header.h without fear. */
+ }
+
+ /* Set up a few more variables that depend on the above values */
+
+ if (!targ) {
+ /* Z-machine */
+ DICT_WORD_BYTES = DICT_WORD_SIZE;
+ /* The Z-code generator doesn't use the following variables, although
+ it would be a little cleaner if it did. */
+ OBJECT_BYTE_LENGTH = 0;
+ DICT_ENTRY_BYTE_LENGTH = (version_number==3)?7:9;
+ DICT_ENTRY_FLAG_POS = 0;
+ }
+ else {
+ /* Glulx */
+ OBJECT_BYTE_LENGTH = (1 + (NUM_ATTR_BYTES) + 6*4 + (GLULX_OBJECT_EXT_BYTES));
+ DICT_WORD_BYTES = DICT_WORD_SIZE*DICT_CHAR_SIZE;
+ if (DICT_CHAR_SIZE == 1) {
+ DICT_ENTRY_BYTE_LENGTH = (7+DICT_WORD_BYTES);
+ DICT_ENTRY_FLAG_POS = (1+DICT_WORD_BYTES);
+ }
+ else {
+ DICT_ENTRY_BYTE_LENGTH = (12+DICT_WORD_BYTES);
+ DICT_ENTRY_FLAG_POS = (4+DICT_WORD_BYTES);
+ }
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Tracery: output control variables */
+/* ------------------------------------------------------------------------- */
+
+int asm_trace_level, /* trace assembly: 0 for off, 1 for assembly
+ only, 2 for full assembly tracing with hex dumps */
+ line_trace_level, /* line tracing: 0 off, 1 on */
+ expr_trace_level, /* expression tracing: 0 off, 1 full, 2 brief */
+ linker_trace_level, /* set by -y: 0 to 4 levels of tracing */
+ tokens_trace_level; /* lexer output tracing: 0 off, 1 on */
+
+/* ------------------------------------------------------------------------- */
+/* On/off switch variables (by default all FALSE); other switch settings */
+/* ------------------------------------------------------------------------- */
+
+int bothpasses_switch, /* -b */
+ concise_switch, /* -c */
+ economy_switch, /* -e */
+ frequencies_switch, /* -f */
+ ignore_switches_switch, /* -i */
+ listobjects_switch, /* -j */
+ debugfile_switch, /* -k */
+ listing_switch, /* -l */
+ memout_switch, /* -m */
+ printprops_switch, /* -n */
+ offsets_switch, /* -o */
+ percentages_switch, /* -p */
+ obsolete_switch, /* -q */
+ transcript_switch, /* -r */
+ statistics_switch, /* -s */
+ optimise_switch, /* -u */
+ version_set_switch, /* -v */
+ nowarnings_switch, /* -w */
+ hash_switch, /* -x */
+ memory_map_switch, /* -z */
+ oddeven_packing_switch, /* -B */
+ define_DEBUG_switch, /* -D */
+ temporary_files_switch, /* -F */
+ module_switch, /* -M */
+ runtime_error_checking_switch, /* -S */
+ define_USE_MODULES_switch, /* -U */
+ define_INFIX_switch; /* -X */
+#ifdef ARC_THROWBACK
+int throwback_switch; /* -T */
+#endif
+#ifdef ARCHIMEDES
+int riscos_file_type_format; /* set by -R */
+#endif
+int compression_switch; /* set by -H */
+int character_set_setting, /* set by -C0 through -C9 */
+ character_set_unicode, /* set by -Cu */
+ error_format, /* set by -E */
+ asm_trace_setting, /* set by -a and -t: value of
+ asm_trace_level to use when tracing */
+ double_space_setting, /* set by -d: 0, 1 or 2 */
+ trace_fns_setting, /* set by -g: 0, 1 or 2 */
+ linker_trace_setting, /* set by -y: ditto for linker_... */
+ store_the_text; /* when set, record game text to a chunk
+ of memory (used by both -r & -k) */
+static int r_e_c_s_set; /* has -S been explicitly set? */
+
+int glulx_mode; /* -G */
+
+static void reset_switch_settings(void)
+{ asm_trace_setting=0;
+ linker_trace_level=0;
+ tokens_trace_level=0;
+
+ store_the_text = FALSE;
+
+ bothpasses_switch = FALSE;
+ concise_switch = FALSE;
+ double_space_setting = 0;
+ economy_switch = FALSE;
+ frequencies_switch = FALSE;
+ trace_fns_setting = 0;
+ ignore_switches_switch = FALSE;
+ listobjects_switch = FALSE;
+ debugfile_switch = FALSE;
+ listing_switch = FALSE;
+ memout_switch = FALSE;
+ printprops_switch = FALSE;
+ offsets_switch = FALSE;
+ percentages_switch = FALSE;
+ obsolete_switch = FALSE;
+ transcript_switch = FALSE;
+ statistics_switch = FALSE;
+ optimise_switch = FALSE;
+ version_set_switch = FALSE;
+ nowarnings_switch = FALSE;
+ hash_switch = FALSE;
+ memory_map_switch = FALSE;
+ oddeven_packing_switch = FALSE;
+ define_DEBUG_switch = FALSE;
+#ifdef USE_TEMPORARY_FILES
+ temporary_files_switch = TRUE;
+#else
+ temporary_files_switch = FALSE;
+#endif
+ define_USE_MODULES_switch = FALSE;
+ module_switch = FALSE;
+#ifdef ARC_THROWBACK
+ throwback_switch = FALSE;
+#endif
+ runtime_error_checking_switch = TRUE;
+ r_e_c_s_set = FALSE;
+ define_INFIX_switch = FALSE;
+#ifdef ARCHIMEDES
+ riscos_file_type_format = 0;
+#endif
+ error_format=DEFAULT_ERROR_FORMAT;
+
+ character_set_setting = 1; /* Default is ISO Latin-1 */
+ character_set_unicode = FALSE;
+
+ compression_switch = TRUE;
+ glulx_mode = FALSE;
+ requested_glulx_version = 0;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Number of files given as command line parameters (0, 1 or 2) */
+/* ------------------------------------------------------------------------- */
+
+static int cli_files_specified,
+ convert_filename_flag;
+
+char Source_Name[PATHLEN]; /* Processed name of first input file */
+char Code_Name[PATHLEN]; /* Processed name of output file */
+
+static char *cli_file1, *cli_file2; /* Unprocessed (and unsafe to alter) */
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+static void init_vars(void)
+{
+ init_arrays_vars();
+ init_asm_vars();
+ init_bpatch_vars();
+ init_chars_vars();
+ init_directs_vars();
+ init_errors_vars();
+ init_expressc_vars();
+ init_expressp_vars();
+ init_files_vars();
+ init_lexer_vars();
+ init_linker_vars();
+ init_memory_vars();
+ init_objects_vars();
+ init_states_vars();
+ init_symbols_vars();
+ init_syntax_vars();
+ init_tables_vars();
+ init_text_vars();
+ init_veneer_vars();
+ init_verbs_vars();
+}
+
+static void begin_pass(void)
+{
+ arrays_begin_pass();
+ asm_begin_pass();
+ bpatch_begin_pass();
+ chars_begin_pass();
+ directs_begin_pass();
+ errors_begin_pass();
+ expressc_begin_pass();
+ expressp_begin_pass();
+ files_begin_pass();
+
+ endofpass_flag = FALSE;
+ line_trace_level = 0; expr_trace_level = 0;
+ asm_trace_level = asm_trace_setting;
+ linker_trace_level = linker_trace_setting;
+ if (listing_switch) line_trace_level=1;
+
+ lexer_begin_pass();
+ linker_begin_pass();
+ memory_begin_pass();
+ objects_begin_pass();
+ states_begin_pass();
+ symbols_begin_pass();
+ syntax_begin_pass();
+ tables_begin_pass();
+ text_begin_pass();
+ veneer_begin_pass();
+ verbs_begin_pass();
+
+ if (!module_switch)
+ {
+ /* Compile a Main__ routine (see "veneer.c") */
+
+ compile_initial_routine();
+
+ /* Make the four metaclasses: Class must be object number 1, so
+ it must come first */
+
+ veneer_mode = TRUE;
+
+ make_class("Class");
+ make_class("Object");
+ make_class("Routine");
+ make_class("String");
+
+ veneer_mode = FALSE;
+ }
+}
+
+extern void allocate_arrays(void)
+{
+ arrays_allocate_arrays();
+ asm_allocate_arrays();
+ bpatch_allocate_arrays();
+ chars_allocate_arrays();
+ directs_allocate_arrays();
+ errors_allocate_arrays();
+ expressc_allocate_arrays();
+ expressp_allocate_arrays();
+ files_allocate_arrays();
+
+ lexer_allocate_arrays();
+ linker_allocate_arrays();
+ memory_allocate_arrays();
+ objects_allocate_arrays();
+ states_allocate_arrays();
+ symbols_allocate_arrays();
+ syntax_allocate_arrays();
+ tables_allocate_arrays();
+ text_allocate_arrays();
+ veneer_allocate_arrays();
+ verbs_allocate_arrays();
+}
+
+extern void free_arrays(void)
+{
+ /* One array may survive this routine, all_the_text (used to hold
+ game text until the abbreviations optimiser begins work on it): this
+ array (if it was ever allocated) is freed at the top level. */
+
+ arrays_free_arrays();
+ asm_free_arrays();
+ bpatch_free_arrays();
+ chars_free_arrays();
+ directs_free_arrays();
+ errors_free_arrays();
+ expressc_free_arrays();
+ expressp_free_arrays();
+ files_free_arrays();
+
+ lexer_free_arrays();
+ linker_free_arrays();
+ memory_free_arrays();
+ objects_free_arrays();
+ states_free_arrays();
+ symbols_free_arrays();
+ syntax_free_arrays();
+ tables_free_arrays();
+ text_free_arrays();
+ veneer_free_arrays();
+ verbs_free_arrays();
+}
+
+/* ------------------------------------------------------------------------- */
+/* Name translation code for filenames */
+/* ------------------------------------------------------------------------- */
+
+static char Source_Path[PATHLEN];
+static char Include_Path[PATHLEN];
+static char Code_Path[PATHLEN];
+static char Module_Path[PATHLEN];
+static char Temporary_Path[PATHLEN];
+static char current_source_path[PATHLEN];
+ char Debugging_Name[PATHLEN];
+ char Transcript_Name[PATHLEN];
+ char Language_Name[PATHLEN];
+ char Charset_Map[PATHLEN];
+static char ICL_Path[PATHLEN];
+
+/* Set one of the above Path buffers to the given location, or list of
+ locations. (A list is comma-separated, and only accepted for Source_Path,
+ Include_Path, ICL_Path, Module_Path.)
+*/
+static void set_path_value(char *path, char *value)
+{ int i, j;
+
+ for (i=0, j=0;;)
+ {
+ if (i >= PATHLEN-1) {
+ printf("A specified path is longer than %d characters.\n",
+ PATHLEN-1);
+ exit(1);
+ }
+ if ((value[j] == FN_ALT) || (value[j] == 0))
+ { if ((value[j] == FN_ALT)
+ && (path != Source_Path) && (path != Include_Path)
+ && (path != ICL_Path) && (path != Module_Path))
+ { printf("The character '%c' is used to divide entries in a list \
+of possible locations, and can only be used in the Include_Path, Source_Path, \
+Module_Path or ICL_Path variables. Other paths are for output only.\n", FN_ALT);
+ exit(1);
+ }
+ if ((path != Debugging_Name) && (path != Transcript_Name)
+ && (path != Language_Name) && (path != Charset_Map)
+ && (i>0) && (isalnum(path[i-1]))) path[i++] = FN_SEP;
+ path[i++] = value[j++];
+ if (value[j-1] == 0) return;
+ }
+ else path[i++] = value[j++];
+ }
+}
+
+/* Prepend the given location or list of locations to one of the above
+ Path buffers. This is only permitted for Source_Path, Include_Path,
+ ICL_Path, Module_Path.
+
+ An empty field (in the comma-separated list) means the current
+ directory. If the Path buffer is entirely empty, we assume that
+ we want to search both value and the current directory, so
+ the result will be "value,".
+*/
+static void prepend_path_value(char *path, char *value)
+{
+ int i, j;
+ int oldlen = strlen(path);
+ int newlen;
+ char new_path[PATHLEN];
+
+ if ((path != Source_Path) && (path != Include_Path)
+ && (path != ICL_Path) && (path != Module_Path))
+ { printf("The character '+' is used to add to a list \
+of possible locations, and can only be used in the Include_Path, Source_Path, \
+Module_Path or ICL_Path variables. Other paths are for output only.\n");
+ exit(1);
+ }
+
+ for (i=0, j=0;;)
+ {
+ if (i >= PATHLEN-1) {
+ printf("A specified path is longer than %d characters.\n",
+ PATHLEN-1);
+ exit(1);
+ }
+ if ((value[j] == FN_ALT) || (value[j] == 0))
+ { if ((path != Debugging_Name) && (path != Transcript_Name)
+ && (path != Language_Name) && (path != Charset_Map)
+ && (i>0) && (isalnum(new_path[i-1]))) new_path[i++] = FN_SEP;
+ new_path[i++] = value[j++];
+ if (value[j-1] == 0) {
+ newlen = i-1;
+ break;
+ }
+ }
+ else new_path[i++] = value[j++];
+ }
+
+ if (newlen+1+oldlen >= PATHLEN-1) {
+ printf("A specified path is longer than %d characters.\n",
+ PATHLEN-1);
+ exit(1);
+ }
+
+ i = newlen;
+ new_path[i++] = FN_ALT;
+ for (j=0; j<oldlen;)
+ new_path[i++] = path[j++];
+ new_path[i] = 0;
+
+ strcpy(path, new_path);
+}
+
+static void set_default_paths(void)
+{
+ set_path_value(Source_Path, Source_Directory);
+ set_path_value(Include_Path, Include_Directory);
+ set_path_value(Code_Path, Code_Directory);
+ set_path_value(Module_Path, Module_Directory);
+ set_path_value(ICL_Path, ICL_Directory);
+ set_path_value(Temporary_Path, Temporary_Directory);
+ set_path_value(Debugging_Name, Debugging_File);
+ set_path_value(Transcript_Name, Transcript_File);
+ set_path_value(Language_Name, "english");
+ set_path_value(Charset_Map, "");
+}
+
+/* Parse a path option which looks like "dir", "+dir", "pathname=dir",
+ or "+pathname=dir". If there is no "=", we assume "include_path=...".
+ If the option begins with a "+" the directory is prepended to the
+ existing path instead of replacing it.
+*/
+static void set_path_command(char *command)
+{ int i, j; char *path_to_set = NULL;
+ int prepend = 0;
+
+ if (command[0] == '+') {
+ prepend = 1;
+ command++;
+ }
+
+ for (i=0; (command[i]!=0) && (command[i]!='=');i++) ;
+
+ path_to_set=Include_Path;
+
+ if (command[i] == '=') {
+ char pathname[PATHLEN];
+ if (i>=PATHLEN) i=PATHLEN-1;
+ for (j=0;j<i;j++) {
+ char ch = command[j];
+ if (isupper(ch)) ch=tolower(ch);
+ pathname[j]=ch;
+ }
+ pathname[j]=0;
+ command = command+i+1;
+
+ path_to_set = NULL;
+ if (strcmp(pathname, "source_path")==0) path_to_set=Source_Path;
+ if (strcmp(pathname, "include_path")==0) path_to_set=Include_Path;
+ if (strcmp(pathname, "code_path")==0) path_to_set=Code_Path;
+ if (strcmp(pathname, "module_path")==0) path_to_set=Module_Path;
+ if (strcmp(pathname, "icl_path")==0) path_to_set=ICL_Path;
+ if (strcmp(pathname, "temporary_path")==0) path_to_set=Temporary_Path;
+ if (strcmp(pathname, "debugging_name")==0) path_to_set=Debugging_Name;
+ if (strcmp(pathname, "transcript_name")==0) path_to_set=Transcript_Name;
+ if (strcmp(pathname, "language_name")==0) path_to_set=Language_Name;
+ if (strcmp(pathname, "charset_map")==0) path_to_set=Charset_Map;
+
+ if (path_to_set == NULL)
+ { printf("No such path setting as \"%s\"\n", pathname);
+ exit(1);
+ }
+ }
+
+ if (!prepend)
+ set_path_value(path_to_set, command);
+ else
+ prepend_path_value(path_to_set, command);
+}
+
+static int contains_separator(char *name)
+{ int i;
+ for (i=0; name[i]!=0; i++)
+ if (name[i] == FN_SEP) return 1;
+ return 0;
+}
+
+static int write_translated_name(char *new_name, char *old_name,
+ char *prefix_path, int start_pos,
+ char *extension)
+{ int x;
+ if (strlen(old_name)+strlen(extension) >= PATHLEN) {
+ printf("One of your filenames is longer than %d characters.\n", PATHLEN);
+ exit(1);
+ }
+ if (prefix_path == NULL)
+ { sprintf(new_name,"%s%s", old_name, extension);
+ return 0;
+ }
+ strcpy(new_name, prefix_path + start_pos);
+ for (x=0; (new_name[x]!=0) && (new_name[x]!=FN_ALT); x++) ;
+ if (new_name[x] == 0) start_pos = 0; else start_pos += x+1;
+ if (x+strlen(old_name)+strlen(extension) >= PATHLEN) {
+ printf("One of your pathnames is longer than %d characters.\n", PATHLEN);
+ exit(1);
+ }
+ sprintf(new_name + x, "%s%s", old_name, extension);
+ return start_pos;
+}
+
+#ifdef FILE_EXTENSIONS
+static char *check_extension(char *name, char *extension)
+{ int i;
+
+ /* If a filename ends in '.', remove the dot and add no file extension: */
+ i = strlen(name)-1;
+ if (name[i] == '.') { name[i]=0; return ""; }
+
+ /* Remove the new extension if it's already got one: */
+
+ for (; (i>=0) && (name[i]!=FN_SEP); i--)
+ if (name[i] == '.') return "";
+ return extension;
+}
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* Three translation routines have to deal with path variables which may */
+/* contain alternative locations separated by the FN_ALT character. */
+/* These have the protocol: */
+/* */
+/* int translate_*_filename(int last_value, ...) */
+/* */
+/* and should first be called with last_value equal to 0. If the */
+/* translated filename works, fine. Otherwise, if the returned integer */
+/* was zero, the caller knows that no filename works and can issue an */
+/* error message. If it was non-zero, the caller should pass it on as */
+/* the last_value again. */
+/* */
+/* As implemented below, last_value is the position in the path variable */
+/* string at which the next directory name to try begins. */
+/* ------------------------------------------------------------------------- */
+
+extern int translate_in_filename(int last_value,
+ char *new_name, char *old_name,
+ int same_directory_flag, int command_line_flag)
+{ char *prefix_path = NULL;
+ char *extension;
+ int add_path_flag = 1;
+ int i;
+
+ if ((same_directory_flag==0)
+ && (contains_separator(old_name)==1)) add_path_flag=0;
+
+ if (add_path_flag==1)
+ { if (command_line_flag == 0)
+ { /* File is opened as a result of an Include directive */
+
+ if (same_directory_flag==1)
+ prefix_path = current_source_path;
+ else
+ if (Include_Path[0]!=0) prefix_path = Include_Path;
+ }
+ /* Main file being opened from the command line */
+
+ else if (Source_Path[0]!=0) prefix_path = Source_Path;
+ }
+
+#ifdef FILE_EXTENSIONS
+ /* Which file extension is expected? */
+
+ if ((command_line_flag==1)||(same_directory_flag==1))
+ extension = Source_Extension;
+ else
+ extension = Include_Extension;
+
+ extension = check_extension(old_name, extension);
+#else
+ extension = "";
+#endif
+
+ last_value = write_translated_name(new_name, old_name,
+ prefix_path, last_value, extension);
+
+ /* Set the "current source path" (for use of Include ">...") */
+
+ if (command_line_flag==1)
+ { strcpy(current_source_path, new_name);
+ for (i=strlen(current_source_path)-1;
+ ((i>0)&&(current_source_path[i]!=FN_SEP));i--) ;
+
+ if (i!=0) current_source_path[i+1] = 0; /* Current file in subdir */
+ else current_source_path[0] = 0; /* Current file at root dir */
+ }
+
+ return last_value;
+}
+
+extern int translate_link_filename(int last_value,
+ char *new_name, char *old_name)
+{ char *prefix_path = NULL;
+ char *extension;
+
+ if (contains_separator(old_name)==0)
+ if (Module_Path[0]!=0)
+ prefix_path = Module_Path;
+
+#ifdef FILE_EXTENSIONS
+ extension = check_extension(old_name, Module_Extension);
+#else
+ extension = "";
+#endif
+
+ return write_translated_name(new_name, old_name,
+ prefix_path, last_value, extension);
+}
+
+static int translate_icl_filename(int last_value,
+ char *new_name, char *old_name)
+{ char *prefix_path = NULL;
+ char *extension = "";
+
+ if (contains_separator(old_name)==0)
+ if (ICL_Path[0]!=0)
+ prefix_path = ICL_Path;
+
+#ifdef FILE_EXTENSIONS
+ extension = check_extension(old_name, ICL_Extension);
+#endif
+
+ return write_translated_name(new_name, old_name,
+ prefix_path, last_value, extension);
+}
+
+extern void translate_out_filename(char *new_name, char *old_name)
+{ char *prefix_path;
+ char *extension = "";
+ int i;
+
+ /* If !convert_filename_flag, then the old_name is just the <file2>
+ parameter on the Inform command line, which we leave alone. */
+
+ if (!convert_filename_flag)
+ { strcpy(new_name, old_name); return;
+ }
+
+ /* Remove any pathname or extension in <file1>. */
+
+ if (contains_separator(old_name)==1)
+ { for (i=strlen(old_name)-1; (i>0)&&(old_name[i]!=FN_SEP) ;i--) { };
+ if (old_name[i]==FN_SEP) i++;
+ old_name += i;
+ }
+#ifdef FILE_EXTENSIONS
+ for (i=strlen(old_name)-1; (i>=0)&&(old_name[i]!='.') ;i--) ;
+ if (old_name[i] == '.') old_name[i] = 0;
+#endif
+
+ prefix_path = NULL;
+ if (module_switch)
+ { extension = Module_Extension;
+ if (Module_Path[0]!=0) prefix_path = Module_Path;
+ }
+ else
+ {
+ if (!glulx_mode) {
+ switch(version_number)
+ { case 3: extension = Code_Extension; break;
+ case 4: extension = V4Code_Extension; break;
+ case 5: extension = V5Code_Extension; break;
+ case 6: extension = V6Code_Extension; break;
+ case 7: extension = V7Code_Extension; break;
+ case 8: extension = V8Code_Extension; break;
+ }
+ }
+ else {
+ extension = GlulxCode_Extension;
+ }
+ if (Code_Path[0]!=0) prefix_path = Code_Path;
+ }
+
+#ifdef FILE_EXTENSIONS
+ extension = check_extension(old_name, extension);
+#endif
+
+ write_translated_name(new_name, old_name, prefix_path, 0, extension);
+}
+
+static char *name_or_unset(char *p)
+{ if (p[0]==0) return "(unset)";
+ return p;
+}
+
+static void help_on_filenames(void)
+{ char old_name[PATHLEN];
+ char new_name[PATHLEN];
+ int save_mm = module_switch, x;
+
+ module_switch = FALSE;
+
+ printf("Help information on filenames:\n\n");
+
+ printf(
+"The command line can take one of two forms:\n\n\
+ inform [commands...] <file1>\n\
+ inform [commands...] <file1> <file2>\n\n\
+Inform translates <file1> into a source file name (see below) for its input.\n\
+<file2> is usually omitted: if so, the output filename is made from <file1>\n\
+by cutting out the name part and translating that (see below).\n\
+If <file2> is given, however, the output filename is set to just <file2>\n\
+(not altered in any way).\n\n");
+
+ printf(
+"Filenames given in the game source (with commands like Include \"name\" and\n\
+Link \"name\") are also translated by the rules below.\n\n");
+
+ printf(
+"Rules of translation:\n\n\
+Inform translates plain filenames (such as \"xyzzy\") into full pathnames\n\
+(such as \"adventure%cgames%cxyzzy\") according to the following rules.\n\n\
+1. If the name contains a '%c' character (so it's already a pathname), it\n\
+ isn't changed.\n\n", FN_SEP, FN_SEP, FN_SEP);
+
+ printf(
+" [Exception: when the name is given in an Include command using the >\n\
+ form (such as Include \">prologue\"), the \">\" is replaced by the path\n\
+ of the file doing the inclusion");
+#ifdef FILE_EXTENSIONS
+ printf(" and a suitable file extension is added");
+#endif
+ printf(".]\n\n");
+
+ printf(
+" Filenames must never contain double-quotation marks \". To use filenames\n\
+ which contain spaces, write them in double-quotes: for instance,\n\n\
+ \"inform +code_path=\"Jigsaw Final Version\" jigsaw\".\n\n");
+
+ printf(
+"2. The file is looked for at a particular \"path\" (the filename of a\n\
+ directory), depending on what kind of file it is.\n\n\
+ File type Name Current setting\n\n\
+ Source code (in) source_path %s\n\
+ Include file (in) include_path %s\n\
+ Story file (out) code_path %s\n",
+ name_or_unset(Source_Path), name_or_unset(Include_Path),
+ name_or_unset(Code_Path));
+
+ printf(
+" Temporary file (out) temporary_path %s\n\
+ ICL command file (in) icl_path %s\n\
+ Module (in & out) module_path %s\n\n",
+ name_or_unset(Temporary_Path),
+ name_or_unset(ICL_Path), name_or_unset(Module_Path));
+
+ printf(
+" If the path is unset, then the current working directory is used (so\n\
+ the filename doesn't change): if, for instance, include_path is set to\n\
+ \"backup%coldlib\" then when \"parser\" is included it is looked for at\n\
+ \"backup%coldlib%cparser\".\n\n\
+ The paths can be set or unset on the Inform command line by, eg,\n\
+ \"inform +code_path=finished jigsaw\" or\n\
+ \"inform +include_path= balances\" (which unsets include_path).\n\n",
+ FN_SEP, FN_SEP, FN_SEP);
+
+ printf(
+" The four input path variables can be set to lists of alternative paths\n\
+ separated by '%c' characters: these alternatives are always tried in\n\
+ the order they are specified in, that is, left to right through the text\n\
+ in the path variable.\n\n",
+ FN_ALT);
+ printf(
+" If two '+' signs are used (\"inform ++include_path=dir jigsaw\") then\n\
+ the path or paths are added to the existing list.\n\n");
+ printf(
+" (Modules are written to the first alternative in the module_path list;\n\
+ it is an error to give alternatives at all for purely output paths.)\n\n");
+
+#ifdef FILE_EXTENSIONS
+ printf("3. The following file extensions are added:\n\n\
+ Source code: %s\n\
+ Include files: %s\n\
+ Story files: %s (Version 3), %s (v4), %s (v5, the default),\n\
+ %s (v6), %s (v7), %s (v8), %s (Glulx)\n\
+ Temporary files: .tmp\n\
+ Modules: %s\n\n",
+ Source_Extension, Include_Extension,
+ Code_Extension, V4Code_Extension, V5Code_Extension, V6Code_Extension,
+ V7Code_Extension, V8Code_Extension, GlulxCode_Extension,
+ Module_Extension);
+ printf("\
+ except that any extension you give (on the command line or in a filename\n\
+ used in a program) will override these. If you give the null extension\n\
+ \".\" then Inform uses no file extension at all (removing the \".\").\n\n");
+#endif
+
+ printf("Names of four individual files can also be set using the same\n\
+ + command notation (though they aren't really pathnames). These are:\n\n\
+ transcript_name (text written by -r switch): now \"%s\"\n\
+ debugging_name (data written by -k switch): now \"%s\"\n\
+ language_name (library file defining natural language of game):\n\
+ now \"%s\"\n\
+ charset_map (file for character set mapping): now \"%s\"\n\n",
+ Transcript_Name, Debugging_Name, Language_Name, Charset_Map);
+
+ translate_in_filename(0, new_name, "rezrov", 0, 1);
+ printf("Examples: 1. \"inform rezrov\"\n\
+ the source code is read from \"%s\"\n",
+ new_name);
+ convert_filename_flag = TRUE;
+ translate_out_filename(new_name, "rezrov");
+ printf(" and a story file is compiled to \"%s\".\n\n", new_name);
+
+ translate_in_filename(0, new_name, "frotz", 0, 1);
+ printf("2. \"inform -M frotz\"\n\
+ the source code is read from \"%s\"\n",
+ new_name);
+ module_switch = TRUE;
+ convert_filename_flag = TRUE;
+ translate_out_filename(new_name, "frotz");
+ printf(" and a module is compiled to \"%s\".\n\n", new_name);
+
+ module_switch = FALSE;
+
+ sprintf(old_name, "demos%cplugh", FN_SEP);
+ printf("3. \"inform %s\"\n", old_name);
+ translate_in_filename(0, new_name, old_name, 0, 1);
+ printf(" the source code is read from \"%s\"\n", new_name);
+ sprintf(old_name, "demos%cplugh", FN_SEP);
+ convert_filename_flag = TRUE;
+ translate_out_filename(new_name, old_name);
+ printf(" and a story file is compiled to \"%s\".\n\n", new_name);
+
+ printf("4. \"inform plover my_demo\"\n");
+ translate_in_filename(0, new_name, "plover", 0, 1);
+ printf(" the source code is read from \"%s\"\n", new_name);
+ convert_filename_flag = FALSE;
+ translate_out_filename(new_name, "my_demo");
+ printf(" and a story file is compiled to \"%s\".\n\n", new_name);
+
+ strcpy(old_name, Source_Path);
+ sprintf(new_name, "%cnew%cold%crecent%cold%cancient",
+ FN_ALT, FN_ALT, FN_SEP, FN_ALT, FN_SEP);
+ printf("5. \"inform +source_path=%s zooge\"\n", new_name);
+ printf(
+" Note that four alternative paths are given, the first being the empty\n\
+ path-name (meaning: where you are now). Inform looks for the source code\n\
+ by trying these four places in turn, stopping when it finds anything:\n\n");
+
+ set_path_value(Source_Path, new_name);
+ x = 0;
+ do
+ { x = translate_in_filename(x, new_name, "zooge", 0, 1);
+ printf(" \"%s\"\n", new_name);
+ } while (x != 0);
+ strcpy(Source_Path, old_name);
+ module_switch = save_mm;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Naming temporary files */
+/* (Arguably temporary files should be made using "tmpfile" in */
+/* the ANSI C library, but many supposed ANSI libraries lack it.) */
+/* ------------------------------------------------------------------------- */
+
+extern void translate_temp_filename(int i)
+{ char *p = NULL;
+ switch(i)
+ { case 1: p=Temp1_Name; break;
+ case 2: p=Temp2_Name; break;
+ case 3: p=Temp3_Name; break;
+ }
+ if (strlen(Temporary_Path)+strlen(Temporary_File)+6 >= PATHLEN) {
+ printf ("Temporary_Path is too long.\n");
+ exit(1);
+ }
+ sprintf(p,"%s%s%d", Temporary_Path, Temporary_File, i);
+#ifdef INCLUDE_TASK_ID
+ sprintf(p+strlen(p), "_proc%08lx", (long int) unique_task_id());
+#endif
+#ifdef FILE_EXTENSIONS
+ sprintf(p+strlen(p), ".tmp");
+#endif
+}
+
+#ifdef ARCHIMEDES
+static char riscos_ft_buffer[4];
+
+extern char *riscos_file_type(void)
+{
+ if (riscos_file_type_format == 1)
+ { if (module_switch) return("data");
+ return("11A");
+ }
+
+ if (module_switch) return("075");
+
+ sprintf(riscos_ft_buffer, "%03x", 0x60 + version_number);
+ return(riscos_ft_buffer);
+}
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* The compilation pass */
+/* ------------------------------------------------------------------------- */
+
+static void run_pass(void)
+{
+ lexer_begin_prepass();
+ files_begin_prepass();
+ load_sourcefile(Source_Name, 0);
+
+ begin_pass();
+
+ parse_program(NULL);
+
+ find_the_actions();
+ issue_unused_warnings();
+ compile_veneer();
+
+ lexer_endpass();
+ if (module_switch) linker_endpass();
+
+ close_all_source();
+ if (hash_switch && hash_printed_since_newline) printf("\n");
+
+ if (temporary_files_switch)
+ { if (module_switch) flush_link_data();
+ check_temp_files();
+ }
+ sort_dictionary();
+ if (track_unused_routines)
+ locate_dead_functions();
+ construct_storyfile();
+}
+
+int output_has_occurred;
+
+static void rennab(int32 time_taken)
+{ /* rennab = reverse of banner */
+
+ int t = no_warnings + no_suppressed_warnings;
+
+ if (memout_switch) print_memory_usage();
+
+ if ((no_errors + t)!=0)
+ { printf("Compiled with ");
+ if (no_errors > 0)
+ { printf("%d error%s", no_errors,(no_errors==1)?"":"s");
+ if (t > 0) printf(" and ");
+ }
+ if (no_warnings > 0)
+ printf("%d warning%s", t, (t==1)?"":"s");
+ if (no_suppressed_warnings > 0)
+ { if (no_warnings > 0)
+ printf(" (%d suppressed)", no_suppressed_warnings);
+ else
+ printf("%d suppressed warning%s", no_suppressed_warnings,
+ (no_suppressed_warnings==1)?"":"s");
+ }
+ if (output_has_occurred == FALSE) printf(" (no output)");
+ printf("\n");
+ }
+
+ if (no_compiler_errors > 0) print_sorry_message();
+
+ if (statistics_switch)
+ printf("Completed in %ld seconds\n", (long int) time_taken);
+}
+
+/* ------------------------------------------------------------------------- */
+/* The compiler abstracted to a routine. */
+/* ------------------------------------------------------------------------- */
+
+static int execute_icl_header(char *file1);
+
+static int compile(int number_of_files_specified, char *file1, char *file2)
+{ int32 time_start;
+
+ if (execute_icl_header(file1))
+ return 1;
+
+ select_target(glulx_mode);
+
+ if (define_INFIX_switch && glulx_mode) {
+ printf("Infix (-X) facilities are not available in Glulx: \
+disabling -X switch\n");
+ define_INFIX_switch = FALSE;
+ }
+
+ if (module_switch && glulx_mode) {
+ printf("Modules are not available in Glulx: \
+disabling -M switch\n");
+ module_switch = FALSE;
+ }
+
+ if (define_INFIX_switch && module_switch)
+ { printf("Infix (-X) facilities are not available when compiling \
+modules: disabling -X switch\n");
+ define_INFIX_switch = FALSE;
+ }
+ if (runtime_error_checking_switch && module_switch)
+ { printf("Strict checking (-S) facilities are not available when \
+compiling modules: disabling -S switch\n");
+ runtime_error_checking_switch = FALSE;
+ }
+
+ time_start=time(0); no_compilations++;
+
+ strcpy(Source_Name, file1); convert_filename_flag = TRUE;
+ strcpy(Code_Name, file1);
+ if (number_of_files_specified == 2)
+ { strcpy(Code_Name, file2); convert_filename_flag = FALSE;
+ }
+
+ init_vars();
+
+ if (debugfile_switch) begin_debug_file();
+
+ allocate_arrays();
+
+ if (transcript_switch) open_transcript_file(Source_Name);
+
+ run_pass();
+
+ 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();
+ }
+
+ if (temporary_files_switch && (no_errors>0)) remove_temp_files();
+
+ free_arrays();
+
+ rennab((int32) (time(0)-time_start));
+
+ if (optimise_switch) optimise_abbreviations();
+
+ if (store_the_text) my_free(&all_text,"transcription text");
+
+ return (no_errors==0)?0:1;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The command line interpreter */
+/* ------------------------------------------------------------------------- */
+
+static void cli_print_help(int help_level)
+{
+ printf(
+"\nThis program is a compiler of Infocom format (also called \"Z-machine\")\n\
+story files: copyright (c) Graham Nelson 1993 - 2017.\n\n");
+
+ /* For people typing just "inform", a summary only: */
+
+ if (help_level==0)
+ {
+
+#ifndef PROMPT_INPUT
+ printf("Usage: \"inform [commands...] <file1> [<file2>]\"\n\n");
+#else
+ printf("When run, Inform prompts you for commands (and switches),\n\
+which are optional, then an input <file1> and an (optional) output\n\
+<file2>.\n\n");
+#endif
+
+ printf(
+"<file1> is the Inform source file of the game to be compiled. <file2>,\n\
+if given, overrides the filename Inform would normally use for the\n\
+compiled output. Try \"inform -h1\" for file-naming conventions.\n\n\
+One or more words can be supplied as \"commands\". These may be:\n\n\
+ -switches a list of compiler switches, 1 or 2 letter\n\
+ (see \"inform -h2\" for the full range)\n\n\
+ +dir set Include_Path to this directory\n\
+ +PATH=dir change the PATH to this directory\n\n\
+ $... one of the following memory commands:\n");
+ printf(
+" $list list current memory allocation settings\n\
+ $huge make standard \"huge game\" settings %s\n\
+ $large make standard \"large game\" settings %s\n\
+ $small make standard \"small game\" settings %s\n\
+ $?SETTING explain briefly what SETTING is for\n\
+ $SETTING=number change SETTING to given number\n\n\
+ (filename) read in a list of commands (in the format above)\n\
+ from this \"setup file\"\n\n",
+ (DEFAULT_MEMORY_SIZE==HUGE_SIZE)?"(default)":"",
+ (DEFAULT_MEMORY_SIZE==LARGE_SIZE)?"(default)":"",
+ (DEFAULT_MEMORY_SIZE==SMALL_SIZE)?"(default)":"");
+
+#ifndef PROMPT_INPUT
+ printf("For example: \"inform -dexs $huge curses\".\n\n");
+#endif
+
+ return;
+ }
+
+ /* The -h1 (filenaming) help information: */
+
+ if (help_level == 1) { help_on_filenames(); return; }
+
+ /* The -h2 (switches) help information: */
+
+ printf("Help on the full list of legal switch commands:\n\n\
+ a trace assembly-language (without hex dumps; see -t)\n\
+ c more concise error messages\n\
+ d contract double spaces after full stops in text\n\
+ d2 contract double spaces after exclamation and question marks, too\n\
+ e economy mode (slower): make use of declared abbreviations\n");
+
+ printf("\
+ f frequencies mode: show how useful abbreviations are\n\
+ g traces calls to functions (except in the library)\n\
+ g2 traces calls to all functions\n\
+ h print this information\n");
+
+ printf("\
+ i ignore default switches set within the file\n\
+ j list objects as constructed\n\
+ k output Infix debugging information to \"%s\" (and switch -D on)\n\
+ l list every statement run through Inform\n\
+ m say how much memory has been allocated\n\
+ n print numbers of properties, attributes and actions\n",
+ Debugging_Name);
+ printf("\
+ o print offset addresses\n\
+ p give percentage breakdown of story file\n\
+ q keep quiet about obsolete usages\n\
+ r record all the text to \"%s\"\n\
+ s give statistics\n\
+ t trace assembly-language (with full hex dumps; see -a)\n",
+ Transcript_Name);
+
+ printf("\
+ u work out most useful abbreviations (very very slowly)\n\
+ v3 compile to version-3 (\"Standard\") story file\n\
+ v4 compile to version-4 (\"Plus\") story file\n\
+ v5 compile to version-5 (\"Advanced\") story file: the default\n\
+ v6 compile to version-6 (graphical) story file\n\
+ v8 compile to version-8 (expanded \"Advanced\") story file\n\
+ w disable warning messages\n\
+ x print # for every 100 lines compiled\n\
+ y trace linking system\n\
+ z print memory map of the Z-machine\n\n");
+
+printf("\
+ B use big memory model (for large V6/V7 files)\n\
+ C0 text character set is plain ASCII only\n\
+ Cu text character set is UTF-8\n\
+ Cn text character set is ISO 8859-n (n = 1 to 9)\n\
+ (1 to 4, Latin1 to Latin4; 5, Cyrillic; 6, Arabic;\n\
+ 7, Greek; 8, Hebrew; 9, Latin5. Default is -C1.)\n");
+printf(" D insert \"Constant DEBUG;\" automatically\n");
+printf(" E0 Archimedes-style error messages%s\n",
+ (error_format==0)?" (current setting)":"");
+printf(" E1 Microsoft-style error messages%s\n",
+ (error_format==1)?" (current setting)":"");
+printf(" E2 Macintosh MPW-style error messages%s\n",
+ (error_format==2)?" (current setting)":"");
+#ifdef USE_TEMPORARY_FILES
+printf(" F0 use extra memory rather than temporary files\n");
+#else
+printf(" F1 use temporary files to reduce memory consumption\n");
+#endif
+printf(" G compile a Glulx game file\n");
+printf(" H use Huffman encoding to compress Glulx strings\n");
+printf(" M compile as a Module for future linking\n");
+
+#ifdef ARCHIMEDES
+printf("\
+ R0 use filetype 060 + version number for games (default)\n\
+ R1 use official Acorn filetype 11A for all games\n");
+#endif
+printf(" S compile strict error-checking at run-time (on by default)\n");
+#ifdef ARC_THROWBACK
+printf(" T enable throwback of errors in the DDE\n");
+#endif
+printf(" U insert \"Constant USE_MODULES;\" automatically\n");
+printf(" V print the version and date of this program\n");
+printf(" Wn header extension table is at least n words (n = 3 to 99)\n");
+printf(" X compile with INFIX debugging facilities present\n");
+ printf("\n");
+}
+
+extern void switches(char *p, int cmode)
+{ int i, s=1, state;
+ /* Here cmode is 0 if switches list is from a "Switches" directive
+ and 1 if from a "-switches" command-line or ICL list */
+
+ if (cmode==1)
+ { if (p[0]!='-')
+ { printf(
+ "Ignoring second word which should be a -list of switches.\n");
+ return;
+ }
+ }
+ for (i=cmode; p[i]!=0; i+=s, s=1)
+ { state = TRUE;
+ if (p[i] == '~')
+ { state = FALSE;
+ i++;
+ }
+ switch(p[i])
+ {
+ case 'a': asm_trace_setting = 1; break;
+ case 'b': bothpasses_switch = state; break;
+ case 'c': concise_switch = state; break;
+ case 'd': switch(p[i+1])
+ { case '1': double_space_setting=1; s=2; break;
+ case '2': double_space_setting=2; s=2; break;
+ default: double_space_setting=1; break;
+ }
+ break;
+ case 'e': economy_switch = state; break;
+ case 'f': frequencies_switch = state; break;
+ case 'g': switch(p[i+1])
+ { case '1': trace_fns_setting=1; s=2; break;
+ case '2': trace_fns_setting=2; s=2; break;
+ default: trace_fns_setting=1; break;
+ }
+ break;
+ case 'h': switch(p[i+1])
+ { case '1': cli_print_help(1); s=2; break;
+ case '2': cli_print_help(2); s=2; break;
+ case '0': s=2;
+ default: cli_print_help(0); break;
+ }
+ break;
+ case 'i': ignore_switches_switch = state; break;
+ case 'j': listobjects_switch = state; break;
+ case 'k': if (cmode == 0)
+ error("The switch '-k' can't be set with 'Switches'");
+ else
+ { debugfile_switch = state;
+ if (state) define_DEBUG_switch = TRUE;
+ }
+ break;
+ case 'l': listing_switch = state; break;
+ case 'm': memout_switch = state; break;
+ case 'n': printprops_switch = state; break;
+ case 'o': offsets_switch = state; break;
+ case 'p': percentages_switch = state; break;
+ case 'q': obsolete_switch = state; break;
+ case 'r': if (cmode == 0)
+ error("The switch '-r' can't be set with 'Switches'");
+ else
+ transcript_switch = state; break;
+ case 's': statistics_switch = state; break;
+ case 't': asm_trace_setting=2; break;
+ case 'u': if (cmode == 0) {
+ error("The switch '-u' can't be set with 'Switches'");
+ break;
+ }
+ optimise_switch = state; break;
+ case 'v': if (glulx_mode) { s = select_glulx_version(p+i+1)+1; break; }
+ if ((cmode==0) && (version_set_switch)) { s=2; break; }
+ version_set_switch = TRUE; s=2;
+ switch(p[i+1])
+ { case '3': select_version(3); break;
+ case '4': select_version(4); break;
+ case '5': select_version(5); break;
+ case '6': select_version(6); break;
+ case '7': select_version(7); break;
+ case '8': select_version(8); break;
+ default: printf("-v must be followed by 3 to 8\n");
+ version_set_switch=0; s=1;
+ break;
+ }
+ if ((version_number < 5) && (r_e_c_s_set == FALSE))
+ runtime_error_checking_switch = FALSE;
+ break;
+ case 'w': nowarnings_switch = state; break;
+ case 'x': hash_switch = state; break;
+ case 'y': s=2; linker_trace_setting=p[i+1]-'0'; break;
+ case 'z': memory_map_switch = state; break;
+ case 'B': oddeven_packing_switch = state; break;
+ case 'C': s=2;
+ if (p[i+1] == 'u') {
+ character_set_unicode = TRUE;
+ /* Leave the set_setting on Latin-1, because that
+ matches the first block of Unicode. */
+ character_set_setting = 1;
+ }
+ else
+ { character_set_setting=p[i+1]-'0';
+ if ((character_set_setting < 0)
+ || (character_set_setting > 9))
+ { printf("-C must be followed by 'u' or 0 to 9. Defaulting to ISO-8859-1.\n");
+ character_set_unicode = FALSE;
+ character_set_setting = 1;
+ }
+ }
+ if (cmode == 0) change_character_set();
+ break;
+ case 'D': define_DEBUG_switch = state; break;
+ case 'E': switch(p[i+1])
+ { case '0': s=2; error_format=0; break;
+ case '1': s=2; error_format=1; break;
+ case '2': s=2; error_format=2; break;
+ default: error_format=1; break;
+ }
+ break;
+ case 'F': if (cmode == 0) {
+ error("The switch '-F' can't be set with 'Switches'");
+ break;
+ }
+ switch(p[i+1])
+ { case '0': s=2; temporary_files_switch = FALSE; break;
+ case '1': s=2; temporary_files_switch = TRUE; break;
+ default: temporary_files_switch = state; break;
+ }
+ break;
+ case 'M': module_switch = state;
+ if (state && (r_e_c_s_set == FALSE))
+ runtime_error_checking_switch = FALSE;
+ break;
+#ifdef ARCHIMEDES
+ case 'R': switch(p[i+1])
+ { case '0': s=2; riscos_file_type_format=0; break;
+ case '1': s=2; riscos_file_type_format=1; break;
+ default: riscos_file_type_format=1; break;
+ }
+ break;
+#endif
+#ifdef ARC_THROWBACK
+ case 'T': throwback_switch = state; break;
+#endif
+ case 'S': runtime_error_checking_switch = state;
+ r_e_c_s_set = TRUE; break;
+ case 'G': if (cmode == 0)
+ error("The switch '-G' can't be set with 'Switches'");
+ else
+ { glulx_mode = state;
+ adjust_memory_sizes();
+ }
+ break;
+ case 'H': compression_switch = state; break;
+ case 'U': define_USE_MODULES_switch = state; break;
+ case 'V': exit(0); break;
+ case 'W': if ((p[i+1]>='0') && (p[i+1]<='9'))
+ { s=2; ZCODE_HEADER_EXT_WORDS = p[i+1]-'0';
+ if ((p[i+2]>='0') && (p[i+2]<='9'))
+ { s=3; ZCODE_HEADER_EXT_WORDS *= 10;
+ ZCODE_HEADER_EXT_WORDS += p[i+2]-'0';
+ }
+ }
+ break;
+ case 'X': define_INFIX_switch = state; break;
+ default:
+ printf("Switch \"-%c\" unknown (try \"inform -h2\" for the list)\n",
+ p[i]);
+ break;
+ }
+ }
+
+ if (optimise_switch && (!store_the_text))
+ { store_the_text=TRUE;
+#ifdef PC_QUICKC
+ if (memout_switch)
+ printf("Allocation %ld bytes for transcription text\n",
+ (long) MAX_TRANSCRIPT_SIZE);
+ all_text = halloc(MAX_TRANSCRIPT_SIZE,1);
+ malloced_bytes += MAX_TRANSCRIPT_SIZE;
+ if (all_text==NULL)
+ fatalerror("Can't hallocate memory for transcription text. Darn.");
+#else
+ all_text=my_malloc(MAX_TRANSCRIPT_SIZE,"transcription text");
+#endif
+ }
+}
+
+static int icl_command(char *p)
+{ if ((p[0]=='+')||(p[0]=='-')||(p[0]=='$')
+ || ((p[0]=='(')&&(p[strlen(p)-1]==')')) ) return TRUE;
+ return FALSE;
+}
+
+static void icl_error(char *filename, int line)
+{ printf("Error in ICL file '%s', line %d:\n", filename, line);
+}
+
+static void icl_header_error(char *filename, int line)
+{ printf("Error in ICL header of file '%s', line %d:\n", filename, line);
+}
+
+static int copy_icl_word(char *from, char *to, int max)
+{
+ /* Copies one token from 'from' to 'to', null-terminated:
+ returns the number of chars in 'from' read past (possibly 0). */
+
+ int i, j, quoted_mode, truncated;
+
+ i = 0; truncated = 0;
+ while ((from[i] == ' ') || (from[i] == TAB_CHARACTER)
+ || (from[i] == (char) 10) || (from[i] == (char) 13)) i++;
+
+ if (from[i] == '!')
+ { while (from[i] != 0) i++;
+ to[0] = 0; return i;
+ }
+
+ for (quoted_mode = FALSE, j=0;;)
+ { if (from[i] == 0) break;
+ if (from[i] == 10) break;
+ if (from[i] == 13) break;
+ if (from[i] == TAB_CHARACTER) break;
+ if ((from[i] == ' ') && (!quoted_mode)) break;
+ if (from[i] == '\"') { quoted_mode = !quoted_mode; i++; }
+ else to[j++] = from[i++];
+ if (j == max) {
+ j--;
+ truncated = 1;
+ }
+ }
+ to[j] = 0;
+ if (truncated == 1)
+ printf("The following parameter has been truncated:\n%s\n", to);
+ return i;
+}
+
+static void execute_icl_command(char *p);
+
+static int execute_icl_header(char *argname)
+{
+ FILE *command_file;
+ char cli_buff[256], fw[256];
+ int line = 0;
+ int errcount = 0;
+ int i;
+ char filename[PATHLEN];
+ int x = 0;
+
+ do
+ { x = translate_in_filename(x, filename, argname, 0, 1);
+ command_file = fopen(filename,"r");
+ } while ((command_file == NULL) && (x != 0));
+ if (!command_file) {
+ /* Fail silently. The regular compiler will try to open the file
+ again, and report the problem. */
+ return 0;
+ }
+
+ while (feof(command_file)==0) {
+ if (fgets(cli_buff,256,command_file)==0) break;
+ line++;
+ if (!(cli_buff[0] == '!' && cli_buff[1] == '%'))
+ break;
+ i = copy_icl_word(cli_buff+2, fw, 256);
+ if (icl_command(fw)) {
+ execute_icl_command(fw);
+ copy_icl_word(cli_buff+2 + i, fw, 256);
+ if ((fw[0] != 0) && (fw[0] != '!')) {
+ icl_header_error(filename, line);
+ errcount++;
+ printf("expected comment or nothing but found '%s'\n", fw);
+ }
+ }
+ else {
+ if (fw[0]!=0) {
+ icl_header_error(filename, line);
+ errcount++;
+ printf("Expected command or comment but found '%s'\n", fw);
+ }
+ }
+ }
+ fclose(command_file);
+
+ return (errcount==0)?0:1;
+}
+
+
+static void run_icl_file(char *filename, FILE *command_file)
+{ char cli_buff[256], fw[256];
+ int i, x, line = 0;
+ printf("[Running ICL file '%s']\n", filename);
+
+ while (feof(command_file)==0)
+ { if (fgets(cli_buff,256,command_file)==0) break;
+ line++;
+ i = copy_icl_word(cli_buff, fw, 256);
+ if (icl_command(fw))
+ { execute_icl_command(fw);
+ copy_icl_word(cli_buff + i, fw, 256);
+ if ((fw[0] != 0) && (fw[0] != '!'))
+ { icl_error(filename, line);
+ printf("expected comment or nothing but found '%s'\n", fw);
+ }
+ }
+ else
+ { if (strcmp(fw, "compile")==0)
+ { char story_name[PATHLEN], code_name[PATHLEN];
+ i += copy_icl_word(cli_buff + i, story_name, PATHLEN);
+ i += copy_icl_word(cli_buff + i, code_name, PATHLEN);
+
+ if (code_name[0] != 0) x=2;
+ else if (story_name[0] != 0) x=1;
+ else x=0;
+
+ switch(x)
+ { case 0: icl_error(filename, line);
+ printf("No filename given to 'compile'\n");
+ break;
+ case 1: printf("[Compiling <%s>]\n", story_name);
+ compile(x, story_name, code_name);
+ break;
+ case 2: printf("[Compiling <%s> to <%s>]\n",
+ story_name, code_name);
+ compile(x, story_name, code_name);
+ copy_icl_word(cli_buff + i, fw, 256);
+ if (fw[0]!=0)
+ { icl_error(filename, line);
+ printf("Expected comment or nothing but found '%s'\n",
+ fw);
+ }
+ break;
+ }
+ }
+ else
+ if (fw[0]!=0)
+ { icl_error(filename, line);
+ printf("Expected command or comment but found '%s'\n", fw);
+ }
+ }
+ }
+}
+
+static void execute_icl_command(char *p)
+{ char filename[PATHLEN], cli_buff[256];
+ FILE *command_file;
+
+ switch(p[0])
+ { case '+': set_path_command(p+1); break;
+ case '-': switches(p,1); break;
+ case '$': memory_command(p+1); break;
+ case '(': strcpy(cli_buff,p+1); cli_buff[strlen(cli_buff)-1]=0;
+ { int x = 0;
+ do
+ { x = translate_icl_filename(x, filename, cli_buff);
+ command_file = fopen(filename,"r");
+ } while ((command_file == NULL) && (x != 0));
+ }
+ if (command_file == NULL)
+ printf("Error in ICL: Couldn't open command file '%s'\n",
+ filename);
+ else
+ { run_icl_file(filename, command_file);
+ fclose(command_file);
+ }
+ break;
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Opening and closing banners */
+/* ------------------------------------------------------------------------- */
+
+char banner_line[80];
+
+static void banner(void)
+{
+ sprintf(banner_line, "Inform %s",
+ (VERSION));
+#ifdef RELEASE_SUFFIX
+ strcat(banner_line, RELEASE_SUFFIX);
+#endif
+#ifdef MACHINE_STRING
+ sprintf(banner_line+strlen(banner_line), " for %s", MACHINE_STRING);
+#endif
+ sprintf(banner_line+strlen(banner_line), " (%s)", RELEASE_DATE);
+ printf("%s\n", banner_line);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Input from the outside world */
+/* ------------------------------------------------------------------------- */
+
+#ifdef PROMPT_INPUT
+static void read_command_line(int argc, char **argv)
+{ int i;
+ char buffer1[PATHLEN], buffer2[PATHLEN], buffer3[PATHLEN];
+ i=0;
+ printf("Source filename?\n> ");
+ while (gets(buffer1)==NULL); cli_file1=buffer1;
+ printf("Output filename (RETURN for the same)?\n> ");
+ while (gets(buffer2)==NULL); cli_file2=buffer2;
+ cli_files_specified=1;
+ if (buffer2[0]!=0) cli_files_specified=2;
+ do
+ { printf("List of commands (RETURN to finish; \"-h\" for help)?\n> ");
+ while (gets(buffer3)==NULL); execute_icl_command(buffer3);
+ } while (buffer3[0]!=0);
+}
+#else
+static void read_command_line(int argc, char **argv)
+{ int i;
+ if (argc==1) switches("-h",1);
+
+ for (i=1, cli_files_specified=0; i<argc; i++)
+ if (icl_command(argv[i]))
+ execute_icl_command(argv[i]);
+ else
+ switch(++cli_files_specified)
+ { case 1: cli_file1 = argv[i]; break;
+ case 2: cli_file2 = argv[i]; break;
+ default:
+ printf("Command line error: unknown parameter '%s'\n",
+ argv[i]); return;
+ }
+}
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* M A I N : An outer shell for machine-specific quirks */
+/* Omitted altogether if EXTERNAL_SHELL is defined, as for instance is */
+/* needed for the Macintosh front end. */
+/* ------------------------------------------------------------------------- */
+
+#ifdef EXTERNAL_SHELL
+extern int sub_main(int argc, char **argv);
+#else
+
+static int sub_main(int argc, char **argv);
+#ifdef MAC_MPW
+int main(int argc, char **argv, char *envp[])
+#else
+int main(int argc, char **argv)
+#endif
+{ int rcode;
+#ifdef MAC_MPW
+ InitCursorCtl((acurHandle)NULL); Show_Cursor(WATCH_CURSOR);
+#endif
+ rcode = sub_main(argc, argv);
+#ifdef ARC_THROWBACK
+ throwback_end();
+#endif
+ return rcode;
+}
+
+#endif
+
+/* ------------------------------------------------------------------------- */
+/* M A I N II: Starting up ICL with the command line */
+/* ------------------------------------------------------------------------- */
+
+#ifdef EXTERNAL_SHELL
+extern int sub_main(int argc, char **argv)
+#else
+static int sub_main(int argc, char **argv)
+#endif
+{ int return_code;
+
+#ifdef MAC_FACE
+ ProcessEvents (&g_proc);
+ if (g_proc != true)
+ { free_arrays();
+ if (store_the_text) my_free(&all_text,"transcription text");
+ longjmp (g_fallback, 1);
+ }
+#endif
+
+ banner();
+
+ set_memory_sizes(DEFAULT_MEMORY_SIZE); set_default_paths();
+ reset_switch_settings(); select_version(5);
+
+ cli_files_specified = 0; no_compilations = 0;
+ cli_file1 = "source"; cli_file2 = "output";
+
+ read_command_line(argc, argv);
+
+ if (cli_files_specified > 0)
+ { return_code = compile(cli_files_specified, cli_file1, cli_file2);
+
+ if (return_code != 0) return(return_code);
+ }
+
+ if (no_compilations == 0)
+ printf("\n[No compilation requested]\n");
+ if (no_compilations > 1)
+ printf("[%d compilations completed]\n", no_compilations);
+
+ return(0);
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "lexer" : Lexical analyser */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+int total_source_line_count, /* Number of source lines so far */
+
+ no_hash_printed_yet, /* Have not yet printed the first # */
+ hash_printed_since_newline, /* A hash has been printed since the
+ most recent new-line was printed
+ (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
+ keyword table is searched. */
+ return_sp_as_variable; /* When TRUE, the word "sp" denotes
+ the stack pointer variable
+ (used in assembly language only) */
+int next_token_begins_syntax_line; /* When TRUE, start a new syntax
+ line (for error reporting, etc.)
+ on the source code line where
+ the next token appears */
+
+int32 last_mapped_line; /* Last syntax line reported to debugging file */
+
+/* ------------------------------------------------------------------------- */
+/* The lexer's output is a sequence of triples, each called a "token", */
+/* representing one lexical unit (or "lexeme") each. Instead of providing */
+/* "lookahead" (that is, always having available the next token after the */
+/* current one, so that syntax analysers higher up in Inform can have */
+/* advance knowledge of what is coming), the lexer instead has a system */
+/* where tokens can be read in and then "put back again". */
+/* The meaning of the number (and to some extent the text) supplied with */
+/* a token depends on its type: see "header.h" for the list of types. */
+/* For example, the lexeme "$1e3" is understood by Inform as a hexadecimal */
+/* number, and translated to the token: */
+/* type NUMBER_TT, value 483, text "$1e3" */
+/* ------------------------------------------------------------------------- */
+/* These three variables are set to the current token on a call to */
+/* get_next_token() (but are not changed by a call to put_token_back()). */
+/* ------------------------------------------------------------------------- */
+
+int token_type;
+int32 token_value;
+char *token_text;
+
+/* ------------------------------------------------------------------------- */
+/* The next two variables are the head and tail of a singly linked list. */
+/* The tail stores the portion most recently read from the current */
+/* lexical block; its end values therefore describe the location of the */
+/* current token, and are updated whenever the three variables above are */
+/* via set_token_location(...). Earlier vertices, if any, represent the */
+/* regions of lexical blocks read beforehand, where new vertices are */
+/* only introduced by interruptions like a file inclusion or an EOF. */
+/* Vertices are deleted off of the front of the list once they are no */
+/* longer referenced by pending debug information records. */
+/* ------------------------------------------------------------------------- */
+
+static debug_locations *first_token_locations;
+static debug_locations *last_token_location;
+
+extern debug_location get_token_location(void)
+{ debug_location result;
+ debug_location *location = &(last_token_location->location);
+ result.file_index = location->file_index;
+ result.beginning_byte_index = location->end_byte_index;
+ result.end_byte_index = location->end_byte_index;
+ result.beginning_line_number = location->end_line_number;
+ result.end_line_number = location->end_line_number;
+ result.beginning_character_number = location->end_character_number;
+ result.end_character_number = location->end_character_number;
+ result.orig_file_index = location->orig_file_index;
+ result.orig_beg_line_number = location->orig_beg_line_number;
+ result.orig_beg_char_number = location->orig_beg_char_number;
+ return result;
+}
+
+extern debug_locations get_token_locations(void)
+{ debug_locations result;
+ result.location = get_token_location();
+ result.next = NULL;
+ result.reference_count = 0;
+ return result;
+}
+
+static void set_token_location(debug_location location)
+{ if (location.file_index == last_token_location->location.file_index)
+ { last_token_location->location.end_byte_index =
+ location.end_byte_index;
+ last_token_location->location.end_line_number =
+ location.end_line_number;
+ last_token_location->location.end_character_number =
+ location.end_character_number;
+ last_token_location->location.orig_file_index =
+ location.orig_file_index;
+ last_token_location->location.orig_beg_line_number =
+ location.orig_beg_line_number;
+ last_token_location->location.orig_beg_char_number =
+ location.orig_beg_char_number;
+ } else
+ { debug_locations*successor =
+ my_malloc
+ (sizeof(debug_locations),
+ "debug locations of recent tokens");
+ successor->location = location;
+ successor->next = NULL;
+ successor->reference_count = 0;
+ last_token_location->next = successor;
+ last_token_location = successor;
+ }
+}
+
+extern debug_location_beginning get_token_location_beginning(void)
+{ debug_location_beginning result;
+ ++(last_token_location->reference_count);
+ result.head = last_token_location;
+ result.beginning_byte_index =
+ last_token_location->location.end_byte_index;
+ result.beginning_line_number =
+ last_token_location->location.end_line_number;
+ result.beginning_character_number =
+ last_token_location->location.end_character_number;
+ result.orig_file_index = last_token_location->location.orig_file_index;
+ result.orig_beg_line_number = last_token_location->location.orig_beg_line_number;
+ result.orig_beg_char_number = last_token_location->location.orig_beg_char_number;
+
+ return result;
+}
+
+static void cleanup_token_locations(debug_location_beginning*beginning)
+{ if (first_token_locations)
+ { while (first_token_locations &&
+ !first_token_locations->reference_count)
+ { debug_locations*moribund = first_token_locations;
+ first_token_locations = moribund->next;
+ my_free(&moribund, "debug locations of recent tokens");
+ if (beginning &&
+ (beginning->head == moribund || !first_token_locations))
+ { compiler_error
+ ("Records needed by a debug_location_beginning are no "
+ "longer allocated, perhaps because of an invalid reuse "
+ "of this or an earlier beginning");
+ }
+ }
+ } else
+ { if (beginning)
+ { compiler_error
+ ("Attempt to use a debug_location_beginning when no token "
+ "locations are defined");
+ } else
+ { compiler_error
+ ("Attempt to clean up token locations when no token locations "
+ "are defined");
+ }
+ }
+}
+
+extern void discard_token_location(debug_location_beginning beginning)
+{ --(beginning.head->reference_count);
+}
+
+extern debug_locations get_token_location_end
+ (debug_location_beginning beginning)
+{ debug_locations result;
+ cleanup_token_locations(&beginning);
+ --(beginning.head->reference_count);
+ /* Sometimes we know what we'll read before we switch to the lexical block
+ where we'll read it. In such cases the beginning will be placed in the
+ prior block and last exactly zero bytes there. It's misleading to
+ include such ranges, so we gobble them. */
+ if (beginning.head->location.end_byte_index ==
+ beginning.beginning_byte_index &&
+ beginning.head->next)
+ { beginning.head = beginning.head->next;
+ result.location = beginning.head->location;
+ result.location.beginning_byte_index = 0;
+ result.location.beginning_line_number = 1;
+ result.location.beginning_character_number = 1;
+ } else
+ { result.location = beginning.head->location;
+ result.location.beginning_byte_index =
+ beginning.beginning_byte_index;
+ result.location.beginning_line_number =
+ beginning.beginning_line_number;
+ result.location.beginning_character_number =
+ beginning.beginning_character_number;
+ }
+
+ result.location.orig_file_index =
+ beginning.orig_file_index;
+ result.location.orig_beg_line_number =
+ beginning.orig_beg_line_number;
+ result.location.orig_beg_char_number =
+ beginning.orig_beg_char_number;
+
+ result.next = beginning.head->next;
+ result.reference_count = 0;
+ return result;
+}
+
+/* ------------------------------------------------------------------------- */
+/* In order to be able to put tokens back efficiently, the lexer stores */
+/* tokens in a "circle": the variable circle_position ranges between */
+/* 0 and CIRCLE_SIZE-1. We only need a circle size as large as the */
+/* maximum number of tokens ever put back at once, plus 1 (in effect, the */
+/* maximum token lookahead ever needed in syntax analysis, plus 1). */
+/* */
+/* Unlike some compilers, Inform does not have a context-free lexer: in */
+/* fact it has 12288 different possible states. However, the context only */
+/* affects the interpretation of "identifiers": lexemes beginning with a */
+/* letter and containing up to 32 chars of alphanumeric and underscore */
+/* chars. (For example, "default" may refer to the directive or statement */
+/* of that name, and which token values are returned depends on the */
+/* current lexical context.) */
+/* */
+/* Along with each token, we also store the lexical context it was */
+/* translated under; because if it is called for again, there may need */
+/* to be a fresh interpretation of it if the context has changed. */
+/* ------------------------------------------------------------------------- */
+
+#define CIRCLE_SIZE 6
+
+/* (The worst case for token lookahead is distinguishing between an
+ old-style "objectloop (a in b)" and a new "objectloop (a in b ...)".) */
+
+static int circle_position;
+static token_data circle[CIRCLE_SIZE];
+
+static int token_contexts[CIRCLE_SIZE];
+
+/* ------------------------------------------------------------------------- */
+/* A complication, however, is that the text of some lexemes needs to be */
+/* held in Inform's memory for much longer periods: for example, a */
+/* dictionary word lexeme (like "'south'") must have its text preserved */
+/* until the code generation time for the expression it occurs in, when */
+/* the dictionary reference is actually made. Code generation in general */
+/* occurs as early as possible in Inform: pending some better method of */
+/* garbage collection, we simply use a buffer so large that unless */
+/* expressions spread across 10K of source code are found, there can be */
+/* no problem. */
+/* ------------------------------------------------------------------------- */
+
+static char *lexeme_memory;
+static char *lex_p; /* Current write position */
+
+/* ------------------------------------------------------------------------- */
+/* The lexer itself needs up to 3 characters of lookahead (it uses an */
+/* LR(3) grammar to translate characters into tokens). */
+/* ------------------------------------------------------------------------- */
+
+#define LOOKAHEAD_SIZE 3
+
+static int current, lookahead, /* The latest character read, and */
+ lookahead2, lookahead3; /* the three characters following it */
+
+static int pipeline_made; /* Whether or not the pipeline of
+ characters has been constructed
+ yet (this pass) */
+
+static int (* get_next_char)(void); /* Routine for reading the stream of
+ characters: the lexer does not
+ need any "ungetc" routine for
+ putting them back again. End of
+ stream is signalled by returning
+ zero. */
+
+static char *source_to_analyse; /* The current lexical source:
+ NULL for "load from source files",
+ otherwise this points to a string
+ containing Inform code */
+
+static int tokens_put_back; /* Count of the number of backward
+ moves made from the last-read
+ token */
+
+extern void describe_token(token_data t)
+{
+ /* Many of the token types are not set in this file, but later on in
+ Inform's higher stages (for example, in the expression evaluator);
+ but this routine describes them all. */
+
+ printf("{ ");
+
+ switch(t.type)
+ {
+ /* The following token types occur in lexer output: */
+
+ case SYMBOL_TT: printf("symbol ");
+ describe_symbol(t.value);
+ break;
+ case NUMBER_TT: printf("literal number %d", t.value);
+ break;
+ case DQ_TT: printf("string \"%s\"", t.text);
+ break;
+ case SQ_TT: printf("string '%s'", t.text);
+ break;
+ case SEP_TT: printf("separator '%s'", t.text);
+ break;
+ case EOF_TT: printf("end of file");
+ break;
+
+ case STATEMENT_TT: printf("statement name '%s'", t.text);
+ break;
+ case SEGMENT_MARKER_TT: printf("object segment marker '%s'", t.text);
+ break;
+ case DIRECTIVE_TT: printf("directive name '%s'", t.text);
+ break;
+ case CND_TT: printf("textual conditional '%s'", t.text);
+ break;
+ case OPCODE_NAME_TT: printf("opcode name '%s'", t.text);
+ break;
+ case SYSFUN_TT: printf("built-in function name '%s'", t.text);
+ break;
+ case LOCAL_VARIABLE_TT: printf("local variable name '%s'", t.text);
+ break;
+ case MISC_KEYWORD_TT: printf("statement keyword '%s'", t.text);
+ break;
+ case DIR_KEYWORD_TT: printf("directive keyword '%s'", t.text);
+ break;
+ case TRACE_KEYWORD_TT: printf("'trace' keyword '%s'", t.text);
+ break;
+ case SYSTEM_CONSTANT_TT: printf("system constant name '%s'", t.text);
+ break;
+
+ /* The remaining are etoken types, not set by the lexer */
+
+ case OP_TT: printf("operator '%s'",
+ operators[t.value].description);
+ break;
+ case ENDEXP_TT: printf("end of expression");
+ break;
+ case SUBOPEN_TT: printf("open bracket");
+ break;
+ case SUBCLOSE_TT: printf("close bracket");
+ break;
+ case LARGE_NUMBER_TT: printf("large number: '%s'=%d",t.text,t.value);
+ break;
+ case SMALL_NUMBER_TT: printf("small number: '%s'=%d",t.text,t.value);
+ break;
+ case VARIABLE_TT: printf("variable '%s'=%d", t.text, t.value);
+ break;
+ case DICTWORD_TT: printf("dictionary word '%s'", t.text);
+ break;
+ case ACTION_TT: printf("action name '%s'", t.text);
+ break;
+
+ default:
+ printf("** unknown token type %d, text='%s', value=%d **",
+ t.type, t.text, t.value);
+ }
+ printf(" }");
+}
+
+/* ------------------------------------------------------------------------- */
+/* All but one of the 280 Inform keywords (118 of them opcode names used */
+/* only by the assembler). (The one left over is "sp", a keyword used in */
+/* assembly language only.) */
+/* */
+/* A "keyword group" is a set of keywords to be searched for. If a match */
+/* is made on an identifier, the token type becomes that given in the KG */
+/* and the token value is its index in the KG. */
+/* */
+/* The keyword ordering must correspond with the appropriate #define's in */
+/* "header.h" but is otherwise not significant. */
+/* ------------------------------------------------------------------------- */
+
+#define MAX_KEYWORDS 350
+
+/* The values will be filled in at compile time, when we know
+ which opcode set to use. */
+keyword_group opcode_names =
+{ { "" },
+ OPCODE_NAME_TT, FALSE, TRUE
+};
+
+static char *opcode_list_z[] = {
+ "je", "jl", "jg", "dec_chk", "inc_chk", "jin", "test", "or", "and",
+ "test_attr", "set_attr", "clear_attr", "store", "insert_obj", "loadw",
+ "loadb", "get_prop", "get_prop_addr", "get_next_prop", "add", "sub",
+ "mul", "div", "mod", "call", "storew", "storeb", "put_prop", "sread",
+ "print_char", "print_num", "random", "push", "pull", "split_window",
+ "set_window", "output_stream", "input_stream", "sound_effect", "jz",
+ "get_sibling", "get_child", "get_parent", "get_prop_len", "inc", "dec",
+ "print_addr", "remove_obj", "print_obj", "ret", "jump", "print_paddr",
+ "load", "not", "rtrue", "rfalse", "print", "print_ret", "nop", "save",
+ "restore", "restart", "ret_popped", "pop", "quit", "new_line",
+ "show_status", "verify", "call_2s", "call_vs", "aread", "call_vs2",
+ "erase_window", "erase_line", "set_cursor", "get_cursor",
+ "set_text_style", "buffer_mode", "read_char", "scan_table", "call_1s",
+ "call_2n", "set_colour", "throw", "call_vn", "call_vn2", "tokenise",
+ "encode_text", "copy_table", "print_table", "check_arg_count", "call_1n",
+ "catch", "piracy", "log_shift", "art_shift", "set_font", "save_undo",
+ "restore_undo", "draw_picture", "picture_data", "erase_picture",
+ "set_margins", "move_window", "window_size", "window_style",
+ "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",
+ ""
+};
+
+static char *opcode_list_g[] = {
+ "nop", "add", "sub", "mul", "div", "mod", "neg", "bitand", "bitor",
+ "bitxor", "bitnot", "shiftl", "sshiftr", "ushiftr", "jump", "jz",
+ "jnz", "jeq", "jne", "jlt", "jge", "jgt", "jle",
+ "jltu", "jgeu", "jgtu", "jleu",
+ "call", "return",
+ "catch", "throw", "tailcall",
+ "copy", "copys", "copyb", "sexs", "sexb", "aload",
+ "aloads", "aloadb", "aloadbit", "astore", "astores", "astoreb",
+ "astorebit", "stkcount", "stkpeek", "stkswap", "stkroll", "stkcopy",
+ "streamchar", "streamnum", "streamstr",
+ "gestalt", "debugtrap", "getmemsize", "setmemsize", "jumpabs",
+ "random", "setrandom", "quit", "verify",
+ "restart", "save", "restore", "saveundo", "restoreundo", "protect",
+ "glk", "getstringtbl", "setstringtbl", "getiosys", "setiosys",
+ "linearsearch", "binarysearch", "linkedsearch",
+ "callf", "callfi", "callfii", "callfiii",
+ "streamunichar",
+ "mzero", "mcopy", "malloc", "mfree",
+ "accelfunc", "accelparam",
+ "numtof", "ftonumz", "ftonumn", "ceil", "floor",
+ "fadd", "fsub", "fmul", "fdiv", "fmod",
+ "sqrt", "exp", "log", "pow",
+ "sin", "cos", "tan", "asin", "acos", "atan", "atan2",
+ "jfeq", "jfne", "jflt", "jfle", "jfgt", "jfge", "jisnan", "jisinf",
+ ""
+};
+
+keyword_group opcode_macros =
+{ { "" },
+ OPCODE_MACRO_TT, FALSE, TRUE
+};
+
+static char *opmacro_list_z[] = { "" };
+
+static char *opmacro_list_g[] = {
+ "pull", "push",
+ ""
+};
+
+keyword_group directives =
+{ { "abbreviate", "array", "attribute", "class", "constant",
+ "default", "dictionary", "end", "endif", "extend", "fake_action",
+ "global", "ifdef", "ifndef", "ifnot", "ifv3", "ifv5", "iftrue",
+ "iffalse", "import", "include", "link", "lowstring", "message",
+ "nearby", "object", "origsource", "property", "release", "replace",
+ "serial", "switches", "statusline", "stub", "system_file", "trace",
+ "undef", "verb", "version", "zcharacter",
+ "" },
+ DIRECTIVE_TT, FALSE, FALSE
+};
+
+keyword_group trace_keywords =
+{ { "dictionary", "symbols", "objects", "verbs",
+ "assembly", "expressions", "lines", "tokens", "linker",
+ "on", "off", "" },
+ TRACE_KEYWORD_TT, FALSE, TRUE
+};
+
+keyword_group segment_markers =
+{ { "class", "has", "private", "with", "" },
+ SEGMENT_MARKER_TT, FALSE, TRUE
+};
+
+keyword_group directive_keywords =
+{ { "alias", "long", "additive",
+ "score", "time",
+ "noun", "held", "multi", "multiheld", "multiexcept",
+ "multiinside", "creature", "special", "number", "scope", "topic",
+ "reverse", "meta", "only", "replace", "first", "last",
+ "string", "table", "buffer", "data", "initial", "initstr",
+ "with", "private", "has", "class",
+ "error", "fatalerror", "warning",
+ "terminating",
+ "" },
+ DIR_KEYWORD_TT, FALSE, TRUE
+};
+
+keyword_group misc_keywords =
+{ { "char", "name", "the", "a", "an", "The", "number",
+ "roman", "reverse", "bold", "underline", "fixed", "on", "off",
+ "to", "address", "string", "object", "near", "from", "property", "A", "" },
+ MISC_KEYWORD_TT, FALSE, TRUE
+};
+
+keyword_group statements =
+{ { "box", "break", "continue", "default", "do", "else", "font", "for",
+ "give", "if", "inversion", "jump", "move", "new_line", "objectloop",
+ "print", "print_ret", "quit", "read", "remove", "restore", "return",
+ "rfalse", "rtrue", "save", "spaces", "string", "style", "switch",
+ "until", "while", "" },
+ STATEMENT_TT, FALSE, TRUE
+};
+
+keyword_group conditions =
+{ { "has", "hasnt", "in", "notin", "ofclass", "or", "provides", "" },
+ CND_TT, FALSE, TRUE
+};
+
+keyword_group system_functions =
+{ { "child", "children", "elder", "eldest", "indirect", "parent", "random",
+ "sibling", "younger", "youngest", "metaclass", "glk", "" },
+ SYSFUN_TT, FALSE, TRUE
+};
+
+keyword_group system_constants =
+{ { "adjectives_table", "actions_table", "classes_table",
+ "identifiers_table", "preactions_table", "version_number",
+ "largest_object", "strings_offset", "code_offset",
+ "dict_par1", "dict_par2", "dict_par3", "actual_largest_object",
+ "static_memory_offset", "array_names_offset", "readable_memory_offset",
+ "cpv__start", "cpv__end", "ipv__start", "ipv__end",
+ "array__start", "array__end",
+ "lowest_attribute_number", "highest_attribute_number",
+ "attribute_names_array",
+ "lowest_property_number", "highest_property_number",
+ "property_names_array",
+ "lowest_action_number", "highest_action_number",
+ "action_names_array",
+ "lowest_fake_action_number", "highest_fake_action_number",
+ "fake_action_names_array",
+ "lowest_routine_number", "highest_routine_number", "routines_array",
+ "routine_names_array", "routine_flags_array",
+ "lowest_global_number", "highest_global_number", "globals_array",
+ "global_names_array", "global_flags_array",
+ "lowest_array_number", "highest_array_number", "arrays_array",
+ "array_names_array", "array_flags_array",
+ "lowest_constant_number", "highest_constant_number", "constants_array",
+ "constant_names_array",
+ "lowest_class_number", "highest_class_number", "class_objects_array",
+ "lowest_object_number", "highest_object_number",
+ "oddeven_packing",
+ "grammar_table", "dictionary_table", "dynam_string_table",
+ "" },
+ SYSTEM_CONSTANT_TT, FALSE, TRUE
+};
+
+keyword_group *keyword_groups[12]
+= { NULL, &opcode_names, &directives, &trace_keywords, &segment_markers,
+ &directive_keywords, &misc_keywords, &statements, &conditions,
+ &system_functions, &system_constants, &opcode_macros};
+
+keyword_group local_variables =
+{ { "" }, /* Filled in when routine declared */
+ LOCAL_VARIABLE_TT, FALSE, FALSE
+};
+
+static int lexical_context(void)
+{
+ /* The lexical context is a number representing all of the context
+ information in the lexical analyser: the same input text will
+ 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). */
+
+ int c = 0;
+ if (opcode_names.enabled) c |= 1;
+ if (directives.enabled) c |= 2;
+ if (trace_keywords.enabled) c |= 4;
+ if (segment_markers.enabled) c |= 8;
+ if (directive_keywords.enabled) c |= 16;
+ if (misc_keywords.enabled) c |= 32;
+ if (statements.enabled) c |= 64;
+ if (conditions.enabled) c |= 128;
+ if (system_functions.enabled) c |= 256;
+ if (system_constants.enabled) c |= 512;
+ if (local_variables.enabled) c |= 1024;
+
+ if (return_sp_as_variable) c |= 2048;
+ return(c);
+}
+
+static void print_context(int c)
+{
+ if ((c & 1) != 0) printf("OPC ");
+ if ((c & 2) != 0) printf("DIR ");
+ if ((c & 4) != 0) printf("TK ");
+ if ((c & 8) != 0) printf("SEG ");
+ if ((c & 16) != 0) printf("DK ");
+ if ((c & 32) != 0) printf("MK ");
+ if ((c & 64) != 0) printf("STA ");
+ if ((c & 128) != 0) printf("CND ");
+ if ((c & 256) != 0) printf("SFUN ");
+ if ((c & 512) != 0) printf("SCON ");
+ if ((c & 1024) != 0) printf("LV ");
+ if ((c & 2048) != 0) printf("sp ");
+}
+
+static int *keywords_hash_table;
+static int *keywords_hash_ends_table;
+static int *keywords_data_table;
+
+static int *local_variable_hash_table;
+static int *local_variable_hash_codes;
+char **local_variable_texts;
+static char *local_variable_text_table;
+
+static char one_letter_locals[128];
+
+static void make_keywords_tables(void)
+{ int i, j, h, tp=0;
+ char **oplist, **maclist;
+
+ if (!glulx_mode) {
+ oplist = opcode_list_z;
+ maclist = opmacro_list_z;
+ }
+ else {
+ oplist = opcode_list_g;
+ maclist = opmacro_list_g;
+ }
+
+ for (j=0; *(oplist[j]); j++) {
+ opcode_names.keywords[j] = oplist[j];
+ }
+ opcode_names.keywords[j] = "";
+
+ for (j=0; *(maclist[j]); j++) {
+ opcode_macros.keywords[j] = maclist[j];
+ }
+ opcode_macros.keywords[j] = "";
+
+ for (i=0; i<HASH_TAB_SIZE; i++)
+ { keywords_hash_table[i] = -1;
+ keywords_hash_ends_table[i] = -1;
+ }
+
+ for (i=1; i<=11; i++)
+ { keyword_group *kg = keyword_groups[i];
+ for (j=0; *(kg->keywords[j]) != 0; j++)
+ { h = hash_code_from_string(kg->keywords[j]);
+ if (keywords_hash_table[h] == -1)
+ keywords_hash_table[h] = tp;
+ else
+ *(keywords_data_table + 3*(keywords_hash_ends_table[h]) + 2) = tp;
+ keywords_hash_ends_table[h] = tp;
+ *(keywords_data_table + 3*tp) = i;
+ *(keywords_data_table + 3*tp+1) = j;
+ *(keywords_data_table + 3*tp+2) = -1;
+ tp++;
+ }
+ }
+}
+
+extern void construct_local_variable_tables(void)
+{ int i, h; char *p = local_variable_text_table;
+ for (i=0; i<HASH_TAB_SIZE; i++) local_variable_hash_table[i] = -1;
+ for (i=0; i<128; i++) one_letter_locals[i] = MAX_LOCAL_VARIABLES;
+
+ for (i=0; i<no_locals; i++)
+ { char *q = local_variables.keywords[i];
+ if (q[1] == 0)
+ { one_letter_locals[(uchar)q[0]] = i;
+ if (isupper(q[0])) one_letter_locals[tolower(q[0])] = i;
+ if (islower(q[0])) one_letter_locals[toupper(q[0])] = i;
+ }
+ h = hash_code_from_string(q);
+ if (local_variable_hash_table[h] == -1)
+ local_variable_hash_table[h] = i;
+ local_variable_hash_codes[i] = h;
+ local_variable_texts[i] = p;
+ strcpy(p, q);
+ p += strlen(p)+1;
+ }
+ for (;i<MAX_LOCAL_VARIABLES-1;i++)
+ local_variable_texts[i] = "<no such local variable>";
+}
+
+static void interpret_identifier(int pos, int dirs_only_flag)
+{ int index, hashcode; char *p = circle[pos].text;
+
+ /* An identifier is either a keyword or a "symbol", a name which the
+ lexical analyser leaves to higher levels of Inform to understand. */
+
+ hashcode = hash_code_from_string(p);
+
+ if (dirs_only_flag) goto KeywordSearch;
+
+ /* If this is assembly language, perhaps it is "sp"? */
+
+ if (return_sp_as_variable && (p[0]=='s') && (p[1]=='p') && (p[2]==0))
+ { circle[pos].value = 0; circle[pos].type = LOCAL_VARIABLE_TT;
+ return;
+ }
+
+ /* Test for local variables first, quite quickly. */
+
+ if (local_variables.enabled)
+ { if (p[1]==0)
+ { index = one_letter_locals[(uchar)p[0]];
+ if (index<MAX_LOCAL_VARIABLES)
+ { circle[pos].type = LOCAL_VARIABLE_TT;
+ circle[pos].value = index+1;
+ return;
+ }
+ }
+ index = local_variable_hash_table[hashcode];
+ if (index >= 0)
+ { for (;index<no_locals;index++)
+ { if (hashcode == local_variable_hash_codes[index])
+ { if (strcmpcis(p, local_variable_texts[index])==0)
+ { circle[pos].type = LOCAL_VARIABLE_TT;
+ circle[pos].value = index+1;
+ return;
+ }
+ }
+ }
+ }
+ }
+
+ /* Now the bulk of the keywords. Note that the lexer doesn't recognise
+ the name of a system function which has been Replaced. */
+
+ KeywordSearch:
+ index = keywords_hash_table[hashcode];
+ while (index >= 0)
+ { int *i = keywords_data_table + 3*index;
+ keyword_group *kg = keyword_groups[*i];
+ if (((!dirs_only_flag) && (kg->enabled))
+ || (dirs_only_flag && (kg == &directives)))
+ { char *q = kg->keywords[*(i+1)];
+ if (((kg->case_sensitive) && (strcmp(p, q)==0))
+ || ((!(kg->case_sensitive)) && (strcmpcis(p, q)==0)))
+ { if ((kg != &system_functions)
+ || (system_function_usage[*(i+1)]!=2))
+ { circle[pos].type = kg->change_token_type;
+ circle[pos].value = *(i+1);
+ return;
+ }
+ }
+ }
+ 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].type = SYMBOL_TT;
+}
+
+
+/* ------------------------------------------------------------------------- */
+/* The tokeniser grid aids a rapid decision about the consequences of a */
+/* character reached in the buffer. In effect it is an efficiently stored */
+/* transition table using an algorithm similar to that of S. C. Johnson's */
+/* "yacc" lexical analyser (see Aho, Sethi and Ullman, section 3.9). */
+/* My thanks to Dilip Sequeira for suggesting this. */
+/* */
+/* tokeniser_grid[c] is (16*n + m) if c is the first character of */
+/* separator numbers n, n+1, ..., n+m-1 */
+/* or certain special values (QUOTE_CODE, etc) */
+/* or 0 otherwise */
+/* */
+/* Since 1000/16 = 62, the code numbers below will need increasing if the */
+/* number of separators supported exceeds 61. */
+/* ------------------------------------------------------------------------- */
+
+static int tokeniser_grid[256];
+
+#define QUOTE_CODE 1000
+#define DQUOTE_CODE 1001
+#define NULL_CODE 1002
+#define SPACE_CODE 1003
+#define NEGATIVE_CODE 1004
+#define DIGIT_CODE 1005
+#define RADIX_CODE 1006
+#define KEYWORD_CODE 1007
+#define EOF_CODE 1008
+#define WHITESPACE_CODE 1009
+#define COMMENT_CODE 1010
+#define IDENTIFIER_CODE 1011
+
+/* This list cannot safely be changed without also changing the header
+ separator #defines. The ordering is significant in that (i) all entries
+ beginning with the same character must be adjacent and (ii) that if
+ X is a an initial substring of Y then X must come before Y.
+
+ E.g. --> must occur before -- to prevent "-->0" being tokenised
+ wrongly as "--", ">", "0" rather than "-->", "0". */
+
+static const char separators[NUMBER_SEPARATORS][4] =
+{ "->", "-->", "--", "-", "++", "+", "*", "/", "%",
+ "||", "|", "&&", "&", "~~",
+ "~=", "~", "==", "=", ">=", ">",
+ "<=", "<", "(", ")", ",",
+ ".&", ".#", "..&", "..#", "..", ".",
+ "::", ":", "@", ";", "[", "]", "{", "}",
+ "$", "?~", "?",
+ "#a$", "#g$", "#n$", "#r$", "#w$", "##", "#"
+};
+
+static void make_tokeniser_grid(void)
+{
+ /* Construct the grid to the specification above. */
+
+ int i, j;
+
+ for (i=0; i<256; i++) tokeniser_grid[i]=0;
+
+ for (i=0; i<NUMBER_SEPARATORS; i++)
+ { j=separators[i][0];
+ if (tokeniser_grid[j]==0)
+ tokeniser_grid[j]=i*16+1; else tokeniser_grid[j]++;
+ }
+ tokeniser_grid['\''] = QUOTE_CODE;
+ tokeniser_grid['\"'] = DQUOTE_CODE;
+ tokeniser_grid[0] = EOF_CODE;
+ tokeniser_grid[' '] = WHITESPACE_CODE;
+ tokeniser_grid['\n'] = WHITESPACE_CODE;
+ tokeniser_grid['$'] = RADIX_CODE;
+ tokeniser_grid['!'] = COMMENT_CODE;
+
+ tokeniser_grid['0'] = DIGIT_CODE;
+ tokeniser_grid['1'] = DIGIT_CODE;
+ tokeniser_grid['2'] = DIGIT_CODE;
+ tokeniser_grid['3'] = DIGIT_CODE;
+ tokeniser_grid['4'] = DIGIT_CODE;
+ tokeniser_grid['5'] = DIGIT_CODE;
+ tokeniser_grid['6'] = DIGIT_CODE;
+ tokeniser_grid['7'] = DIGIT_CODE;
+ tokeniser_grid['8'] = DIGIT_CODE;
+ tokeniser_grid['9'] = DIGIT_CODE;
+
+ tokeniser_grid['a'] = IDENTIFIER_CODE;
+ tokeniser_grid['b'] = IDENTIFIER_CODE;
+ tokeniser_grid['c'] = IDENTIFIER_CODE;
+ tokeniser_grid['d'] = IDENTIFIER_CODE;
+ tokeniser_grid['e'] = IDENTIFIER_CODE;
+ tokeniser_grid['f'] = IDENTIFIER_CODE;
+ tokeniser_grid['g'] = IDENTIFIER_CODE;
+ tokeniser_grid['h'] = IDENTIFIER_CODE;
+ tokeniser_grid['i'] = IDENTIFIER_CODE;
+ tokeniser_grid['j'] = IDENTIFIER_CODE;
+ tokeniser_grid['k'] = IDENTIFIER_CODE;
+ tokeniser_grid['l'] = IDENTIFIER_CODE;
+ tokeniser_grid['m'] = IDENTIFIER_CODE;
+ tokeniser_grid['n'] = IDENTIFIER_CODE;
+ tokeniser_grid['o'] = IDENTIFIER_CODE;
+ tokeniser_grid['p'] = IDENTIFIER_CODE;
+ tokeniser_grid['q'] = IDENTIFIER_CODE;
+ tokeniser_grid['r'] = IDENTIFIER_CODE;
+ tokeniser_grid['s'] = IDENTIFIER_CODE;
+ tokeniser_grid['t'] = IDENTIFIER_CODE;
+ tokeniser_grid['u'] = IDENTIFIER_CODE;
+ tokeniser_grid['v'] = IDENTIFIER_CODE;
+ tokeniser_grid['w'] = IDENTIFIER_CODE;
+ tokeniser_grid['x'] = IDENTIFIER_CODE;
+ tokeniser_grid['y'] = IDENTIFIER_CODE;
+ tokeniser_grid['z'] = IDENTIFIER_CODE;
+
+ tokeniser_grid['A'] = IDENTIFIER_CODE;
+ tokeniser_grid['B'] = IDENTIFIER_CODE;
+ tokeniser_grid['C'] = IDENTIFIER_CODE;
+ tokeniser_grid['D'] = IDENTIFIER_CODE;
+ tokeniser_grid['E'] = IDENTIFIER_CODE;
+ tokeniser_grid['F'] = IDENTIFIER_CODE;
+ tokeniser_grid['G'] = IDENTIFIER_CODE;
+ tokeniser_grid['H'] = IDENTIFIER_CODE;
+ tokeniser_grid['I'] = IDENTIFIER_CODE;
+ tokeniser_grid['J'] = IDENTIFIER_CODE;
+ tokeniser_grid['K'] = IDENTIFIER_CODE;
+ tokeniser_grid['L'] = IDENTIFIER_CODE;
+ tokeniser_grid['M'] = IDENTIFIER_CODE;
+ tokeniser_grid['N'] = IDENTIFIER_CODE;
+ tokeniser_grid['O'] = IDENTIFIER_CODE;
+ tokeniser_grid['P'] = IDENTIFIER_CODE;
+ tokeniser_grid['Q'] = IDENTIFIER_CODE;
+ tokeniser_grid['R'] = IDENTIFIER_CODE;
+ tokeniser_grid['S'] = IDENTIFIER_CODE;
+ tokeniser_grid['T'] = IDENTIFIER_CODE;
+ tokeniser_grid['U'] = IDENTIFIER_CODE;
+ tokeniser_grid['V'] = IDENTIFIER_CODE;
+ tokeniser_grid['W'] = IDENTIFIER_CODE;
+ tokeniser_grid['X'] = IDENTIFIER_CODE;
+ tokeniser_grid['Y'] = IDENTIFIER_CODE;
+ tokeniser_grid['Z'] = IDENTIFIER_CODE;
+
+ tokeniser_grid['_'] = IDENTIFIER_CODE;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Definition of a lexical block: a source file or a string containing */
+/* text for lexical analysis; an independent source from the point of */
+/* view of issuing error reports. */
+/* ------------------------------------------------------------------------- */
+
+typedef struct LexicalBlock_s
+{ char *filename; /* Full translated name */
+ int main_flag; /* TRUE if the main file
+ (the first one opened) */
+ int sys_flag; /* TRUE if a System_File */
+ int source_line; /* Line number count */
+ int line_start; /* Char number within file
+ where the current line
+ starts */
+ int chars_read; /* Char number of read pos */
+ int file_no; /* Or 255 if not from a
+ file; used for debug
+ information */
+ char *orig_source; /* From #origsource direct */
+ int orig_file;
+ int32 orig_line;
+ int32 orig_char;
+} LexicalBlock;
+
+static LexicalBlock NoFileOpen =
+ { "<before compilation>", FALSE, FALSE, 0, 0, 0, 255, NULL, 0, 0, 0 };
+
+static LexicalBlock MakingOutput =
+ { "<constructing output>", FALSE, FALSE, 0, 0, 0, 255, NULL, 0, 0, 0 };
+
+static LexicalBlock StringLB =
+ { "<veneer routine>", FALSE, TRUE, 0, 0, 0, 255, NULL, 0, 0, 0 };
+
+static LexicalBlock *CurrentLB; /* The current lexical
+ block of input text */
+
+extern void declare_systemfile(void)
+{ CurrentLB->sys_flag = TRUE;
+}
+
+extern int is_systemfile(void)
+{ return ((CurrentLB->sys_flag)?1:0);
+}
+
+extern void set_origsource_location(char *source, int32 line, int32 charnum)
+{
+ if (!source) {
+ /* Clear the Origsource declaration. */
+ CurrentLB->orig_file = 0;
+ CurrentLB->orig_source = NULL;
+ CurrentLB->orig_line = 0;
+ CurrentLB->orig_char = 0;
+ return;
+ }
+
+ /* Get the file number for a new or existing InputFiles entry. */
+ int file_no = register_orig_sourcefile(source);
+
+ CurrentLB->orig_file = file_no;
+ CurrentLB->orig_source = InputFiles[file_no-1].filename;
+ CurrentLB->orig_line = line;
+ CurrentLB->orig_char = charnum;
+}
+
+/* Error locations. */
+
+extern debug_location get_current_debug_location(void)
+{ debug_location result;
+ /* Assume that all input characters are one byte. */
+ result.file_index = CurrentLB->file_no;
+ result.beginning_byte_index = CurrentLB->chars_read - LOOKAHEAD_SIZE;
+ result.end_byte_index = result.beginning_byte_index;
+ result.beginning_line_number = CurrentLB->source_line;
+ result.end_line_number = result.beginning_line_number;
+ result.beginning_character_number =
+ CurrentLB->chars_read - CurrentLB->line_start;
+ result.end_character_number = result.beginning_character_number;
+ result.orig_file_index = CurrentLB->orig_file;
+ result.orig_beg_line_number = CurrentLB->orig_line;
+ result.orig_beg_char_number = CurrentLB->orig_char;
+ return result;
+}
+
+static debug_location ErrorReport_debug_location;
+
+extern void report_errors_at_current_line(void)
+{ ErrorReport.line_number = CurrentLB->source_line;
+ ErrorReport.file_number = CurrentLB->file_no;
+ if (ErrorReport.file_number == 255)
+ ErrorReport.file_number = -1;
+ ErrorReport.source = CurrentLB->filename;
+ ErrorReport.main_flag = CurrentLB->main_flag;
+ if (debugfile_switch)
+ ErrorReport_debug_location = get_current_debug_location();
+ ErrorReport.orig_file = CurrentLB->orig_file;
+ ErrorReport.orig_source = CurrentLB->orig_source;
+ ErrorReport.orig_line = CurrentLB->orig_line;
+ ErrorReport.orig_char = CurrentLB->orig_char;
+}
+
+extern debug_location get_error_report_debug_location(void)
+{ return ErrorReport_debug_location;
+}
+
+extern int32 get_current_line_start(void)
+{ return CurrentLB->line_start;
+}
+
+brief_location blank_brief_location;
+
+extern brief_location get_brief_location(ErrorPosition *errpos)
+{
+ brief_location loc;
+ loc.file_index = errpos->file_number;
+ loc.line_number = errpos->line_number;
+ loc.orig_file_index = errpos->orig_file;
+ loc.orig_line_number = errpos->orig_line;
+ return loc;
+}
+
+extern void export_brief_location(brief_location loc, ErrorPosition *errpos)
+{
+ if (loc.file_index != -1)
+ { errpos->file_number = loc.file_index;
+ errpos->line_number = loc.line_number;
+ errpos->main_flag = (errpos->file_number == 1);
+ errpos->orig_source = NULL;
+ errpos->orig_file = loc.orig_file_index;
+ errpos->orig_line = loc.orig_line_number;
+ errpos->orig_char = 0;
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Hash printing and line counting */
+/* ------------------------------------------------------------------------- */
+
+static void print_hash(void)
+{
+ /* Hash-printing is the practice of printing a # character every 100
+ lines of source code (the -x switch), reassuring the user that
+ progress is being made */
+
+ if (no_hash_printed_yet)
+ { printf("::"); no_hash_printed_yet = FALSE;
+ }
+ printf("#"); hash_printed_since_newline = TRUE;
+
+#ifndef MAC_FACE
+ /* On some systems, text output is buffered to a line at a time, and
+ this would frustrate the point of hash-printing, so: */
+
+ fflush(stdout);
+#endif
+}
+
+static void reached_new_line(void)
+{
+ /* Called to signal that a new line has been reached in the source code */
+
+ forerrors_pointer = 0;
+
+ CurrentLB->source_line++;
+ CurrentLB->line_start = CurrentLB->chars_read;
+
+ total_source_line_count++;
+
+ if (total_source_line_count%100==0)
+ { if (hash_switch) print_hash();
+#ifdef MAC_MPW
+ SpinCursor(32); /* I.e., allow other tasks to run */
+#endif
+ }
+
+#ifdef MAC_FACE
+ if (total_source_line_count%((**g_pm_hndl).linespercheck) == 0)
+ { ProcessEvents (&g_proc);
+ if (g_proc != true)
+ { free_arrays();
+ close_all_source();
+ if (temporary_files_switch)
+ remove_temp_files();
+ if (store_the_text)
+ my_free(&all_text,"transcription text");
+ abort_transcript_file();
+ longjmp (g_fallback, 1);
+ }
+ }
+#endif
+}
+
+static void new_syntax_line(void)
+{ if (source_to_analyse != NULL) forerrors_pointer = 0;
+ report_errors_at_current_line();
+}
+
+/* Return 10 raised to the expo power.
+ *
+ * I'm avoiding the standard pow() function for a rather lame reason:
+ * it's in the libmath (-lm) library, and I don't want to change the
+ * build model for the compiler. So, this is implemented with a stupid
+ * lookup table. It's faster than pow() for small values of expo.
+ * Probably not as fast if expo is 200, but "$+1e200" is an overflow
+ * anyway, so I don't expect that to be a problem.
+ *
+ * (For some reason, frexp() and ldexp(), which are used later on, do
+ * not require libmath to be linked in.)
+ */
+static double pow10_cheap(int expo)
+{
+ #define POW10_RANGE (8)
+ static double powers[POW10_RANGE*2+1] = {
+ 0.00000001, 0.0000001, 0.000001, 0.00001, 0.0001, 0.001, 0.01, 0.1,
+ 1.0,
+ 10.0, 100.0, 1000.0, 10000.0, 100000.0, 1000000.0, 10000000.0, 100000000.0
+ };
+
+ double res = 1.0;
+
+ if (expo < 0) {
+ for (; expo < -POW10_RANGE; expo += POW10_RANGE) {
+ res *= powers[0];
+ }
+ return res * powers[POW10_RANGE+expo];
+ }
+ else {
+ for (; expo > POW10_RANGE; expo -= POW10_RANGE) {
+ res *= powers[POW10_RANGE*2];
+ }
+ return res * powers[POW10_RANGE+expo];
+ }
+}
+
+/* Return the IEEE-754 single-precision encoding of a floating-point
+ * number. See http://www.psc.edu/general/software/packages/ieee/ieee.php
+ * for an explanation.
+ *
+ * The number is provided in the pieces it was parsed in:
+ * [+|-] intv "." fracv "e" [+|-]expo
+ *
+ * If the magnitude is too large (beyond about 3.4e+38), this returns
+ * an infinite value (0x7f800000 or 0xff800000). If the magnitude is too
+ * small (below about 1e-45), this returns a zero value (0x00000000 or
+ * 0x80000000). If any of the inputs are NaN, this returns NaN (but the
+ * lexer should never do that).
+ *
+ * Note that using a float constant does *not* set the uses_float_features
+ * flag (which would cause the game file to be labelled 3.1.2). There's
+ * no VM feature here, just an integer. Of course, any use of the float
+ * *opcodes* will set the flag.
+ *
+ * The math functions in this routine require #including <math.h>, but
+ * they should not require linking the math library (-lm). At least,
+ * they do not on OSX and Linux.
+ */
+static int32 construct_float(int signbit, double intv, double fracv, int expo)
+{
+ double absval = (intv + fracv) * pow10_cheap(expo);
+ int32 sign = (signbit ? 0x80000000 : 0x0);
+ double mant;
+ int32 fbits;
+
+ if (isinf(absval)) {
+ return sign | 0x7f800000; /* infinity */
+ }
+ if (isnan(absval)) {
+ return sign | 0x7fc00000;
+ }
+
+ mant = frexp(absval, &expo);
+
+ /* Normalize mantissa to be in the range [1.0, 2.0) */
+ if (0.5 <= mant && mant < 1.0) {
+ mant *= 2.0;
+ expo--;
+ }
+ else if (mant == 0.0) {
+ expo = 0;
+ }
+ else {
+ return sign | 0x7f800000; /* infinity */
+ }
+
+ if (expo >= 128) {
+ return sign | 0x7f800000; /* infinity */
+ }
+ else if (expo < -126) {
+ /* Denormalized (very small) number */
+ mant = ldexp(mant, 126 + expo);
+ expo = 0;
+ }
+ else if (!(expo == 0 && mant == 0.0)) {
+ expo += 127;
+ mant -= 1.0; /* Get rid of leading 1 */
+ }
+
+ mant *= 8388608.0; /* 2^23 */
+ fbits = (int32)(mant + 0.5); /* round mant to nearest int */
+ if (fbits >> 23) {
+ /* The carry propagated out of a string of 23 1 bits. */
+ fbits = 0;
+ expo++;
+ if (expo >= 255) {
+ return sign | 0x7f800000; /* infinity */
+ }
+ }
+
+ return (sign) | ((int32)(expo << 23)) | (fbits);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Characters are read via a "pipeline" of variables, allowing us to look */
+/* up to three characters ahead of the current position. */
+/* */
+/* There are two possible sources: from the source files being loaded in, */
+/* and from a string inside Inform (which is where the code for veneer */
+/* routines comes from). Each source has its own get-next-character */
+/* routine. */
+/* ------------------------------------------------------------------------- */
+/* Source 1: from files */
+/* */
+/* 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 */
+/* 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. */
+/* */
+/* The routine returns the number of characters it has written, and note */
+/* that this conveniently ensures that all characters in the buffer come */
+/* from the same file. */
+/* ------------------------------------------------------------------------- */
+
+#define SOURCE_BUFFER_SIZE 4096 /* Typical disc block size */
+
+typedef struct Sourcefile_s
+{ char *buffer; /* Input buffer */
+ int read_pos; /* Read position in buffer */
+ int size; /* Number of meaningful
+ characters in buffer */
+ int la, la2, la3; /* Three characters of
+ lookahead pipeline */
+ int file_no; /* Internal file number
+ (1, 2, 3, ...) */
+ LexicalBlock LB;
+} Sourcefile;
+
+static Sourcefile *FileStack;
+static int File_sp; /* Stack pointer */
+
+static Sourcefile *CF; /* Top entry on stack */
+
+static int last_input_file;
+
+static void begin_buffering_file(int i, int file_no)
+{ int j, cnt; uchar *p;
+
+ if (i >= MAX_INCLUSION_DEPTH)
+ memoryerror("MAX_INCLUSION_DEPTH",MAX_INCLUSION_DEPTH);
+
+ p = (uchar *) FileStack[i].buffer;
+
+ if (i>0)
+ { FileStack[i-1].la = lookahead;
+ FileStack[i-1].la2 = lookahead2;
+ FileStack[i-1].la3 = lookahead3;
+ }
+
+ FileStack[i].file_no = file_no;
+ FileStack[i].size = file_load_chars(file_no,
+ (char *) p, SOURCE_BUFFER_SIZE);
+ lookahead = source_to_iso_grid[p[0]];
+ lookahead2 = source_to_iso_grid[p[1]];
+ lookahead3 = source_to_iso_grid[p[2]];
+ if (LOOKAHEAD_SIZE != 3)
+ compiler_error
+ ("Lexer lookahead size does not match hard-coded lookahead code");
+ FileStack[i].read_pos = LOOKAHEAD_SIZE;
+
+ if (file_no==1) FileStack[i].LB.main_flag = TRUE;
+ else FileStack[i].LB.main_flag = FALSE;
+ FileStack[i].LB.sys_flag = FALSE;
+ FileStack[i].LB.source_line = 1;
+ FileStack[i].LB.line_start = LOOKAHEAD_SIZE;
+ FileStack[i].LB.chars_read = LOOKAHEAD_SIZE;
+ FileStack[i].LB.filename = InputFiles[file_no-1].filename;
+ FileStack[i].LB.file_no = file_no;
+ FileStack[i].LB.orig_source = NULL; FileStack[i].LB.orig_file = 0;
+ FileStack[i].LB.orig_line = 0; FileStack[i].LB.orig_char = 0;
+
+ CurrentLB = &(FileStack[i].LB);
+ CF = &(FileStack[i]);
+
+ /* Check for recursive inclusion */
+ cnt = 0;
+ for (j=0; j<i; j++)
+ { if (!strcmp(FileStack[i].LB.filename, FileStack[j].LB.filename))
+ cnt++;
+ }
+ if (cnt==1)
+ warning_named("File included more than once",
+ FileStack[j].LB.filename);
+}
+
+static void create_char_pipeline(void)
+{
+ File_sp = 0;
+ begin_buffering_file(File_sp++, 1);
+ pipeline_made = TRUE;
+ last_input_file = current_input_file;
+}
+
+static int get_next_char_from_pipeline(void)
+{ uchar *p;
+
+ while (last_input_file < current_input_file)
+ {
+ /* An "Include" file must have opened since the last character
+ was read. Perhaps more than one. We run forward through the
+ list and add them to the include stack. But we ignore
+ "Origsource" files (which were never actually opened for
+ reading). */
+
+ last_input_file++;
+ if (!InputFiles[last_input_file-1].is_input)
+ continue;
+
+ begin_buffering_file(File_sp++, last_input_file);
+ }
+ if (last_input_file != current_input_file)
+ compiler_error("last_input_file did not match after Include");
+
+ if (File_sp == 0)
+ { lookahead = 0; lookahead2 = 0; lookahead3 = 0; return 0;
+ }
+
+ if (CF->read_pos == CF->size)
+ { CF->size =
+ file_load_chars(CF->file_no, CF->buffer, SOURCE_BUFFER_SIZE);
+ CF->read_pos = 0;
+ }
+ else
+ if (CF->read_pos == -(CF->size))
+ { set_token_location(get_current_debug_location());
+ File_sp--;
+ if (File_sp == 0)
+ { lookahead = 0; lookahead2 = 0; lookahead3 = 0; return 0;
+ }
+ CF = &(FileStack[File_sp-1]);
+ CurrentLB = &(FileStack[File_sp-1].LB);
+ lookahead = CF->la; lookahead2 = CF->la2; lookahead3 = CF->la3;
+ if (CF->read_pos == CF->size)
+ { CF->size =
+ file_load_chars(CF->file_no, CF->buffer, SOURCE_BUFFER_SIZE);
+ CF->read_pos = 0;
+ }
+ set_token_location(get_current_debug_location());
+ }
+
+ p = (uchar *) (CF->buffer);
+
+ current = lookahead;
+ lookahead = lookahead2;
+ lookahead2 = lookahead3;
+ lookahead3 = source_to_iso_grid[p[CF->read_pos++]];
+
+ CurrentLB->chars_read++;
+ if (forerrors_pointer < 511)
+ forerrors_buff[forerrors_pointer++] = current;
+ if (current == '\n') reached_new_line();
+ return(current);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Source 2: from a string */
+/* ------------------------------------------------------------------------- */
+
+static int source_to_analyse_pointer; /* Current read position */
+
+static int get_next_char_from_string(void)
+{ uchar *p = (uchar *) source_to_analyse + source_to_analyse_pointer++;
+ current = source_to_iso_grid[p[0]];
+
+ if (current == 0) lookahead = 0;
+ else lookahead = source_to_iso_grid[p[1]];
+ if (lookahead == 0) lookahead2 = 0;
+ else lookahead2 = source_to_iso_grid[p[2]];
+ if (lookahead2 == 0) lookahead3 = 0;
+ else lookahead3 = source_to_iso_grid[p[3]];
+
+ CurrentLB->chars_read++;
+ if (forerrors_pointer < 511)
+ forerrors_buff[forerrors_pointer++] = current;
+ if (current == '\n') reached_new_line();
+ return(current);
+}
+
+/* ========================================================================= */
+/* The interface between the lexer and Inform's higher levels: */
+/* */
+/* put_token_back() (effectively) move the read position */
+/* back by one token */
+/* */
+/* get_next_token() copy the token at the current read */
+/* position into the triple */
+/* (token_type, token_value, token_text) */
+/* and move the read position forward */
+/* by one */
+/* */
+/* restart_lexer(source, name) if source is NULL, initialise the lexer */
+/* to read from source files; */
+/* otherwise, to read from this string. */
+/* ------------------------------------------------------------------------- */
+
+extern void put_token_back(void)
+{ tokens_put_back++;
+
+ if (tokens_trace_level > 0)
+ { if (tokens_trace_level == 1) printf("<- ");
+ else printf("<-\n");
+ }
+
+ /* The following error, of course, should never happen! */
+
+ if (tokens_put_back == CIRCLE_SIZE)
+ { compiler_error("The lexical analyser has collapsed because of a wrong \
+assumption inside Inform");
+ tokens_put_back--;
+ return;
+ }
+}
+
+extern void get_next_token(void)
+{ int d, i, j, k, quoted_size, e, radix, context; int32 n; char *r;
+ int returning_a_put_back_token = TRUE;
+
+ context = lexical_context();
+
+ if (tokens_put_back > 0)
+ { i = circle_position - tokens_put_back + 1;
+ if (i<0) i += CIRCLE_SIZE;
+ tokens_put_back--;
+ if (context != token_contexts[i])
+ { j = circle[i].type;
+ if ((j==0) || ((j>=100) && (j<200)))
+ interpret_identifier(i, FALSE);
+ }
+ goto ReturnBack;
+ }
+ returning_a_put_back_token = FALSE;
+
+ if (circle_position == CIRCLE_SIZE-1) circle_position = 0;
+ else circle_position++;
+
+ if (lex_p > lexeme_memory + 4*MAX_QTEXT_SIZE)
+ lex_p = lexeme_memory;
+
+ circle[circle_position].text = lex_p;
+ circle[circle_position].value = 0;
+ *lex_p = 0;
+
+ StartTokenAgain:
+ d = (*get_next_char)();
+ e = tokeniser_grid[d];
+
+ if (next_token_begins_syntax_line)
+ { if ((e != WHITESPACE_CODE) && (e != COMMENT_CODE))
+ { new_syntax_line();
+ next_token_begins_syntax_line = FALSE;
+ }
+ }
+
+ circle[circle_position].location = get_current_debug_location();
+
+ switch(e)
+ { case 0: char_error("Illegal character found in source:", d);
+ goto StartTokenAgain;
+
+ case WHITESPACE_CODE:
+ while (tokeniser_grid[lookahead] == WHITESPACE_CODE)
+ (*get_next_char)();
+ goto StartTokenAgain;
+
+ case COMMENT_CODE:
+ while ((lookahead != '\n') && (lookahead != 0))
+ (*get_next_char)();
+ goto StartTokenAgain;
+
+ case EOF_CODE:
+ circle[circle_position].type = EOF_TT;
+ strcpy(lex_p, "<end of file>");
+ lex_p += strlen(lex_p) + 1;
+ break;
+
+ case DIGIT_CODE:
+ radix = 10;
+ ReturnNumber:
+ n=0;
+ do
+ { n = n*radix + character_digit_value[d];
+ *lex_p++ = d;
+ } while ((character_digit_value[lookahead] < radix)
+ && (d = (*get_next_char)(), TRUE));
+
+ *lex_p++ = 0;
+ circle[circle_position].type = NUMBER_TT;
+ circle[circle_position].value = n;
+ break;
+
+ FloatNumber:
+ { int expo=0; double intv=0, fracv=0;
+ int expocount=0, intcount=0, fraccount=0;
+ int signbit = (d == '-');
+ *lex_p++ = d;
+ while (character_digit_value[lookahead] < 10) {
+ intv = 10.0*intv + character_digit_value[lookahead];
+ intcount++;
+ *lex_p++ = lookahead;
+ (*get_next_char)();
+ }
+ if (lookahead == '.') {
+ double fracpow = 1.0;
+ *lex_p++ = lookahead;
+ (*get_next_char)();
+ while (character_digit_value[lookahead] < 10) {
+ fracpow *= 0.1;
+ fracv = fracv + fracpow*character_digit_value[lookahead];
+ fraccount++;
+ *lex_p++ = lookahead;
+ (*get_next_char)();
+ }
+ }
+ if (lookahead == 'e' || lookahead == 'E') {
+ int exposign = 0;
+ *lex_p++ = lookahead;
+ (*get_next_char)();
+ if (lookahead == '+' || lookahead == '-') {
+ exposign = (lookahead == '-');
+ *lex_p++ = lookahead;
+ (*get_next_char)();
+ }
+ while (character_digit_value[lookahead] < 10) {
+ expo = 10*expo + character_digit_value[lookahead];
+ expocount++;
+ *lex_p++ = lookahead;
+ (*get_next_char)();
+ }
+ if (expocount == 0)
+ error("Floating-point literal must have digits after the 'e'");
+ if (exposign) { expo = -expo; }
+ }
+ if (intcount + fraccount == 0)
+ error("Floating-point literal must have digits");
+ n = construct_float(signbit, intv, fracv, expo);
+ }
+ *lex_p++ = 0;
+ circle[circle_position].type = NUMBER_TT;
+ circle[circle_position].value = n;
+ if (!glulx_mode && dont_enter_into_symbol_table != -2) error("Floating-point literals are not available in Z-code");
+ break;
+
+ case RADIX_CODE:
+ radix = 16; d = (*get_next_char)();
+ if (d == '-' || d == '+') { goto FloatNumber; }
+ if (d == '$') { d = (*get_next_char)(); radix = 2; }
+ if (character_digit_value[d] >= radix)
+ { if (radix == 2)
+ error("Binary number expected after '$$'");
+ else
+ error("Hexadecimal number expected after '$'");
+ }
+ goto ReturnNumber;
+
+ case QUOTE_CODE: /* Single-quotes: scan a literal string */
+ quoted_size=0;
+ do
+ { e = d; d = (*get_next_char)(); *lex_p++ = d;
+ if (quoted_size++==64)
+ { error(
+ "Too much text for one pair of quotations '...' to hold");
+ *lex_p='\''; break;
+ }
+ if ((d == '\'') && (e != '@'))
+ { if (quoted_size == 1)
+ { d = (*get_next_char)(); *lex_p++ = d;
+ if (d != '\'')
+ error("No text between quotation marks ''");
+ }
+ break;
+ }
+ } while (d != EOF);
+ if (d==EOF) ebf_error("'\''", "end of file");
+ *(lex_p-1) = 0;
+ circle[circle_position].type = SQ_TT;
+ break;
+
+ case DQUOTE_CODE: /* Double-quotes: scan a literal string */
+ quoted_size=0;
+ do
+ { d = (*get_next_char)(); *lex_p++ = d;
+ if (quoted_size++==MAX_QTEXT_SIZE)
+ { memoryerror("MAX_QTEXT_SIZE", MAX_QTEXT_SIZE);
+ break;
+ }
+ if (d == '\n')
+ { lex_p--;
+ while (*(lex_p-1) == ' ') lex_p--;
+ if (*(lex_p-1) != '^') *lex_p++ = ' ';
+ while ((lookahead != EOF) &&
+ (tokeniser_grid[lookahead] == WHITESPACE_CODE))
+ (*get_next_char)();
+ }
+ else if (d == '\\')
+ { int newline_passed = FALSE;
+ lex_p--;
+ while ((lookahead != EOF) &&
+ (tokeniser_grid[lookahead] == WHITESPACE_CODE))
+ if ((d = (*get_next_char)()) == '\n')
+ newline_passed = TRUE;
+ if (!newline_passed)
+ { char chb[4];
+ chb[0] = '\"'; chb[1] = lookahead;
+ chb[2] = '\"'; chb[3] = 0;
+ ebf_error("empty rest of line after '\\' in string",
+ chb);
+ }
+ }
+ } while ((d != EOF) && (d!='\"'));
+ if (d==EOF) ebf_error("'\"'", "end of file");
+ *(lex_p-1) = 0;
+ circle[circle_position].type = DQ_TT;
+ break;
+
+ case IDENTIFIER_CODE: /* Letter or underscore: an identifier */
+
+ *lex_p++ = d; n=1;
+ while ((n<=MAX_IDENTIFIER_LENGTH)
+ && ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
+ || (tokeniser_grid[lookahead] == DIGIT_CODE)))
+ n++, *lex_p++ = (*get_next_char)();
+
+ *lex_p++ = 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, circle[circle_position].text);
+ /* Trim token so that it doesn't violate
+ MAX_IDENTIFIER_LENGTH during error recovery */
+ circle[circle_position].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(circle_position, TRUE);
+ break;
+ }
+
+ interpret_identifier(circle_position, FALSE);
+ break;
+
+ default:
+
+ /* The character is initial to at least one of the separators */
+
+ for (j=e>>4, k=j+(e&0x0f); j<k; j++)
+ { r = (char *) separators[j];
+ if (r[1]==0)
+ { *lex_p++=d; *lex_p++=0;
+ goto SeparatorMatched;
+ }
+ else
+ if (r[2]==0)
+ { if (*(r+1) == lookahead)
+ { *lex_p++=d;
+ *lex_p++=(*get_next_char)();
+ *lex_p++=0;
+ goto SeparatorMatched;
+ }
+ }
+ else
+ { if ((*(r+1) == lookahead) && (*(r+2) == lookahead2))
+ { *lex_p++=d;
+ *lex_p++=(*get_next_char)();
+ *lex_p++=(*get_next_char)();
+ *lex_p++=0;
+ goto SeparatorMatched;
+ }
+ }
+ }
+
+ /* The following contingency never in fact arises with the
+ current set of separators, but might in future */
+
+ *lex_p++ = d; *lex_p++ = lookahead; *lex_p++ = lookahead2;
+ *lex_p++ = 0;
+ error_named("Unrecognised combination in source:", lex_p);
+ goto StartTokenAgain;
+
+ SeparatorMatched:
+
+ circle[circle_position].type = SEP_TT;
+ circle[circle_position].value = j;
+ switch(j)
+ { case SEMICOLON_SEP: break;
+ case HASHNDOLLAR_SEP:
+ case HASHWDOLLAR_SEP:
+ if (tokeniser_grid[lookahead] == WHITESPACE_CODE)
+ { error_named("Character expected after",
+ circle[circle_position].text);
+ break;
+ }
+ lex_p--;
+ *lex_p++ = (*get_next_char)();
+ while ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
+ || (tokeniser_grid[lookahead] == DIGIT_CODE))
+ *lex_p++ = (*get_next_char)();
+ *lex_p++ = 0;
+ break;
+ case HASHADOLLAR_SEP:
+ case HASHGDOLLAR_SEP:
+ case HASHRDOLLAR_SEP:
+ case HASHHASH_SEP:
+ if (tokeniser_grid[lookahead] != IDENTIFIER_CODE)
+ { error_named("Alphabetic character expected after",
+ circle[circle_position].text);
+ break;
+ }
+ lex_p--;
+ while ((tokeniser_grid[lookahead] == IDENTIFIER_CODE)
+ || (tokeniser_grid[lookahead] == DIGIT_CODE))
+ *lex_p++ = (*get_next_char)();
+ *lex_p++ = 0;
+ break;
+ }
+ break;
+ }
+
+ i = circle_position;
+
+ ReturnBack:
+ token_value = circle[i].value;
+ token_type = circle[i].type;
+ token_text = circle[i].text;
+ if (!returning_a_put_back_token)
+ { set_token_location(circle[i].location);
+ }
+ token_contexts[i] = context;
+
+ if (tokens_trace_level > 0)
+ { if (tokens_trace_level == 1)
+ printf("'%s' ", circle[i].text);
+ else
+ { printf("-> "); describe_token(circle[i]);
+ printf(" ");
+ if (tokens_trace_level > 2) print_context(token_contexts[i]);
+ printf("\n");
+ }
+ }
+}
+
+static char veneer_error_title[64];
+
+extern void restart_lexer(char *lexical_source, char *name)
+{ int i;
+ circle_position = 0;
+ for (i=0; i<CIRCLE_SIZE; i++)
+ { circle[i].type = 0;
+ circle[i].value = 0;
+ circle[i].text = "(if this is ever visible, there is a bug)";
+ token_contexts[i] = 0;
+ }
+
+ lex_p = lexeme_memory;
+ tokens_put_back = 0;
+ forerrors_pointer = 0;
+ dont_enter_into_symbol_table = FALSE;
+ return_sp_as_variable = FALSE;
+ next_token_begins_syntax_line = TRUE;
+
+ source_to_analyse = lexical_source;
+
+ if (source_to_analyse == NULL)
+ { get_next_char = get_next_char_from_pipeline;
+ if (!pipeline_made) create_char_pipeline();
+ forerrors_buff[0] = 0; forerrors_pointer = 0;
+ }
+ else
+ { get_next_char = get_next_char_from_string;
+ source_to_analyse_pointer = 0;
+ CurrentLB = &StringLB;
+ sprintf(veneer_error_title, "<veneer routine '%s'>", name);
+ StringLB.filename = veneer_error_title;
+
+ CurrentLB->source_line = 1;
+ CurrentLB->line_start = 0;
+ CurrentLB->chars_read = 0;
+ }
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_lexer_vars(void)
+{
+ blank_brief_location.file_index = -1;
+ blank_brief_location.line_number = 0;
+ blank_brief_location.orig_file_index = 0;
+ blank_brief_location.orig_line_number = 0;
+}
+
+extern void lexer_begin_prepass(void)
+{ total_source_line_count = 0;
+ CurrentLB = &NoFileOpen;
+ report_errors_at_current_line();
+}
+
+extern void lexer_begin_pass(void)
+{ no_hash_printed_yet = TRUE;
+ hash_printed_since_newline = FALSE;
+
+ pipeline_made = FALSE;
+
+ restart_lexer(NULL, NULL);
+}
+
+extern void lexer_endpass(void)
+{ CurrentLB = &MakingOutput;
+ report_errors_at_current_line();
+}
+
+extern void lexer_allocate_arrays(void)
+{ int i;
+
+ FileStack = my_malloc(MAX_INCLUSION_DEPTH*sizeof(Sourcefile),
+ "filestack buffer");
+
+ for (i=0; i<MAX_INCLUSION_DEPTH; i++)
+ FileStack[i].buffer = my_malloc(SOURCE_BUFFER_SIZE+4, "source file buffer");
+
+ lexeme_memory = my_malloc(5*MAX_QTEXT_SIZE, "lexeme memory");
+
+ keywords_hash_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
+ "keyword hash table");
+ keywords_hash_ends_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
+ "keyword hash end table");
+ keywords_data_table = my_calloc(sizeof(int), 3*MAX_KEYWORDS,
+ "keyword hashing linked list");
+ local_variable_hash_table = my_calloc(sizeof(int), HASH_TAB_SIZE,
+ "local variable hash table");
+ local_variable_text_table = my_malloc(
+ (MAX_LOCAL_VARIABLES-1)*(MAX_IDENTIFIER_LENGTH+1),
+ "text of local variable names");
+
+ local_variable_hash_codes = my_calloc(sizeof(int), MAX_LOCAL_VARIABLES,
+ "local variable hash codes");
+ local_variable_texts = my_calloc(sizeof(char *), MAX_LOCAL_VARIABLES,
+ "local variable text pointers");
+
+ make_tokeniser_grid();
+ make_keywords_tables();
+
+ first_token_locations =
+ my_malloc(sizeof(debug_locations), "debug locations of recent tokens");
+ first_token_locations->location.file_index = 0;
+ first_token_locations->location.beginning_byte_index = 0;
+ first_token_locations->location.end_byte_index = 0;
+ first_token_locations->location.beginning_line_number = 0;
+ first_token_locations->location.end_line_number = 0;
+ first_token_locations->location.beginning_character_number = 0;
+ first_token_locations->location.end_character_number = 0;
+ first_token_locations->location.orig_file_index = 0;
+ first_token_locations->location.orig_beg_line_number = 0;
+ first_token_locations->location.orig_beg_char_number = 0;
+ first_token_locations->next = NULL;
+ first_token_locations->reference_count = 0;
+ last_token_location = first_token_locations;
+}
+
+extern void lexer_free_arrays(void)
+{ int i; char *p;
+
+ for (i=0; i<MAX_INCLUSION_DEPTH; i++)
+ { p = FileStack[i].buffer;
+ my_free(&p, "source file buffer");
+ }
+ my_free(&FileStack, "filestack buffer");
+ my_free(&lexeme_memory, "lexeme memory");
+
+ my_free(&keywords_hash_table, "keyword hash table");
+ my_free(&keywords_hash_ends_table, "keyword hash end table");
+ my_free(&keywords_data_table, "keyword hashing linked list");
+ my_free(&local_variable_hash_table, "local variable hash table");
+ my_free(&local_variable_text_table, "text of local variable names");
+
+ my_free(&local_variable_hash_codes, "local variable hash codes");
+ my_free(&local_variable_texts, "local variable text pointers");
+
+ cleanup_token_locations(NULL);
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "linker" : For compiling and linking modules */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+memory_block link_data_area;
+uchar *link_data_holding_area, *link_data_top;
+ /* Start, current top, size of */
+int32 link_data_size; /* link data table being written */
+ /* (holding import/export names) */
+extern int32 *action_symbol;
+
+/* ------------------------------------------------------------------------- */
+/* Marker values */
+/* ------------------------------------------------------------------------- */
+
+extern char *describe_mv(int mval)
+{ switch(mval)
+ { case NULL_MV: return("null");
+
+ /* Marker values used in ordinary story file backpatching */
+
+ case DWORD_MV: return("dictionary word");
+ case STRING_MV: return("string literal");
+ case INCON_MV: return("system constant");
+ case IROUTINE_MV: return("routine");
+ case VROUTINE_MV: return("veneer routine");
+ case ARRAY_MV: return("internal array");
+ case NO_OBJS_MV: return("the number of objects");
+ case INHERIT_MV: return("inherited common p value");
+ case INDIVPT_MV: return("indiv prop table address");
+ case INHERIT_INDIV_MV: return("inherited indiv p value");
+ case MAIN_MV: return("ref to Main");
+ case SYMBOL_MV: return("ref to symbol value");
+
+ /* Additional marker values used in module backpatching */
+
+ case VARIABLE_MV: return("global variable");
+ case IDENT_MV: return("prop identifier number");
+ case ACTION_MV: return("action");
+ case OBJECT_MV: return("internal object");
+
+ /* Record types in the import/export table (not really marker
+ values at all) */
+
+ case EXPORT_MV: return("Export ");
+ case EXPORTSF_MV: return("Export sf");
+ case EXPORTAC_MV: return("Export ##");
+ case IMPORT_MV: return("Import ");
+ }
+ return("** No such MV **");
+}
+
+/* ------------------------------------------------------------------------- */
+/* Import/export records */
+/* ------------------------------------------------------------------------- */
+
+typedef struct importexport_s
+{ int module_value;
+ int32 symbol_number;
+ char symbol_type;
+ int backpatch;
+ int32 symbol_value;
+ char *symbol_name;
+} ImportExport;
+
+static void describe_importexport(ImportExport *I)
+{ printf("%8s %20s %04d %04x %s\n",
+ describe_mv(I->module_value), I->symbol_name,
+ I->symbol_number, I->symbol_value, typename(I->symbol_type));
+}
+
+/* ========================================================================= */
+/* Linking in external modules: this code is run when the external */
+/* program hits a Link directive. */
+/* ------------------------------------------------------------------------- */
+/* This map is between global variable numbers in the module and in the */
+/* external program: variables_map[n] will be the external global variable */
+/* no for module global variable no n. (The entries [0] to [15] are not */
+/* used.) */
+/* ------------------------------------------------------------------------- */
+
+static int variables_map[256], actions_map[256];
+
+int32 module_map[16];
+
+ImportExport IE;
+
+/* ------------------------------------------------------------------------- */
+/* These are offsets within the module: */
+/* ------------------------------------------------------------------------- */
+
+static int32 m_code_offset, m_strs_offset, m_static_offset, m_dict_offset,
+ m_vars_offset, m_objs_offset, m_props_offset, m_class_numbers,
+ m_individuals_offset, m_individuals_length;
+
+static int m_no_objects, m_no_globals, p_no_globals, lowest_imported_global_no;
+
+int32 *xref_table; int xref_top;
+int32 *property_identifier_map;
+int *accession_numbers_map;
+int32 routine_replace[64],
+ routine_replace_with[64]; int no_rr;
+
+/* ------------------------------------------------------------------------- */
+/* Reading and writing bytes/words in the module (as loaded in), indexing */
+/* via "marker addresses". */
+/* ------------------------------------------------------------------------- */
+
+static int32 read_marker_address(uchar *p, int size,
+ int zmachine_area, int32 offset)
+{
+ /* A routine to read the value referred to by the marker address
+ (zmachine_area, offset): size is 1 for byte, 2 for word, and the
+ module itself resides at p. */
+
+ int32 addr = 0;
+
+ switch(zmachine_area)
+ {
+ case DYNAMIC_ARRAY_ZA:
+ addr = m_vars_offset; break;
+ case ZCODE_ZA:
+ addr = m_code_offset; break;
+ case STATIC_STRINGS_ZA:
+ addr = m_strs_offset; break;
+ case DICTIONARY_ZA:
+ addr = m_dict_offset; break;
+ case OBJECT_TREE_ZA:
+ addr = m_objs_offset; break;
+ case PROP_ZA:
+ addr = m_props_offset; break;
+ case INDIVIDUAL_PROP_ZA:
+ addr = m_individuals_offset; break;
+ }
+ if (size == 1) return p[addr+offset];
+ return 256*p[addr+offset] + p[addr+offset+1];
+}
+
+static void write_marker_address(uchar *p, int size,
+ int zmachine_area, int32 offset, int32 value)
+{
+ /* Similar, but to write to it. */
+
+ int32 addr = 0;
+
+ switch(zmachine_area)
+ {
+ case DYNAMIC_ARRAY_ZA:
+ addr = m_vars_offset; break;
+ case ZCODE_ZA:
+ addr = m_code_offset; break;
+ case STATIC_STRINGS_ZA:
+ addr = m_strs_offset; break;
+ case DICTIONARY_ZA:
+ addr = m_dict_offset; break;
+ case OBJECT_TREE_ZA:
+ addr = m_objs_offset; break;
+ case PROP_ZA:
+ addr = m_props_offset; break;
+ case INDIVIDUAL_PROP_ZA:
+ addr = m_individuals_offset; break;
+ }
+ if (size == 1) { p[addr+offset] = value%256; return; }
+ p[addr+offset] = value/256;
+ p[addr+offset+1] = value%256;
+}
+
+int m_read_pos;
+
+static int get_next_record(uchar *p)
+{ int i;
+ int record_type = p[m_read_pos++];
+ switch(record_type)
+ { case 0: break;
+ case EXPORT_MV:
+ case EXPORTSF_MV:
+ case EXPORTAC_MV:
+ case IMPORT_MV:
+ IE.module_value = record_type;
+ i=p[m_read_pos++]; IE.symbol_number = 256*i + p[m_read_pos++];
+ IE.symbol_type = p[m_read_pos++];
+ if (record_type != IMPORT_MV) IE.backpatch = p[m_read_pos++];
+ i=p[m_read_pos++]; IE.symbol_value = 256*i + p[m_read_pos++];
+ IE.symbol_name = (char *) (p+m_read_pos);
+ m_read_pos += strlen((char *) (p+m_read_pos))+1;
+ if (linker_trace_level >= 2) describe_importexport(&IE);
+ break;
+ default:
+ printf("Marker value of %d\n", record_type);
+ compiler_error("Link: illegal import/export marker value");
+ return -1;
+ }
+ return record_type;
+}
+
+static char link_errorm[128];
+
+static void accept_export(void)
+{ int32 index, map_to = IE.symbol_value % 0x10000;
+ index = symbol_index(IE.symbol_name, -1);
+
+ xref_table[IE.symbol_number] = index;
+
+ if (!(sflags[index] & UNKNOWN_SFLAG))
+ { if (IE.module_value == EXPORTAC_MV)
+ { if ((!(sflags[index] & ACTION_SFLAG))
+ && (stypes[index] != FAKE_ACTION_T))
+ link_error_named(
+"action name clash with", IE.symbol_name);
+ }
+ else
+ if (stypes[index] == IE.symbol_type)
+ { switch(IE.symbol_type)
+ { case CONSTANT_T:
+ if ((!(svals[index] == IE.symbol_value))
+ || (IE.backpatch != 0))
+ link_error_named(
+"program and module give differing values of", IE.symbol_name);
+ break;
+ case INDIVIDUAL_PROPERTY_T:
+ property_identifier_map[IE.symbol_value] = svals[index];
+ break;
+ case ROUTINE_T:
+ if ((IE.module_value == EXPORTSF_MV)
+ && (sflags[index] & REPLACE_SFLAG))
+ break;
+ default:
+ sprintf(link_errorm,
+ "%s '%s' in both program and module",
+ typename(IE.symbol_type), IE.symbol_name);
+ link_error(link_errorm);
+ break;
+ }
+ }
+ else
+ { sprintf(link_errorm,
+ "'%s' has type %s in program but type %s in module",
+ IE.symbol_name, typename(stypes[index]),
+ typename(IE.symbol_type));
+ link_error(link_errorm);
+ }
+ }
+ else
+ { if (IE.module_value == EXPORTAC_MV)
+ { IE.symbol_value = no_actions;
+ action_symbol[no_actions++] = index;
+ if (linker_trace_level >= 4)
+ printf("Creating action ##%s\n", (char *) symbs[index]);
+ }
+ else
+ switch(IE.symbol_type)
+ { case ROUTINE_T:
+ if ((IE.module_value == EXPORTSF_MV)
+ && (sflags[index] & REPLACE_SFLAG))
+ { routine_replace[no_rr] = IE.symbol_value;
+ routine_replace_with[no_rr++] = index;
+ return;
+ }
+ IE.symbol_value += (zmachine_pc/scale_factor);
+ break;
+ case OBJECT_T:
+ case CLASS_T:
+ IE.symbol_value += no_objects;
+ break;
+ case ARRAY_T:
+ IE.symbol_value += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
+ break;
+ case GLOBAL_VARIABLE_T:
+ if (no_globals==233)
+ { link_error(
+"failed because too many extra global variables needed");
+ return;
+ }
+ variables_map[16 + m_no_globals++] = 16 + no_globals;
+ set_variable_value(no_globals, IE.symbol_value);
+ IE.symbol_value = 16 + no_globals++;
+ break;
+ case INDIVIDUAL_PROPERTY_T:
+ property_identifier_map[IE.symbol_value]
+ = no_individual_properties;
+ IE.symbol_value = no_individual_properties++;
+
+ if (debugfile_switch)
+ { debug_file_printf("<property>");
+ debug_file_printf
+ ("<identifier>%s</identifier>", IE.symbol_name);
+ debug_file_printf
+ ("<value>%d</value>", IE.symbol_value);
+ debug_file_printf("</property>");
+ }
+
+ break;
+ }
+ assign_symbol(index, IE.backpatch*0x10000 + IE.symbol_value,
+ IE.symbol_type);
+ if (IE.backpatch != 0) sflags[index] |= CHANGE_SFLAG;
+ sflags[index] |= EXPORT_SFLAG;
+ if (IE.module_value == EXPORTSF_MV)
+ sflags[index] |= INSF_SFLAG;
+ if (IE.module_value == EXPORTAC_MV)
+ sflags[index] |= ACTION_SFLAG;
+ }
+
+ if (IE.module_value == EXPORTAC_MV)
+ { if (linker_trace_level >= 4)
+ printf("Map %d '%s' to %d\n",
+ IE.symbol_value, (char *) (symbs[index]), svals[index]);
+ actions_map[map_to] = svals[index];
+ }
+}
+
+static void accept_import(void)
+{ int32 index;
+
+ index = symbol_index(IE.symbol_name, -1);
+ sflags[index] |= USED_SFLAG;
+ xref_table[IE.symbol_number] = index;
+
+ if (!(sflags[index] & UNKNOWN_SFLAG))
+ { switch (IE.symbol_type)
+ {
+ case GLOBAL_VARIABLE_T:
+ if (stypes[index] != GLOBAL_VARIABLE_T)
+ link_error_named(
+"module (wrongly) declared this a variable:", IE.symbol_name);
+ variables_map[IE.symbol_value] = svals[index];
+ if (IE.symbol_value < lowest_imported_global_no)
+ lowest_imported_global_no = IE.symbol_value;
+ break;
+ default:
+ switch(stypes[index])
+ { case ATTRIBUTE_T:
+ link_error_named(
+"this attribute is undeclared within module:", IE.symbol_name);; break;
+ case PROPERTY_T:
+ link_error_named(
+"this property is undeclared within module:", IE.symbol_name); break;
+ case INDIVIDUAL_PROPERTY_T:
+ case ARRAY_T:
+ case ROUTINE_T:
+ case CONSTANT_T:
+ case OBJECT_T:
+ case CLASS_T:
+ case FAKE_ACTION_T:
+ break;
+ default:
+ link_error_named(
+"this was referred to as a constant, but isn't:", IE.symbol_name);
+ break;
+ }
+ break;
+ }
+ }
+ else
+ { switch (IE.symbol_type)
+ {
+ case GLOBAL_VARIABLE_T:
+ if (stypes[index] != GLOBAL_VARIABLE_T)
+ link_error_named(
+ "Module tried to import a Global variable not defined here:",
+ IE.symbol_name);
+ variables_map[IE.symbol_value] = 16;
+ if (IE.symbol_value < lowest_imported_global_no)
+ lowest_imported_global_no = IE.symbol_value;
+ break;
+ }
+ }
+}
+
+static int32 backpatch_backpatch(int32 v)
+{ switch(backpatch_marker)
+ {
+ /* Backpatches made now which are final */
+
+ case OBJECT_MV:
+ v += no_objects;
+ backpatch_marker = NULL_MV;
+ break;
+
+ case ACTION_MV:
+ if ((v<0) || (v>=256) || (actions_map[v] == -1))
+ { link_error("unmapped action number");
+ printf("*** Link: unmapped action number %d ***", v);
+ v = 0;
+ break;
+ }
+ v = actions_map[v];
+ backpatch_marker = NULL_MV;
+ break;
+
+ case IDENT_MV:
+ { int f = v & 0x8000;
+ v = f + property_identifier_map[v-f];
+ backpatch_marker = NULL_MV;
+ break;
+ }
+
+ case VARIABLE_MV:
+ backpatch_marker = NULL_MV;
+ if (v < lowest_imported_global_no)
+ { v = v + p_no_globals; break;
+ }
+ if (variables_map[v] == -1)
+ { printf("** Unmapped variable %d! **\n", v);
+ variables_map[v] = 16;
+ link_error("unmapped variable error"); break;
+ }
+ v = variables_map[v];
+ break;
+
+ /* Backpatch values which are themselves being backpatched */
+
+ case INDIVPT_MV:
+ v += individuals_length;
+ break;
+
+ case SYMBOL_MV:
+ v = xref_table[v];
+ if ((v<0) || (v>=no_symbols))
+ { printf("** Symbol number %d cannot be crossreferenced **\n", v);
+ link_error("symbol crossreference error"); v=0;
+ break;
+ }
+ break;
+
+ case STRING_MV:
+ v += static_strings_extent/scale_factor;
+ break;
+
+ case IROUTINE_MV:
+ { int i;
+ for (i=0;i<no_rr;i++)
+ if (v == routine_replace[i])
+ { v = routine_replace_with[i];
+ backpatch_marker = SYMBOL_MV;
+ goto IR_Done;
+ }
+ v += zmachine_pc/scale_factor;
+ }
+ IR_Done: break;
+
+ case VROUTINE_MV:
+ veneer_routine(v);
+ break;
+
+ case ARRAY_MV:
+ if (v < (MAX_GLOBAL_VARIABLES*2))
+ { v = 2*(variables_map[v/2 + 16] - 16);
+ }
+ else
+ { v += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
+ }
+ break;
+
+ case DWORD_MV:
+ v = accession_numbers_map[v];
+ break;
+
+ case INHERIT_MV:
+ v += properties_table_size;
+ break;
+
+ case INHERIT_INDIV_MV:
+ v += individuals_length;
+ break;
+ }
+ return v;
+}
+
+static void backpatch_module_image(uchar *p,
+ int marker_value, int zmachine_area, int32 offset)
+{ int size = (marker_value>=0x80)?1:2; int32 v;
+ marker_value &= 0x7f;
+
+ backpatch_marker = marker_value;
+
+ if (zmachine_area == PROP_DEFAULTS_ZA) return;
+
+ if (linker_trace_level >= 3)
+ printf("Backpatch %s area %d offset %04x size %d: ",
+ describe_mv(marker_value), zmachine_area, offset, size);
+
+ v = read_marker_address(p, size, zmachine_area, offset);
+ if (linker_trace_level >= 3) printf("%04x ", v);
+
+ v = backpatch_backpatch(v);
+
+ write_marker_address(p, size, zmachine_area, offset, v);
+ if (linker_trace_level >= 3) printf("%04x\n", v);
+}
+
+/* ------------------------------------------------------------------------- */
+/* The main routine: linking in a module with the given filename. */
+/* ------------------------------------------------------------------------- */
+
+char current_module_filename[128];
+
+void link_module(char *given_filename)
+{ FILE *fin;
+ int record_type;
+ char filename[128];
+ uchar *p, p0[64];
+ int32 last, i, j, k, l, m, vn, len, size, link_offset, module_size, map,
+ max_property_identifier, symbols_base = no_symbols;
+
+ strcpy(current_module_filename, given_filename);
+
+ /* (1) Load in the module to link */
+
+ i = 0;
+ do
+ { i = translate_link_filename(i, filename, given_filename);
+ fin=fopen(filename,"rb");
+ } while ((fin == NULL) && (i != 0));
+
+ if (fin==NULL)
+ { error_named("Couldn't open module file", filename); return;
+ }
+
+ for (i=0;i<64;i++) p0[i]=fgetc(fin);
+
+ vn = p0[0];
+ if ((vn<65) || (vn>75))
+ { error_named("File isn't a module:", filename);
+ fclose(fin); return;
+ }
+
+ if (vn != 64 + version_number)
+ { char ebuff[100];
+ sprintf(ebuff,
+ "module compiled as Version %d (so it can't link\
+ into this V%d game):", vn-64, version_number);
+ error_named(ebuff, filename);
+ fclose(fin); return;
+ }
+
+ module_size = (256*p0[26] + p0[27])*scale_factor;
+ p = my_malloc(module_size + 16, "link module storage");
+ /* The + 16 allows for rounding errors */
+
+ for (k=0;k<64;k++) p[k] = p0[k];
+ for (k=64;k<module_size;k++) p[k] = fgetc(fin);
+ fclose(fin);
+
+ if ((p0[52] != 0) || (p0[53] != 0))
+ { /* Then the module contains a character set table */
+ if (alphabet_modified)
+ { k = FALSE; m = 256*p0[52] + p0[53];
+ for (i=0;i<3;i++) for (j=0;j<26;j++)
+ { l = alphabet[i][j]; if (l == '~') l = '\"';
+ if (l != p[m]) k = TRUE;
+ }
+ if (k)
+ link_error("module and game both define non-standard character sets, \
+but they disagree");
+ k = FALSE;
+ }
+ else k = TRUE;
+ }
+ else
+ { if (alphabet_modified) k = TRUE;
+ else k = FALSE;
+ }
+ if (k)
+ link_error("module and game use different character sets");
+
+ i = p[1];
+ if (i > MODULE_VERSION_NUMBER)
+ warning_named("module has a more advanced format than this release \
+of the Inform 6 compiler knows about: it may not link in correctly", filename);
+
+ /* (2) Calculate offsets: see the header-writing code in "tables.c" */
+
+ map = (256*p[6] + p[7]);
+ for (i=0; i<16; i++) module_map[i] = 256*p[map + i*2] + p[map + i*2 + 1];
+
+ m_vars_offset = (256*p[12] + p[13]);
+ m_static_offset = (256*p[14] + p[15]);
+ m_dict_offset = (256*p[8] + p[9]);
+ m_code_offset = (256*p[4] + p[5]);
+
+ /* (3) Read the "module map" table */
+
+ if (linker_trace_level>=4)
+ { printf("[Reading module map:\n");
+ for (i=0; i<16; i++) printf("%04x ", module_map[i]);
+ printf("]\n");
+ }
+
+ m_objs_offset = module_map[0];
+ m_props_offset = module_map[1];
+ m_strs_offset = scale_factor*module_map[2];
+ m_class_numbers = module_map[3];
+ m_individuals_offset = module_map[4];
+ m_individuals_length = module_map[5];
+
+ for (i=16;i<256;i++) variables_map[i] = -1;
+ for (i=0;i<16;i++) variables_map[i] = i;
+ for (i=LOWEST_SYSTEM_VAR_NUMBER;i<256;i++) variables_map[i] = i;
+
+ for (i=0;i<256;i++) actions_map[i] = -1;
+
+ xref_table = my_calloc(sizeof(int32), module_map[6],
+ "linker cross-references table");
+ for (i=0;i<module_map[6];i++) xref_table[i] = -1;
+
+ max_property_identifier = module_map[7];
+ property_identifier_map = my_calloc(sizeof(int32), max_property_identifier,
+ "property identifier map");
+ for (i=0; i<max_property_identifier; i++)
+ property_identifier_map[i] = i;
+
+ m_no_objects = module_map[8];
+ link_offset = module_map[9];
+
+ m_no_globals = 0; p_no_globals = no_globals;
+ lowest_imported_global_no=236;
+
+ no_rr = 0;
+
+ if ((linker_trace_level>=1) || transcript_switch)
+ { char link_banner[128];
+ sprintf(link_banner,
+ "[Linking release %d.%c%c%c%c%c%c of module '%s' (size %dK)]",
+ p[2]*256 + p[3], p[18], p[19], p[20], p[21], p[22], p[23],
+ filename, module_size/1024);
+ if (linker_trace_level >= 1) printf("%s\n", link_banner);
+ if (transcript_switch)
+ write_to_transcript_file(link_banner);
+ }
+
+ /* (4) Merge in the dictionary */
+
+ if (linker_trace_level >= 2)
+ printf("Merging module's dictionary at %04x\n", m_dict_offset);
+ k=m_dict_offset; k+=p[k]+1;
+ len=p[k++];
+ size = p[k]*256 + p[k+1]; k+=2;
+
+ accession_numbers_map = my_calloc(sizeof(int), size,
+ "dictionary accession numbers map");
+
+ for (i=0;i<size;i++, k+=len)
+ { char word[10];
+ word_to_ascii(p+k,word);
+ if (linker_trace_level >= 3)
+ printf("%03d %04x '%s' %02x %02x %02x\n",i,k,
+ word, p[k+len-3], p[k+len-2], p[k+len-1]);
+
+ accession_numbers_map[i]
+ = dictionary_add(word, p[k+len-3], p[k+len-2], p[k+len-1]);
+ }
+
+ /* (5) Run through import/export table */
+
+ m_read_pos = module_map[9];
+ if (linker_trace_level>=2)
+ printf("Import/export table is at byte offset %04x\n", m_read_pos);
+
+ do
+ { record_type = get_next_record(p);
+ if (((record_type == EXPORT_MV) || (record_type == EXPORTSF_MV))
+ && (IE.symbol_type == INDIVIDUAL_PROPERTY_T))
+ { int32 si = symbol_index(IE.symbol_name, -1);
+ property_identifier_map[IE.symbol_value] = svals[si];
+ }
+ switch(record_type)
+ { case EXPORT_MV:
+ case EXPORTSF_MV:
+ case EXPORTAC_MV:
+ accept_export(); break;
+ case IMPORT_MV:
+ accept_import(); break;
+ }
+ } while (record_type != 0);
+
+ if ((linker_trace_level >= 4) && (no_rr != 0))
+ { printf("Replaced routine addresses:\n");
+ for (i=0; i<no_rr; i++)
+ { printf("Replace code offset %04x with %04x\n",
+ routine_replace[i], routine_replace_with[i]);
+ }
+ }
+
+ if (linker_trace_level >= 4)
+ { printf("Symbol cross-references table:\n");
+ for (i=0; i<module_map[6]; i++)
+ { if (xref_table[i] != -1)
+ printf("module %4d -> story file '%s'\n", i,
+ (char *) symbs[xref_table[i]]);
+ }
+ }
+
+ if (linker_trace_level >= 4)
+ { printf("Action numbers map:\n");
+ for (i=0; i<256; i++)
+ if (actions_map[i] != -1)
+ printf("%3d -> %3d\n", i, actions_map[i]);
+ }
+
+ if ((linker_trace_level >= 4) && (max_property_identifier > 72))
+ { printf("Property identifier number map:\n");
+ for (i=72; i<max_property_identifier; i++)
+ { printf("module %04x -> program %04x\n",
+ i, property_identifier_map[i]);
+ }
+ }
+
+ /* (6) Backpatch the backpatch markers attached to exported symbols */
+
+ for (i=symbols_base; i<no_symbols; i++)
+ { if ((sflags[i] & CHANGE_SFLAG) && (sflags[i] & EXPORT_SFLAG))
+ { backpatch_marker = svals[i]/0x10000;
+ j = svals[i] % 0x10000;
+
+ j = backpatch_backpatch(j);
+
+ svals[i] = backpatch_marker*0x10000 + j;
+ if (backpatch_marker == 0) sflags[i] &= (~(CHANGE_SFLAG));
+ }
+ }
+
+ /* (7) Run through the Z-code backpatch table */
+
+ for (i=module_map[11]; i<module_map[11]+module_map[12]; i += 3)
+ { int marker_value = p[i];
+ int32 offset = 256*p[i+1] + p[i+2];
+
+ switch(marker_value & 0x7f)
+ { case OBJECT_MV:
+ case ACTION_MV:
+ case IDENT_MV:
+ case VARIABLE_MV:
+ backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
+ break;
+ default:
+ backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, backpatch_marker);
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, (offset + zmachine_pc)/256);
+ write_byte_to_memory_block(&zcode_backpatch_table,
+ zcode_backpatch_size++, (offset + zmachine_pc)%256);
+ break;
+ }
+ }
+
+ /* (8) Run through the Z-machine backpatch table */
+
+ for (i=module_map[13]; i<module_map[13]+module_map[14]; i += 4)
+ { int marker_value = p[i], zmachine_area = p[i+1];
+ int32 offset = 256*p[i+2] + p[i+3];
+
+ switch(marker_value)
+ { case OBJECT_MV:
+ case ACTION_MV:
+ case IDENT_MV:
+ backpatch_module_image(p, marker_value, zmachine_area, offset);
+ break;
+ default:
+ backpatch_module_image(p, marker_value, zmachine_area, offset);
+ switch(zmachine_area)
+ { case PROP_DEFAULTS_ZA:
+ break;
+ case PROP_ZA:
+ offset += properties_table_size; break;
+ case INDIVIDUAL_PROP_ZA:
+ offset += individuals_length; break;
+ case DYNAMIC_ARRAY_ZA:
+ if (offset < (MAX_GLOBAL_VARIABLES*2))
+ { offset = 2*(variables_map[offset/2 + 16] - 16);
+ }
+ else
+ { offset += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
+ }
+ break;
+ }
+ backpatch_zmachine(backpatch_marker, zmachine_area, offset);
+ break;
+ }
+ }
+
+ /* (9) Adjust initial values of variables */
+
+ if (linker_trace_level >= 3)
+ printf("\nFinal variables map, Module -> Main:\n");
+
+ for (i=16;i<255;i++)
+ if (variables_map[i]!=-1)
+ { if (linker_trace_level>=2)
+ printf("%d->%d ",i,variables_map[i]);
+ if (i<lowest_imported_global_no)
+ { int32 j = read_marker_address(p, 2,
+ DYNAMIC_ARRAY_ZA, 2*(i-16));
+ set_variable_value(variables_map[i]-16, j);
+ if (linker_trace_level>=2)
+ printf("(set var %d to %d) ",
+ variables_map[i], j);
+ }
+ }
+ if (linker_trace_level>=2) printf("\n");
+
+ /* (10) Glue in the dynamic array data */
+
+ i = m_static_offset - m_vars_offset - MAX_GLOBAL_VARIABLES*2;
+ if (dynamic_array_area_size + i >= MAX_STATIC_DATA)
+ memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
+
+ if (linker_trace_level >= 2)
+ printf("Inserting dynamic array area, %04x to %04x, at %04x\n",
+ m_vars_offset + MAX_GLOBAL_VARIABLES*2, m_static_offset,
+ variables_offset + dynamic_array_area_size);
+ for (k=0;k<i;k++)
+ { dynamic_array_area[dynamic_array_area_size+k]
+ = p[m_vars_offset+MAX_GLOBAL_VARIABLES*2+k];
+ }
+ dynamic_array_area_size+=i;
+
+ /* (11) Glue in the code area */
+
+ if (linker_trace_level >= 2)
+ printf("Inserting code area, %04x to %04x, at code offset %04x (+%04x)\n",
+ m_code_offset, m_strs_offset, code_offset, zmachine_pc);
+
+ for (k=m_code_offset;k<m_strs_offset;k++)
+ { if (temporary_files_switch)
+ { fputc(p[k],Temp2_fp);
+ zmachine_pc++;
+ }
+ else
+ write_byte_to_memory_block(&zcode_area, zmachine_pc++, p[k]);
+ }
+
+ /* (12) Glue in the static strings area */
+
+ if (linker_trace_level >= 2)
+ printf("Inserting strings area, %04x to %04x, \
+at strings offset %04x (+%04x)\n",
+ m_strs_offset, link_offset, strings_offset,
+ static_strings_extent);
+ for (k=m_strs_offset;k<link_offset;k++)
+ { if (temporary_files_switch)
+ { fputc(p[k], Temp1_fp);
+ static_strings_extent++;
+ }
+ else
+ write_byte_to_memory_block(&static_strings_area,
+ static_strings_extent++, p[k]);
+ }
+
+ /* (13) Append the class object-numbers table: note that modules
+ provide extra information in this table */
+
+ i = m_class_numbers;
+ do
+ { j = p[i]*256 + p[i+1]; i+=2;
+ if (j == 0) break;
+
+ class_object_numbers[no_classes] = j + no_objects;
+ j = p[i]*256 + p[i+1]; i+=2;
+ class_begins_at[no_classes++] = j + properties_table_size;
+
+ } while (TRUE);
+
+ /* (14) Glue on the object tree */
+
+ if ((linker_trace_level>=2) && (m_no_objects>0))
+ printf("Joining on object tree of size %d\n", m_no_objects);
+
+ for (i=0, k=no_objects, last=m_props_offset;i<m_no_objects;i++)
+ { objectsz[no_objects].atts[0]=p[m_objs_offset+14*i];
+ objectsz[no_objects].atts[1]=p[m_objs_offset+14*i+1];
+ objectsz[no_objects].atts[2]=p[m_objs_offset+14*i+2];
+ objectsz[no_objects].atts[3]=p[m_objs_offset+14*i+3];
+ objectsz[no_objects].atts[4]=p[m_objs_offset+14*i+4];
+ objectsz[no_objects].atts[5]=p[m_objs_offset+14*i+5];
+ objectsz[no_objects].parent =
+ (p[m_objs_offset+14*i+6])*256+p[m_objs_offset+14*i+7];
+ objectsz[no_objects].next =
+ (p[m_objs_offset+14*i+8])*256+p[m_objs_offset+14*i+9];
+ objectsz[no_objects].child =
+ (p[m_objs_offset+14*i+10])*256+p[m_objs_offset+14*i+11];
+ if (linker_trace_level>=4)
+ printf("Module objects[%d] has %d,%d,%d\n",
+ i,objectsz[no_objects].parent,
+ objectsz[no_objects].next,objectsz[no_objects].child);
+ if (objectsz[no_objects].parent == 0x7fff)
+ { objectsz[no_objects].parent = 1;
+ if (objectsz[1].child == 0)
+ { objectsz[1].child = no_objects+1;
+ }
+ else
+ { int j1 = 0, j2 = objectsz[1].child;
+ while (j2 != 0)
+ { j1 = j2;
+ j2 = objectsz[j2].next;
+ }
+ objectsz[j1].next = no_objects+1;
+ }
+ objectsz[no_objects].next = 0;
+ }
+ else
+ if (objectsz[no_objects].parent>0) objectsz[no_objects].parent += k;
+ if (objectsz[no_objects].next>0) objectsz[no_objects].next += k;
+ if (objectsz[no_objects].child>0) objectsz[no_objects].child += k;
+ objectsz[no_objects].propsize =
+ (p[m_objs_offset+14*i+12])*256+p[m_objs_offset+14*i+13];
+ last += objectsz[no_objects].propsize;
+ if (linker_trace_level>=4)
+ printf("Objects[%d] has %d,%d,%d\n",
+ no_objects,objectsz[no_objects].parent,
+ objectsz[no_objects].next,objectsz[no_objects].child);
+ no_objects++;
+ }
+
+ /* (15) Glue on the properties */
+
+ if (last>m_props_offset)
+ { i = m_static_offset - m_vars_offset - MAX_GLOBAL_VARIABLES*2;
+ if (dynamic_array_area_size + i >= MAX_STATIC_DATA)
+ memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
+
+ if (linker_trace_level >= 2)
+ printf("Inserting object properties area, %04x to %04x, at +%04x\n",
+ m_props_offset, last, properties_table_size);
+ for (k=0;k<last-m_props_offset;k++)
+ properties_table[properties_table_size++] = p[m_props_offset+k];
+ }
+
+ /* (16) Bitwise OR Flags 2 (Z-machine requirements flags) */
+
+ j = p[16]*256 + p[17];
+ for (i=0, k=1;i<16;i++, k=k*2) flags2_requirements[i] |= ((j/k)%2);
+
+ /* (17) Append the individual property values table */
+
+ i = m_individuals_length;
+ if (individuals_length + i >= MAX_INDIV_PROP_TABLE_SIZE)
+ memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
+ MAX_INDIV_PROP_TABLE_SIZE);
+
+ if (linker_trace_level >= 2)
+ printf("Inserting individual prop tables area, %04x to %04x, at +%04x\n",
+ m_individuals_offset, m_individuals_offset + i,
+ individuals_length);
+ for (k=0;k<i;k++)
+ { individuals_table[individuals_length + k]
+ = p[m_individuals_offset + k];
+ }
+ individuals_length += i;
+
+ /* (18) All done */
+
+ if (linker_trace_level >= 2)
+ printf("Link complete\n");
+
+ my_free(&p, "link module storage");
+ my_free(&xref_table, "linker cross-references table");
+ my_free(&property_identifier_map, "property identifier map");
+ my_free(&accession_numbers_map, "accession numbers map");
+}
+
+/* ========================================================================= */
+/* Writing imports, exports and markers to the link data table during */
+/* module compilation */
+/* ------------------------------------------------------------------------- */
+/* Writing to the link data table */
+/* ------------------------------------------------------------------------- */
+
+static void write_link_byte(int x)
+{ *link_data_top=(unsigned char) x; link_data_top++; link_data_size++;
+ if (subtract_pointers(link_data_top,link_data_holding_area)
+ >= MAX_LINK_DATA_SIZE)
+ { memoryerror("MAX_LINK_DATA_SIZE",MAX_LINK_DATA_SIZE);
+ }
+}
+
+extern void flush_link_data(void)
+{ int32 i, j;
+ j = subtract_pointers(link_data_top, link_data_holding_area);
+ if (temporary_files_switch)
+ for (i=0;i<j;i++) fputc(link_data_holding_area[i], Temp3_fp);
+ else
+ for (i=0;i<j;i++)
+ write_byte_to_memory_block(&link_data_area, link_data_size-j+i,
+ link_data_holding_area[i]);
+ link_data_top=link_data_holding_area;
+}
+
+static void write_link_word(int32 x)
+{ write_link_byte(x/256); write_link_byte(x%256);
+}
+
+static void write_link_string(char *s)
+{ int i;
+ for (i=0; s[i]!=0; i++) write_link_byte(s[i]);
+ write_link_byte(0);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Exports and imports */
+/* ------------------------------------------------------------------------- */
+
+static void export_symbols(void)
+{ int symbol_number;
+
+ for (symbol_number = 0; symbol_number < no_symbols; symbol_number++)
+ { int export_flag = FALSE, import_flag = FALSE;
+
+ if (stypes[symbol_number]==GLOBAL_VARIABLE_T)
+ { if (svals[symbol_number] < LOWEST_SYSTEM_VAR_NUMBER)
+ { if (sflags[symbol_number] & IMPORT_SFLAG)
+ import_flag = TRUE;
+ else
+ if (!(sflags[symbol_number] & SYSTEM_SFLAG))
+ export_flag = TRUE;
+ }
+ }
+ else
+ { if (!(sflags[symbol_number] & SYSTEM_SFLAG))
+ { if (sflags[symbol_number] & UNKNOWN_SFLAG)
+ { if (sflags[symbol_number] & IMPORT_SFLAG)
+ import_flag = TRUE;
+ }
+ else
+ switch(stypes[symbol_number])
+ { case LABEL_T:
+ case ATTRIBUTE_T:
+ case PROPERTY_T:
+ /* Ephemera */
+ break;
+
+ default: export_flag = TRUE;
+ }
+ }
+ }
+
+ if (export_flag)
+ { if (linker_trace_level >= 1)
+ { IE.module_value = EXPORT_MV;
+ IE.symbol_number = symbol_number;
+ IE.symbol_type = stypes[symbol_number];
+ IE.symbol_value = svals[symbol_number];
+ IE.symbol_name = (char *) (symbs[symbol_number]);
+ describe_importexport(&IE);
+ }
+
+ if (sflags[symbol_number] & ACTION_SFLAG)
+ write_link_byte(EXPORTAC_MV);
+ else
+ if (sflags[symbol_number] & INSF_SFLAG)
+ write_link_byte(EXPORTSF_MV);
+ else
+ write_link_byte(EXPORT_MV);
+
+ write_link_word(symbol_number);
+ write_link_byte(stypes[symbol_number]);
+ if (sflags[symbol_number] & CHANGE_SFLAG)
+ write_link_byte(svals[symbol_number] / 0x10000);
+ else write_link_byte(0);
+ write_link_word(svals[symbol_number] % 0x10000);
+ write_link_string((char *) (symbs[symbol_number]));
+ flush_link_data();
+ }
+
+ if (import_flag)
+ { if (linker_trace_level >= 1)
+ { IE.module_value = IMPORT_MV;
+ IE.symbol_number = symbol_number;
+ IE.symbol_type = stypes[symbol_number];
+ IE.symbol_value = svals[symbol_number];
+ IE.symbol_name = (char *) (symbs[symbol_number]);
+ describe_importexport(&IE);
+ }
+
+ write_link_byte(IMPORT_MV);
+ write_link_word(symbol_number);
+ write_link_byte(stypes[symbol_number]);
+ write_link_word(svals[symbol_number]);
+ write_link_string((char *) (symbs[symbol_number]));
+ flush_link_data();
+ }
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Marking for later importation */
+/* ------------------------------------------------------------------------- */
+
+int mv_vref=LOWEST_SYSTEM_VAR_NUMBER-1;
+
+void import_symbol(int32 symbol_number)
+{ sflags[symbol_number] |= IMPORT_SFLAG;
+ switch(stypes[symbol_number])
+ { case GLOBAL_VARIABLE_T:
+ assign_symbol(symbol_number, mv_vref--, stypes[symbol_number]);
+ break;
+ }
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_linker_vars(void)
+{ link_data_size = 0;
+ initialise_memory_block(&link_data_area);
+}
+
+extern void linker_begin_pass(void)
+{ link_data_top = link_data_holding_area;
+}
+
+extern void linker_endpass(void)
+{ export_symbols();
+ write_link_byte(0);
+ flush_link_data();
+}
+
+extern void linker_allocate_arrays(void)
+{ if (!module_switch)
+ link_data_holding_area
+ = my_malloc(64, "link data holding area");
+ else
+ link_data_holding_area
+ = my_malloc(MAX_LINK_DATA_SIZE, "link data holding area");
+}
+
+extern void linker_free_arrays(void)
+{ my_free(&link_data_holding_area, "link data holding area");
+ deallocate_memory_block(&link_data_area);
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "memory" : Memory management and ICL memory setting commands */
+/* (For "memoryerror", see "errors.c") */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+int32 malloced_bytes=0; /* Total amount of memory allocated */
+
+#ifdef PC_QUICKC
+
+extern void *my_malloc(int32 size, char *whatfor)
+{ char _huge *c;
+ if (memout_switch)
+ printf("Allocating %ld bytes for %s\n",size,whatfor);
+ if (size==0) return(NULL);
+ c=(char _huge *)halloc(size,1); malloced_bytes+=size;
+ if (c==0) memory_out_error(size, 1, whatfor);
+ return(c);
+}
+
+extern void my_realloc(void *pointer, int32 oldsize, int32 size,
+ char *whatfor)
+{ char _huge *c;
+ if (size==0) {
+ my_free(pointer, whatfor);
+ return;
+ }
+ c=halloc(size,1); malloced_bytes+=size;
+ if (c==0) memory_out_error(size, 1, whatfor);
+ if (memout_switch)
+ printf("Increasing allocation to %ld bytes for %s was (%08lx) \
+now (%08lx)\n",
+ (long int) size,whatfor,(long int) (*(int **)pointer),
+ (long int) c);
+ memcpy(c, *(int **)pointer, MIN(oldsize, size));
+ hfree(*(int **)pointer);
+ *(int **)pointer = c;
+}
+
+extern void *my_calloc(int32 size, int32 howmany, char *whatfor)
+{ void _huge *c;
+ if (memout_switch)
+ printf("Allocating %d bytes: array (%ld entries size %ld) for %s\n",
+ size*howmany,howmany,size,whatfor);
+ if ((size*howmany) == 0) return(NULL);
+ c=(void _huge *)halloc(howmany*size,1); malloced_bytes+=size*howmany;
+ if (c==0) memory_out_error(size, howmany, whatfor);
+ return(c);
+}
+
+extern void my_recalloc(void *pointer, int32 size, int32 oldhowmany,
+ int32 howmany, char *whatfor)
+{ void _huge *c;
+ if (size*howmany==0) {
+ my_free(pointer, whatfor);
+ return;
+ }
+ c=(void _huge *)halloc(size*howmany,1); malloced_bytes+=size*howmany;
+ if (c==0) memory_out_error(size, howmany, whatfor);
+ if (memout_switch)
+ printf("Increasing allocation to %ld bytes: array (%ld entries size %ld) \
+for %s was (%08lx) now (%08lx)\n",
+ ((long int)size) * ((long int)howmany),
+ (long int)howmany,(long int)size,whatfor,
+ (long int) *(int **)pointer, (long int) c);
+ memcpy(c, *(int **)pointer, MIN(size*oldhowmany, size*howmany));
+ hfree(*(int **)pointer);
+ *(int **)pointer = c;
+}
+
+#else
+
+extern void *my_malloc(int32 size, char *whatfor)
+{ char *c;
+ if (size==0) return(NULL);
+ c=malloc((size_t) size); malloced_bytes+=size;
+ if (c==0) memory_out_error(size, 1, whatfor);
+ if (memout_switch)
+ printf("Allocating %ld bytes for %s at (%08lx)\n",
+ (long int) size,whatfor,(long int) c);
+ return(c);
+}
+
+extern void my_realloc(void *pointer, int32 oldsize, int32 size,
+ char *whatfor)
+{ void *c;
+ if (size==0) {
+ my_free(pointer, whatfor);
+ return;
+ }
+ c=realloc(*(int **)pointer, (size_t) size); malloced_bytes+=size;
+ if (c==0) memory_out_error(size, 1, whatfor);
+ if (memout_switch)
+ printf("Increasing allocation to %ld bytes for %s was (%08lx) \
+now (%08lx)\n",
+ (long int) size,whatfor,(long int) (*(int **)pointer),
+ (long int) c);
+ *(int **)pointer = c;
+}
+
+extern void *my_calloc(int32 size, int32 howmany, char *whatfor)
+{ void *c;
+ if (size*howmany==0) return(NULL);
+ c=calloc(howmany,(size_t) size); malloced_bytes+=size*howmany;
+ if (c==0) memory_out_error(size, howmany, whatfor);
+ if (memout_switch)
+ printf("Allocating %ld bytes: array (%ld entries size %ld) \
+for %s at (%08lx)\n",
+ ((long int)size) * ((long int)howmany),
+ (long int)howmany,(long int)size,whatfor,
+ (long int) c);
+ return(c);
+}
+
+extern void my_recalloc(void *pointer, int32 size, int32 oldhowmany,
+ int32 howmany, char *whatfor)
+{ void *c;
+ if (size*howmany==0) {
+ my_free(pointer, whatfor);
+ return;
+ }
+ c=realloc(*(int **)pointer, (size_t)size*(size_t)howmany);
+ malloced_bytes+=size*howmany;
+ if (c==0) memory_out_error(size, howmany, whatfor);
+ if (memout_switch)
+ printf("Increasing allocation to %ld bytes: array (%ld entries size %ld) \
+for %s was (%08lx) now (%08lx)\n",
+ ((long int)size) * ((long int)howmany),
+ (long int)howmany,(long int)size,whatfor,
+ (long int) *(int **)pointer, (long int) c);
+ *(int **)pointer = c;
+}
+
+#endif
+
+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));
+#ifdef PC_QUICKC
+ hfree(*(int **)pointer);
+#else
+ free(*(int **)pointer);
+#endif
+ *(int **)pointer = NULL;
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Extensible blocks of memory, providing a kind of RAM disc as an */
+/* alternative to the temporary files option */
+/* ------------------------------------------------------------------------- */
+
+static char chunk_name_buffer[60];
+static char *chunk_name(memory_block *MB, int no)
+{ char *p = "(unknown)";
+ if (MB == &static_strings_area) p = "static strings area";
+ if (MB == &zcode_area) p = "Z-code area";
+ if (MB == &link_data_area) p = "link data area";
+ if (MB == &zcode_backpatch_table) p = "Z-code backpatch table";
+ if (MB == &zmachine_backpatch_table) p = "Z-machine backpatch table";
+ sprintf(chunk_name_buffer, "%s chunk %d", p, no);
+ return(chunk_name_buffer);
+}
+
+extern void initialise_memory_block(memory_block *MB)
+{ int i;
+ MB->chunks = 0;
+ for (i=0; i<72; i++) MB->chunk[i] = NULL;
+ MB->extent_of_last = 0;
+ MB->write_pos = 0;
+}
+
+extern void deallocate_memory_block(memory_block *MB)
+{ int i;
+ for (i=0; i<72; i++)
+ if (MB->chunk[i] != NULL)
+ my_free(&(MB->chunk[i]), chunk_name(MB, i));
+ MB->chunks = 0;
+ MB->extent_of_last = 0;
+}
+
+extern int read_byte_from_memory_block(memory_block *MB, int32 index)
+{ uchar *p;
+ p = MB->chunk[index/ALLOC_CHUNK_SIZE];
+ if (p == NULL)
+ { compiler_error_named("memory: read from unwritten byte in",
+ chunk_name(MB, index/ALLOC_CHUNK_SIZE));
+ return 0;
+ }
+ return p[index % ALLOC_CHUNK_SIZE];
+}
+
+extern void write_byte_to_memory_block(memory_block *MB, int32 index, int value)
+{ uchar *p; int ch = index/ALLOC_CHUNK_SIZE;
+ if (ch < 0)
+ { compiler_error_named("memory: negative index to", chunk_name(MB, 0));
+ return;
+ }
+ if (ch >= 72) memoryerror("ALLOC_CHUNK_SIZE", ALLOC_CHUNK_SIZE);
+
+ if (MB->chunk[ch] == NULL)
+ { int i;
+ MB->chunk[ch] = my_malloc(ALLOC_CHUNK_SIZE, chunk_name(MB, ch));
+ p = MB->chunk[ch];
+ for (i=0; i<ALLOC_CHUNK_SIZE; i++) p[i] = 255;
+ }
+
+ p = MB->chunk[ch];
+ p[index % ALLOC_CHUNK_SIZE] = value;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Where the memory settings are declared as variables */
+/* ------------------------------------------------------------------------- */
+
+int MAX_QTEXT_SIZE;
+int MAX_SYMBOLS;
+int SYMBOLS_CHUNK_SIZE;
+int HASH_TAB_SIZE;
+int MAX_OBJECTS;
+int MAX_ARRAYS;
+int MAX_ACTIONS;
+int MAX_ADJECTIVES;
+int MAX_DICT_ENTRIES;
+int MAX_STATIC_DATA;
+int MAX_PROP_TABLE_SIZE;
+int MAX_ABBREVS;
+int MAX_EXPRESSION_NODES;
+int MAX_VERBS;
+int MAX_VERBSPACE;
+int MAX_LABELS;
+int MAX_LINESPACE;
+int32 MAX_STATIC_STRINGS;
+int32 MAX_ZCODE_SIZE;
+int MAX_LOW_STRINGS;
+int32 MAX_TRANSCRIPT_SIZE;
+int MAX_CLASSES;
+int32 MAX_LINK_DATA_SIZE;
+int MAX_INCLUSION_DEPTH;
+int MAX_SOURCE_FILES;
+int32 MAX_INDIV_PROP_TABLE_SIZE;
+int32 MAX_OBJ_PROP_TABLE_SIZE;
+int MAX_OBJ_PROP_COUNT;
+int MAX_LOCAL_VARIABLES;
+int MAX_GLOBAL_VARIABLES;
+int DICT_WORD_SIZE; /* number of characters in a dict word */
+int DICT_CHAR_SIZE; /* (glulx) 1 for one-byte chars, 4 for Unicode chars */
+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 NUM_ATTR_BYTES;
+int GLULX_OBJECT_EXT_BYTES; /* (glulx) extra bytes for each object record */
+int32 MAX_NUM_STATIC_STRINGS;
+int32 MAX_UNICODE_CHARS;
+int32 MAX_STACK_SIZE;
+int32 MEMORY_MAP_EXTENSION;
+int ALLOC_CHUNK_SIZE;
+int WARN_UNUSED_ROUTINES; /* 0: no, 1: yes except in system files, 2: yes always */
+int OMIT_UNUSED_ROUTINES; /* 0: no, 1: yes */
+
+/* The way memory sizes are set causes great nuisance for those parameters
+ which have different defaults under Z-code and Glulx. We have to get
+ the defaults right whether the user sets "-G $HUGE" or "$HUGE -G".
+ And an explicit value set by the user should override both defaults. */
+static int32 MAX_ZCODE_SIZE_z, MAX_ZCODE_SIZE_g;
+static int MAX_PROP_TABLE_SIZE_z, MAX_PROP_TABLE_SIZE_g;
+static int MAX_GLOBAL_VARIABLES_z, MAX_GLOBAL_VARIABLES_g;
+static int MAX_LOCAL_VARIABLES_z, MAX_LOCAL_VARIABLES_g;
+static int DICT_WORD_SIZE_z, DICT_WORD_SIZE_g;
+static int NUM_ATTR_BYTES_z, NUM_ATTR_BYTES_g;
+static int ALLOC_CHUNK_SIZE_z, ALLOC_CHUNK_SIZE_g;
+
+/* ------------------------------------------------------------------------- */
+/* Memory control from the command line */
+/* ------------------------------------------------------------------------- */
+
+static void list_memory_sizes(void)
+{ printf("+--------------------------------------+\n");
+ printf("| %25s = %-7s |\n","Memory setting","Value");
+ printf("+--------------------------------------+\n");
+ printf("| %25s = %-7d |\n","MAX_ABBREVS",MAX_ABBREVS);
+ printf("| %25s = %-7d |\n","MAX_ACTIONS",MAX_ACTIONS);
+ printf("| %25s = %-7d |\n","MAX_ADJECTIVES",MAX_ADJECTIVES);
+ printf("| %25s = %-7d |\n","ALLOC_CHUNK_SIZE",ALLOC_CHUNK_SIZE);
+ printf("| %25s = %-7d |\n","MAX_ARRAYS",MAX_ARRAYS);
+ printf("| %25s = %-7d |\n","NUM_ATTR_BYTES",NUM_ATTR_BYTES);
+ printf("| %25s = %-7d |\n","MAX_CLASSES",MAX_CLASSES);
+ printf("| %25s = %-7d |\n","MAX_DICT_ENTRIES",MAX_DICT_ENTRIES);
+ printf("| %25s = %-7d |\n","DICT_WORD_SIZE",DICT_WORD_SIZE);
+ if (glulx_mode)
+ printf("| %25s = %-7d |\n","DICT_CHAR_SIZE",DICT_CHAR_SIZE);
+ printf("| %25s = %-7d |\n","MAX_EXPRESSION_NODES",MAX_EXPRESSION_NODES);
+ printf("| %25s = %-7d |\n","MAX_GLOBAL_VARIABLES",MAX_GLOBAL_VARIABLES);
+ printf("| %25s = %-7d |\n","HASH_TAB_SIZE",HASH_TAB_SIZE);
+ if (!glulx_mode)
+ printf("| %25s = %-7d |\n","ZCODE_HEADER_EXT_WORDS",ZCODE_HEADER_EXT_WORDS);
+ if (!glulx_mode)
+ printf("| %25s = %-7d |\n","ZCODE_HEADER_FLAGS_3",ZCODE_HEADER_FLAGS_3);
+ printf("| %25s = %-7d |\n","MAX_INCLUSION_DEPTH",MAX_INCLUSION_DEPTH);
+ printf("| %25s = %-7d |\n","MAX_INDIV_PROP_TABLE_SIZE", MAX_INDIV_PROP_TABLE_SIZE);
+ printf("| %25s = %-7d |\n","INDIV_PROP_START", INDIV_PROP_START);
+ printf("| %25s = %-7d |\n","MAX_LABELS",MAX_LABELS);
+ printf("| %25s = %-7d |\n","MAX_LINESPACE",MAX_LINESPACE);
+ printf("| %25s = %-7d |\n","MAX_LINK_DATA_SIZE",MAX_LINK_DATA_SIZE);
+ if (glulx_mode)
+ printf("| %25s = %-7d |\n","MAX_LOCAL_VARIABLES",MAX_LOCAL_VARIABLES);
+ printf("| %25s = %-7d |\n","MAX_LOW_STRINGS",MAX_LOW_STRINGS);
+ if (glulx_mode)
+ printf("| %25s = %-7d |\n","MEMORY_MAP_EXTENSION",
+ MEMORY_MAP_EXTENSION);
+ if (glulx_mode)
+ printf("| %25s = %-7d |\n","MAX_NUM_STATIC_STRINGS",
+ MAX_NUM_STATIC_STRINGS);
+ printf("| %25s = %-7d |\n","MAX_OBJECTS",MAX_OBJECTS);
+ if (glulx_mode)
+ printf("| %25s = %-7d |\n","GLULX_OBJECT_EXT_BYTES",
+ GLULX_OBJECT_EXT_BYTES);
+ if (glulx_mode)
+ printf("| %25s = %-7d |\n","MAX_OBJ_PROP_COUNT",
+ MAX_OBJ_PROP_COUNT);
+ if (glulx_mode)
+ printf("| %25s = %-7d |\n","MAX_OBJ_PROP_TABLE_SIZE",
+ MAX_OBJ_PROP_TABLE_SIZE);
+ printf("| %25s = %-7d |\n","MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+ printf("| %25s = %-7d |\n","MAX_QTEXT_SIZE",MAX_QTEXT_SIZE);
+ printf("| %25s = %-7d |\n","MAX_SOURCE_FILES",MAX_SOURCE_FILES);
+ if (glulx_mode)
+ printf("| %25s = %-7ld |\n","MAX_STACK_SIZE",
+ (long int) MAX_STACK_SIZE);
+ printf("| %25s = %-7d |\n","MAX_STATIC_DATA",MAX_STATIC_DATA);
+ printf("| %25s = %-7ld |\n","MAX_STATIC_STRINGS",
+ (long int) MAX_STATIC_STRINGS);
+ printf("| %25s = %-7d |\n","MAX_SYMBOLS",MAX_SYMBOLS);
+ printf("| %25s = %-7d |\n","SYMBOLS_CHUNK_SIZE",SYMBOLS_CHUNK_SIZE);
+ printf("| %25s = %-7ld |\n","MAX_TRANSCRIPT_SIZE",
+ (long int) MAX_TRANSCRIPT_SIZE);
+ if (glulx_mode)
+ printf("| %25s = %-7ld |\n","MAX_UNICODE_CHARS",
+ (long int) MAX_UNICODE_CHARS);
+ printf("| %25s = %-7d |\n","WARN_UNUSED_ROUTINES",WARN_UNUSED_ROUTINES);
+ printf("| %25s = %-7d |\n","OMIT_UNUSED_ROUTINES",OMIT_UNUSED_ROUTINES);
+ printf("| %25s = %-7d |\n","MAX_VERBS",MAX_VERBS);
+ printf("| %25s = %-7d |\n","MAX_VERBSPACE",MAX_VERBSPACE);
+ printf("| %25s = %-7ld |\n","MAX_ZCODE_SIZE",
+ (long int) MAX_ZCODE_SIZE);
+ printf("+--------------------------------------+\n");
+}
+
+extern void set_memory_sizes(int size_flag)
+{
+ if (size_flag == HUGE_SIZE)
+ {
+ MAX_QTEXT_SIZE = 4000;
+ MAX_SYMBOLS = 10000;
+
+ SYMBOLS_CHUNK_SIZE = 5000;
+ HASH_TAB_SIZE = 512;
+
+ MAX_OBJECTS = 640;
+
+ MAX_ACTIONS = 200;
+ MAX_ADJECTIVES = 50;
+ MAX_DICT_ENTRIES = 2000;
+ MAX_STATIC_DATA = 10000;
+
+ MAX_PROP_TABLE_SIZE_z = 30000;
+ MAX_PROP_TABLE_SIZE_g = 60000;
+
+ MAX_ABBREVS = 64;
+
+ MAX_EXPRESSION_NODES = 100;
+ MAX_VERBS = 200;
+ MAX_VERBSPACE = 4096;
+ MAX_LABELS = 1000;
+ MAX_LINESPACE = 16000;
+
+ MAX_STATIC_STRINGS = 8000;
+ MAX_ZCODE_SIZE_z = 20000;
+ MAX_ZCODE_SIZE_g = 40000;
+ MAX_LINK_DATA_SIZE = 2000;
+
+ MAX_LOW_STRINGS = 2048;
+
+ MAX_TRANSCRIPT_SIZE = 200000;
+ MAX_NUM_STATIC_STRINGS = 20000;
+
+ MAX_CLASSES = 64;
+
+ MAX_OBJ_PROP_COUNT = 128;
+ MAX_OBJ_PROP_TABLE_SIZE = 4096;
+
+ MAX_INDIV_PROP_TABLE_SIZE = 15000;
+ MAX_ARRAYS = 128;
+
+ MAX_GLOBAL_VARIABLES_z = 240;
+ MAX_GLOBAL_VARIABLES_g = 512;
+
+ ALLOC_CHUNK_SIZE_z = 8192;
+ ALLOC_CHUNK_SIZE_g = 32768;
+ }
+ if (size_flag == LARGE_SIZE)
+ {
+ MAX_QTEXT_SIZE = 4000;
+ MAX_SYMBOLS = 6400;
+
+ SYMBOLS_CHUNK_SIZE = 5000;
+ HASH_TAB_SIZE = 512;
+
+ MAX_OBJECTS = 512;
+
+ MAX_ACTIONS = 200;
+ MAX_ADJECTIVES = 50;
+ MAX_DICT_ENTRIES = 1300;
+ MAX_STATIC_DATA = 10000;
+
+ MAX_PROP_TABLE_SIZE_z = 15000;
+ MAX_PROP_TABLE_SIZE_g = 30000;
+
+ MAX_ABBREVS = 64;
+
+ MAX_EXPRESSION_NODES = 100;
+ MAX_VERBS = 140;
+ MAX_VERBSPACE = 4096;
+ MAX_LINESPACE = 10000;
+
+ MAX_LABELS = 1000;
+ MAX_STATIC_STRINGS = 8000;
+ MAX_ZCODE_SIZE_z = 20000;
+ MAX_ZCODE_SIZE_g = 40000;
+ MAX_LINK_DATA_SIZE = 2000;
+
+ MAX_LOW_STRINGS = 2048;
+
+ MAX_TRANSCRIPT_SIZE = 200000;
+ MAX_NUM_STATIC_STRINGS = 20000;
+
+ MAX_CLASSES = 64;
+
+ MAX_OBJ_PROP_COUNT = 64;
+ MAX_OBJ_PROP_TABLE_SIZE = 2048;
+
+ MAX_INDIV_PROP_TABLE_SIZE = 10000;
+ MAX_ARRAYS = 128;
+
+ MAX_GLOBAL_VARIABLES_z = 240;
+ MAX_GLOBAL_VARIABLES_g = 512;
+
+ ALLOC_CHUNK_SIZE_z = 8192;
+ ALLOC_CHUNK_SIZE_g = 16384;
+ }
+ if (size_flag == SMALL_SIZE)
+ {
+ MAX_QTEXT_SIZE = 4000;
+ MAX_SYMBOLS = 3000;
+
+ SYMBOLS_CHUNK_SIZE = 2500;
+ HASH_TAB_SIZE = 512;
+
+ MAX_OBJECTS = 300;
+
+ MAX_ACTIONS = 200;
+ MAX_ADJECTIVES = 50;
+ MAX_DICT_ENTRIES = 700;
+ MAX_STATIC_DATA = 10000;
+
+ MAX_PROP_TABLE_SIZE_z = 8000;
+ MAX_PROP_TABLE_SIZE_g = 16000;
+
+ MAX_ABBREVS = 64;
+
+ MAX_EXPRESSION_NODES = 40;
+ MAX_VERBS = 110;
+ MAX_VERBSPACE = 2048;
+ MAX_LINESPACE = 10000;
+ MAX_LABELS = 1000;
+
+ MAX_STATIC_STRINGS = 8000;
+ MAX_ZCODE_SIZE_z = 10000;
+ MAX_ZCODE_SIZE_g = 20000;
+ MAX_LINK_DATA_SIZE = 1000;
+
+ MAX_LOW_STRINGS = 1024;
+
+ MAX_TRANSCRIPT_SIZE = 100000;
+ MAX_NUM_STATIC_STRINGS = 10000;
+
+ MAX_CLASSES = 32;
+
+ MAX_OBJ_PROP_COUNT = 64;
+ MAX_OBJ_PROP_TABLE_SIZE = 1024;
+
+ MAX_INDIV_PROP_TABLE_SIZE = 5000;
+ MAX_ARRAYS = 64;
+
+ MAX_GLOBAL_VARIABLES_z = 240;
+ MAX_GLOBAL_VARIABLES_g = 256;
+
+ ALLOC_CHUNK_SIZE_z = 8192;
+ ALLOC_CHUNK_SIZE_g = 8192;
+ }
+
+ /* Regardless of size_flag... */
+ MAX_SOURCE_FILES = 256;
+ MAX_INCLUSION_DEPTH = 5;
+ MAX_LOCAL_VARIABLES_z = 16;
+ MAX_LOCAL_VARIABLES_g = 32;
+ DICT_CHAR_SIZE = 1;
+ DICT_WORD_SIZE_z = 6;
+ DICT_WORD_SIZE_g = 9;
+ NUM_ATTR_BYTES_z = 6;
+ NUM_ATTR_BYTES_g = 7;
+ /* Backwards-compatible behavior: allow for a unicode table
+ whether we need one or not. The user can set this to zero if
+ there's no unicode table. */
+ ZCODE_HEADER_EXT_WORDS = 3;
+ ZCODE_HEADER_FLAGS_3 = 0;
+ GLULX_OBJECT_EXT_BYTES = 0;
+ MAX_UNICODE_CHARS = 64;
+ MEMORY_MAP_EXTENSION = 0;
+ /* We estimate the default Glulx stack size at 4096. That's about
+ enough for 90 nested function calls with 8 locals each -- the
+ same capacity as the Z-Spec's suggestion for Z-machine stack
+ size. Note that Inform 7 wants more stack; I7-generated code
+ sets MAX_STACK_SIZE to 65536 by default. */
+ MAX_STACK_SIZE = 4096;
+ OMIT_UNUSED_ROUTINES = 0;
+ WARN_UNUSED_ROUTINES = 0;
+
+ adjust_memory_sizes();
+}
+
+extern void adjust_memory_sizes()
+{
+ if (!glulx_mode) {
+ MAX_ZCODE_SIZE = MAX_ZCODE_SIZE_z;
+ MAX_PROP_TABLE_SIZE = MAX_PROP_TABLE_SIZE_z;
+ MAX_GLOBAL_VARIABLES = MAX_GLOBAL_VARIABLES_z;
+ MAX_LOCAL_VARIABLES = MAX_LOCAL_VARIABLES_z;
+ DICT_WORD_SIZE = DICT_WORD_SIZE_z;
+ NUM_ATTR_BYTES = NUM_ATTR_BYTES_z;
+ ALLOC_CHUNK_SIZE = ALLOC_CHUNK_SIZE_z;
+ INDIV_PROP_START = 64;
+ }
+ else {
+ MAX_ZCODE_SIZE = MAX_ZCODE_SIZE_g;
+ MAX_PROP_TABLE_SIZE = MAX_PROP_TABLE_SIZE_g;
+ MAX_GLOBAL_VARIABLES = MAX_GLOBAL_VARIABLES_g;
+ MAX_LOCAL_VARIABLES = MAX_LOCAL_VARIABLES_g;
+ DICT_WORD_SIZE = DICT_WORD_SIZE_g;
+ NUM_ATTR_BYTES = NUM_ATTR_BYTES_g;
+ ALLOC_CHUNK_SIZE = ALLOC_CHUNK_SIZE_g;
+ INDIV_PROP_START = 256;
+ }
+}
+
+static void explain_parameter(char *command)
+{ printf("\n");
+ if (strcmp(command,"MAX_QTEXT_SIZE")==0)
+ { printf(
+" MAX_QTEXT_SIZE is the maximum length of a quoted string. Increasing\n\
+ by 1 costs 5 bytes (for lexical analysis memory). Inform automatically\n\
+ ensures that MAX_STATIC_STRINGS is at least twice the size of this.");
+ return;
+ }
+ if (strcmp(command,"MAX_SYMBOLS")==0)
+ { printf(
+" MAX_SYMBOLS is the maximum number of symbols - names of variables, \n\
+ objects, routines, the many internal Inform-generated names and so on.\n");
+ return;
+ }
+ if (strcmp(command,"SYMBOLS_CHUNK_SIZE")==0)
+ { printf(
+" The symbols names are stored in memory which is allocated in chunks \n\
+ of size SYMBOLS_CHUNK_SIZE.\n");
+ return;
+ }
+ if (strcmp(command,"HASH_TAB_SIZE")==0)
+ { printf(
+" HASH_TAB_SIZE is the size of the hash tables used for the heaviest \n\
+ symbols banks.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_OBJECTS")==0)
+ { printf(
+" MAX_OBJECTS is the maximum number of objects. (If compiling a version-3 \n\
+ game, 255 is an absolute maximum in any event.)\n");
+ return;
+ }
+ if (strcmp(command,"MAX_ACTIONS")==0)
+ { printf(
+" MAX_ACTIONS is the maximum number of actions - that is, routines such as \n\
+ TakeSub which are referenced in the grammar table.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_ADJECTIVES")==0)
+ { printf(
+" MAX_ADJECTIVES is the maximum number of different \"adjectives\" in the \n\
+ grammar table. Adjectives are misleadingly named: they are words such as \n\
+ \"in\", \"under\" and the like.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_DICT_ENTRIES")==0)
+ { printf(
+" MAX_DICT_ENTRIES is the maximum number of words which can be entered \n\
+ into the game's dictionary. It costs 29 bytes to increase this by one.\n");
+ return;
+ }
+ if (strcmp(command,"DICT_WORD_SIZE")==0)
+ { printf(
+" DICT_WORD_SIZE is the number of characters in a dictionary word. In \n\
+ Z-code this is always 6 (only 4 are used in v3 games). In Glulx it \n\
+ can be any number.\n");
+ return;
+ }
+ if (strcmp(command,"DICT_CHAR_SIZE")==0)
+ { printf(
+" DICT_CHAR_SIZE is the byte size of one character in the dictionary. \n\
+ (This is only meaningful in Glulx, since Z-code has compressed dictionary \n\
+ words.) It can be either 1 (the default) or 4 (to enable full Unicode \n\
+ input.)\n");
+ return;
+ }
+ if (strcmp(command,"NUM_ATTR_BYTES")==0)
+ { printf(
+" NUM_ATTR_BYTES is the space used to store attribute flags. Each byte \n\
+ stores eight attributes. In Z-code this is always 6 (only 4 are used in \n\
+ v3 games). In Glulx it can be any number which is a multiple of four, \n\
+ plus three.\n");
+ return;
+ }
+ if (strcmp(command,"ZCODE_HEADER_EXT_WORDS")==0)
+ { printf(
+" ZCODE_HEADER_EXT_WORDS is the number of words in the Z-code header \n\
+ extension table (Z-Spec 1.0). The -W switch also sets this. It defaults \n\
+ to 3, but can be set higher. (It can be set lower if no Unicode \n\
+ translation table is created.)\n");
+ return;
+ }
+ if (strcmp(command,"ZCODE_HEADER_FLAGS_3")==0)
+ { printf(
+" ZCODE_HEADER_FLAGS_3 is the value to store in the Flags 3 word of the \n\
+ header extension table (Z-Spec 1.1).\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\
+ object record. It is initialized to zero bytes, and the game is free to \n\
+ use it as desired. (This is only meaningful in Glulx, since Z-code \n\
+ specifies the object structure.)\n");
+ return;
+ }
+ if (strcmp(command,"MAX_STATIC_DATA")==0)
+ { printf(
+" MAX_STATIC_DATA is the size of an array of integers holding initial \n\
+ values for arrays and strings stored as ASCII inside the Z-machine. It \n\
+ should be at least 1024 but seldom needs much more.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_PROP_TABLE_SIZE")==0)
+ { printf(
+" MAX_PROP_TABLE_SIZE is the number of bytes allocated to hold the \n\
+ properties table.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_ABBREVS")==0)
+ { printf(
+" MAX_ABBREVS is the maximum number of declared abbreviations. It is not \n\
+ allowed to exceed 64.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_ARRAYS")==0)
+ { printf(
+" MAX_ARRAYS is the maximum number of declared arrays.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_EXPRESSION_NODES")==0)
+ { printf(
+" MAX_EXPRESSION_NODES is the maximum number of nodes in the expression \n\
+ evaluator's storage for parse trees. In effect, it measures how \n\
+ complicated algebraic expressions are allowed to be. Increasing it by \n\
+ one costs about 80 bytes.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_VERBS")==0)
+ { printf(
+" MAX_VERBS is the maximum number of verbs (such as \"take\") which can be \n\
+ defined, each with its own grammar. To increase it by one costs about\n\
+ 128 bytes. A full game will contain at least 100.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_VERBSPACE")==0)
+ { printf(
+" MAX_VERBSPACE is the size of workspace used to store verb words, so may\n\
+ need increasing in games with many synonyms: unlikely to exceed 4K.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_LABELS")==0)
+ { printf(
+" MAX_LABELS is the maximum number of label points in any one routine.\n\
+ (If the -k debugging information switch is set, MAX_LABELS is raised to\n\
+ a minimum level of 2000, as about twice the normal number of label points\n\
+ are needed to generate tables of how source code corresponds to positions\n\
+ in compiled code.)");
+ return;
+ }
+ if (strcmp(command,"MAX_LINESPACE")==0)
+ { printf(
+" MAX_LINESPACE is the size of workspace used to store grammar lines, so \n\
+ may need increasing in games with complex or extensive grammars.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_STATIC_STRINGS")==0)
+ {
+ printf(
+" MAX_STATIC_STRINGS is the size in bytes of a buffer to hold compiled\n\
+ strings before they're written into longer-term storage. 2000 bytes is \n\
+ plenty, allowing string constants of up to about 3000 characters long.\n\
+ Inform automatically ensures that this is at least twice the size of\n\
+ MAX_QTEXT_SIZE, to be on the safe side.");
+ return;
+ }
+ if (strcmp(command,"MAX_ZCODE_SIZE")==0)
+ {
+ printf(
+" MAX_ZCODE_SIZE is the size in bytes of a buffer to hold compiled \n\
+ code for a single routine. (It applies to both Z-code and Glulx, \n\
+ despite the name.) As a guide, the longest library routine is \n\
+ about 6500 bytes long in Z-code; about twice that in Glulx.");
+ return;
+ }
+ if (strcmp(command,"MAX_LINK_DATA_SIZE")==0)
+ {
+ printf(
+" MAX_LINK_DATA_SIZE is the size in bytes of a buffer to hold module \n\
+ link data before it's written into longer-term storage. 2000 bytes \n\
+ is plenty.");
+ return;
+ }
+ if (strcmp(command,"MAX_LOW_STRINGS")==0)
+ { printf(
+" MAX_LOW_STRINGS is the size in bytes of a buffer to hold all the \n\
+ compiled \"low strings\" which are to be written above the synonyms table \n\
+ in the Z-machine. 1024 is plenty.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_TRANSCRIPT_SIZE")==0)
+ { printf(
+" MAX_TRANSCRIPT_SIZE is only allocated for the abbreviations optimisation \n\
+ switch, and has the size in bytes of a buffer to hold the entire text of\n\
+ the game being compiled: it has to be enormous, say 100000 to 200000.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_CLASSES")==0)
+ { printf(
+" MAX_CLASSES maximum number of object classes which can be defined. This\n\
+ is cheap to increase.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_INCLUSION_DEPTH")==0)
+ { printf(
+" MAX_INCLUSION_DEPTH is the number of nested includes permitted.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_SOURCE_FILES")==0)
+ { printf(
+" MAX_SOURCE_FILES is the number of source files that can be read in the \n\
+ compilation.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_INDIV_PROP_TABLE_SIZE")==0)
+ { printf(
+" MAX_INDIV_PROP_TABLE_SIZE is the number of bytes allocated to hold the \n\
+ table of ..variable values.\n");
+ return;
+ }
+ if (strcmp(command,"INDIV_PROP_START")==0)
+ { printf(
+" Properties 1 to INDIV_PROP_START-1 are common properties; individual\n\
+ properties are numbered INDIV_PROP_START and up.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_OBJ_PROP_COUNT")==0)
+ { printf(
+" MAX_OBJ_PROP_COUNT is the maximum number of properties a single object \n\
+ can have. (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"MAX_OBJ_PROP_TABLE_SIZE")==0)
+ { printf(
+" MAX_OBJ_PROP_TABLE_SIZE is the number of words allocated to hold a \n\
+ single object's properties. (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"MAX_LOCAL_VARIABLES")==0)
+ { printf(
+" MAX_LOCAL_VARIABLES is the number of local variables (including \n\
+ arguments) allowed in a procedure. (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"MAX_GLOBAL_VARIABLES")==0)
+ { printf(
+" MAX_GLOBAL_VARIABLES is the number of global variables allowed in the \n\
+ program. (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"MAX_NUM_STATIC_STRINGS")==0)
+ {
+ printf(
+" MAX_NUM_STATIC_STRINGS is the maximum number of compiled strings \n\
+ allowed in the program. (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"MAX_UNICODE_CHARS")==0)
+ {
+ printf(
+" MAX_UNICODE_CHARS is the maximum number of different Unicode characters \n\
+ (beyond the Latin-1 range, $00..$FF) which the game text can use. \n\
+ (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"ALLOC_CHUNK_SIZE")==0)
+ {
+ printf(
+" ALLOC_CHUNK_SIZE is a base unit of Inform's internal memory allocation \n\
+ for various structures.\n");
+ return;
+ }
+ if (strcmp(command,"MAX_STACK_SIZE")==0)
+ {
+ printf(
+" MAX_STACK_SIZE is the maximum size (in bytes) of the interpreter stack \n\
+ during gameplay. (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"MEMORY_MAP_EXTENSION")==0)
+ {
+ printf(
+" MEMORY_MAP_EXTENSION is the number of bytes (all zeroes) to map into \n\
+ memory after the game file. (Glulx only)\n");
+ return;
+ }
+ if (strcmp(command,"WARN_UNUSED_ROUTINES")==0)
+ {
+ printf(
+" WARN_UNUSED_ROUTINES, if set to 2, will display a warning for each \n\
+ routine in the game file which is never called. (This includes \n\
+ routines called only from uncalled routines, etc.) If set to 1, will warn \n\
+ only about functions in game code, not in the system library.\n");
+ return;
+ }
+ if (strcmp(command,"OMIT_UNUSED_ROUTINES")==0)
+ {
+ printf(
+" OMIT_UNUSED_ROUTINES, if set to 1, will avoid compiling unused routines \n\
+ into the game file.\n");
+ return;
+ }
+ if (strcmp(command,"SERIAL")==0)
+ {
+ printf(
+" SERIAL, if set, will be used as the six digit serial number written into \n\
+ the header of the output file.\n");
+ return;
+ }
+
+ printf("No such memory setting as \"%s\"\n",command);
+
+ return;
+}
+
+/* Parse a decimal number as an int32. Return true if a valid number
+ was found; otherwise print a warning and return false.
+
+ Anything over nine digits is considered an overflow; we report a
+ warning but return +/- 999999999 (and true). This is not entirely
+ clever about leading zeroes ("0000000001" is treated as an
+ overflow) but this is better than trying to detect genuine
+ overflows in a long.
+
+ (Some Glulx settings might conceivably want to go up to $7FFFFFFF,
+ which is a ten-digit number, but we're not going to allow that
+ today.)
+
+ This used to rely on atoi(), and we retain the atoi() behavior of
+ ignoring garbage characters after a valid decimal number.
+ */
+static int parse_memory_setting(char *str, char *label, int32 *result)
+{
+ char *cx = str;
+ char *ex;
+ long val;
+
+ *result = 0;
+
+ while (*cx == ' ') cx++;
+
+ val = strtol(cx, &ex, 10);
+
+ if (ex == cx) {
+ printf("Bad numerical setting in $ command \"%s=%s\"\n",
+ label, str);
+ return 0;
+ }
+
+ if (*cx == '-') {
+ if (ex > cx+10) {
+ val = -999999999;
+ printf("Numerical setting underflowed in $ command \"%s=%s\" (limiting to %ld)\n",
+ label, str, val);
+ }
+ }
+ else {
+ if (ex > cx+9) {
+ val = 999999999;
+ printf("Numerical setting overflowed in $ command \"%s=%s\" (limiting to %ld)\n",
+ label, str, val);
+ }
+ }
+
+ *result = (int32)val;
+ return 1;
+}
+
+extern void memory_command(char *command)
+{ int i, k, flag=0; int32 j;
+
+ for (k=0; command[k]!=0; k++)
+ if (islower(command[k])) command[k]=toupper(command[k]);
+
+ if (command[0]=='?') { explain_parameter(command+1); return; }
+
+ if (strcmp(command, "HUGE")==0) { set_memory_sizes(HUGE_SIZE); return; }
+ if (strcmp(command, "LARGE")==0) { set_memory_sizes(LARGE_SIZE); return; }
+ if (strcmp(command, "SMALL")==0) { set_memory_sizes(SMALL_SIZE); return; }
+ if (strcmp(command, "LIST")==0) { list_memory_sizes(); return; }
+ for (i=0; command[i]!=0; i++)
+ { if (command[i]=='=')
+ { command[i]=0;
+ if (!parse_memory_setting(command+i+1, command, &j)) {
+ return;
+ }
+ if (strcmp(command,"BUFFER_LENGTH")==0)
+ flag=2;
+ if (strcmp(command,"MAX_QTEXT_SIZE")==0)
+ { MAX_QTEXT_SIZE=j, flag=1;
+ if (2*MAX_QTEXT_SIZE > MAX_STATIC_STRINGS)
+ MAX_STATIC_STRINGS = 2*MAX_QTEXT_SIZE;
+ }
+ if (strcmp(command,"MAX_SYMBOLS")==0)
+ MAX_SYMBOLS=j, flag=1;
+ if (strcmp(command,"MAX_BANK_SIZE")==0)
+ flag=2;
+ if (strcmp(command,"SYMBOLS_CHUNK_SIZE")==0)
+ SYMBOLS_CHUNK_SIZE=j, flag=1;
+ if (strcmp(command,"BANK_CHUNK_SIZE")==0)
+ flag=2;
+ if (strcmp(command,"HASH_TAB_SIZE")==0)
+ HASH_TAB_SIZE=j, flag=1;
+ if (strcmp(command,"MAX_OBJECTS")==0)
+ MAX_OBJECTS=j, flag=1;
+ if (strcmp(command,"MAX_ACTIONS")==0)
+ MAX_ACTIONS=j, flag=1;
+ if (strcmp(command,"MAX_ADJECTIVES")==0)
+ MAX_ADJECTIVES=j, flag=1;
+ if (strcmp(command,"MAX_DICT_ENTRIES")==0)
+ MAX_DICT_ENTRIES=j, flag=1;
+ if (strcmp(command,"DICT_WORD_SIZE")==0)
+ { DICT_WORD_SIZE=j, flag=1;
+ DICT_WORD_SIZE_g=DICT_WORD_SIZE_z=j;
+ }
+ if (strcmp(command,"DICT_CHAR_SIZE")==0)
+ DICT_CHAR_SIZE=j, flag=1;
+ if (strcmp(command,"NUM_ATTR_BYTES")==0)
+ { NUM_ATTR_BYTES=j, flag=1;
+ NUM_ATTR_BYTES_g=NUM_ATTR_BYTES_z=j;
+ }
+ if (strcmp(command,"ZCODE_HEADER_EXT_WORDS")==0)
+ ZCODE_HEADER_EXT_WORDS=j, flag=1;
+ if (strcmp(command,"ZCODE_HEADER_FLAGS_3")==0)
+ ZCODE_HEADER_FLAGS_3=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)
+ MAX_STATIC_DATA=j, flag=1;
+ if (strcmp(command,"MAX_OLDEPTH")==0)
+ flag=2;
+ if (strcmp(command,"MAX_ROUTINES")==0)
+ flag=2;
+ if (strcmp(command,"MAX_GCONSTANTS")==0)
+ flag=2;
+ if (strcmp(command,"MAX_PROP_TABLE_SIZE")==0)
+ { MAX_PROP_TABLE_SIZE=j, flag=1;
+ MAX_PROP_TABLE_SIZE_g=MAX_PROP_TABLE_SIZE_z=j;
+ }
+ if (strcmp(command,"MAX_FORWARD_REFS")==0)
+ flag=2;
+ if (strcmp(command,"STACK_SIZE")==0)
+ flag=2;
+ if (strcmp(command,"STACK_LONG_SLOTS")==0)
+ flag=2;
+ if (strcmp(command,"STACK_SHORT_LENGTH")==0)
+ flag=2;
+ if (strcmp(command,"MAX_ABBREVS")==0)
+ MAX_ABBREVS=j, flag=1;
+ if (strcmp(command,"MAX_ARRAYS")==0)
+ MAX_ARRAYS=j, flag=1;
+ if (strcmp(command,"MAX_EXPRESSION_NODES")==0)
+ MAX_EXPRESSION_NODES=j, flag=1;
+ if (strcmp(command,"MAX_VERBS")==0)
+ MAX_VERBS=j, flag=1;
+ if (strcmp(command,"MAX_VERBSPACE")==0)
+ MAX_VERBSPACE=j, flag=1;
+ if (strcmp(command,"MAX_LABELS")==0)
+ MAX_LABELS=j, flag=1;
+ if (strcmp(command,"MAX_LINESPACE")==0)
+ MAX_LINESPACE=j, flag=1;
+ if (strcmp(command,"MAX_NUM_STATIC_STRINGS")==0)
+ MAX_NUM_STATIC_STRINGS=j, flag=1;
+ if (strcmp(command,"MAX_STATIC_STRINGS")==0)
+ { MAX_STATIC_STRINGS=j, flag=1;
+ if (2*MAX_QTEXT_SIZE > MAX_STATIC_STRINGS)
+ MAX_STATIC_STRINGS = 2*MAX_QTEXT_SIZE;
+ }
+ if (strcmp(command,"MAX_ZCODE_SIZE")==0)
+ { MAX_ZCODE_SIZE=j, flag=1;
+ MAX_ZCODE_SIZE_g=MAX_ZCODE_SIZE_z=j;
+ }
+ if (strcmp(command,"MAX_LINK_DATA_SIZE")==0)
+ MAX_LINK_DATA_SIZE=j, flag=1;
+ if (strcmp(command,"MAX_LOW_STRINGS")==0)
+ MAX_LOW_STRINGS=j, flag=1;
+ if (strcmp(command,"MAX_TRANSCRIPT_SIZE")==0)
+ MAX_TRANSCRIPT_SIZE=j, flag=1;
+ if (strcmp(command,"MAX_CLASSES")==0)
+ MAX_CLASSES=j, flag=1;
+ if (strcmp(command,"MAX_INCLUSION_DEPTH")==0)
+ MAX_INCLUSION_DEPTH=j, flag=1;
+ if (strcmp(command,"MAX_SOURCE_FILES")==0)
+ MAX_SOURCE_FILES=j, flag=1;
+ if (strcmp(command,"MAX_INDIV_PROP_TABLE_SIZE")==0)
+ MAX_INDIV_PROP_TABLE_SIZE=j, flag=1;
+ if (strcmp(command,"INDIV_PROP_START")==0)
+ INDIV_PROP_START=j, flag=1;
+ if (strcmp(command,"MAX_OBJ_PROP_TABLE_SIZE")==0)
+ MAX_OBJ_PROP_TABLE_SIZE=j, flag=1;
+ if (strcmp(command,"MAX_OBJ_PROP_COUNT")==0)
+ MAX_OBJ_PROP_COUNT=j, flag=1;
+ if (strcmp(command,"MAX_LOCAL_VARIABLES")==0)
+ { MAX_LOCAL_VARIABLES=j, flag=1;
+ MAX_LOCAL_VARIABLES_g=MAX_LOCAL_VARIABLES_z=j;
+ }
+ if (strcmp(command,"MAX_GLOBAL_VARIABLES")==0)
+ { MAX_GLOBAL_VARIABLES=j, flag=1;
+ MAX_GLOBAL_VARIABLES_g=MAX_GLOBAL_VARIABLES_z=j;
+ }
+ if (strcmp(command,"ALLOC_CHUNK_SIZE")==0)
+ { ALLOC_CHUNK_SIZE=j, flag=1;
+ ALLOC_CHUNK_SIZE_g=ALLOC_CHUNK_SIZE_z=j;
+ }
+ if (strcmp(command,"MAX_UNICODE_CHARS")==0)
+ MAX_UNICODE_CHARS=j, flag=1;
+ if (strcmp(command,"MAX_STACK_SIZE")==0)
+ {
+ MAX_STACK_SIZE=j, flag=1;
+ /* Adjust up to a 256-byte boundary. */
+ MAX_STACK_SIZE = (MAX_STACK_SIZE + 0xFF) & (~0xFF);
+ }
+ if (strcmp(command,"MEMORY_MAP_EXTENSION")==0)
+ {
+ MEMORY_MAP_EXTENSION=j, flag=1;
+ /* Adjust up to a 256-byte boundary. */
+ MEMORY_MAP_EXTENSION = (MEMORY_MAP_EXTENSION + 0xFF) & (~0xFF);
+ }
+ if (strcmp(command,"WARN_UNUSED_ROUTINES")==0)
+ {
+ WARN_UNUSED_ROUTINES=j, flag=1;
+ if (WARN_UNUSED_ROUTINES > 2 || WARN_UNUSED_ROUTINES < 0)
+ WARN_UNUSED_ROUTINES = 2;
+ }
+ if (strcmp(command,"OMIT_UNUSED_ROUTINES")==0)
+ {
+ OMIT_UNUSED_ROUTINES=j, flag=1;
+ if (OMIT_UNUSED_ROUTINES > 1 || OMIT_UNUSED_ROUTINES < 0)
+ OMIT_UNUSED_ROUTINES = 1;
+ }
+ if (strcmp(command,"SERIAL")==0)
+ {
+ if (j >= 0 && j <= 999999)
+ {
+ sprintf(serial_code_buffer,"%06d",j);
+ serial_code_given_in_program = TRUE;
+ flag=1;
+ }
+ }
+
+ if (flag==0)
+ printf("No such memory setting as \"%s\"\n", command);
+ if (flag==2)
+ printf("The Inform 5 memory setting \"%s\" has been withdrawn.\n\
+It should be safe to omit it (putting nothing in its place).\n", command);
+ return;
+ }
+ }
+ printf("No such memory $ command as \"%s\"\n",command);
+}
+
+extern void print_memory_usage(void)
+{
+ printf("Properties table used %d\n",
+ properties_table_size);
+ printf("Allocated a total of %ld bytes of memory\n",
+ (long int) malloced_bytes);
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_memory_vars(void)
+{ malloced_bytes = 0;
+}
+
+extern void memory_begin_pass(void) { }
+
+extern void memory_allocate_arrays(void) { }
+
+extern void memory_free_arrays(void) { }
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "objects" : [1] the object-maker, which constructs objects and enters */
+/* them into the tree, given a low-level specification; */
+/* */
+/* [2] the parser of Object/Nearby/Class directives, which */
+/* checks syntax and translates such directives into */
+/* specifications for the object-maker. */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+/* ------------------------------------------------------------------------- */
+/* Objects. */
+/* ------------------------------------------------------------------------- */
+
+int no_objects; /* Number of objects made so far */
+
+static int no_embedded_routines; /* Used for naming routines which
+ are given as property values: these
+ are called EmbeddedRoutine__1, ... */
+
+static fpropt full_object; /* "fpropt" is a typedef for a struct
+ containing an array to hold the
+ attribute and property values of
+ a single object. We only keep one
+ of these, for the current object
+ being made, and compile it into
+ Z-machine tables when each object
+ definition is complete, since
+ sizeof(fpropt) is about 6200 bytes */
+static fproptg full_object_g; /* Equivalent for Glulx. This object
+ is very small, since the large arrays
+ are allocated dynamically by the
+ Glulx compiler */
+static char shortname_buffer[766]; /* Text buffer to hold the short name
+ (which is read in first, but
+ written almost last) */
+static int parent_of_this_obj;
+
+static char *classname_text, *objectname_text;
+ /* For printing names of embedded
+ routines only */
+
+/* ------------------------------------------------------------------------- */
+/* Classes. */
+/* ------------------------------------------------------------------------- */
+/* Arrays defined below: */
+/* */
+/* int32 class_begins_at[n] offset of properties block for */
+/* nth class (always an offset */
+/* inside the properties_table) */
+/* int classes_to_inherit_from[] The list of classes to inherit */
+/* from as taken from the current */
+/* Nearby/Object/Class definition */
+/* int class_object_numbers[n] The number of the prototype-object */
+/* for the nth class */
+/* ------------------------------------------------------------------------- */
+
+int no_classes; /* Number of class defns made so far */
+
+static int current_defn_is_class, /* TRUE if current Nearby/Object/Class
+ defn is in fact a Class definition */
+ no_classes_to_inherit_from; /* Number of classes in the list
+ of classes to inherit in the
+ current Nearby/Object/Class defn */
+
+/* ------------------------------------------------------------------------- */
+/* Making attributes and properties. */
+/* ------------------------------------------------------------------------- */
+
+int no_attributes, /* Number of attributes defined so far */
+ no_properties; /* Number of properties defined so far,
+ plus 1 (properties are numbered from
+ 1 and Inform creates "name" and two
+ others itself, so the variable begins
+ the compilation pass set to 4) */
+
+static void trace_s(char *name, int32 number, int f)
+{ if (!printprops_switch) return;
+ printf("%s %02ld ",(f==0)?"Attr":"Prop",(long int) number);
+ if (f==0) printf(" ");
+ else printf("%s%s",(prop_is_long[number])?"L":" ",
+ (prop_is_additive[number])?"A":" ");
+ printf(" %s\n",name);
+}
+
+extern void make_attribute(void)
+{ int i; char *name;
+ debug_location_beginning beginning_debug_location =
+ get_token_location_beginning();
+
+ if (!glulx_mode) {
+ if (no_attributes==((version_number==3)?32:48))
+ { discard_token_location(beginning_debug_location);
+ if (version_number==3)
+ error("All 32 attributes already declared (compile as Advanced \
+game to get an extra 16)");
+ else
+ error("All 48 attributes already declared");
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+ }
+ 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",
+ NUM_ATTR_BYTES*8);
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+ }
+
+ get_next_token();
+ i = token_value; name = token_text;
+ if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("new attribute name", token_text);
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+
+ directive_keywords.enabled = TRUE;
+ get_next_token();
+ directive_keywords.enabled = FALSE;
+
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
+ { get_next_token();
+ if (!((token_type == SYMBOL_TT)
+ && (stypes[token_value] == ATTRIBUTE_T)))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("an existing attribute name after 'alias'",
+ token_text);
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+ assign_symbol(i, svals[token_value], ATTRIBUTE_T);
+ sflags[token_value] |= ALIASED_SFLAG;
+ sflags[i] |= ALIASED_SFLAG;
+ }
+ else
+ { assign_symbol(i, no_attributes++, ATTRIBUTE_T);
+ put_token_back();
+ }
+
+ if (debugfile_switch)
+ { debug_file_printf("<attribute>");
+ debug_file_printf("<identifier>%s</identifier>", name);
+ debug_file_printf("<value>%d</value>", svals[i]);
+ write_debug_locations(get_token_location_end(beginning_debug_location));
+ debug_file_printf("</attribute>");
+ }
+
+ trace_s(name, svals[i], 0);
+ return;
+}
+
+extern void make_property(void)
+{ int32 default_value, i;
+ int additive_flag=FALSE; char *name;
+ assembly_operand AO;
+ debug_location_beginning beginning_debug_location =
+ get_token_location_beginning();
+
+ if (!glulx_mode) {
+ if (no_properties==((version_number==3)?32:64))
+ { discard_token_location(beginning_debug_location);
+ if (version_number==3)
+ error("All 30 properties already declared (compile as \
+Advanced game to get an extra 62)");
+ else
+ error("All 62 properties already declared");
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+ }
+ else {
+ if (no_properties==INDIV_PROP_START) {
+ discard_token_location(beginning_debug_location);
+ error_numbered("All properties already declared -- max is",
+ INDIV_PROP_START);
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+ }
+
+ do
+ { directive_keywords.enabled = TRUE;
+ get_next_token();
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == LONG_DK))
+ obsolete_warning("all properties are now automatically 'long'");
+ else
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == ADDITIVE_DK))
+ additive_flag = TRUE;
+ else break;
+ } while (TRUE);
+
+ put_token_back();
+ directive_keywords.enabled = FALSE;
+ get_next_token();
+
+ i = token_value; name = token_text;
+ if ((token_type != SYMBOL_TT) || (!(sflags[i] & UNKNOWN_SFLAG)))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("new property name", token_text);
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+
+ directive_keywords.enabled = TRUE;
+ get_next_token();
+ directive_keywords.enabled = FALSE;
+
+ if (strcmp(name+strlen(name)-3, "_to") == 0) sflags[i] |= STAR_SFLAG;
+
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == ALIAS_DK))
+ { discard_token_location(beginning_debug_location);
+ if (additive_flag)
+ { error("'alias' incompatible with 'additive'");
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+ get_next_token();
+ if (!((token_type == SYMBOL_TT)
+ && (stypes[token_value] == PROPERTY_T)))
+ { ebf_error("an existing property name after 'alias'",
+ token_text);
+ panic_mode_error_recovery();
+ put_token_back();
+ return;
+ }
+
+ assign_symbol(i, svals[token_value], PROPERTY_T);
+ trace_s(name, svals[i], 1);
+ sflags[token_value] |= ALIASED_SFLAG;
+ sflags[i] |= ALIASED_SFLAG;
+ return;
+ }
+
+ default_value = 0;
+ put_token_back();
+
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { AO = parse_expression(CONSTANT_CONTEXT);
+ default_value = AO.value;
+ if (AO.marker != 0)
+ backpatch_zmachine(AO.marker, PROP_DEFAULTS_ZA,
+ (no_properties-1) * WORDSIZE);
+ }
+
+ prop_default_value[no_properties] = default_value;
+ prop_is_long[no_properties] = TRUE;
+ prop_is_additive[no_properties] = additive_flag;
+
+ assign_symbol(i, no_properties++, PROPERTY_T);
+
+ if (debugfile_switch)
+ { debug_file_printf("<property>");
+ debug_file_printf("<identifier>%s</identifier>", name);
+ debug_file_printf("<value>%d</value>", svals[i]);
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ debug_file_printf("</property>");
+ }
+
+ trace_s(name, svals[i], 1);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Properties. */
+/* ------------------------------------------------------------------------- */
+
+int32 *prop_default_value; /* Default values for properties */
+int *prop_is_long, /* Property modifiers, TRUE or FALSE:
+ "long" means "never write a 1-byte
+ value to this property", and is an
+ obsolete feature: since Inform 5
+ all properties have been "long" */
+ *prop_is_additive; /* "additive" means that values
+ accumulate rather than erase each
+ other during class inheritance */
+char *properties_table; /* Holds the table of property values
+ (holding one block for each object
+ and coming immediately after the
+ object tree in Z-memory) */
+int properties_table_size; /* Number of bytes in this table */
+
+/* ------------------------------------------------------------------------- */
+/* Individual properties */
+/* */
+/* Each new i.p. name is given a unique number. These numbers start from */
+/* 72, since 0 is reserved as a null, 1 to 63 refer to common properties */
+/* and 64 to 71 are kept for methods of the metaclass Class (for example, */
+/* 64 is "create"). */
+/* */
+/* An object provides individual properties by having property 3 set to a */
+/* non-zero value, which must be a byte address of a table in the form: */
+/* */
+/* <record-1> ... <record-n> 00 00 */
+/* */
+/* where a <record> looks like */
+/* */
+/* <identifier> <size> <up to 255 bytes of data> */
+/* or <identifier + 0x8000> */
+/* ----- 2 bytes ---------- 1 byte <size> number of bytes */
+/* */
+/* The <identifier> part is the number allocated to the name of what is */
+/* being provided. The top bit of this word is set to indicate that */
+/* although the individual property is being provided, it is provided */
+/* only privately (so that it is inaccessible except to the object's own */
+/* embedded routines). */
+/* */
+/* In Glulx: i-props are numbered from INDIV_PROP_START+8 up. And all */
+/* properties, common and individual, are stored in the same table. */
+/* ------------------------------------------------------------------------- */
+
+ int no_individual_properties; /* Actually equal to the next
+ identifier number to be allocated,
+ so this is initially 72 even though
+ none have been made yet. */
+static int individual_prop_table_size; /* Size of the table of individual
+ properties so far for current obj */
+ uchar *individuals_table; /* Table of records, each being the
+ i.p. table for an object */
+ int i_m; /* Write mark position in the above */
+ int individuals_length; /* Extent of individuals_table */
+
+/* ------------------------------------------------------------------------- */
+/* Arrays used by this file */
+/* ------------------------------------------------------------------------- */
+
+objecttz *objectsz; /* Z-code only */
+objecttg *objectsg; /* Glulx only */
+uchar *objectatts; /* Glulx only */
+static int *classes_to_inherit_from;
+int *class_object_numbers;
+int32 *class_begins_at;
+
+
+/* ------------------------------------------------------------------------- */
+/* Tracing for compiler maintenance */
+/* ------------------------------------------------------------------------- */
+
+extern void list_object_tree(void)
+{ int i;
+ printf("obj par nxt chl Object tree:\n");
+ for (i=0; i<no_objects; i++)
+ printf("%3d %3d %3d %3d\n",
+ i+1,objectsz[i].parent,objectsz[i].next, objectsz[i].child);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Object and class manufacture begins here. */
+/* */
+/* These definitions have headers (parsed far, far below) and a series */
+/* of segments, introduced by keywords and optionally separated by commas. */
+/* Each segment has its own parsing routine. Note that when errors are */
+/* detected, parsing continues rather than being abandoned, which assists */
+/* a little in "error recovery" (i.e. in stopping lots more errors being */
+/* produced for essentially the same mistake). */
+/* ------------------------------------------------------------------------- */
+
+/* ========================================================================= */
+/* [1] The object-maker: builds an object from a specification, viz.: */
+/* */
+/* full_object, */
+/* shortname_buffer, */
+/* parent_of_this_obj, */
+/* current_defn_is_class (flag) */
+/* classes_to_inherit_from[], no_classes_to_inherit_from, */
+/* individual_prop_table_size (to date ) */
+/* */
+/* For efficiency's sake, the individual properties table has already been */
+/* created (as far as possible, i.e., all except for inherited individual */
+/* properties); unless the flag is clear, in which case the actual */
+/* definition did not specify any individual properties. */
+/* ========================================================================= */
+/* Property inheritance from classes. */
+/* ------------------------------------------------------------------------- */
+
+static void property_inheritance_z(void)
+{
+ /* Apply the property inheritance rules to full_object, which should
+ initially be complete (i.e., this routine takes place after the whole
+ Nearby/Object/Class definition has been parsed through).
+
+ On exit, full_object contains the final state of the properties to
+ be written. */
+
+ int i, j, k, kmax, class, mark,
+ prop_number, prop_length, prop_in_current_defn;
+ uchar *class_prop_block;
+
+ ASSERT_ZCODE();
+
+ for (class=0; class<no_classes_to_inherit_from; class++)
+ {
+ j=0;
+ mark = class_begins_at[classes_to_inherit_from[class]-1];
+ class_prop_block = (uchar *) (properties_table + mark);
+
+ while (class_prop_block[j]!=0)
+ { if (version_number == 3)
+ { prop_number = class_prop_block[j]%32;
+ prop_length = 1 + class_prop_block[j++]/32;
+ }
+ else
+ { prop_number = class_prop_block[j]%64;
+ prop_length = 1 + class_prop_block[j++]/64;
+ if (prop_length > 2)
+ prop_length = class_prop_block[j++]%64;
+ }
+
+ /* So we now have property number prop_number present in the
+ property block for the class being read: its bytes are
+
+ class_prop_block[j, ..., j + prop_length - 1]
+
+ Question now is: is there already a value given in the
+ current definition under this property name? */
+
+ prop_in_current_defn = FALSE;
+
+ kmax = full_object.l;
+
+ for (k=0; k<kmax; k++)
+ if (full_object.pp[k].num == prop_number)
+ { prop_in_current_defn = TRUE;
+
+ /* (Note that the built-in "name" property is additive) */
+
+ if ((prop_number==1) || (prop_is_additive[prop_number]))
+ {
+ /* The additive case: we accumulate the class
+ property values onto the end of the full_object
+ property */
+
+ for (i=full_object.pp[k].l;
+ i<full_object.pp[k].l+prop_length/2; i++)
+ { if (i >= 32)
+ { error("An additive property has inherited \
+so many values that the list has overflowed the maximum 32 entries");
+ break;
+ }
+ full_object.pp[k].ao[i].value = mark + j;
+ j += 2;
+ full_object.pp[k].ao[i].marker = INHERIT_MV;
+ full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
+ }
+ full_object.pp[k].l += prop_length/2;
+ }
+ else
+ /* The ordinary case: the full_object property
+ values simply overrides the class definition,
+ so we skip over the values in the class table */
+
+ j+=prop_length;
+
+ if (prop_number==3)
+ { int y, z, class_block_offset;
+ uchar *p;
+
+ /* Property 3 holds the address of the table of
+ instance variables, so this is the case where
+ the object already has instance variables in its
+ own table but must inherit some more from the
+ class */
+
+ class_block_offset = class_prop_block[j-2]*256
+ + class_prop_block[j-1];
+
+ p = individuals_table + class_block_offset;
+ z = class_block_offset;
+ while ((p[0]!=0)||(p[1]!=0))
+ { int already_present = FALSE, l;
+ for (l = full_object.pp[k].ao[0].value; l < i_m;
+ l = l + 3 + individuals_table[l + 2])
+ if (individuals_table[l] == p[0]
+ && individuals_table[l + 1] == p[1])
+ { already_present = TRUE; break;
+ }
+ if (already_present == FALSE)
+ { if (module_switch)
+ backpatch_zmachine(IDENT_MV,
+ INDIVIDUAL_PROP_ZA, i_m);
+ if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
+ memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
+ MAX_INDIV_PROP_TABLE_SIZE);
+ individuals_table[i_m++] = p[0];
+ individuals_table[i_m++] = p[1];
+ individuals_table[i_m++] = p[2];
+ for (y=0;y < p[2]/2;y++)
+ { individuals_table[i_m++] = (z+3+y*2)/256;
+ individuals_table[i_m++] = (z+3+y*2)%256;
+ backpatch_zmachine(INHERIT_INDIV_MV,
+ INDIVIDUAL_PROP_ZA, i_m-2);
+ }
+ }
+ z += p[2] + 3;
+ p += p[2] + 3;
+ }
+ individuals_length = i_m;
+ }
+
+ /* For efficiency we exit the loop now (this property
+ number has been dealt with) */
+
+ break;
+ }
+
+ if (!prop_in_current_defn)
+ {
+ /* The case where the class defined a property which wasn't
+ defined at all in full_object: we copy out the data into
+ a new property added to full_object */
+
+ k=full_object.l++;
+ full_object.pp[k].num = prop_number;
+ full_object.pp[k].l = prop_length/2;
+ for (i=0; i<prop_length/2; i++)
+ { full_object.pp[k].ao[i].value = mark + j;
+ j+=2;
+ full_object.pp[k].ao[i].marker = INHERIT_MV;
+ full_object.pp[k].ao[i].type = LONG_CONSTANT_OT;
+ }
+
+ if (prop_number==3)
+ { int y, z, class_block_offset;
+ uchar *p;
+
+ /* Property 3 holds the address of the table of
+ instance variables, so this is the case where
+ the object had no instance variables of its own
+ but must inherit some more from the class */
+
+ if (individual_prop_table_size++ == 0)
+ { full_object.pp[k].num = 3;
+ full_object.pp[k].l = 1;
+ full_object.pp[k].ao[0].value
+ = individuals_length;
+ full_object.pp[k].ao[0].marker = INDIVPT_MV;
+ full_object.pp[k].ao[0].type = LONG_CONSTANT_OT;
+ i_m = individuals_length;
+ }
+ class_block_offset = class_prop_block[j-2]*256
+ + class_prop_block[j-1];
+
+ p = individuals_table + class_block_offset;
+ z = class_block_offset;
+ while ((p[0]!=0)||(p[1]!=0))
+ { if (module_switch)
+ backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
+ if (i_m+3+p[2] > MAX_INDIV_PROP_TABLE_SIZE)
+ memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
+ MAX_INDIV_PROP_TABLE_SIZE);
+ individuals_table[i_m++] = p[0];
+ individuals_table[i_m++] = p[1];
+ individuals_table[i_m++] = p[2];
+ for (y=0;y < p[2]/2;y++)
+ { individuals_table[i_m++] = (z+3+y*2)/256;
+ individuals_table[i_m++] = (z+3+y*2)%256;
+ backpatch_zmachine(INHERIT_INDIV_MV,
+ INDIVIDUAL_PROP_ZA, i_m-2);
+ }
+ z += p[2] + 3;
+ p += p[2] + 3;
+ }
+ individuals_length = i_m;
+ }
+ }
+ }
+ }
+
+ if (individual_prop_table_size > 0)
+ {
+ if (i_m+2 > MAX_INDIV_PROP_TABLE_SIZE)
+ memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
+ MAX_INDIV_PROP_TABLE_SIZE);
+
+ individuals_table[i_m++] = 0;
+ individuals_table[i_m++] = 0;
+ individuals_length += 2;
+ }
+}
+
+static void property_inheritance_g(void)
+{
+ /* Apply the property inheritance rules to full_object, which should
+ initially be complete (i.e., this routine takes place after the whole
+ Nearby/Object/Class definition has been parsed through).
+
+ On exit, full_object contains the final state of the properties to
+ be written. */
+
+ int i, j, k, class, num_props,
+ prop_number, prop_length, prop_flags, prop_in_current_defn;
+ int32 mark, prop_addr;
+ uchar *cpb, *pe;
+
+ ASSERT_GLULX();
+
+ for (class=0; class<no_classes_to_inherit_from; class++) {
+ mark = class_begins_at[classes_to_inherit_from[class]-1];
+ cpb = (uchar *) (properties_table + mark);
+ /* This now points to the compiled property-table for the class.
+ We'll have to go through and decompile it. (For our sins.) */
+ num_props = ReadInt32(cpb);
+ for (j=0; j<num_props; j++) {
+ pe = cpb + 4 + j*10;
+ prop_number = ReadInt16(pe);
+ pe += 2;
+ prop_length = ReadInt16(pe);
+ pe += 2;
+ prop_addr = ReadInt32(pe);
+ pe += 4;
+ prop_flags = ReadInt16(pe);
+ pe += 2;
+
+ /* So we now have property number prop_number present in the
+ property block for the class being read. Its bytes are
+ cpb[prop_addr ... prop_addr + prop_length - 1]
+ Question now is: is there already a value given in the
+ current definition under this property name? */
+
+ prop_in_current_defn = FALSE;
+
+ for (k=0; k<full_object_g.numprops; k++) {
+ if (full_object_g.props[k].num == prop_number) {
+ prop_in_current_defn = TRUE;
+ break;
+ }
+ }
+
+ if (prop_in_current_defn) {
+ if ((prop_number==1)
+ || (prop_number < INDIV_PROP_START
+ && prop_is_additive[prop_number])) {
+ /* The additive case: we accumulate the class
+ property values onto the end of the full_object
+ properties. Remember that k is still the index number
+ of the first prop-block matching our property number. */
+ int prevcont;
+ if (full_object_g.props[k].continuation == 0) {
+ full_object_g.props[k].continuation = 1;
+ prevcont = 1;
+ }
+ else {
+ prevcont = full_object_g.props[k].continuation;
+ for (k++; k<full_object_g.numprops; k++) {
+ if (full_object_g.props[k].num == prop_number) {
+ prevcont = full_object_g.props[k].continuation;
+ }
+ }
+ }
+ k = full_object_g.numprops++;
+ full_object_g.props[k].num = prop_number;
+ full_object_g.props[k].flags = 0;
+ full_object_g.props[k].datastart = full_object_g.propdatasize;
+ full_object_g.props[k].continuation = prevcont+1;
+ full_object_g.props[k].datalen = prop_length;
+ if (full_object_g.propdatasize + prop_length
+ > MAX_OBJ_PROP_TABLE_SIZE) {
+ memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
+ }
+
+ for (i=0; i<prop_length; i++) {
+ int ppos = full_object_g.propdatasize++;
+ full_object_g.propdata[ppos].value = prop_addr + 4*i;
+ full_object_g.propdata[ppos].marker = INHERIT_MV;
+ full_object_g.propdata[ppos].type = CONSTANT_OT;
+ }
+ }
+ else {
+ /* The ordinary case: the full_object_g property
+ values simply overrides the class definition,
+ so we skip over the values in the class table. */
+ }
+ }
+ else {
+ /* The case where the class defined a property which wasn't
+ defined at all in full_object_g: we copy out the data into
+ a new property added to full_object_g. */
+ k = full_object_g.numprops++;
+ full_object_g.props[k].num = prop_number;
+ full_object_g.props[k].flags = prop_flags;
+ full_object_g.props[k].datastart = full_object_g.propdatasize;
+ full_object_g.props[k].continuation = 0;
+ full_object_g.props[k].datalen = prop_length;
+ if (full_object_g.propdatasize + prop_length
+ > MAX_OBJ_PROP_TABLE_SIZE) {
+ memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
+ }
+
+ for (i=0; i<prop_length; i++) {
+ int ppos = full_object_g.propdatasize++;
+ full_object_g.propdata[ppos].value = prop_addr + 4*i;
+ full_object_g.propdata[ppos].marker = INHERIT_MV;
+ full_object_g.propdata[ppos].type = CONSTANT_OT;
+ }
+ }
+
+ if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
+ memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
+ }
+ }
+ }
+
+}
+
+/* ------------------------------------------------------------------------- */
+/* Construction of Z-machine-format property blocks. */
+/* ------------------------------------------------------------------------- */
+
+static int write_properties_between(uchar *p, int mark, int from, int to)
+{ int j, k, prop_number, prop_length;
+ /* Note that p is properties_table. */
+ for (prop_number=to; prop_number>=from; prop_number--)
+ { for (j=0; j<full_object.l; j++)
+ { if ((full_object.pp[j].num == prop_number)
+ && (full_object.pp[j].l != 100))
+ { prop_length = 2*full_object.pp[j].l;
+ if (mark+2+prop_length >= MAX_PROP_TABLE_SIZE)
+ memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+ if (version_number == 3)
+ p[mark++] = prop_number + (prop_length - 1)*32;
+ else
+ { switch(prop_length)
+ { case 1:
+ p[mark++] = prop_number; break;
+ case 2:
+ p[mark++] = prop_number + 0x40; break;
+ default:
+ p[mark++] = prop_number + 0x80;
+ p[mark++] = prop_length + 0x80; break;
+ }
+ }
+
+ for (k=0; k<full_object.pp[j].l; k++)
+ { if (full_object.pp[j].ao[k].marker != 0)
+ backpatch_zmachine(full_object.pp[j].ao[k].marker,
+ PROP_ZA, mark);
+ p[mark++] = full_object.pp[j].ao[k].value/256;
+ p[mark++] = full_object.pp[j].ao[k].value%256;
+ }
+ }
+ }
+ }
+
+ p[mark++]=0;
+ return(mark);
+}
+
+static int write_property_block_z(char *shortname)
+{
+ /* Compile the (now complete) full_object properties into a
+ property-table block at "p" in Inform's memory.
+ "shortname" is the object's short name, if specified; otherwise
+ NULL.
+
+ Return the number of bytes written to the block. */
+
+ int32 mark = properties_table_size, i;
+ uchar *p = (uchar *) properties_table;
+
+ /* printf("Object at %04x\n", mark); */
+
+ if (shortname != NULL)
+ { uchar *tmp;
+ if (mark+1+510 >= MAX_PROP_TABLE_SIZE)
+ memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+ tmp = translate_text(p+mark+1,p+mark+1+510,shortname);
+ if (!tmp) error ("Short name of object exceeded 765 Z-characters");
+ i = subtract_pointers(tmp,(p+mark+1));
+ p[mark] = i/2;
+ mark += i+1;
+ }
+ if (current_defn_is_class)
+ { mark = write_properties_between(p,mark,3,3);
+ for (i=0;i<6;i++)
+ p[mark++] = full_object.atts[i];
+ class_begins_at[no_classes++] = mark;
+ }
+
+ mark = write_properties_between(p, mark, 1, (version_number==3)?31:63);
+
+ i = mark - properties_table_size;
+ properties_table_size = mark;
+
+ return(i);
+}
+
+static int gpropsort(void *ptr1, void *ptr2)
+{
+ propg *prop1 = ptr1;
+ propg *prop2 = ptr2;
+
+ if (prop2->num == -1)
+ return -1;
+ if (prop1->num == -1)
+ return 1;
+ if (prop1->num < prop2->num)
+ return -1;
+ if (prop1->num > prop2->num)
+ return 1;
+
+ return (prop1->continuation - prop2->continuation);
+}
+
+static int32 write_property_block_g(void)
+{
+ /* Compile the (now complete) full_object properties into a
+ property-table block at "p" in Inform's memory.
+ Return the number of bytes written to the block.
+ In Glulx, the shortname property isn't used here; it's already
+ been compiled into an ordinary string. */
+
+ int32 i;
+ int ix, jx, kx, totalprops;
+ int32 mark = properties_table_size;
+ int32 datamark;
+ uchar *p = (uchar *) properties_table;
+
+ if (current_defn_is_class) {
+ for (i=0;i<NUM_ATTR_BYTES;i++)
+ p[mark++] = full_object_g.atts[i];
+ class_begins_at[no_classes++] = mark;
+ }
+
+ qsort(full_object_g.props, full_object_g.numprops, sizeof(propg),
+ (int (*)(const void *, const void *))(&gpropsort));
+
+ full_object_g.finalpropaddr = mark;
+
+ totalprops = 0;
+
+ for (ix=0; ix<full_object_g.numprops; ix=jx) {
+ int propnum = full_object_g.props[ix].num;
+ if (propnum == -1)
+ break;
+ for (jx=ix;
+ jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
+ jx++);
+ totalprops++;
+ }
+
+ /* Write out the number of properties in this table. */
+ if (mark+4 >= MAX_PROP_TABLE_SIZE)
+ memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+ WriteInt32(p+mark, totalprops);
+ mark += 4;
+
+ datamark = mark + 10*totalprops;
+
+ for (ix=0; ix<full_object_g.numprops; ix=jx) {
+ int propnum = full_object_g.props[ix].num;
+ int flags = full_object_g.props[ix].flags;
+ int totallen = 0;
+ int32 datamarkstart = datamark;
+ if (propnum == -1)
+ break;
+ for (jx=ix;
+ jx<full_object_g.numprops && full_object_g.props[jx].num == propnum;
+ jx++) {
+ int32 datastart = full_object_g.props[jx].datastart;
+ if (datamark+4*full_object_g.props[jx].datalen >= MAX_PROP_TABLE_SIZE)
+ memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+ for (kx=0; kx<full_object_g.props[jx].datalen; kx++) {
+ int32 val = full_object_g.propdata[datastart+kx].value;
+ WriteInt32(p+datamark, val);
+ if (full_object_g.propdata[datastart+kx].marker != 0)
+ backpatch_zmachine(full_object_g.propdata[datastart+kx].marker,
+ PROP_ZA, datamark);
+ totallen++;
+ datamark += 4;
+ }
+ }
+ if (mark+10 >= MAX_PROP_TABLE_SIZE)
+ memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+ WriteInt16(p+mark, propnum);
+ mark += 2;
+ WriteInt16(p+mark, totallen);
+ mark += 2;
+ WriteInt32(p+mark, datamarkstart);
+ mark += 4;
+ WriteInt16(p+mark, flags);
+ mark += 2;
+ }
+
+ mark = datamark;
+
+ i = mark - properties_table_size;
+ properties_table_size = mark;
+ return i;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The final stage in Nearby/Object/Class definition processing. */
+/* ------------------------------------------------------------------------- */
+
+static void manufacture_object_z(void)
+{ int i, j;
+
+ segment_markers.enabled = FALSE;
+ directives.enabled = TRUE;
+
+ property_inheritance_z();
+
+ objectsz[no_objects].parent = parent_of_this_obj;
+ objectsz[no_objects].next = 0;
+ objectsz[no_objects].child = 0;
+
+ if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fff))
+ { i = objectsz[parent_of_this_obj-1].child;
+ if (i == 0)
+ objectsz[parent_of_this_obj-1].child = no_objects + 1;
+ else
+ { while(objectsz[i-1].next != 0) i = objectsz[i-1].next;
+ objectsz[i-1].next = no_objects+1;
+ }
+ }
+
+ /* The properties table consists simply of a sequence of property
+ blocks, one for each object in order of definition, exactly as
+ it will appear in the final Z-machine. */
+
+ j = write_property_block_z(shortname_buffer);
+
+ objectsz[no_objects].propsize = j;
+ if (properties_table_size >= MAX_PROP_TABLE_SIZE)
+ memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+
+ if (current_defn_is_class)
+ for (i=0;i<6;i++) objectsz[no_objects].atts[i] = 0;
+ else
+ for (i=0;i<6;i++)
+ objectsz[no_objects].atts[i] = full_object.atts[i];
+
+ no_objects++;
+}
+
+static void manufacture_object_g(void)
+{ int32 i, j;
+
+ segment_markers.enabled = FALSE;
+ directives.enabled = TRUE;
+
+ property_inheritance_g();
+
+ objectsg[no_objects].parent = parent_of_this_obj;
+ objectsg[no_objects].next = 0;
+ objectsg[no_objects].child = 0;
+
+ if ((parent_of_this_obj > 0) && (parent_of_this_obj != 0x7fffffff))
+ { i = objectsg[parent_of_this_obj-1].child;
+ if (i == 0)
+ objectsg[parent_of_this_obj-1].child = no_objects + 1;
+ else
+ { while(objectsg[i-1].next != 0) i = objectsg[i-1].next;
+ objectsg[i-1].next = no_objects+1;
+ }
+ }
+
+ objectsg[no_objects].shortname = compile_string(shortname_buffer,
+ FALSE, FALSE);
+
+ /* The properties table consists simply of a sequence of property
+ blocks, one for each object in order of definition, exactly as
+ it will appear in the final machine image. */
+
+ j = write_property_block_g();
+
+ objectsg[no_objects].propaddr = full_object_g.finalpropaddr;
+
+ objectsg[no_objects].propsize = j;
+ if (properties_table_size >= MAX_PROP_TABLE_SIZE)
+ memoryerror("MAX_PROP_TABLE_SIZE",MAX_PROP_TABLE_SIZE);
+
+ if (current_defn_is_class)
+ for (i=0;i<NUM_ATTR_BYTES;i++)
+ objectatts[no_objects*NUM_ATTR_BYTES+i] = 0;
+ else
+ for (i=0;i<NUM_ATTR_BYTES;i++)
+ objectatts[no_objects*NUM_ATTR_BYTES+i] = full_object_g.atts[i];
+
+ no_objects++;
+}
+
+
+/* ========================================================================= */
+/* [2] The Object/Nearby/Class directives parser: translating the syntax */
+/* into object specifications and then triggering off the above. */
+/* ========================================================================= */
+/* Properties ("with" or "private") segment. */
+/* ------------------------------------------------------------------------- */
+
+static int *defined_this_segment;
+static long defined_this_segment_size; /* calloc size */
+static int def_t_s;
+
+static void ensure_defined_this_segment(int newsize)
+{
+ int oldsize = defined_this_segment_size;
+ defined_this_segment_size = newsize;
+ my_recalloc(&defined_this_segment, sizeof(int), oldsize,
+ defined_this_segment_size, "defined this segment table");
+}
+
+static void properties_segment_z(int this_segment)
+{
+ /* Parse through the "with" part of an object/class definition:
+
+ <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
+
+ This routine also handles "private", with this_segment being equal
+ to the token value for the introductory word ("private" or "with"). */
+
+
+ int i, property_name_symbol, property_number=0, next_prop=0, length,
+ individual_property, this_identifier_number;
+
+ do
+ { get_next_token_with_directives();
+ if ((token_type == SEGMENT_MARKER_TT)
+ || (token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { put_token_back(); return;
+ }
+
+ if (token_type != SYMBOL_TT)
+ { ebf_error("property name", token_text);
+ return;
+ }
+
+ individual_property = (stypes[token_value] != PROPERTY_T);
+
+ if (individual_property)
+ { if (sflags[token_value] & UNKNOWN_SFLAG)
+ { this_identifier_number = no_individual_properties++;
+ assign_symbol(token_value, this_identifier_number,
+ INDIVIDUAL_PROPERTY_T);
+
+ if (debugfile_switch)
+ { debug_file_printf("<property>");
+ debug_file_printf
+ ("<identifier>%s</identifier>", token_text);
+ debug_file_printf
+ ("<value>%d</value>", this_identifier_number);
+ debug_file_printf("</property>");
+ }
+
+ }
+ else
+ { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
+ this_identifier_number = svals[token_value];
+ else
+ { char already_error[128];
+ sprintf(already_error,
+ "\"%s\" is a name already in use (with type %s) \
+and may not be used as a property name too",
+ token_text, typename(stypes[token_value]));
+ error(already_error);
+ return;
+ }
+ }
+
+ if (def_t_s >= defined_this_segment_size)
+ ensure_defined_this_segment(def_t_s*2);
+ defined_this_segment[def_t_s++] = token_value;
+
+ if (individual_prop_table_size++ == 0)
+ { full_object.pp[full_object.l].num = 3;
+ full_object.pp[full_object.l].l = 1;
+ full_object.pp[full_object.l].ao[0].value
+ = individuals_length;
+ full_object.pp[full_object.l].ao[0].type = LONG_CONSTANT_OT;
+ full_object.pp[full_object.l].ao[0].marker = INDIVPT_MV;
+
+ i_m = individuals_length;
+ full_object.l++;
+ }
+ individuals_table[i_m] = this_identifier_number/256;
+ if (this_segment == PRIVATE_SEGMENT)
+ individuals_table[i_m] |= 0x80;
+ individuals_table[i_m+1] = this_identifier_number%256;
+ if (module_switch)
+ backpatch_zmachine(IDENT_MV, INDIVIDUAL_PROP_ZA, i_m);
+ individuals_table[i_m+2] = 0;
+ }
+ else
+ { if (sflags[token_value] & UNKNOWN_SFLAG)
+ { error_named("No such property name as", token_text);
+ return;
+ }
+ if (this_segment == PRIVATE_SEGMENT)
+ error_named("Property should be declared in 'with', \
+not 'private':", token_text);
+ if (def_t_s >= defined_this_segment_size)
+ ensure_defined_this_segment(def_t_s*2);
+ defined_this_segment[def_t_s++] = token_value;
+ property_number = svals[token_value];
+
+ next_prop=full_object.l++;
+ full_object.pp[next_prop].num = property_number;
+ }
+
+ for (i=0; i<(def_t_s-1); i++)
+ if (defined_this_segment[i] == token_value)
+ { error_named("Property given twice in the same declaration:",
+ (char *) symbs[token_value]);
+ }
+ else
+ if (svals[defined_this_segment[i]] == svals[token_value])
+ { char error_b[128];
+ sprintf(error_b,
+ "Property given twice in the same declaration, because \
+the names '%s' and '%s' actually refer to the same property",
+ (char *) symbs[defined_this_segment[i]],
+ (char *) symbs[token_value]);
+ error(error_b);
+ }
+
+ property_name_symbol = token_value;
+ sflags[token_value] |= USED_SFLAG;
+
+ length=0;
+ do
+ { assembly_operand AO;
+ get_next_token_with_directives();
+ if ((token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
+ break;
+
+ if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
+
+ if ((!individual_property) && (property_number==1)
+ && ((token_type != SQ_TT) || (strlen(token_text) <2 ))
+ && (token_type != DQ_TT)
+ )
+ warning ("'name' property should only contain dictionary words");
+
+ if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
+ { char embedded_name[80];
+ if (current_defn_is_class)
+ { sprintf(embedded_name,
+ "%s::%s", classname_text,
+ (char *) symbs[property_name_symbol]);
+ }
+ else
+ { sprintf(embedded_name,
+ "%s.%s", objectname_text,
+ (char *) symbs[property_name_symbol]);
+ }
+ AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
+ AO.type = LONG_CONSTANT_OT;
+ AO.marker = IROUTINE_MV;
+
+ directives.enabled = FALSE;
+ segment_markers.enabled = TRUE;
+
+ statements.enabled = FALSE;
+ misc_keywords.enabled = FALSE;
+ local_variables.enabled = FALSE;
+ system_functions.enabled = FALSE;
+ conditions.enabled = FALSE;
+ }
+ else
+
+ /* A special rule applies to values in double-quotes of the
+ built-in property "name", which always has number 1: such
+ property values are dictionary entries and not static
+ strings */
+
+ if ((!individual_property) &&
+ (property_number==1) && (token_type == DQ_TT))
+ { AO.value = dictionary_add(token_text, 0x80, 0, 0);
+ AO.type = LONG_CONSTANT_OT;
+ AO.marker = DWORD_MV;
+ }
+ else
+ { if (length!=0)
+ {
+ if ((token_type == SYMBOL_TT)
+ && (stypes[token_value]==PROPERTY_T))
+ {
+ /* This is not necessarily an error: it's possible
+ to imagine a property whose value is a list
+ of other properties to look up, but far more
+ likely that a comma has been omitted in between
+ two property blocks */
+
+ warning_named(
+ "Missing ','? Property data seems to contain the property name",
+ token_text);
+ }
+ }
+
+ /* An ordinary value, then: */
+
+ put_token_back();
+ AO = parse_expression(ARRAY_CONTEXT);
+ }
+
+ if (length == 64)
+ { error_named("Limit (of 32 values) exceeded for property",
+ (char *) symbs[property_name_symbol]);
+ break;
+ }
+
+ if (individual_property)
+ { if (AO.marker != 0)
+ backpatch_zmachine(AO.marker, INDIVIDUAL_PROP_ZA,
+ i_m+3+length);
+ individuals_table[i_m+3+length++] = AO.value/256;
+ individuals_table[i_m+3+length++] = AO.value%256;
+ }
+ else
+ { full_object.pp[next_prop].ao[length/2] = AO;
+ length = length + 2;
+ }
+
+ } while (TRUE);
+
+ /* People rarely do, but it is legal to declare a property without
+ a value at all:
+
+ with name "fish", number, time_left;
+
+ in which case the properties "number" and "time_left" are
+ created as in effect variables and initialised to zero. */
+
+ if (length == 0)
+ { if (individual_property)
+ { individuals_table[i_m+3+length++] = 0;
+ individuals_table[i_m+3+length++] = 0;
+ }
+ else
+ { full_object.pp[next_prop].ao[0].value = 0;
+ full_object.pp[next_prop].ao[0].type = LONG_CONSTANT_OT;
+ full_object.pp[next_prop].ao[0].marker = 0;
+ length = 2;
+ }
+ }
+
+ 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",
+ (char *) symbs[property_name_symbol]);
+ full_object.pp[next_prop].l=4;
+ }
+ }
+
+ if (individual_property)
+ {
+ if (individuals_length+length+3 > MAX_INDIV_PROP_TABLE_SIZE)
+ memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
+ MAX_INDIV_PROP_TABLE_SIZE);
+ individuals_table[i_m + 2] = length;
+ individuals_length += length+3;
+ i_m = individuals_length;
+ }
+ else
+ full_object.pp[next_prop].l = length/2;
+
+ if ((token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { put_token_back(); return;
+ }
+
+ } while (TRUE);
+}
+
+
+static void properties_segment_g(int this_segment)
+{
+ /* Parse through the "with" part of an object/class definition:
+
+ <prop-1> <values...>, <prop-2> <values...>, ..., <prop-n> <values...>
+
+ This routine also handles "private", with this_segment being equal
+ to the token value for the introductory word ("private" or "with"). */
+
+
+ int i, next_prop,
+ individual_property, this_identifier_number;
+ int32 property_name_symbol, property_number, length;
+
+ do
+ { get_next_token_with_directives();
+ if ((token_type == SEGMENT_MARKER_TT)
+ || (token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { put_token_back(); return;
+ }
+
+ if (token_type != SYMBOL_TT)
+ { ebf_error("property name", token_text);
+ return;
+ }
+
+ individual_property = (stypes[token_value] != PROPERTY_T);
+
+ if (individual_property)
+ { if (sflags[token_value] & UNKNOWN_SFLAG)
+ { this_identifier_number = no_individual_properties++;
+ assign_symbol(token_value, this_identifier_number,
+ INDIVIDUAL_PROPERTY_T);
+
+ if (debugfile_switch)
+ { debug_file_printf("<property>");
+ debug_file_printf
+ ("<identifier>%s</identifier>", token_text);
+ debug_file_printf
+ ("<value>%d</value>", this_identifier_number);
+ debug_file_printf("</property>");
+ }
+
+ }
+ else
+ { if (stypes[token_value]==INDIVIDUAL_PROPERTY_T)
+ this_identifier_number = svals[token_value];
+ else
+ { char already_error[128];
+ sprintf(already_error,
+ "\"%s\" is a name already in use (with type %s) \
+and may not be used as a property name too",
+ token_text, typename(stypes[token_value]));
+ error(already_error);
+ return;
+ }
+ }
+
+ if (def_t_s >= defined_this_segment_size)
+ ensure_defined_this_segment(def_t_s*2);
+ defined_this_segment[def_t_s++] = token_value;
+ property_number = svals[token_value];
+
+ next_prop=full_object_g.numprops++;
+ full_object_g.props[next_prop].num = property_number;
+ full_object_g.props[next_prop].flags =
+ ((this_segment == PRIVATE_SEGMENT) ? 1 : 0);
+ full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
+ full_object_g.props[next_prop].continuation = 0;
+ full_object_g.props[next_prop].datalen = 0;
+ }
+ else
+ { if (sflags[token_value] & UNKNOWN_SFLAG)
+ { error_named("No such property name as", token_text);
+ return;
+ }
+ if (this_segment == PRIVATE_SEGMENT)
+ error_named("Property should be declared in 'with', \
+not 'private':", token_text);
+
+ if (def_t_s >= defined_this_segment_size)
+ ensure_defined_this_segment(def_t_s*2);
+ defined_this_segment[def_t_s++] = token_value;
+ property_number = svals[token_value];
+
+ next_prop=full_object_g.numprops++;
+ full_object_g.props[next_prop].num = property_number;
+ full_object_g.props[next_prop].flags = 0;
+ full_object_g.props[next_prop].datastart = full_object_g.propdatasize;
+ full_object_g.props[next_prop].continuation = 0;
+ full_object_g.props[next_prop].datalen = 0;
+ }
+
+ for (i=0; i<(def_t_s-1); i++)
+ if (defined_this_segment[i] == token_value)
+ { error_named("Property given twice in the same declaration:",
+ (char *) symbs[token_value]);
+ }
+ else
+ if (svals[defined_this_segment[i]] == svals[token_value])
+ { char error_b[128];
+ sprintf(error_b,
+ "Property given twice in the same declaration, because \
+the names '%s' and '%s' actually refer to the same property",
+ (char *) symbs[defined_this_segment[i]],
+ (char *) symbs[token_value]);
+ error(error_b);
+ }
+
+ if (full_object_g.numprops == MAX_OBJ_PROP_COUNT) {
+ memoryerror("MAX_OBJ_PROP_COUNT",MAX_OBJ_PROP_COUNT);
+ }
+
+ property_name_symbol = token_value;
+ sflags[token_value] |= USED_SFLAG;
+
+ length=0;
+ do
+ { assembly_operand AO;
+ get_next_token_with_directives();
+ if ((token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ || ((token_type == SEP_TT) && (token_value == COMMA_SEP)))
+ break;
+
+ if (token_type == SEGMENT_MARKER_TT) { put_token_back(); break; }
+
+ if ((!individual_property) && (property_number==1)
+ && (token_type != SQ_TT) && (token_type != DQ_TT)
+ )
+ warning ("'name' property should only contain dictionary words");
+
+ if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
+ { char embedded_name[80];
+ if (current_defn_is_class)
+ { sprintf(embedded_name,
+ "%s::%s", classname_text,
+ (char *) symbs[property_name_symbol]);
+ }
+ else
+ { sprintf(embedded_name,
+ "%s.%s", objectname_text,
+ (char *) symbs[property_name_symbol]);
+ }
+ AO.value = parse_routine(NULL, TRUE, embedded_name, FALSE, -1);
+ AO.type = CONSTANT_OT;
+ AO.marker = IROUTINE_MV;
+
+ directives.enabled = FALSE;
+ segment_markers.enabled = TRUE;
+
+ statements.enabled = FALSE;
+ misc_keywords.enabled = FALSE;
+ local_variables.enabled = FALSE;
+ system_functions.enabled = FALSE;
+ conditions.enabled = FALSE;
+ }
+ else
+
+ /* A special rule applies to values in double-quotes of the
+ built-in property "name", which always has number 1: such
+ property values are dictionary entries and not static
+ strings */
+
+ if ((!individual_property) &&
+ (property_number==1) && (token_type == DQ_TT))
+ { AO.value = dictionary_add(token_text, 0x80, 0, 0);
+ AO.type = CONSTANT_OT;
+ AO.marker = DWORD_MV;
+ }
+ else
+ { if (length!=0)
+ {
+ if ((token_type == SYMBOL_TT)
+ && (stypes[token_value]==PROPERTY_T))
+ {
+ /* This is not necessarily an error: it's possible
+ to imagine a property whose value is a list
+ of other properties to look up, but far more
+ likely that a comma has been omitted in between
+ two property blocks */
+
+ warning_named(
+ "Missing ','? Property data seems to contain the property name",
+ token_text);
+ }
+ }
+
+ /* An ordinary value, then: */
+
+ put_token_back();
+ AO = parse_expression(ARRAY_CONTEXT);
+ }
+
+ if (length == 32768) /* VENEER_CONSTRAINT_ON_PROP_TABLE_SIZE? */
+ { error_named("Limit (of 32768 values) exceeded for property",
+ (char *) symbs[property_name_symbol]);
+ break;
+ }
+
+ if (full_object_g.propdatasize >= MAX_OBJ_PROP_TABLE_SIZE) {
+ memoryerror("MAX_OBJ_PROP_TABLE_SIZE",MAX_OBJ_PROP_TABLE_SIZE);
+ }
+
+ full_object_g.propdata[full_object_g.propdatasize++] = AO;
+ length += 1;
+
+ } while (TRUE);
+
+ /* People rarely do, but it is legal to declare a property without
+ a value at all:
+
+ with name "fish", number, time_left;
+
+ in which case the properties "number" and "time_left" are
+ created as in effect variables and initialised to zero. */
+
+ if (length == 0)
+ {
+ assembly_operand AO;
+ AO.value = 0;
+ AO.type = CONSTANT_OT;
+ AO.marker = 0;
+ full_object_g.propdata[full_object_g.propdatasize++] = AO;
+ length += 1;
+ }
+
+ full_object_g.props[next_prop].datalen = length;
+
+ if ((token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { put_token_back(); return;
+ }
+
+ } while (TRUE);
+}
+
+static void properties_segment(int this_segment)
+{
+ if (!glulx_mode)
+ properties_segment_z(this_segment);
+ else
+ properties_segment_g(this_segment);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Attributes ("has") segment. */
+/* ------------------------------------------------------------------------- */
+
+static void attributes_segment(void)
+{
+ /* Parse through the "has" part of an object/class definition:
+
+ [~]<attribute-1> [~]<attribute-2> ... [~]<attribute-n> */
+
+ int attribute_number, truth_state, bitmask;
+ uchar *attrbyte;
+ do
+ { truth_state = TRUE;
+
+ ParseAttrN:
+
+ get_next_token_with_directives();
+ if ((token_type == SEGMENT_MARKER_TT)
+ || (token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { if (!truth_state)
+ ebf_error("attribute name after '~'", token_text);
+ put_token_back(); return;
+ }
+ if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
+
+ if ((token_type == SEP_TT) && (token_value == ARTNOT_SEP))
+ { truth_state = !truth_state; goto ParseAttrN;
+ }
+
+ if ((token_type != SYMBOL_TT)
+ || (stypes[token_value] != ATTRIBUTE_T))
+ { ebf_error("name of an already-declared attribute", token_text);
+ return;
+ }
+
+ attribute_number = svals[token_value];
+ sflags[token_value] |= USED_SFLAG;
+
+ if (!glulx_mode) {
+ bitmask = (1 << (7-attribute_number%8));
+ attrbyte = &(full_object.atts[attribute_number/8]);
+ }
+ else {
+ /* In Glulx, my prejudices rule, and therefore bits are numbered
+ from least to most significant. This is the opposite of the
+ way the Z-machine works. */
+ bitmask = (1 << (attribute_number%8));
+ attrbyte = &(full_object_g.atts[attribute_number/8]);
+ }
+
+ if (truth_state)
+ *attrbyte |= bitmask; /* Set attribute bit */
+ else
+ *attrbyte &= ~bitmask; /* Clear attribute bit */
+
+ } while (TRUE);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Classes ("class") segment. */
+/* ------------------------------------------------------------------------- */
+
+static void add_class_to_inheritance_list(int class_number)
+{
+ int i;
+
+ /* The class number is actually the class's object number, which needs
+ to be translated into its actual class number: */
+
+ for (i=0;i<no_classes;i++)
+ if (class_number == class_object_numbers[i])
+ { class_number = i+1;
+ break;
+ }
+
+ /* Remember the inheritance list so that property inheritance can
+ be sorted out later on, when the definition has been finished: */
+
+ classes_to_inherit_from[no_classes_to_inherit_from++] = class_number;
+
+ /* Inheriting attributes from the class at once: */
+
+ if (!glulx_mode) {
+ for (i=0; i<6; i++)
+ full_object.atts[i]
+ |= properties_table[class_begins_at[class_number-1] - 6 + i];
+ }
+ else {
+ for (i=0; i<NUM_ATTR_BYTES; i++)
+ full_object_g.atts[i]
+ |= properties_table[class_begins_at[class_number-1]
+ - NUM_ATTR_BYTES + i];
+ }
+}
+
+static void classes_segment(void)
+{
+ /* Parse through the "class" part of an object/class definition:
+
+ <class-1> ... <class-n> */
+
+ do
+ { get_next_token_with_directives();
+ if ((token_type == SEGMENT_MARKER_TT)
+ || (token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { put_token_back(); return;
+ }
+ if ((token_type == SEP_TT) && (token_value == COMMA_SEP)) return;
+
+ if ((token_type != SYMBOL_TT)
+ || (stypes[token_value] != CLASS_T))
+ { ebf_error("name of an already-declared class", token_text);
+ return;
+ }
+
+ sflags[token_value] |= USED_SFLAG;
+ add_class_to_inheritance_list(svals[token_value]);
+ } while (TRUE);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Parse the body of a Nearby/Object/Class definition. */
+/* ------------------------------------------------------------------------- */
+
+static void parse_body_of_definition(void)
+{ int commas_in_row;
+
+ def_t_s = 0;
+
+ do
+ { commas_in_row = -1;
+ do
+ { get_next_token_with_directives(); commas_in_row++;
+ } while ((token_type == SEP_TT) && (token_value == COMMA_SEP));
+
+ if (commas_in_row>1)
+ error("Two commas ',' in a row in object/class definition");
+
+ if ((token_type == EOF_TT)
+ || ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ { if (commas_in_row > 0)
+ error("Object/class definition finishes with ','");
+ if (token_type == EOF_TT)
+ error("Object/class definition incomplete (no ';') at end of file");
+ break;
+ }
+
+ if (token_type != SEGMENT_MARKER_TT)
+ { error_named("Expected 'with', 'has' or 'class' in \
+object/class definition but found", token_text);
+ break;
+ }
+ else
+ switch(token_value)
+ { case WITH_SEGMENT:
+ properties_segment(WITH_SEGMENT);
+ break;
+ case PRIVATE_SEGMENT:
+ properties_segment(PRIVATE_SEGMENT);
+ break;
+ case HAS_SEGMENT:
+ attributes_segment();
+ break;
+ case CLASS_SEGMENT:
+ classes_segment();
+ break;
+ }
+
+ } while (TRUE);
+
+}
+
+/* ------------------------------------------------------------------------- */
+/* Class directives: */
+/* */
+/* Class <name> <body of definition> */
+/* ------------------------------------------------------------------------- */
+
+static void initialise_full_object(void)
+{
+ int i;
+ if (!glulx_mode) {
+ full_object.l = 0;
+ full_object.atts[0] = 0;
+ full_object.atts[1] = 0;
+ full_object.atts[2] = 0;
+ full_object.atts[3] = 0;
+ full_object.atts[4] = 0;
+ full_object.atts[5] = 0;
+ }
+ else {
+ full_object_g.numprops = 0;
+ full_object_g.propdatasize = 0;
+ for (i=0; i<NUM_ATTR_BYTES; i++)
+ full_object_g.atts[i] = 0;
+ }
+}
+
+extern void make_class(char * metaclass_name)
+{ int n, duplicates_to_make = 0, class_number = no_objects+1,
+ metaclass_flag = (metaclass_name != NULL);
+ char duplicate_name[128];
+ int class_symbol;
+ debug_location_beginning beginning_debug_location =
+ get_token_location_beginning();
+
+ current_defn_is_class = TRUE; no_classes_to_inherit_from = 0;
+ individual_prop_table_size = 0;
+
+ if (no_classes==MAX_CLASSES)
+ memoryerror("MAX_CLASSES", MAX_CLASSES);
+
+ if (no_classes==VENEER_CONSTRAINT_ON_CLASSES)
+ fatalerror("Inform's maximum possible number of classes (whatever \
+amount of memory is allocated) has been reached. If this causes serious \
+inconvenience, please contact the maintainers.");
+
+ directives.enabled = FALSE;
+
+ if (metaclass_flag)
+ { token_text = metaclass_name;
+ token_value = symbol_index(token_text, -1);
+ token_type = SYMBOL_TT;
+ }
+ else
+ { get_next_token();
+ if ((token_type != SYMBOL_TT)
+ || (!(sflags[token_value] & UNKNOWN_SFLAG)))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("new class name", token_text);
+ panic_mode_error_recovery();
+ return;
+ }
+ }
+
+ /* Each class also creates a modest object representing itself: */
+
+ strcpy(shortname_buffer, token_text);
+
+ assign_symbol(token_value, class_number, CLASS_T);
+ classname_text = (char *) symbs[token_value];
+
+ if (!glulx_mode) {
+ if (metaclass_flag) sflags[token_value] |= SYSTEM_SFLAG;
+ }
+ else {
+ /* In Glulx, metaclasses have to be backpatched too! So we can't
+ mark it as "system", but we should mark it "used". */
+ if (metaclass_flag) sflags[token_value] |= USED_SFLAG;
+ }
+
+ /* "Class" (object 1) has no parent, whereas all other classes are
+ the children of "Class". Since "Class" is not present in a module,
+ a special value is used which is corrected to 1 by the linker. */
+
+ if (metaclass_flag) parent_of_this_obj = 0;
+ else parent_of_this_obj = (module_switch)?MAXINTWORD:1;
+
+ class_object_numbers[no_classes] = class_number;
+
+ initialise_full_object();
+
+ /* Give the class the (nameless in Inform syntax) "inheritance" property
+ with value its own class number. (This therefore accumulates onto
+ the inheritance property of any object inheriting from the class,
+ since property 2 is always set to "additive" -- see below) */
+
+ if (!glulx_mode) {
+ full_object.l = 1;
+ full_object.pp[0].num = 2;
+ full_object.pp[0].l = 1;
+ full_object.pp[0].ao[0].value = no_objects + 1;
+ full_object.pp[0].ao[0].type = LONG_CONSTANT_OT;
+ full_object.pp[0].ao[0].marker = OBJECT_MV;
+ }
+ else {
+ full_object_g.numprops = 1;
+ full_object_g.props[0].num = 2;
+ full_object_g.props[0].flags = 0;
+ full_object_g.props[0].datastart = 0;
+ full_object_g.props[0].continuation = 0;
+ full_object_g.props[0].datalen = 1;
+ full_object_g.propdatasize = 1;
+ full_object_g.propdata[0].value = no_objects + 1;
+ full_object_g.propdata[0].type = CONSTANT_OT;
+ full_object_g.propdata[0].marker = OBJECT_MV;
+ }
+
+ class_symbol = token_value;
+
+ if (!metaclass_flag)
+ { get_next_token();
+ if ((token_type == SEP_TT) && (token_value == OPENB_SEP))
+ { assembly_operand AO;
+ AO = parse_expression(CONSTANT_CONTEXT);
+ if (AO.marker != 0)
+ { error("Duplicate-number not known at compile time");
+ n=0;
+ }
+ else
+ n = AO.value;
+ if ((n<0) || (n>10000))
+ { error("The number of duplicates must be 0 to 10000");
+ n=0;
+ }
+
+ /* Make one extra duplicate, since the veneer routines need
+ always to keep an undamaged prototype for the class in stock */
+
+ duplicates_to_make = n + 1;
+
+ match_close_bracket();
+ } else put_token_back();
+
+ /* Parse the body of the definition: */
+
+ parse_body_of_definition();
+ }
+
+ if (debugfile_switch)
+ { debug_file_printf("<class>");
+ debug_file_printf("<identifier>%s</identifier>", shortname_buffer);
+ debug_file_printf("<class-number>%d</class-number>", no_classes);
+ debug_file_printf("<value>");
+ write_debug_object_backpatch(no_objects + 1);
+ debug_file_printf("</value>");
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ debug_file_printf("</class>");
+ }
+
+ if (!glulx_mode)
+ manufacture_object_z();
+ else
+ manufacture_object_g();
+
+ if (individual_prop_table_size >= VENEER_CONSTRAINT_ON_IP_TABLE_SIZE)
+ error("This class is too complex: it now carries too many properties. \
+You may be able to get round this by declaring some of its property names as \
+\"common properties\" using the 'Property' directive.");
+
+ if (duplicates_to_make > 0)
+ { sprintf(duplicate_name, "%s_1", shortname_buffer);
+ for (n=1; (duplicates_to_make--) > 0; n++)
+ { if (n>1)
+ { int i = strlen(duplicate_name);
+ while (duplicate_name[i] != '_') i--;
+ sprintf(duplicate_name+i+1, "%d", n);
+ }
+ make_object(FALSE, duplicate_name, class_number, class_number, -1);
+ }
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Object/Nearby directives: */
+/* */
+/* Object <name-1> ... <name-n> "short name" [parent] <body of def> */
+/* */
+/* Nearby <name-1> ... <name-n> "short name" <body of definition> */
+/* ------------------------------------------------------------------------- */
+
+static int end_of_header(void)
+{ if (((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ || ((token_type == SEP_TT) && (token_value == COMMA_SEP))
+ || (token_type == SEGMENT_MARKER_TT)) return TRUE;
+ return FALSE;
+}
+
+extern void make_object(int nearby_flag,
+ char *textual_name, int specified_parent, int specified_class,
+ int instance_of)
+{
+ /* Ordinarily this is called with nearby_flag TRUE for "Nearby",
+ FALSE for "Object"; and textual_name NULL, specified_parent and
+ specified_class both -1. The next three arguments are used when
+ the routine is called for class duplicates manufacture (see above).
+ The last is used to create instances of a particular class. */
+
+ int i, tree_depth, internal_name_symbol = 0;
+ char internal_name[64];
+ debug_location_beginning beginning_debug_location =
+ get_token_location_beginning();
+
+ directives.enabled = FALSE;
+
+ if (no_objects==MAX_OBJECTS) memoryerror("MAX_OBJECTS", MAX_OBJECTS);
+
+ sprintf(internal_name, "nameless_obj__%d", no_objects+1);
+ objectname_text = internal_name;
+
+ current_defn_is_class = FALSE;
+
+ no_classes_to_inherit_from=0;
+
+ individual_prop_table_size = 0;
+
+ if (nearby_flag) tree_depth=1; else tree_depth=0;
+
+ if (specified_class != -1) goto HeaderPassed;
+
+ get_next_token();
+
+ /* Read past and count a sequence of "->"s, if any are present */
+
+ if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
+ { if (nearby_flag)
+ error("The syntax '->' is only used as an alternative to 'Nearby'");
+
+ while ((token_type == SEP_TT) && (token_value == ARROW_SEP))
+ { tree_depth++;
+ get_next_token();
+ }
+ }
+
+ sprintf(shortname_buffer, "?");
+
+ segment_markers.enabled = TRUE;
+
+ /* This first word is either an internal name, or a textual short name,
+ or the end of the header part */
+
+ if (end_of_header()) goto HeaderPassed;
+
+ if (token_type == DQ_TT) textual_name = token_text;
+ else
+ { if ((token_type != SYMBOL_TT)
+ || (!(sflags[token_value] & UNKNOWN_SFLAG)))
+ ebf_error("name for new object or its textual short name",
+ token_text);
+ else
+ { internal_name_symbol = token_value;
+ strcpy(internal_name, token_text);
+ }
+ }
+
+ /* The next word is either a parent object, or
+ a textual short name, or the end of the header part */
+
+ get_next_token_with_directives();
+ if (end_of_header()) goto HeaderPassed;
+
+ if (token_type == DQ_TT)
+ { if (textual_name != NULL)
+ error("Two textual short names given for only one object");
+ else
+ textual_name = token_text;
+ }
+ else
+ { if ((token_type != SYMBOL_TT)
+ || (sflags[token_value] & UNKNOWN_SFLAG))
+ { if (textual_name == NULL)
+ ebf_error("parent object or the object's textual short name",
+ token_text);
+ else
+ ebf_error("parent object", token_text);
+ }
+ else goto SpecParent;
+ }
+
+ /* Finally, it's possible that there is still a parent object */
+
+ get_next_token();
+ if (end_of_header()) goto HeaderPassed;
+
+ if (specified_parent != -1)
+ ebf_error("body of object definition", token_text);
+ else
+ { SpecParent:
+ if ((stypes[token_value] == OBJECT_T)
+ || (stypes[token_value] == CLASS_T))
+ { specified_parent = svals[token_value];
+ sflags[token_value] |= USED_SFLAG;
+ }
+ else ebf_error("name of (the parent) object", token_text);
+ }
+
+ /* Now it really has to be the body of the definition. */
+
+ get_next_token_with_directives();
+ if (end_of_header()) goto HeaderPassed;
+
+ ebf_error("body of object definition", token_text);
+
+ HeaderPassed:
+ if (specified_class == -1) put_token_back();
+
+ if (internal_name_symbol > 0)
+ assign_symbol(internal_name_symbol, no_objects + 1, OBJECT_T);
+
+ if (listobjects_switch)
+ printf("%3d \"%s\"\n", no_objects+1,
+ (textual_name==NULL)?"(with no short name)":textual_name);
+ if (textual_name == NULL)
+ { if (internal_name_symbol > 0)
+ sprintf(shortname_buffer, "(%s)",
+ (char *) symbs[internal_name_symbol]);
+ else
+ 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 (specified_parent != -1)
+ { if (tree_depth > 0)
+ error("Use of '->' (or 'Nearby') clashes with giving a parent");
+ parent_of_this_obj = specified_parent;
+ }
+ else
+ { parent_of_this_obj = 0;
+ if (tree_depth>0)
+ {
+ /* We have to set the parent object to the most recently defined
+ object at level (tree_depth - 1) in the tree.
+
+ A complication is that objects are numbered 1, 2, ... in the
+ Z-machine (and in the objects[].parent, etc., fields) but
+ 0, 1, 2, ... internally (and as indices to object[]). */
+
+ for (i=no_objects-1; i>=0; i--)
+ { int j = i, k = 0;
+
+ /* Metaclass or class objects cannot be '->' parents: */
+ if ((!module_switch) && (i<4))
+ continue;
+
+ if (!glulx_mode) {
+ if (objectsz[i].parent == 1)
+ continue;
+ while (objectsz[j].parent != 0)
+ { j = objectsz[j].parent - 1; k++; }
+ }
+ else {
+ if (objectsg[i].parent == 1)
+ continue;
+ while (objectsg[j].parent != 0)
+ { j = objectsg[j].parent - 1; k++; }
+ }
+
+ if (k == tree_depth - 1)
+ { parent_of_this_obj = i+1;
+ break;
+ }
+ }
+ if (parent_of_this_obj == 0)
+ { if (tree_depth == 1)
+ error("'->' (or 'Nearby') fails because there is no previous object");
+ else
+ error("'-> -> ...' fails because no previous object is deep enough");
+ }
+ }
+ }
+
+ initialise_full_object();
+ if (instance_of != -1) add_class_to_inheritance_list(instance_of);
+
+ if (specified_class == -1) parse_body_of_definition();
+ else add_class_to_inheritance_list(specified_class);
+
+ if (debugfile_switch)
+ { debug_file_printf("<object>");
+ if (internal_name_symbol > 0)
+ { debug_file_printf("<identifier>%s</identifier>", internal_name);
+ } else
+ { debug_file_printf
+ ("<identifier artificial=\"true\">%s</identifier>",
+ internal_name);
+ }
+ debug_file_printf("<value>");
+ write_debug_object_backpatch(no_objects + 1);
+ debug_file_printf("</value>");
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ debug_file_printf("</object>");
+ }
+
+ if (!glulx_mode)
+ manufacture_object_z();
+ else
+ manufacture_object_g();
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_objects_vars(void)
+{
+ properties_table = NULL;
+ prop_is_long = NULL;
+ prop_is_additive = NULL;
+ prop_default_value = NULL;
+
+ objectsz = NULL;
+ objectsg = NULL;
+ objectatts = NULL;
+ classes_to_inherit_from = NULL;
+ class_begins_at = NULL;
+}
+
+extern void objects_begin_pass(void)
+{
+ properties_table_size=0;
+ prop_is_long[1] = TRUE; prop_is_additive[1] = TRUE; /* "name" */
+ prop_is_long[2] = TRUE; prop_is_additive[2] = TRUE; /* inheritance prop */
+ if (!glulx_mode)
+ prop_is_long[3] = TRUE; prop_is_additive[3] = FALSE;
+ /* instance variables table address */
+ no_properties = 4;
+
+ if (debugfile_switch)
+ { debug_file_printf("<property>");
+ debug_file_printf
+ ("<identifier artificial=\"true\">inheritance class</identifier>");
+ debug_file_printf("<value>2</value>");
+ debug_file_printf("</property>");
+ debug_file_printf("<property>");
+ debug_file_printf
+ ("<identifier artificial=\"true\">instance variables table address "
+ "(Z-code)</identifier>");
+ debug_file_printf("<value>3</value>");
+ debug_file_printf("</property>");
+ }
+
+ if (define_INFIX_switch) no_attributes = 1;
+ else no_attributes = 0;
+
+ no_objects = 0;
+ if (!glulx_mode) {
+ objectsz[0].parent = 0; objectsz[0].child = 0; objectsz[0].next = 0;
+ no_individual_properties=72;
+ }
+ else {
+ objectsg[0].parent = 0; objectsg[0].child = 0; objectsg[0].next = 0;
+ no_individual_properties = INDIV_PROP_START+8;
+ }
+ no_classes = 0;
+
+ no_embedded_routines = 0;
+
+ individuals_length=0;
+}
+
+extern void objects_allocate_arrays(void)
+{
+ objectsz = NULL;
+ objectsg = NULL;
+ objectatts = NULL;
+
+ prop_default_value = my_calloc(sizeof(int32), INDIV_PROP_START,
+ "property default values");
+ prop_is_long = my_calloc(sizeof(int), INDIV_PROP_START,
+ "property-is-long flags");
+ prop_is_additive = my_calloc(sizeof(int), INDIV_PROP_START,
+ "property-is-additive flags");
+
+ classes_to_inherit_from = my_calloc(sizeof(int), MAX_CLASSES,
+ "inherited classes list");
+ class_begins_at = my_calloc(sizeof(int32), MAX_CLASSES,
+ "pointers to classes");
+ class_object_numbers = my_calloc(sizeof(int), MAX_CLASSES,
+ "class object numbers");
+
+ properties_table = my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
+ individuals_table = my_malloc(MAX_INDIV_PROP_TABLE_SIZE,
+ "individual properties table");
+
+ defined_this_segment_size = 128;
+ defined_this_segment = my_calloc(sizeof(int), defined_this_segment_size,
+ "defined this segment table");
+
+ if (!glulx_mode) {
+ objectsz = my_calloc(sizeof(objecttz), MAX_OBJECTS,
+ "z-objects");
+ }
+ else {
+ objectsg = my_calloc(sizeof(objecttg), MAX_OBJECTS,
+ "g-objects");
+ objectatts = my_calloc(NUM_ATTR_BYTES, MAX_OBJECTS,
+ "g-attributes");
+ full_object_g.props = my_calloc(sizeof(propg), MAX_OBJ_PROP_COUNT,
+ "object property list");
+ full_object_g.propdata = my_calloc(sizeof(assembly_operand),
+ MAX_OBJ_PROP_TABLE_SIZE,
+ "object property data table");
+ }
+}
+
+extern void objects_free_arrays(void)
+{
+ my_free(&prop_default_value, "property default values");
+ my_free(&prop_is_long, "property-is-long flags");
+ my_free(&prop_is_additive, "property-is-additive flags");
+
+ my_free(&objectsz, "z-objects");
+ my_free(&objectsg, "g-objects");
+ my_free(&objectatts, "g-attributes");
+ my_free(&class_object_numbers,"class object numbers");
+ my_free(&classes_to_inherit_from, "inherited classes list");
+ my_free(&class_begins_at, "pointers to classes");
+
+ my_free(&properties_table, "properties table");
+ my_free(&individuals_table,"individual properties table");
+
+ my_free(&defined_this_segment,"defined this segment table");
+
+ if (!glulx_mode) {
+ my_free(&full_object_g.props, "object property list");
+ my_free(&full_object_g.propdata, "object property data table");
+ }
+
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "states" : Statement translator */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+static int match_colon(void)
+{ get_next_token();
+ if (token_type == SEP_TT)
+ { if (token_value == SEMICOLON_SEP)
+ warning("Unlike C, Inform uses ':' to divide parts \
+of a 'for' loop specification: replacing ';' with ':'");
+ else
+ if (token_value != COLON_SEP)
+ { ebf_error("':'", token_text);
+ panic_mode_error_recovery();
+ return(FALSE);
+ }
+ }
+ else
+ { ebf_error("':'", token_text);
+ panic_mode_error_recovery();
+ return(FALSE);
+ }
+ return(TRUE);
+}
+
+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);
+}
+
+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);
+}
+
+static void parse_action(void)
+{ int level = 1, args = 0, codegen_action;
+ assembly_operand AO, AO2, AO3, AO4, AO5;
+
+ /* An action statement has the form <ACTION NOUN SECOND, ACTOR>
+ or <<ACTION NOUN SECOND, ACTOR>>. It simply compiles into a call
+ to R_Process() with those four arguments. (The latter form,
+ with double brackets, means "return true afterwards".)
+
+ The R_Process() function should be supplied by the library,
+ although a stub is defined in the veneer.
+
+ The NOUN, SECOND, and ACTOR arguments are optional. If not
+ supplied, R_Process() will be called with fewer arguments.
+ (But if you supply ACTOR, it must be preceded by a comma.
+ <ACTION, ACTOR> is equivalent to <ACTION 0 0, ACTOR>.)
+
+ To complicate life, the ACTION argument may be a bare action
+ name or a parenthesized expression. (So <Take> is equivalent
+ to <(##Take)>.) We have to peek at the first token, checking
+ whether it's an open-paren, to distinguish these cases.
+
+ You may ask why the ACTOR argument is last; the "natural"
+ Inform ordering would be "<floyd, take ball>". True! Sadly,
+ Inform's lexer isn't smart enough to parse this consistently,
+ so we can't do it.
+ */
+
+ dont_enter_into_symbol_table = TRUE;
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == LESS_SEP))
+ { level = 2; get_next_token();
+ }
+ dont_enter_into_symbol_table = FALSE;
+
+ /* Peek at the next token; see if it's an open-paren. */
+ if ((token_type==SEP_TT) && (token_value==OPENB_SEP))
+ { put_token_back();
+ AO2 = parse_expression(ACTION_Q_CONTEXT);
+ codegen_action = TRUE;
+ }
+ else
+ { codegen_action = FALSE;
+ AO2 = action_of_name(token_text);
+ }
+
+ get_next_token();
+ AO3 = zero_operand;
+ AO4 = zero_operand;
+ AO5 = zero_operand;
+ if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
+ { put_token_back();
+ args = 1;
+ AO3 = parse_expression(ACTION_Q_CONTEXT);
+
+ get_next_token();
+ }
+ if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
+ { put_token_back();
+ args = 2;
+ AO4 = parse_expression(QUANTITY_CONTEXT);
+ get_next_token();
+ }
+ if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
+ {
+ ebf_error("',' or '>'", token_text);
+ }
+
+ if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
+ {
+ if (!glulx_mode && (version_number < 4))
+ {
+ error("<x, y> syntax is not available in Z-code V3 or earlier");
+ }
+ args = 3;
+ AO5 = parse_expression(QUANTITY_CONTEXT);
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
+ {
+ ebf_error("'>'", token_text);
+ }
+ }
+
+ if (level == 2)
+ { get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
+ { put_token_back();
+ ebf_error("'>>'", token_text);
+ }
+ }
+
+ if (!glulx_mode) {
+
+ AO = veneer_routine(R_Process_VR);
+
+ switch(args)
+ { case 0:
+ if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ if (version_number>=5)
+ assemblez_2(call_2n_zc, AO, AO2);
+ else
+ if (version_number==4)
+ assemblez_2_to(call_vs_zc, AO, AO2, temp_var1);
+ else
+ assemblez_2_to(call_zc, AO, AO2, temp_var1);
+ break;
+ case 1:
+ AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
+ if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ if (version_number>=5)
+ assemblez_3(call_vn_zc, AO, AO2, AO3);
+ else
+ if (version_number==4)
+ assemblez_3_to(call_vs_zc, AO, AO2, AO3, temp_var1);
+ else
+ assemblez_3_to(call_zc, AO, AO2, AO3, temp_var1);
+ break;
+ case 2:
+ AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
+ AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
+ if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ if (version_number>=5)
+ assemblez_4(call_vn_zc, AO, AO2, AO3, AO4);
+ else
+ if (version_number==4)
+ assemblez_4_to(call_vs_zc, AO, AO2, AO3, AO4, temp_var1);
+ else
+ assemblez_4(call_zc, AO, AO2, AO3, AO4);
+ break;
+ case 3:
+ AO5 = code_generate(AO5, QUANTITY_CONTEXT, -1);
+ AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
+ AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
+ if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ if (version_number>=5)
+ assemblez_5(call_vn2_zc, AO, AO2, AO3, AO4, AO5);
+ else
+ if (version_number==4)
+ assemblez_5_to(call_vs2_zc, AO, AO2, AO3, AO4, AO5, temp_var1);
+ /* if V3 or earlier, we've already displayed an error */
+ break;
+ break;
+ }
+
+ if (level == 2) assemblez_0(rtrue_zc);
+
+ }
+ else {
+
+ AO = veneer_routine(R_Process_VR);
+
+ switch (args) {
+
+ case 0:
+ if (codegen_action)
+ AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ assembleg_call_1(AO, AO2, zero_operand);
+ break;
+
+ case 1:
+ AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
+ if (codegen_action)
+ AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ assembleg_call_2(AO, AO2, AO3, zero_operand);
+ break;
+
+ case 2:
+ AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
+ AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
+ if (codegen_action)
+ AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ assembleg_call_3(AO, AO2, AO3, AO4, zero_operand);
+ break;
+
+ case 3:
+ AO5 = code_generate(AO5, QUANTITY_CONTEXT, -1);
+ if (!((AO5.type == LOCALVAR_OT) && (AO5.value == 0)))
+ assembleg_store(stack_pointer, AO5);
+ AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
+ if (!((AO4.type == LOCALVAR_OT) && (AO4.value == 0)))
+ assembleg_store(stack_pointer, AO4);
+ AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
+ if (!((AO3.type == LOCALVAR_OT) && (AO3.value == 0)))
+ assembleg_store(stack_pointer, AO3);
+ if (codegen_action)
+ AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
+ if (!((AO2.type == LOCALVAR_OT) && (AO2.value == 0)))
+ assembleg_store(stack_pointer, AO2);
+ assembleg_3(call_gc, AO, four_operand, zero_operand);
+ break;
+ }
+
+ if (level == 2)
+ assembleg_1(return_gc, one_operand);
+
+ }
+}
+
+extern int parse_label(void)
+{
+ get_next_token();
+
+ if ((token_type == SYMBOL_TT) &&
+ (stypes[token_value] == LABEL_T))
+ { sflags[token_value] |= USED_SFLAG;
+ return(svals[token_value]);
+ }
+
+ if ((token_type == SYMBOL_TT) && (sflags[token_value] & UNKNOWN_SFLAG))
+ { assign_symbol(token_value, next_label, LABEL_T);
+ define_symbol_label(token_value);
+ next_label++;
+ sflags[token_value] |= CHANGE_SFLAG + USED_SFLAG;
+ return(svals[token_value]);
+ }
+
+ ebf_error("label name", token_text);
+ return 0;
+}
+
+static void parse_print_z(int finally_return)
+{ int count = 0; assembly_operand AO;
+
+ /* print <printlist> -------------------------------------------------- */
+ /* print_ret <printlist> ---------------------------------------------- */
+ /* <literal-string> --------------------------------------------------- */
+ /* */
+ /* <printlist> is a comma-separated list of items: */
+ /* */
+ /* <literal-string> */
+ /* <other-expression> */
+ /* (char) <expression> */
+ /* (address) <expression> */
+ /* (string) <expression> */
+ /* (a) <expression> */
+ /* (the) <expression> */
+ /* (The) <expression> */
+ /* (name) <expression> */
+ /* (number) <expression> */
+ /* (property) <expression> */
+ /* (<routine>) <expression> */
+ /* (object) <expression> (for use in low-level code only) */
+ /* --------------------------------------------------------------------- */
+
+ do
+ { AI.text = token_text;
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
+ switch(token_type)
+ { case DQ_TT:
+ if (strlen(token_text) > 32)
+ { INITAOT(&AO, LONG_CONSTANT_OT);
+ AO.marker = STRING_MV;
+ AO.value = compile_string(token_text, FALSE, FALSE);
+ assemblez_1(print_paddr_zc, AO);
+ if (finally_return)
+ { get_next_token();
+ if ((token_type == SEP_TT)
+ && (token_value == SEMICOLON_SEP))
+ { assemblez_0(new_line_zc);
+ assemblez_0(rtrue_zc);
+ return;
+ }
+ put_token_back();
+ }
+ break;
+ }
+ if (finally_return)
+ { get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { assemblez_0(print_ret_zc); return;
+ }
+ put_token_back();
+ }
+ assemblez_0(print_zc);
+ break;
+
+ case SEP_TT:
+ if (token_value == OPENB_SEP)
+ { misc_keywords.enabled = TRUE;
+ get_next_token();
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
+ { assembly_operand AO1;
+
+ put_token_back(); put_token_back();
+ local_variables.enabled = FALSE;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ local_variables.enabled = TRUE;
+
+ if ((token_type == STATEMENT_TT)
+ &&(token_value == STRING_CODE))
+ { token_type = MISC_KEYWORD_TT;
+ token_value = STRING_MK;
+ }
+
+ switch(token_type)
+ {
+ case MISC_KEYWORD_TT:
+ switch(token_value)
+ { case CHAR_MK:
+ if (runtime_error_checking_switch)
+ { AO = veneer_routine(RT__ChPrintC_VR);
+ goto PrintByRoutine;
+ }
+ get_next_token();
+ AO1 = code_generate(
+ parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ assemblez_1(print_char_zc, AO1);
+ goto PrintTermDone;
+ case ADDRESS_MK:
+ if (runtime_error_checking_switch)
+ { AO = veneer_routine(RT__ChPrintA_VR);
+ goto PrintByRoutine;
+ }
+ get_next_token();
+ AO1 = code_generate(
+ parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ assemblez_1(print_addr_zc, AO1);
+ goto PrintTermDone;
+ case STRING_MK:
+ if (runtime_error_checking_switch)
+ { AO = veneer_routine(RT__ChPrintS_VR);
+ goto PrintByRoutine;
+ }
+ get_next_token();
+ AO1 = code_generate(
+ parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ assemblez_1(print_paddr_zc, AO1);
+ goto PrintTermDone;
+ case OBJECT_MK:
+ if (runtime_error_checking_switch)
+ { AO = veneer_routine(RT__ChPrintO_VR);
+ goto PrintByRoutine;
+ }
+ get_next_token();
+ AO1 = code_generate(
+ parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ assemblez_1(print_obj_zc, AO1);
+ goto PrintTermDone;
+ case THE_MK:
+ AO = veneer_routine(DefArt_VR);
+ goto PrintByRoutine;
+ case AN_MK:
+ case A_MK:
+ AO = veneer_routine(InDefArt_VR);
+ goto PrintByRoutine;
+ case CAP_THE_MK:
+ AO = veneer_routine(CDefArt_VR);
+ goto PrintByRoutine;
+ case CAP_A_MK:
+ AO = veneer_routine(CInDefArt_VR);
+ goto PrintByRoutine;
+ case NAME_MK:
+ AO = veneer_routine(PrintShortName_VR);
+ goto PrintByRoutine;
+ case NUMBER_MK:
+ AO = veneer_routine(EnglishNumber_VR);
+ goto PrintByRoutine;
+ case PROPERTY_MK:
+ AO = veneer_routine(Print__Pname_VR);
+ goto PrintByRoutine;
+ default:
+ error_named("A reserved word was used as a print specification:",
+ token_text);
+ }
+ break;
+
+ case SYMBOL_TT:
+ if (sflags[token_value] & UNKNOWN_SFLAG)
+ { INITAOT(&AO, LONG_CONSTANT_OT);
+ AO.value = token_value;
+ AO.marker = SYMBOL_MV;
+ }
+ else
+ { INITAOT(&AO, LONG_CONSTANT_OT);
+ AO.value = svals[token_value];
+ AO.marker = IROUTINE_MV;
+ if (stypes[token_value] != ROUTINE_T)
+ ebf_error("printing routine name", token_text);
+ }
+ sflags[token_value] |= USED_SFLAG;
+
+ PrintByRoutine:
+
+ get_next_token();
+ if (version_number >= 5)
+ assemblez_2(call_2n_zc, AO,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ else if (version_number == 4)
+ assemblez_2_to(call_vs_zc, AO,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1), temp_var1);
+ else
+ assemblez_2_to(call_zc, AO,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1), temp_var1);
+ goto PrintTermDone;
+
+ default: ebf_error("print specification", token_text);
+ get_next_token();
+ assemblez_1(print_num_zc,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ goto PrintTermDone;
+ }
+ }
+ put_token_back(); put_token_back(); put_token_back();
+ misc_keywords.enabled = FALSE;
+ assemblez_1(print_num_zc,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ break;
+ }
+
+ default:
+ put_token_back(); misc_keywords.enabled = FALSE;
+ assemblez_1(print_num_zc,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ break;
+ }
+
+ PrintTermDone: misc_keywords.enabled = FALSE;
+
+ count++;
+ 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);
+ panic_mode_error_recovery(); return;
+ }
+ else get_next_token();
+ } while(TRUE);
+
+ if (count == 0) ebf_error("something to print", token_text);
+ if (finally_return)
+ { assemblez_0(new_line_zc);
+ assemblez_0(rtrue_zc);
+ }
+}
+
+static void parse_print_g(int finally_return)
+{ int count = 0; assembly_operand AO, AO2;
+
+ /* print <printlist> -------------------------------------------------- */
+ /* print_ret <printlist> ---------------------------------------------- */
+ /* <literal-string> --------------------------------------------------- */
+ /* */
+ /* <printlist> is a comma-separated list of items: */
+ /* */
+ /* <literal-string> */
+ /* <other-expression> */
+ /* (char) <expression> */
+ /* (address) <expression> */
+ /* (string) <expression> */
+ /* (a) <expression> */
+ /* (A) <expression> */
+ /* (the) <expression> */
+ /* (The) <expression> */
+ /* (name) <expression> */
+ /* (number) <expression> */
+ /* (property) <expression> */
+ /* (<routine>) <expression> */
+ /* (object) <expression> (for use in low-level code only) */
+ /* --------------------------------------------------------------------- */
+
+ do
+ {
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
+ switch(token_type)
+ { case DQ_TT:
+ /* We can't compile a string into the instruction,
+ so this always goes into the string area. */
+ { INITAOT(&AO, CONSTANT_OT);
+ AO.marker = STRING_MV;
+ AO.value = compile_string(token_text, FALSE, FALSE);
+ assembleg_1(streamstr_gc, AO);
+ if (finally_return)
+ { get_next_token();
+ if ((token_type == SEP_TT)
+ && (token_value == SEMICOLON_SEP))
+ { INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
+ assembleg_1(streamchar_gc, AO);
+ INITAOTV(&AO, BYTECONSTANT_OT, 1);
+ assembleg_1(return_gc, AO);
+ return;
+ }
+ put_token_back();
+ }
+ break;
+ }
+ break;
+
+ case SEP_TT:
+ if (token_value == OPENB_SEP)
+ { misc_keywords.enabled = TRUE;
+ get_next_token();
+ 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;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ local_variables.enabled = TRUE;
+
+ if ((token_type == STATEMENT_TT)
+ &&(token_value == STRING_CODE))
+ { token_type = MISC_KEYWORD_TT;
+ token_value = STRING_MK;
+ }
+
+ switch(token_type)
+ {
+ case MISC_KEYWORD_TT:
+ switch(token_value)
+ { case CHAR_MK:
+ if (runtime_error_checking_switch)
+ { AO = veneer_routine(RT__ChPrintC_VR);
+ goto PrintByRoutine;
+ }
+ get_next_token();
+ 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);
+ }
+ INITAOTV(&AO2, HALFCONSTANT_OT, 0x100);
+ assembleg_2_branch(jgeu_gc, AO1, AO2,
+ ln = next_label++);
+ ln2 = next_label++;
+ assembleg_1(streamchar_gc, AO1);
+ assembleg_jump(ln2);
+ assemble_label_no(ln);
+ assembleg_1(streamunichar_gc, AO1);
+ assemble_label_no(ln2);
+ goto PrintTermDone;
+ case ADDRESS_MK:
+ if (runtime_error_checking_switch)
+ AO = veneer_routine(RT__ChPrintA_VR);
+ else
+ AO = veneer_routine(Print__Addr_VR);
+ goto PrintByRoutine;
+ case STRING_MK:
+ if (runtime_error_checking_switch)
+ { AO = veneer_routine(RT__ChPrintS_VR);
+ goto PrintByRoutine;
+ }
+ get_next_token();
+ AO1 = code_generate(
+ parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ assembleg_1(streamstr_gc, AO1);
+ goto PrintTermDone;
+ case OBJECT_MK:
+ if (runtime_error_checking_switch)
+ { AO = veneer_routine(RT__ChPrintO_VR);
+ goto PrintByRoutine;
+ }
+ get_next_token();
+ AO1 = code_generate(
+ parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ INITAOT(&AO2, BYTECONSTANT_OT);
+ AO2.value = GOBJFIELD_NAME();
+ assembleg_3(aload_gc, AO1, AO2,
+ stack_pointer);
+ assembleg_1(streamstr_gc, stack_pointer);
+ goto PrintTermDone;
+ case THE_MK:
+ AO = veneer_routine(DefArt_VR);
+ goto PrintByRoutine;
+ case AN_MK:
+ case A_MK:
+ AO = veneer_routine(InDefArt_VR);
+ goto PrintByRoutine;
+ case CAP_THE_MK:
+ AO = veneer_routine(CDefArt_VR);
+ goto PrintByRoutine;
+ case CAP_A_MK:
+ AO = veneer_routine(CInDefArt_VR);
+ goto PrintByRoutine;
+ case NAME_MK:
+ AO = veneer_routine(PrintShortName_VR);
+ goto PrintByRoutine;
+ case NUMBER_MK:
+ AO = veneer_routine(EnglishNumber_VR);
+ goto PrintByRoutine;
+ case PROPERTY_MK:
+ AO = veneer_routine(Print__Pname_VR);
+ goto PrintByRoutine;
+ default:
+ error_named("A reserved word was used as a print specification:",
+ token_text);
+ }
+ break;
+
+ case SYMBOL_TT:
+ if (sflags[token_value] & UNKNOWN_SFLAG)
+ { INITAOT(&AO, CONSTANT_OT);
+ AO.value = token_value;
+ AO.marker = SYMBOL_MV;
+ }
+ else
+ { INITAOT(&AO, CONSTANT_OT);
+ AO.value = svals[token_value];
+ AO.marker = IROUTINE_MV;
+ if (stypes[token_value] != ROUTINE_T)
+ ebf_error("printing routine name", token_text);
+ }
+ sflags[token_value] |= USED_SFLAG;
+
+ PrintByRoutine:
+
+ get_next_token();
+ INITAOT(&AO2, ZEROCONSTANT_OT);
+ assembleg_call_1(AO,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1),
+ AO2);
+ goto PrintTermDone;
+
+ default: ebf_error("print specification", token_text);
+ get_next_token();
+ assembleg_1(streamnum_gc,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ goto PrintTermDone;
+ }
+ }
+ put_token_back(); put_token_back(); put_token_back();
+ misc_keywords.enabled = FALSE;
+ assembleg_1(streamnum_gc,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ break;
+ }
+
+ default:
+ put_token_back(); misc_keywords.enabled = FALSE;
+ assembleg_1(streamnum_gc,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ break;
+ }
+
+ PrintTermDone: misc_keywords.enabled = FALSE;
+
+ count++;
+ 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);
+ panic_mode_error_recovery(); return;
+ }
+ else get_next_token();
+ } while(TRUE);
+
+ if (count == 0) ebf_error("something to print", token_text);
+ if (finally_return)
+ {
+ INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
+ assembleg_1(streamchar_gc, AO);
+ INITAOTV(&AO, BYTECONSTANT_OT, 1);
+ assembleg_1(return_gc, AO);
+ }
+}
+
+static void parse_statement_z(int break_label, int continue_label)
+{ int ln, ln2, ln3, ln4, flag;
+ assembly_operand AO, AO2, AO3, AO4;
+ debug_location spare_debug_location1, spare_debug_location2;
+
+ ASSERT_ZCODE();
+
+ if ((token_type == SEP_TT) && (token_value == PROPERTY_SEP))
+ { /* That is, a full stop, signifying a label */
+
+ get_next_token();
+ if (token_type == SYMBOL_TT)
+ {
+ if (sflags[token_value] & UNKNOWN_SFLAG)
+ { assign_symbol(token_value, next_label, LABEL_T);
+ sflags[token_value] |= USED_SFLAG;
+ assemble_label_no(next_label);
+ define_symbol_label(token_value);
+ next_label++;
+ }
+ else
+ { if (stypes[token_value] != LABEL_T) goto LabelError;
+ if (sflags[token_value] & CHANGE_SFLAG)
+ { sflags[token_value] &= (~(CHANGE_SFLAG));
+ assemble_label_no(svals[token_value]);
+ define_symbol_label(token_value);
+ }
+ else error_named("Duplicate definition of label:", token_text);
+ }
+
+ get_next_token();
+ if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+ { ebf_error("';'", token_text);
+ put_token_back(); return;
+ }
+
+ /* Interesting point of Inform grammar: a statement can only
+ consist solely of a label when it is immediately followed
+ by a "}". */
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == CLOSE_BRACE_SEP))
+ { put_token_back(); return;
+ }
+ statement_debug_location = get_token_location();
+ parse_statement(break_label, continue_label);
+ return;
+ }
+ LabelError: ebf_error("label name", token_text);
+ }
+
+ if ((token_type == SEP_TT) && (token_value == HASH_SEP))
+ { parse_directive(TRUE);
+ parse_statement(break_label, continue_label); return;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == AT_SEP))
+ { parse_assembly(); return;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
+
+ if (token_type == DQ_TT)
+ { parse_print_z(TRUE); return;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == LESS_SEP))
+ { parse_action(); goto StatementTerminator; }
+
+ if (token_type == EOF_TT)
+ { ebf_error("statement", token_text); return; }
+
+ if (token_type != STATEMENT_TT)
+ { put_token_back();
+ AO = parse_expression(VOID_CONTEXT);
+ code_generate(AO, VOID_CONTEXT, -1);
+ if (vivc_flag) { panic_mode_error_recovery(); return; }
+ goto StatementTerminator;
+ }
+
+ statements.enabled = FALSE;
+
+ switch(token_value)
+ {
+ /* -------------------------------------------------------------------- */
+ /* box <string-1> ... <string-n> -------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case BOX_CODE:
+ if (version_number == 3)
+ warning("The 'box' statement has no effect in a version 3 game");
+ INITAOT(&AO3, LONG_CONSTANT_OT);
+ AO3.value = begin_table_array();
+ AO3.marker = ARRAY_MV;
+ ln = 0; ln2 = 0;
+ do
+ { get_next_token();
+ 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);
+ { int i, j;
+ for (i=0, j=0; token_text[i] != 0; j++)
+ if (token_text[i] == '@')
+ { if (token_text[i+1] == '@')
+ { i = i + 2;
+ while (isdigit(token_text[i])) i++;
+ }
+ else
+ { i++;
+ if (token_text[i] != 0) i++;
+ if (token_text[i] != 0) i++;
+ }
+ }
+ else i++;
+ if (j > ln2) ln2 = j;
+ }
+ put_token_back();
+ array_entry(ln++,parse_expression(CONSTANT_CONTEXT));
+ } while (TRUE);
+ finish_array(ln);
+ if (ln == 0)
+ error("No lines of text given for 'box' display");
+
+ if (version_number == 3) return;
+
+ INITAOTV(&AO2, SHORT_CONSTANT_OT, ln2);
+ INITAOTV(&AO4, VARIABLE_OT, 255);
+ assemblez_3_to(call_vs_zc, veneer_routine(Box__Routine_VR),
+ AO2, AO3, AO4);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* break -------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case BREAK_CODE:
+ if (break_label == -1)
+ error("'break' can only be used in a loop or 'switch' block");
+ else
+ assemblez_jump(break_label);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* continue ----------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case CONTINUE_CODE:
+ if (continue_label == -1)
+ error("'continue' can only be used in a loop block");
+ else
+ assemblez_jump(continue_label);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* do <codeblock> until (<condition>) --------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case DO_CODE:
+ assemble_label_no(ln = next_label++);
+ ln2 = next_label++; ln3 = next_label++;
+ parse_code_block(ln3, ln2, 0);
+ statements.enabled = TRUE;
+ get_next_token();
+ if ((token_type == STATEMENT_TT)
+ && (token_value == UNTIL_CODE))
+ { assemble_label_no(ln2);
+ match_open_bracket();
+ AO = parse_expression(CONDITION_CONTEXT);
+ match_close_bracket();
+ code_generate(AO, CONDITION_CONTEXT, ln);
+ }
+ else error("'do' without matching 'until'");
+
+ assemble_label_no(ln3);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* font on/off -------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case FONT_CODE:
+ misc_keywords.enabled = TRUE;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ if ((token_type != MISC_KEYWORD_TT)
+ || ((token_value != ON_MK)
+ && (token_value != OFF_MK)))
+ { ebf_error("'on' or 'off'", token_text);
+ panic_mode_error_recovery();
+ break;
+ }
+
+ if (version_number >= 5)
+ { /* Use the V5 @set_font opcode, setting font 4
+ (for font off) or 1 (for font on). */
+ INITAOT(&AO, SHORT_CONSTANT_OT);
+ if (token_value == ON_MK)
+ AO.value = 1;
+ else
+ AO.value = 4;
+ assemblez_1_to(set_font_zc, AO, temp_var1);
+ break;
+ }
+
+ /* Set the fixed-pitch header bit. */
+ INITAOTV(&AO, SHORT_CONSTANT_OT, 0);
+ INITAOTV(&AO2, SHORT_CONSTANT_OT, 8);
+ INITAOTV(&AO3, VARIABLE_OT, 255);
+ assemblez_2_to(loadw_zc, AO, AO2, AO3);
+
+ if (token_value == ON_MK)
+ { INITAOTV(&AO4, LONG_CONSTANT_OT, 0xfffd);
+ assemblez_2_to(and_zc, AO4, AO3, AO3);
+ }
+ else
+ { INITAOTV(&AO4, SHORT_CONSTANT_OT, 2);
+ assemblez_2_to(or_zc, AO4, AO3, AO3);
+ }
+
+ assemblez_3(storew_zc, AO, AO2, AO3);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* for (<initialisation> : <continue-condition> : <updating>) --------- */
+ /* -------------------------------------------------------------------- */
+
+ /* Note that it's legal for any or all of the three sections of a
+ 'for' specification to be empty. This 'for' implementation
+ often wastes 3 bytes with a redundant branch rather than keep
+ expression parse trees for long periods (as previous versions
+ of Inform did, somewhat crudely by simply storing the textual
+ form of a 'for' loop). It is adequate for now. */
+
+ case FOR_CODE:
+ match_open_bracket();
+ get_next_token();
+
+ /* Initialisation code */
+
+ if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
+ { put_token_back();
+ if (!((token_type==SEP_TT)&&(token_value==SUPERCLASS_SEP)))
+ { sequence_point_follows = TRUE;
+ statement_debug_location = get_token_location();
+ code_generate(parse_expression(FORINIT_CONTEXT),
+ VOID_CONTEXT, -1);
+ }
+ get_next_token();
+ if ((token_type==SEP_TT)&&(token_value == SUPERCLASS_SEP))
+ { get_next_token();
+ if ((token_type==SEP_TT)&&(token_value == CLOSEB_SEP))
+ { assemble_label_no(ln = next_label++);
+ ln2 = next_label++;
+ parse_code_block(ln2, ln, 0);
+ sequence_point_follows = FALSE;
+ if (!execution_never_reaches_here)
+ assemblez_jump(ln);
+ assemble_label_no(ln2);
+ return;
+ }
+ AO.type = OMITTED_OT;
+ goto ParseUpdate;
+ }
+ put_token_back();
+ if (!match_colon()) break;
+ }
+
+ get_next_token();
+ AO.type = OMITTED_OT;
+ if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
+ { put_token_back();
+ spare_debug_location1 = get_token_location();
+ AO = parse_expression(CONDITION_CONTEXT);
+ if (!match_colon()) break;
+ }
+ get_next_token();
+
+ ParseUpdate:
+ AO2.type = OMITTED_OT; flag = 0;
+ if (!((token_type==SEP_TT)&&(token_value==CLOSEB_SEP)))
+ { put_token_back();
+ spare_debug_location2 = get_token_location();
+ AO2 = parse_expression(VOID_CONTEXT);
+ match_close_bracket();
+ flag = test_for_incdec(AO2);
+ }
+
+ ln = next_label++;
+ ln2 = next_label++;
+ ln3 = next_label++;
+
+ if ((AO2.type == OMITTED_OT) || (flag != 0))
+ {
+ assemble_label_no(ln);
+ if (flag==0) assemble_label_no(ln2);
+
+ /* The "finished yet?" condition */
+
+ if (AO.type != OMITTED_OT)
+ { sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location1;
+ code_generate(AO, CONDITION_CONTEXT, ln3);
+ }
+
+ }
+ else
+ {
+ /* This is the jump which could be avoided with the aid
+ of long-term expression storage */
+
+ sequence_point_follows = FALSE;
+ assemblez_jump(ln2);
+
+ /* The "update" part */
+
+ assemble_label_no(ln);
+ sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location2;
+ code_generate(AO2, VOID_CONTEXT, -1);
+
+ assemble_label_no(ln2);
+
+ /* The "finished yet?" condition */
+
+ if (AO.type != OMITTED_OT)
+ { sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location1;
+ code_generate(AO, CONDITION_CONTEXT, ln3);
+ }
+ }
+
+ if (flag != 0)
+ {
+ /* In this optimised case, update code is at the end
+ of the loop block, so "continue" goes there */
+
+ parse_code_block(ln3, ln2, 0);
+ assemble_label_no(ln2);
+
+ sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location2;
+ if (flag > 0)
+ { INITAOTV(&AO3, SHORT_CONSTANT_OT, flag);
+ if (module_switch
+ && (flag>=MAX_LOCAL_VARIABLES) && (flag<LOWEST_SYSTEM_VAR_NUMBER))
+ AO3.marker = VARIABLE_MV;
+ assemblez_1(inc_zc, AO3);
+ }
+ else
+ { INITAOTV(&AO3, SHORT_CONSTANT_OT, -flag);
+ if ((module_switch) && (flag>=MAX_LOCAL_VARIABLES)
+ && (flag<LOWEST_SYSTEM_VAR_NUMBER))
+ AO3.marker = VARIABLE_MV;
+ assemblez_1(dec_zc, AO3);
+ }
+ assemblez_jump(ln);
+ }
+ else
+ {
+ /* In the unoptimised case, update code is at the
+ start of the loop block, so "continue" goes there */
+
+ parse_code_block(ln3, ln, 0);
+ if (!execution_never_reaches_here)
+ { sequence_point_follows = FALSE;
+ assemblez_jump(ln);
+ }
+ }
+
+ assemble_label_no(ln3);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* give <expression> [~]attr [, [~]attr [, ...]] ---------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case GIVE_CODE:
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ if ((AO.type == VARIABLE_OT) && (AO.value == 0))
+ { INITAOTV(&AO, SHORT_CONSTANT_OT, 252);
+ if (version_number != 6) assemblez_1(pull_zc, AO);
+ else assemblez_0_to(pull_zc, AO);
+ AO.type = VARIABLE_OT;
+ }
+
+ do
+ { get_next_token();
+ if ((token_type == SEP_TT)&&(token_value == SEMICOLON_SEP))
+ return;
+ if ((token_type == SEP_TT)&&(token_value == ARTNOT_SEP))
+ ln = clear_attr_zc;
+ else
+ { if ((token_type == SYMBOL_TT)
+ && (stypes[token_value] != ATTRIBUTE_T))
+ warning_named("This is not a declared Attribute:",
+ token_text);
+ ln = set_attr_zc;
+ put_token_back();
+ }
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ if (runtime_error_checking_switch)
+ { ln2 = (ln==set_attr_zc)?RT__ChG_VR:RT__ChGt_VR;
+ if (version_number >= 5)
+ assemblez_3(call_vn_zc, veneer_routine(ln2),
+ AO, AO2);
+ else
+ {
+ assemblez_3_to(call_zc, veneer_routine(ln2),
+ AO, AO2, temp_var1);
+ }
+ }
+ else
+ assemblez_2(ln, AO, AO2);
+ } while(TRUE);
+
+ /* -------------------------------------------------------------------- */
+ /* if (<condition>) <codeblock> [else <codeblock>] -------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case IF_CODE:
+ flag = FALSE;
+ ln2 = 0;
+
+ match_open_bracket();
+ AO = parse_expression(CONDITION_CONTEXT);
+ match_close_bracket();
+
+ statements.enabled = TRUE;
+ get_next_token();
+ if ((token_type == STATEMENT_TT)&&(token_value == RTRUE_CODE))
+ ln = -4;
+ else
+ if ((token_type == STATEMENT_TT)&&(token_value == RFALSE_CODE))
+ ln = -3;
+ else
+ { put_token_back();
+ ln = next_label++;
+ }
+
+ code_generate(AO, CONDITION_CONTEXT, ln);
+
+ if (ln >= 0) parse_code_block(break_label, continue_label, 0);
+ else
+ { get_next_token();
+ if ((token_type != SEP_TT)
+ || (token_value != SEMICOLON_SEP))
+ { ebf_error("';'", token_text);
+ put_token_back();
+ }
+ }
+
+ statements.enabled = TRUE;
+ get_next_token();
+ if ((token_type == STATEMENT_TT) && (token_value == ELSE_CODE))
+ { flag = TRUE;
+ if (ln >= 0)
+ { ln2 = next_label++;
+ if (!execution_never_reaches_here)
+ { sequence_point_follows = FALSE;
+ assemblez_jump(ln2);
+ }
+ }
+ }
+ else put_token_back();
+
+ if (ln >= 0) assemble_label_no(ln);
+
+ if (flag)
+ { parse_code_block(break_label, continue_label, 0);
+ if (ln >= 0) assemble_label_no(ln2);
+ }
+
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* inversion ---------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case INVERSION_CODE:
+ INITAOTV(&AO, SHORT_CONSTANT_OT, 0);
+ INITAOT(&AO2, SHORT_CONSTANT_OT);
+
+ AO2.value = 60;
+ assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
+ assemblez_1(print_char_zc, temp_var1);
+ AO2.value = 61;
+ assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
+ assemblez_1(print_char_zc, temp_var1);
+ AO2.value = 62;
+ assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
+ assemblez_1(print_char_zc, temp_var1);
+ AO2.value = 63;
+ assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
+ assemblez_1(print_char_zc, temp_var1);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* jump <label> ------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case JUMP_CODE:
+ assemblez_jump(parse_label());
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* move <expression> to <expression> ---------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case MOVE_CODE:
+ misc_keywords.enabled = TRUE;
+ AO = parse_expression(QUANTITY_CONTEXT);
+
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ if ((token_type != MISC_KEYWORD_TT)
+ || (token_value != TO_MK))
+ { ebf_error("'to'", token_text);
+ panic_mode_error_recovery();
+ return;
+ }
+
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ AO = code_generate(AO, QUANTITY_CONTEXT, -1);
+ if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
+ { if (version_number >= 5)
+ assemblez_3(call_vn_zc, veneer_routine(RT__ChT_VR),
+ AO, AO2);
+ else
+ { assemblez_3_to(call_zc, veneer_routine(RT__ChT_VR),
+ AO, AO2, temp_var1);
+ }
+ }
+ else
+ assemblez_2(insert_obj_zc, AO, AO2);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* new_line ----------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case NEW_LINE_CODE: assemblez_0(new_line_zc); break;
+
+ /* -------------------------------------------------------------------- */
+ /* objectloop (<initialisation>) <codeblock> -------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case OBJECTLOOP_CODE:
+
+ match_open_bracket();
+ get_next_token();
+ INITAOT(&AO, VARIABLE_OT);
+ if (token_type == LOCAL_VARIABLE_TT)
+ AO.value = token_value;
+ else
+ if ((token_type == SYMBOL_TT) &&
+ (stypes[token_value] == GLOBAL_VARIABLE_T))
+ AO.value = svals[token_value];
+ else
+ { ebf_error("'objectloop' variable", token_text);
+ panic_mode_error_recovery(); break;
+ }
+ if ((module_switch) && (AO.value >= MAX_LOCAL_VARIABLES)
+ && (AO.value < LOWEST_SYSTEM_VAR_NUMBER))
+ AO.marker = VARIABLE_MV;
+ misc_keywords.enabled = TRUE;
+ get_next_token(); flag = TRUE;
+ misc_keywords.enabled = FALSE;
+ if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
+ flag = FALSE;
+
+ ln = 0;
+ if ((token_type == MISC_KEYWORD_TT)
+ && (token_value == NEAR_MK)) ln = 1;
+ if ((token_type == MISC_KEYWORD_TT)
+ && (token_value == FROM_MK)) ln = 2;
+ if ((token_type == CND_TT) && (token_value == IN_COND))
+ { get_next_token();
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
+ ln = 3;
+ put_token_back();
+ put_token_back();
+ }
+
+ if (ln > 0)
+ { /* Old style (Inform 5) objectloops: note that we
+ implement objectloop (a in b) in the old way since
+ this runs through objects in a different order from
+ the new way, and there may be existing Inform code
+ relying on this. */
+ assembly_operand AO4;
+ INITAO(&AO4);
+
+ sequence_point_follows = TRUE;
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ match_close_bracket();
+ if (ln == 1)
+ { INITAOTV(&AO3, VARIABLE_OT, 0);
+ if (runtime_error_checking_switch)
+ AO2 = check_nonzero_at_runtime(AO2, -1,
+ OBJECTLOOP_RTE);
+ assemblez_1_to(get_parent_zc, AO2, AO3);
+ assemblez_objcode(get_child_zc, AO3, AO3, -2, TRUE);
+ AO2 = AO3;
+ }
+ if (ln == 3)
+ { INITAOTV(&AO3, VARIABLE_OT, 0);
+ if (runtime_error_checking_switch)
+ { AO4 = AO2;
+ AO2 = check_nonzero_at_runtime(AO2, -1,
+ CHILD_RTE);
+ }
+ assemblez_objcode(get_child_zc, AO2, AO3, -2, TRUE);
+ AO2 = AO3;
+ }
+ assemblez_store(AO, AO2);
+ assemblez_1_branch(jz_zc, AO, ln2 = next_label++, TRUE);
+ assemble_label_no(ln4 = next_label++);
+ parse_code_block(ln2, ln3 = next_label++, 0);
+ sequence_point_follows = FALSE;
+ assemble_label_no(ln3);
+ if (runtime_error_checking_switch)
+ { AO2 = check_nonzero_at_runtime(AO, ln2,
+ OBJECTLOOP2_RTE);
+ if ((ln == 3)
+ && ((AO4.type != VARIABLE_OT)||(AO4.value != 0))
+ && ((AO4.type != VARIABLE_OT)
+ ||(AO4.value != AO.value)))
+ { assembly_operand en_ao;
+ INITAOTV(&en_ao, SHORT_CONSTANT_OT, OBJECTLOOP_BROKEN_RTE);
+ assemblez_2_branch(jin_zc, AO, AO4,
+ next_label, TRUE);
+ assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR),
+ en_ao, AO);
+ assemblez_jump(ln2);
+ assemble_label_no(next_label++);
+ }
+ }
+ else AO2 = AO;
+ assemblez_objcode(get_sibling_zc, AO2, AO, ln4, TRUE);
+ assemble_label_no(ln2);
+ return;
+ }
+
+ sequence_point_follows = TRUE;
+ INITAOTV(&AO2, SHORT_CONSTANT_OT, 1);
+ assemblez_store(AO, AO2);
+
+ assemble_label_no(ln = next_label++);
+ ln2 = next_label++;
+ ln3 = next_label++;
+ if (flag)
+ { put_token_back();
+ put_token_back();
+ sequence_point_follows = TRUE;
+ code_generate(parse_expression(CONDITION_CONTEXT),
+ CONDITION_CONTEXT, ln3);
+ match_close_bracket();
+ }
+ parse_code_block(ln2, ln3, 0);
+
+ sequence_point_follows = FALSE;
+ assemble_label_no(ln3);
+ assemblez_inc(AO);
+ INITAOTV(&AO2, LONG_CONSTANT_OT, no_objects);
+ AO2.marker = NO_OBJS_MV;
+ assemblez_2_branch(jg_zc, AO, AO2, ln2, TRUE);
+ assemblez_jump(ln);
+ assemble_label_no(ln2);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* (see routine above) ------------------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case PRINT_CODE:
+ get_next_token();
+ parse_print_z(FALSE); return;
+ case PRINT_RET_CODE:
+ get_next_token();
+ parse_print_z(TRUE); return;
+
+ /* -------------------------------------------------------------------- */
+ /* quit --------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case QUIT_CODE: assemblez_0(quit_zc); break;
+
+ /* -------------------------------------------------------------------- */
+ /* read <expression> <expression> [<Routine>] ------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case READ_CODE:
+ INITAOTV(&AO, VARIABLE_OT, 252);
+ assemblez_store(AO,
+ code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1));
+ if (version_number > 3)
+ { INITAOTV(&AO3, SHORT_CONSTANT_OT, 1);
+ INITAOTV(&AO4, SHORT_CONSTANT_OT, 0);
+ assemblez_3(storeb_zc, AO, AO3, AO4);
+ }
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ put_token_back();
+ else
+ { if (version_number == 3)
+ error(
+"In Version 3 no status-line drawing routine can be given");
+ else
+ { assembly_operand AO5;
+ /* Move the temp4 (buffer) value to the stack,
+ since the routine might alter temp4. */
+ assemblez_store(stack_pointer, AO);
+ AO = stack_pointer;
+ put_token_back();
+ AO5 = parse_expression(CONSTANT_CONTEXT);
+
+ if (version_number >= 5)
+ assemblez_1(call_1n_zc, AO5);
+ else
+ assemblez_1_to(call_zc, AO5, temp_var1);
+ }
+ }
+
+ if (version_number > 4)
+ { assemblez_2_to(aread_zc, AO, AO2, temp_var1);
+ }
+ else assemblez_2(sread_zc, AO, AO2);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* remove <expression> ------------------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case REMOVE_CODE:
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
+ { if (version_number >= 5)
+ assemblez_2(call_2n_zc, veneer_routine(RT__ChR_VR),
+ AO);
+ else
+ { assemblez_2_to(call_zc, veneer_routine(RT__ChR_VR),
+ AO, temp_var1);
+ }
+ }
+ else
+ assemblez_1(remove_obj_zc, AO);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* restore <label> ---------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case RESTORE_CODE:
+ if (version_number < 5)
+ assemblez_0_branch(restore_zc, parse_label(), TRUE);
+ else
+ { INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
+ assemblez_0_to(restore_zc, temp_var1);
+ assemblez_2_branch(je_zc, temp_var1, AO2, parse_label(), TRUE);
+ }
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* return [<expression>] ---------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case RETURN_CODE:
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { assemblez_0(rtrue_zc); return; }
+ put_token_back();
+ AO = code_generate(parse_expression(RETURN_Q_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ if ((AO.type == SHORT_CONSTANT_OT) && (AO.value == 0)
+ && (AO.marker == 0))
+ { assemblez_0(rfalse_zc); break; }
+ if ((AO.type == SHORT_CONSTANT_OT) && (AO.value == 1)
+ && (AO.marker == 0))
+ { assemblez_0(rtrue_zc); break; }
+ if ((AO.type == VARIABLE_OT) && (AO.value == 0))
+ { assemblez_0(ret_popped_zc); break; }
+ assemblez_1(ret_zc, AO);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* rfalse ------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case RFALSE_CODE: assemblez_0(rfalse_zc); break;
+
+ /* -------------------------------------------------------------------- */
+ /* rtrue -------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case RTRUE_CODE: assemblez_0(rtrue_zc); break;
+
+ /* -------------------------------------------------------------------- */
+ /* save <label> ------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case SAVE_CODE:
+ if (version_number < 5)
+ assemblez_0_branch(save_zc, parse_label(), TRUE);
+ else
+ { INITAOTV(&AO, VARIABLE_OT, 255);
+ assemblez_0_to(save_zc, AO);
+ assemblez_1_branch(jz_zc, AO, parse_label(), FALSE);
+ }
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* spaces <expression> ------------------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case SPACES_CODE:
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ INITAOTV(&AO2, VARIABLE_OT, 255);
+
+ assemblez_store(AO2, AO);
+
+ INITAOTV(&AO, SHORT_CONSTANT_OT, 32);
+ INITAOTV(&AO3, SHORT_CONSTANT_OT, 1);
+
+ assemblez_2_branch(jl_zc, AO2, AO3, ln = next_label++, TRUE);
+ assemble_label_no(ln2 = next_label++);
+ assemblez_1(print_char_zc, AO);
+ assemblez_dec(AO2);
+ assemblez_1_branch(jz_zc, AO2, ln2, FALSE);
+ assemble_label_no(ln);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* string <expression> <literal-string> ------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case STRING_CODE:
+ INITAOTV(&AO, SHORT_CONSTANT_OT, 0);
+ INITAOTV(&AO2, SHORT_CONSTANT_OT, 12);
+ INITAOTV(&AO3, VARIABLE_OT, 252);
+ assemblez_2_to(loadw_zc, AO, AO2, AO3);
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ get_next_token();
+ if (token_type == DQ_TT)
+ { INITAOT(&AO4, LONG_CONSTANT_OT);
+ AO4.value = compile_string(token_text, TRUE, TRUE);
+ }
+ else
+ { put_token_back();
+ AO4 = parse_expression(CONSTANT_CONTEXT);
+ }
+ assemblez_3(storew_zc, AO3, AO2, AO4);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* style roman/reverse/bold/underline/fixed --------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case STYLE_CODE:
+ if (version_number==3)
+ { error(
+"The 'style' statement cannot be used for Version 3 games");
+ panic_mode_error_recovery();
+ break;
+ }
+
+ misc_keywords.enabled = TRUE;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ if ((token_type != MISC_KEYWORD_TT)
+ || ((token_value != ROMAN_MK)
+ && (token_value != REVERSE_MK)
+ && (token_value != BOLD_MK)
+ && (token_value != UNDERLINE_MK)
+ && (token_value != FIXED_MK)))
+ { ebf_error(
+"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
+ token_text);
+ panic_mode_error_recovery();
+ break;
+ }
+
+ INITAOT(&AO, SHORT_CONSTANT_OT);
+ switch(token_value)
+ { case ROMAN_MK: AO.value = 0; break;
+ case REVERSE_MK: AO.value = 1; break;
+ case BOLD_MK: AO.value = 2; break;
+ case UNDERLINE_MK: AO.value = 4; break;
+ case FIXED_MK: AO.value = 8; break;
+ }
+ assemblez_1(set_text_style_zc, AO); break;
+
+ /* -------------------------------------------------------------------- */
+ /* switch (<expression>) <codeblock> ---------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case SWITCH_CODE:
+ match_open_bracket();
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ match_close_bracket();
+
+ INITAOTV(&AO2, VARIABLE_OT, 255);
+ assemblez_store(AO2, AO);
+
+ parse_code_block(ln = next_label++, continue_label, 1);
+ assemble_label_no(ln);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* while (<condition>) <codeblock> ------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case WHILE_CODE:
+ assemble_label_no(ln = next_label++);
+ match_open_bracket();
+
+ code_generate(parse_expression(CONDITION_CONTEXT),
+ CONDITION_CONTEXT, ln2 = next_label++);
+ match_close_bracket();
+
+ parse_code_block(ln2, ln, 0);
+ sequence_point_follows = FALSE;
+ assemblez_jump(ln);
+ assemble_label_no(ln2);
+ return;
+
+ /* -------------------------------------------------------------------- */
+
+ case SDEFAULT_CODE:
+ error("'default' without matching 'switch'"); break;
+ case ELSE_CODE:
+ error("'else' without matching 'if'"); break;
+ case UNTIL_CODE:
+ error("'until' without matching 'do'");
+ panic_mode_error_recovery(); return;
+ }
+
+ StatementTerminator:
+
+ get_next_token();
+ if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+ { ebf_error("';'", token_text);
+ put_token_back();
+ }
+}
+
+static void parse_statement_g(int break_label, int continue_label)
+{ int ln, ln2, ln3, ln4, flag, onstack;
+ assembly_operand AO, AO2, AO3, AO4;
+ debug_location spare_debug_location1, spare_debug_location2;
+
+ ASSERT_GLULX();
+
+ if ((token_type == SEP_TT) && (token_value == PROPERTY_SEP))
+ { /* That is, a full stop, signifying a label */
+
+ get_next_token();
+ if (token_type == SYMBOL_TT)
+ {
+ if (sflags[token_value] & UNKNOWN_SFLAG)
+ { assign_symbol(token_value, next_label, LABEL_T);
+ sflags[token_value] |= USED_SFLAG;
+ assemble_label_no(next_label);
+ define_symbol_label(token_value);
+ next_label++;
+ }
+ else
+ { if (stypes[token_value] != LABEL_T) goto LabelError;
+ if (sflags[token_value] & CHANGE_SFLAG)
+ { sflags[token_value] &= (~(CHANGE_SFLAG));
+ assemble_label_no(svals[token_value]);
+ define_symbol_label(token_value);
+ }
+ else error_named("Duplicate definition of label:", token_text);
+ }
+
+ get_next_token();
+ if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+ { ebf_error("';'", token_text);
+ put_token_back(); return;
+ }
+
+ /* Interesting point of Inform grammar: a statement can only
+ consist solely of a label when it is immediately followed
+ by a "}". */
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == CLOSE_BRACE_SEP))
+ { put_token_back(); return;
+ }
+ /* The following line prevents labels from influencing the positions
+ of sequence points. */
+ statement_debug_location = get_token_location();
+ parse_statement(break_label, continue_label);
+ return;
+ }
+ LabelError: ebf_error("label name", token_text);
+ }
+
+ if ((token_type == SEP_TT) && (token_value == HASH_SEP))
+ { parse_directive(TRUE);
+ parse_statement(break_label, continue_label); return;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == AT_SEP))
+ { parse_assembly(); return;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
+
+ if (token_type == DQ_TT)
+ { parse_print_g(TRUE); return;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == LESS_SEP))
+ { parse_action(); goto StatementTerminator; }
+
+ if (token_type == EOF_TT)
+ { ebf_error("statement", token_text); return; }
+
+ if (token_type != STATEMENT_TT)
+ { put_token_back();
+ AO = parse_expression(VOID_CONTEXT);
+ code_generate(AO, VOID_CONTEXT, -1);
+ if (vivc_flag) { panic_mode_error_recovery(); return; }
+ goto StatementTerminator;
+ }
+
+ statements.enabled = FALSE;
+
+ switch(token_value)
+ {
+
+ /* -------------------------------------------------------------------- */
+ /* box <string-1> ... <string-n> -------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case BOX_CODE:
+ INITAOT(&AO3, CONSTANT_OT);
+ AO3.value = begin_table_array();
+ AO3.marker = ARRAY_MV;
+ ln = 0; ln2 = 0;
+ do
+ { get_next_token();
+ 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);
+ { int i, j;
+ for (i=0, j=0; token_text[i] != 0; j++)
+ if (token_text[i] == '@')
+ { if (token_text[i+1] == '@')
+ { i = i + 2;
+ while (isdigit(token_text[i])) i++;
+ }
+ else
+ { i++;
+ if (token_text[i] != 0) i++;
+ if (token_text[i] != 0) i++;
+ }
+ }
+ else i++;
+ if (j > ln2) ln2 = j;
+ }
+ put_token_back();
+ array_entry(ln++,parse_expression(CONSTANT_CONTEXT));
+ } while (TRUE);
+ finish_array(ln);
+ if (ln == 0)
+ error("No lines of text given for 'box' display");
+
+ INITAO(&AO2);
+ AO2.value = ln2; set_constant_ot(&AO2);
+ assembleg_call_2(veneer_routine(Box__Routine_VR),
+ AO2, AO3, zero_operand);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* break -------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case BREAK_CODE:
+ if (break_label == -1)
+ error("'break' can only be used in a loop or 'switch' block");
+ else
+ assembleg_jump(break_label);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* continue ----------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case CONTINUE_CODE:
+ if (continue_label == -1)
+ error("'continue' can only be used in a loop block");
+ else
+ assembleg_jump(continue_label);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* do <codeblock> until (<condition>) --------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case DO_CODE:
+ assemble_label_no(ln = next_label++);
+ ln2 = next_label++; ln3 = next_label++;
+ parse_code_block(ln3, ln2, 0);
+ statements.enabled = TRUE;
+ get_next_token();
+ if ((token_type == STATEMENT_TT)
+ && (token_value == UNTIL_CODE))
+ { assemble_label_no(ln2);
+ match_open_bracket();
+ AO = parse_expression(CONDITION_CONTEXT);
+ match_close_bracket();
+ code_generate(AO, CONDITION_CONTEXT, ln);
+ }
+ else error("'do' without matching 'until'");
+
+ assemble_label_no(ln3);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* font on/off -------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case FONT_CODE:
+ misc_keywords.enabled = TRUE;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ if ((token_type != MISC_KEYWORD_TT)
+ || ((token_value != ON_MK)
+ && (token_value != OFF_MK)))
+ { ebf_error("'on' or 'off'", token_text);
+ panic_mode_error_recovery();
+ break;
+ }
+
+ /* Call glk_set_style(normal or preformatted) */
+ INITAO(&AO);
+ AO.value = 0x0086;
+ set_constant_ot(&AO);
+ if (token_value == ON_MK)
+ AO2 = zero_operand;
+ else
+ AO2 = two_operand;
+ assembleg_call_2(veneer_routine(Glk__Wrap_VR),
+ AO, AO2, zero_operand);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* for (<initialisation> : <continue-condition> : <updating>) --------- */
+ /* -------------------------------------------------------------------- */
+
+ /* Note that it's legal for any or all of the three sections of a
+ 'for' specification to be empty. This 'for' implementation
+ often wastes 3 bytes with a redundant branch rather than keep
+ expression parse trees for long periods (as previous versions
+ of Inform did, somewhat crudely by simply storing the textual
+ form of a 'for' loop). It is adequate for now. */
+
+ case FOR_CODE:
+ match_open_bracket();
+ get_next_token();
+
+ /* Initialisation code */
+
+ if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
+ { put_token_back();
+ if (!((token_type==SEP_TT)&&(token_value==SUPERCLASS_SEP)))
+ { sequence_point_follows = TRUE;
+ statement_debug_location = get_token_location();
+ code_generate(parse_expression(FORINIT_CONTEXT),
+ VOID_CONTEXT, -1);
+ }
+ get_next_token();
+ if ((token_type==SEP_TT)&&(token_value == SUPERCLASS_SEP))
+ { get_next_token();
+ if ((token_type==SEP_TT)&&(token_value == CLOSEB_SEP))
+ { assemble_label_no(ln = next_label++);
+ ln2 = next_label++;
+ parse_code_block(ln2, ln, 0);
+ sequence_point_follows = FALSE;
+ if (!execution_never_reaches_here)
+ assembleg_jump(ln);
+ assemble_label_no(ln2);
+ return;
+ }
+ AO.type = OMITTED_OT;
+ goto ParseUpdate;
+ }
+ put_token_back();
+ if (!match_colon()) break;
+ }
+
+ get_next_token();
+ AO.type = OMITTED_OT;
+ if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
+ { put_token_back();
+ spare_debug_location1 = get_token_location();
+ AO = parse_expression(CONDITION_CONTEXT);
+ if (!match_colon()) break;
+ }
+ get_next_token();
+
+ ParseUpdate:
+ AO2.type = OMITTED_OT; flag = 0;
+ if (!((token_type==SEP_TT)&&(token_value==CLOSEB_SEP)))
+ { put_token_back();
+ spare_debug_location2 = get_token_location();
+ AO2 = parse_expression(VOID_CONTEXT);
+ match_close_bracket();
+ flag = test_for_incdec(AO2);
+ }
+
+ ln = next_label++;
+ ln2 = next_label++;
+ ln3 = next_label++;
+
+ if ((AO2.type == OMITTED_OT) || (flag != 0))
+ {
+ assemble_label_no(ln);
+ if (flag==0) assemble_label_no(ln2);
+
+ /* The "finished yet?" condition */
+
+ if (AO.type != OMITTED_OT)
+ { sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location1;
+ code_generate(AO, CONDITION_CONTEXT, ln3);
+ }
+
+ }
+ else
+ {
+ /* This is the jump which could be avoided with the aid
+ of long-term expression storage */
+
+ sequence_point_follows = FALSE;
+ assembleg_jump(ln2);
+
+ /* The "update" part */
+
+ assemble_label_no(ln);
+ sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location2;
+ code_generate(AO2, VOID_CONTEXT, -1);
+
+ assemble_label_no(ln2);
+
+ /* The "finished yet?" condition */
+
+ if (AO.type != OMITTED_OT)
+ { sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location1;
+ code_generate(AO, CONDITION_CONTEXT, ln3);
+ }
+ }
+
+ if (flag != 0)
+ {
+ /* In this optimised case, update code is at the end
+ of the loop block, so "continue" goes there */
+
+ parse_code_block(ln3, ln2, 0);
+ assemble_label_no(ln2);
+
+ sequence_point_follows = TRUE;
+ statement_debug_location = spare_debug_location2;
+ if (flag > 0)
+ { INITAO(&AO3);
+ AO3.value = flag;
+ if (AO3.value >= MAX_LOCAL_VARIABLES)
+ AO3.type = GLOBALVAR_OT;
+ else
+ AO3.type = LOCALVAR_OT;
+ assembleg_3(add_gc, AO3, one_operand, AO3);
+ }
+ else
+ { INITAO(&AO3);
+ AO3.value = -flag;
+ if (AO3.value >= MAX_LOCAL_VARIABLES)
+ AO3.type = GLOBALVAR_OT;
+ else
+ AO3.type = LOCALVAR_OT;
+ assembleg_3(sub_gc, AO3, one_operand, AO3);
+ }
+ assembleg_jump(ln);
+ }
+ else
+ {
+ /* In the unoptimised case, update code is at the
+ start of the loop block, so "continue" goes there */
+
+ parse_code_block(ln3, ln, 0);
+ if (!execution_never_reaches_here)
+ { sequence_point_follows = FALSE;
+ assembleg_jump(ln);
+ }
+ }
+
+ assemble_label_no(ln3);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* give <expression> [~]attr [, [~]attr [, ...]] ---------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case GIVE_CODE:
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ if ((AO.type == LOCALVAR_OT) && (AO.value == 0))
+ onstack = TRUE;
+ else
+ onstack = FALSE;
+
+ do
+ { get_next_token();
+ if ((token_type == SEP_TT)
+ && (token_value == SEMICOLON_SEP)) {
+ if (onstack) {
+ assembleg_2(copy_gc, stack_pointer, zero_operand);
+ }
+ return;
+ }
+ if ((token_type == SEP_TT)&&(token_value == ARTNOT_SEP))
+ ln = 0;
+ else
+ { if ((token_type == SYMBOL_TT)
+ && (stypes[token_value] != ATTRIBUTE_T))
+ warning_named("This is not a declared Attribute:",
+ token_text);
+ ln = 1;
+ put_token_back();
+ }
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ if (runtime_error_checking_switch && (!veneer_mode))
+ { ln2 = (ln ? RT__ChG_VR : RT__ChGt_VR);
+ if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
+ /* already on stack */
+ }
+ else {
+ assembleg_store(stack_pointer, AO2);
+ }
+ if (onstack)
+ assembleg_2(stkpeek_gc, one_operand, stack_pointer);
+ else
+ assembleg_store(stack_pointer, AO);
+ assembleg_3(call_gc, veneer_routine(ln2), two_operand,
+ zero_operand);
+ }
+ else {
+ if (is_constant_ot(AO2.type) && AO2.marker == 0) {
+ AO2.value += 8;
+ set_constant_ot(&AO2);
+ }
+ else {
+ INITAOTV(&AO3, BYTECONSTANT_OT, 8);
+ assembleg_3(add_gc, AO2, AO3, stack_pointer);
+ AO2 = stack_pointer;
+ }
+ if (onstack) {
+ if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
+ assembleg_2(stkpeek_gc, one_operand,
+ stack_pointer);
+ else
+ assembleg_2(stkpeek_gc, zero_operand,
+ stack_pointer);
+ }
+ if (ln)
+ AO3 = one_operand;
+ else
+ AO3 = zero_operand;
+ assembleg_3(astorebit_gc, AO, AO2, AO3);
+ }
+ } while(TRUE);
+
+ /* -------------------------------------------------------------------- */
+ /* if (<condition>) <codeblock> [else <codeblock>] -------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case IF_CODE:
+ flag = FALSE;
+ ln2 = 0;
+
+ match_open_bracket();
+ AO = parse_expression(CONDITION_CONTEXT);
+ match_close_bracket();
+
+ statements.enabled = TRUE;
+ get_next_token();
+ if ((token_type == STATEMENT_TT)&&(token_value == RTRUE_CODE))
+ ln = -4;
+ else
+ if ((token_type == STATEMENT_TT)&&(token_value == RFALSE_CODE))
+ ln = -3;
+ else
+ { put_token_back();
+ ln = next_label++;
+ }
+
+ code_generate(AO, CONDITION_CONTEXT, ln);
+
+ if (ln >= 0) parse_code_block(break_label, continue_label, 0);
+ else
+ { get_next_token();
+ if ((token_type != SEP_TT)
+ || (token_value != SEMICOLON_SEP))
+ { ebf_error("';'", token_text);
+ put_token_back();
+ }
+ }
+
+ statements.enabled = TRUE;
+ get_next_token();
+ if ((token_type == STATEMENT_TT) && (token_value == ELSE_CODE))
+ { flag = TRUE;
+ if (ln >= 0)
+ { ln2 = next_label++;
+ if (!execution_never_reaches_here)
+ { sequence_point_follows = FALSE;
+ assembleg_jump(ln2);
+ }
+ }
+ }
+ else put_token_back();
+
+ if (ln >= 0) assemble_label_no(ln);
+
+ if (flag)
+ { parse_code_block(break_label, continue_label, 0);
+ if (ln >= 0) assemble_label_no(ln2);
+ }
+
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* inversion ---------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case INVERSION_CODE:
+ INITAOTV(&AO2, DEREFERENCE_OT, GLULX_HEADER_SIZE+8);
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+ AO2.value = GLULX_HEADER_SIZE+9;
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+ AO2.value = GLULX_HEADER_SIZE+10;
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+ AO2.value = GLULX_HEADER_SIZE+11;
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+
+ if (/* DISABLES CODE */ (0)) {
+ INITAO(&AO);
+ AO.value = '(';
+ set_constant_ot(&AO);
+ assembleg_1(streamchar_gc, AO);
+ AO.value = 'G';
+ set_constant_ot(&AO);
+ assembleg_1(streamchar_gc, AO);
+
+ AO2.value = GLULX_HEADER_SIZE+12;
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+ AO2.value = GLULX_HEADER_SIZE+13;
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+ AO2.value = GLULX_HEADER_SIZE+14;
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+ AO2.value = GLULX_HEADER_SIZE+15;
+ assembleg_2(copyb_gc, AO2, stack_pointer);
+ assembleg_1(streamchar_gc, stack_pointer);
+
+ AO.marker = 0;
+ AO.value = ')';
+ set_constant_ot(&AO);
+ assembleg_1(streamchar_gc, AO);
+ }
+
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* jump <label> ------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case JUMP_CODE:
+ assembleg_jump(parse_label());
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* move <expression> to <expression> ---------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case MOVE_CODE:
+ misc_keywords.enabled = TRUE;
+ AO = parse_expression(QUANTITY_CONTEXT);
+
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ if ((token_type != MISC_KEYWORD_TT)
+ || (token_value != TO_MK))
+ { ebf_error("'to'", token_text);
+ panic_mode_error_recovery();
+ return;
+ }
+
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ AO = code_generate(AO, QUANTITY_CONTEXT, -1);
+ if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
+ assembleg_call_2(veneer_routine(RT__ChT_VR), AO, AO2,
+ zero_operand);
+ else
+ assembleg_call_2(veneer_routine(OB__Move_VR), AO, AO2,
+ zero_operand);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* new_line ----------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case NEW_LINE_CODE:
+ INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
+ assembleg_1(streamchar_gc, AO);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* objectloop (<initialisation>) <codeblock> -------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case OBJECTLOOP_CODE:
+
+ match_open_bracket();
+ get_next_token();
+ if (token_type == LOCAL_VARIABLE_TT) {
+ INITAOTV(&AO, LOCALVAR_OT, token_value);
+ }
+ else if ((token_type == SYMBOL_TT) &&
+ (stypes[token_value] == GLOBAL_VARIABLE_T)) {
+ INITAOTV(&AO, GLOBALVAR_OT, svals[token_value]);
+ }
+ else {
+ ebf_error("'objectloop' variable", token_text);
+ panic_mode_error_recovery();
+ break;
+ }
+ misc_keywords.enabled = TRUE;
+ get_next_token(); flag = TRUE;
+ misc_keywords.enabled = FALSE;
+ if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
+ flag = FALSE;
+
+ ln = 0;
+ if ((token_type == MISC_KEYWORD_TT)
+ && (token_value == NEAR_MK)) ln = 1;
+ if ((token_type == MISC_KEYWORD_TT)
+ && (token_value == FROM_MK)) ln = 2;
+ if ((token_type == CND_TT) && (token_value == IN_COND))
+ { get_next_token();
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
+ ln = 3;
+ put_token_back();
+ put_token_back();
+ }
+
+ if (ln != 0) {
+ /* Old style (Inform 5) objectloops: note that we
+ implement objectloop (a in b) in the old way since
+ this runs through objects in a different order from
+ the new way, and there may be existing Inform code
+ relying on this. */
+ assembly_operand AO4, AO5;
+ INITAO(&AO5);
+
+ sequence_point_follows = TRUE;
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ match_close_bracket();
+ if (ln == 1) {
+ if (runtime_error_checking_switch)
+ AO2 = check_nonzero_at_runtime(AO2, -1,
+ OBJECTLOOP_RTE);
+ INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_PARENT());
+ assembleg_3(aload_gc, AO2, AO4, stack_pointer);
+ INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_CHILD());
+ assembleg_3(aload_gc, stack_pointer, AO4, stack_pointer);
+ AO2 = stack_pointer;
+ }
+ else if (ln == 3) {
+ if (runtime_error_checking_switch) {
+ AO5 = AO2;
+ AO2 = check_nonzero_at_runtime(AO2, -1,
+ CHILD_RTE);
+ }
+ INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_CHILD());
+ assembleg_3(aload_gc, AO2, AO4, stack_pointer);
+ AO2 = stack_pointer;
+ }
+ else {
+ /* do nothing */
+ }
+ assembleg_store(AO, AO2);
+ assembleg_1_branch(jz_gc, AO, ln2 = next_label++);
+ assemble_label_no(ln4 = next_label++);
+ parse_code_block(ln2, ln3 = next_label++, 0);
+ sequence_point_follows = FALSE;
+ assemble_label_no(ln3);
+ if (runtime_error_checking_switch) {
+ AO2 = check_nonzero_at_runtime(AO, ln2,
+ OBJECTLOOP2_RTE);
+ if ((ln == 3)
+ && ((AO5.type != LOCALVAR_OT)||(AO5.value != 0))
+ && ((AO5.type != LOCALVAR_OT)||(AO5.value != AO.value)))
+ { assembly_operand en_ao;
+ INITAO(&en_ao);
+ en_ao.value = OBJECTLOOP_BROKEN_RTE;
+ set_constant_ot(&en_ao);
+ INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_PARENT());
+ assembleg_3(aload_gc, AO, AO4, stack_pointer);
+ assembleg_2_branch(jeq_gc, stack_pointer, AO5,
+ next_label);
+ assembleg_call_2(veneer_routine(RT__Err_VR),
+ en_ao, AO, zero_operand);
+ assembleg_jump(ln2);
+ assemble_label_no(next_label++);
+ }
+ }
+ else {
+ AO2 = AO;
+ }
+ INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
+ assembleg_3(aload_gc, AO2, AO4, AO);
+ assembleg_1_branch(jnz_gc, AO, ln4);
+ assemble_label_no(ln2);
+ return;
+ }
+
+ sequence_point_follows = TRUE;
+ ln = symbol_index("Class", -1);
+ INITAOT(&AO2, CONSTANT_OT);
+ AO2.value = svals[ln];
+ AO2.marker = OBJECT_MV;
+ assembleg_store(AO, AO2);
+
+ assemble_label_no(ln = next_label++);
+ ln2 = next_label++;
+ ln3 = next_label++;
+ if (flag)
+ { put_token_back();
+ put_token_back();
+ sequence_point_follows = TRUE;
+ code_generate(parse_expression(CONDITION_CONTEXT),
+ CONDITION_CONTEXT, ln3);
+ match_close_bracket();
+ }
+ parse_code_block(ln2, ln3, 0);
+
+ sequence_point_follows = FALSE;
+ assemble_label_no(ln3);
+ INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_CHAIN());
+ assembleg_3(aload_gc, AO, AO4, AO);
+ assembleg_1_branch(jnz_gc, AO, ln);
+ assemble_label_no(ln2);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* (see routine above) ------------------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case PRINT_CODE:
+ get_next_token();
+ parse_print_g(FALSE); return;
+ case PRINT_RET_CODE:
+ get_next_token();
+ parse_print_g(TRUE); return;
+
+ /* -------------------------------------------------------------------- */
+ /* quit --------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case QUIT_CODE:
+ assembleg_0(quit_gc); break;
+
+ /* -------------------------------------------------------------------- */
+ /* remove <expression> ------------------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case REMOVE_CODE:
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
+ assembleg_call_1(veneer_routine(RT__ChR_VR), AO,
+ zero_operand);
+ else
+ assembleg_call_1(veneer_routine(OB__Remove_VR), AO,
+ zero_operand);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* return [<expression>] ---------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case RETURN_CODE:
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
+ assembleg_1(return_gc, one_operand);
+ return;
+ }
+ put_token_back();
+ AO = code_generate(parse_expression(RETURN_Q_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ assembleg_1(return_gc, AO);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* rfalse ------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case RFALSE_CODE:
+ assembleg_1(return_gc, zero_operand);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* rtrue -------------------------------------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case RTRUE_CODE:
+ assembleg_1(return_gc, one_operand);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* spaces <expression> ------------------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case SPACES_CODE:
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+
+ assembleg_store(temp_var1, AO);
+
+ INITAO(&AO);
+ AO.value = 32; set_constant_ot(&AO);
+
+ assembleg_2_branch(jlt_gc, temp_var1, one_operand,
+ ln = next_label++);
+ assemble_label_no(ln2 = next_label++);
+ assembleg_1(streamchar_gc, AO);
+ assembleg_dec(temp_var1);
+ assembleg_1_branch(jnz_gc, temp_var1, ln2);
+ assemble_label_no(ln);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* string <expression> <literal-string> ------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case STRING_CODE:
+ AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ get_next_token();
+ if (token_type == DQ_TT)
+ { INITAOT(&AO4, CONSTANT_OT);
+ AO4.value = compile_string(token_text, TRUE, TRUE);
+ AO4.marker = STRING_MV;
+ }
+ else
+ { put_token_back();
+ AO4 = parse_expression(CONSTANT_CONTEXT);
+ }
+ assembleg_call_2(veneer_routine(Dynam__String_VR),
+ AO2, AO4, zero_operand);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* style roman/reverse/bold/underline/fixed --------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case STYLE_CODE:
+ misc_keywords.enabled = TRUE;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+ if ((token_type != MISC_KEYWORD_TT)
+ || ((token_value != ROMAN_MK)
+ && (token_value != REVERSE_MK)
+ && (token_value != BOLD_MK)
+ && (token_value != UNDERLINE_MK)
+ && (token_value != FIXED_MK)))
+ { ebf_error(
+"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
+ token_text);
+ panic_mode_error_recovery();
+ break;
+ }
+
+ /* Call glk_set_style() */
+
+ INITAO(&AO);
+ AO.value = 0x0086;
+ set_constant_ot(&AO);
+ switch(token_value)
+ { case ROMAN_MK:
+ default:
+ AO2 = zero_operand; /* normal */
+ break;
+ case REVERSE_MK:
+ INITAO(&AO2);
+ AO2.value = 5; /* alert */
+ set_constant_ot(&AO2);
+ break;
+ case BOLD_MK:
+ INITAO(&AO2);
+ AO2.value = 4; /* subheader */
+ set_constant_ot(&AO2);
+ break;
+ case UNDERLINE_MK:
+ AO2 = one_operand; /* emphasized */
+ break;
+ case FIXED_MK:
+ AO2 = two_operand; /* preformatted */
+ break;
+ }
+ assembleg_call_2(veneer_routine(Glk__Wrap_VR),
+ AO, AO2, zero_operand);
+ break;
+
+ /* -------------------------------------------------------------------- */
+ /* switch (<expression>) <codeblock> ---------------------------------- */
+ /* -------------------------------------------------------------------- */
+
+ case SWITCH_CODE:
+ match_open_bracket();
+ AO = code_generate(parse_expression(QUANTITY_CONTEXT),
+ QUANTITY_CONTEXT, -1);
+ match_close_bracket();
+
+ assembleg_store(temp_var1, AO);
+
+ parse_code_block(ln = next_label++, continue_label, 1);
+ assemble_label_no(ln);
+ return;
+
+ /* -------------------------------------------------------------------- */
+ /* while (<condition>) <codeblock> ------------------------------------ */
+ /* -------------------------------------------------------------------- */
+
+ case WHILE_CODE:
+ assemble_label_no(ln = next_label++);
+ match_open_bracket();
+
+ code_generate(parse_expression(CONDITION_CONTEXT),
+ CONDITION_CONTEXT, ln2 = next_label++);
+ match_close_bracket();
+
+ parse_code_block(ln2, ln, 0);
+ sequence_point_follows = FALSE;
+ assembleg_jump(ln);
+ assemble_label_no(ln2);
+ return;
+
+ /* -------------------------------------------------------------------- */
+
+ case SDEFAULT_CODE:
+ error("'default' without matching 'switch'"); break;
+ case ELSE_CODE:
+ error("'else' without matching 'if'"); break;
+ case UNTIL_CODE:
+ error("'until' without matching 'do'");
+ panic_mode_error_recovery(); return;
+
+ /* -------------------------------------------------------------------- */
+
+ /* And a useful default, which will never be triggered in a complete
+ Inform compiler, but which is important in development. */
+
+ default:
+ error("*** Statement code gen: Can't generate yet ***\n");
+ panic_mode_error_recovery(); return;
+ }
+
+ StatementTerminator:
+
+ get_next_token();
+ if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+ { ebf_error("';'", token_text);
+ put_token_back();
+ }
+}
+
+extern void parse_statement(int break_label, int continue_label)
+{
+ if (!glulx_mode)
+ parse_statement_z(break_label, continue_label);
+ else
+ parse_statement_g(break_label, continue_label);
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_states_vars(void)
+{
+}
+
+extern void states_begin_pass(void)
+{
+}
+
+extern void states_allocate_arrays(void)
+{
+}
+
+extern void states_free_arrays(void)
+{
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "symbols" : The symbols table; creating stock of reserved words */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+/* ------------------------------------------------------------------------- */
+/* This section of Inform is a service detached from the rest. */
+/* Only two variables are accessible from the outside: */
+/* ------------------------------------------------------------------------- */
+
+int no_symbols; /* Total number of symbols defined */
+int no_named_constants; /* Copied into story file */
+
+/* ------------------------------------------------------------------------- */
+/* Plus six arrays. Each symbol has its own index n (an int32) and */
+/* */
+/* svals[n] is its value (must be 32 bits wide, i.e. an int32, tho' */
+/* it is used to hold an unsigned 16 bit Z-machine value) */
+/* sflags[n] holds flags (see "header.h" for a list) */
+/* stypes[n] is the "type", distinguishing between the data type of */
+/* different kinds of constants/variables. */
+/* (See the "typename()" below.) */
+/* symbs[n] (needs to be cast to (char *) to be used) is the name */
+/* of the symbol, in the same case form as when created. */
+/* slines[n] is the source line on which the symbol value was first */
+/* assigned */
+/* symbol_debug_backpatch_positions[n] */
+/* is a file position in the debug information file where */
+/* the symbol's value should be written after backpatching, */
+/* or else the null position if the value was known and */
+/* written beforehand */
+/* replacement_debug_backpatch_positions[n] */
+/* is a file position in the debug information file where */
+/* the symbol's name can be erased if it is replaced, or */
+/* else null if the name will never need to be replaced */
+/* */
+/* Comparison is case insensitive. */
+/* Note that local variable names are not entered into the symbols table, */
+/* as their numbers and scope are too limited for this to be efficient. */
+/* ------------------------------------------------------------------------- */
+/* Caveat editor: some array types are set up to work even on machines */
+/* where sizeof(int32 *) differs from, e.g., sizeof(char *): so do not */
+/* alter the types unless you understand what is going on! */
+/* ------------------------------------------------------------------------- */
+
+ int32 **symbs;
+ int32 *svals;
+ int *smarks; /* Glulx-only */
+ brief_location *slines;
+ int *sflags;
+#ifdef VAX
+ char *stypes; /* In VAX C, insanely, "signed char" is illegal */
+#else
+ signed char *stypes;
+#endif
+ maybe_file_position *symbol_debug_backpatch_positions;
+ maybe_file_position *replacement_debug_backpatch_positions;
+
+/* ------------------------------------------------------------------------- */
+/* Memory to hold the text of symbol names: note that this memory is */
+/* allocated as needed in chunks of size SYMBOLS_CHUNK_SIZE. */
+/* ------------------------------------------------------------------------- */
+
+#define MAX_SYMBOL_CHUNKS (100)
+
+static uchar *symbols_free_space, /* Next byte free to hold new names */
+ *symbols_ceiling; /* Pointer to the end of the current
+ allocation of memory for names */
+
+static char** symbol_name_space_chunks; /* For chunks of memory used to hold
+ the name strings of symbols */
+static int no_symbol_name_space_chunks;
+
+typedef struct value_pair_struct {
+ int original_symbol;
+ int renamed_symbol;
+} value_pair_t;
+static value_pair_t *symbol_replacements;
+static int symbol_replacements_count;
+static int symbol_replacements_size; /* calloced size */
+
+/* ------------------------------------------------------------------------- */
+/* The symbols table is "hash-coded" into a disjoint union of linked */
+/* lists, so that for any symbol i, next_entry[i] is either -1 (meaning */
+/* that it's the last in its list) or the next in the list. */
+/* */
+/* Each list contains, in alphabetical order, all the symbols which share */
+/* the same "hash code" (a numerical function of the text of the symbol */
+/* name, designed with the aim that roughly equal numbers of symbols are */
+/* given each possible hash code). The hash codes are 0 to HASH_TAB_SIZE */
+/* (which is a memory setting) minus 1: start_of_list[h] gives the first */
+/* symbol with hash code h, or -1 if no symbol exists with hash code h. */
+/* */
+/* Note that the running time of the symbol search algorithm is about */
+/* */
+/* O ( n^2 / HASH_TAB_SIZE ) */
+/* */
+/* (where n is the number of symbols in the program) so that it is a good */
+/* idea to choose HASH_TAB_SIZE as large as conveniently possible. */
+/* ------------------------------------------------------------------------- */
+
+static int *next_entry;
+static int32 *start_of_list;
+
+/* ------------------------------------------------------------------------- */
+/* Initialisation. */
+/* ------------------------------------------------------------------------- */
+
+static void init_symbol_banks(void)
+{ int i;
+ for (i=0; i<HASH_TAB_SIZE; i++) start_of_list[i] = -1;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The hash coding we use is quite standard; the variable hashcode is */
+/* expected to overflow a good deal. (The aim is to produce a number */
+/* so that similar names do not produce the same number.) Note that */
+/* 30011 is prime. It doesn't matter if the unsigned int to int cast */
+/* behaves differently on different ports. */
+/* ------------------------------------------------------------------------- */
+
+int case_conversion_grid[128];
+
+static void make_case_conversion_grid(void)
+{
+ /* Assumes that A to Z are contiguous in the host OS character set:
+ true for ASCII but not for EBCDIC, for instance. */
+
+ int i;
+ for (i=0; i<128; i++) case_conversion_grid[i] = i;
+ for (i=0; i<26; i++) case_conversion_grid['A'+i]='a'+i;
+}
+
+extern int hash_code_from_string(char *p)
+{ uint32 hashcode=0;
+ for (; *p; p++) hashcode=hashcode*30011 + case_conversion_grid[(uchar)*p];
+ return (int) (hashcode % HASH_TAB_SIZE);
+}
+
+extern int strcmpcis(char *p, char *q)
+{
+ /* Case insensitive strcmp */
+
+ int i, j, pc, qc;
+ for (i=0;p[i] != 0;i++)
+ { pc = p[i]; if (isupper(pc)) pc = tolower(pc);
+ qc = q[i]; if (isupper(qc)) qc = tolower(qc);
+ j = pc - qc;
+ if (j!=0) return j;
+ }
+ qc = q[i]; if (isupper(qc)) qc = tolower(qc);
+ return -qc;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Symbol finding, creating, and removing. */
+/* ------------------------------------------------------------------------- */
+
+extern int symbol_index(char *p, int hashcode)
+{
+ /* Return the index in the symbs/svals/sflags/stypes/... arrays of symbol
+ "p", creating a new symbol with that name if it isn't already there.
+
+ New symbols are created with flag UNKNOWN_SFLAG, value 0x100
+ (a 2-byte quantity in Z-machine terms) and type CONSTANT_T.
+
+ The string "p" is undamaged. */
+
+ int32 new_entry, this, last; char *r;
+
+ if (hashcode == -1) hashcode = hash_code_from_string(p);
+
+ this = start_of_list[hashcode]; last = -1;
+
+ do
+ { if (this == -1) break;
+
+ r = (char *)symbs[this];
+ new_entry = strcmpcis(r, p);
+ if (new_entry == 0)
+ {
+ if (track_unused_routines)
+ df_note_function_symbol(this);
+ return this;
+ }
+ if (new_entry > 0) break;
+
+ last = this;
+ this = next_entry[this];
+ } while (this != -1);
+
+ if (no_symbols >= MAX_SYMBOLS)
+ memoryerror("MAX_SYMBOLS", MAX_SYMBOLS);
+
+ if (last == -1)
+ { next_entry[no_symbols]=start_of_list[hashcode];
+ start_of_list[hashcode]=no_symbols;
+ }
+ else
+ { next_entry[no_symbols]=this;
+ next_entry[last]=no_symbols;
+ }
+
+ if (symbols_free_space+strlen(p)+1 >= symbols_ceiling)
+ { symbols_free_space
+ = my_malloc(SYMBOLS_CHUNK_SIZE, "symbol names chunk");
+ symbols_ceiling = symbols_free_space + SYMBOLS_CHUNK_SIZE;
+ /* If we've passed MAX_SYMBOL_CHUNKS chunks, we print an error
+ message telling the user to increase SYMBOLS_CHUNK_SIZE.
+ That is the correct cure, even though the error comes out
+ worded inaccurately. */
+ if (no_symbol_name_space_chunks >= MAX_SYMBOL_CHUNKS)
+ memoryerror("SYMBOLS_CHUNK_SIZE", SYMBOLS_CHUNK_SIZE);
+ symbol_name_space_chunks[no_symbol_name_space_chunks++]
+ = (char *) symbols_free_space;
+ if (symbols_free_space+strlen(p)+1 >= symbols_ceiling)
+ memoryerror("SYMBOLS_CHUNK_SIZE", SYMBOLS_CHUNK_SIZE);
+ }
+
+ strcpy((char *) symbols_free_space, p);
+ symbs[no_symbols] = (int32 *) symbols_free_space;
+ symbols_free_space += strlen((char *)symbols_free_space) + 1;
+
+ svals[no_symbols] = 0x100; /* ###-wrong? Would this fix the
+ unbound-symbol-causes-asm-error? */
+ sflags[no_symbols] = UNKNOWN_SFLAG;
+ stypes[no_symbols] = CONSTANT_T;
+ slines[no_symbols] = get_brief_location(&ErrorReport);
+ if (debugfile_switch)
+ { nullify_debug_file_position
+ (&symbol_debug_backpatch_positions[no_symbols]);
+ nullify_debug_file_position
+ (&replacement_debug_backpatch_positions[no_symbols]);
+ }
+
+ if (track_unused_routines)
+ df_note_function_symbol(no_symbols);
+ return(no_symbols++);
+}
+
+extern void end_symbol_scope(int k)
+{
+ /* 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.
+ */
+
+ int j;
+ j = hash_code_from_string((char *) symbs[k]);
+ if (start_of_list[j] == k)
+ { start_of_list[j] = next_entry[k];
+ return;
+ }
+ j = start_of_list[j];
+ while (j != -1)
+ {
+ if (next_entry[j] == k)
+ { next_entry[j] = next_entry[k];
+ return;
+ }
+ j = next_entry[j];
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Printing diagnostics */
+/* ------------------------------------------------------------------------- */
+
+extern char *typename(int type)
+{ switch(type)
+ {
+ /* These are the possible symbol types. Note that local variables
+ do not reside in the symbol table (for scope and efficiency
+ reasons) and actions have their own name-space (via routine
+ names with "Sub" appended). */
+
+ case ROUTINE_T: return("Routine");
+ case LABEL_T: return("Label");
+ case GLOBAL_VARIABLE_T: return("Global variable");
+ case ARRAY_T: return("Array");
+ case CONSTANT_T: return("Defined constant");
+ case ATTRIBUTE_T: return("Attribute");
+ case PROPERTY_T: return("Property");
+ case INDIVIDUAL_PROPERTY_T: return("Individual property");
+ case OBJECT_T: return("Object");
+ case CLASS_T: return("Class");
+ case FAKE_ACTION_T: return("Fake action");
+
+ default: return("(Unknown type)");
+ }
+}
+
+static void describe_flags(int flags)
+{ if (flags & UNKNOWN_SFLAG) printf("(?) ");
+ if (flags & USED_SFLAG) printf("(used) ");
+ if (flags & REPLACE_SFLAG) printf("(Replaced) ");
+ if (flags & DEFCON_SFLAG) printf("(Defaulted) ");
+ if (flags & STUB_SFLAG) printf("(Stubbed) ");
+ if (flags & CHANGE_SFLAG) printf("(value will change) ");
+ if (flags & IMPORT_SFLAG) printf("(Imported) ");
+ if (flags & EXPORT_SFLAG) printf("(Exported) ");
+ if (flags & SYSTEM_SFLAG) printf("(System) ");
+ if (flags & INSF_SFLAG) printf("(created in sys file) ");
+ if (flags & UERROR_SFLAG) printf("('Unknown' error issued) ");
+ if (flags & ALIASED_SFLAG) printf("(aliased) ");
+ if (flags & ACTION_SFLAG) printf("(Action name) ");
+ if (flags & REDEFINABLE_SFLAG) printf("(Redefinable) ");
+}
+
+extern void describe_symbol(int k)
+{ printf("%4d %-16s %2d:%04d %04x %s ",
+ k, (char *) (symbs[k]),
+ (int)(slines[k].file_index),
+ (int)(slines[k].line_number),
+ svals[k], typename(stypes[k]));
+ describe_flags(sflags[k]);
+}
+
+extern void list_symbols(int level)
+{ int k;
+ for (k=0; k<no_symbols; k++)
+ { if ((level==2) ||
+ ((sflags[k] & (SYSTEM_SFLAG + UNKNOWN_SFLAG + INSF_SFLAG)) == 0))
+ { describe_symbol(k); printf("\n");
+ }
+ }
+}
+
+extern void issue_unused_warnings(void)
+{ int32 i;
+
+ if (module_switch) return;
+
+ /* Update any ad-hoc variables that might help the library */
+ if (glulx_mode)
+ { global_initial_value[10]=statusline_flag;
+ }
+ /* Now back to mark anything necessary as used */
+
+ i = symbol_index("Main", -1);
+ if (!(sflags[i] & UNKNOWN_SFLAG)) sflags[i] |= USED_SFLAG;
+
+ for (i=0;i<no_symbols;i++)
+ { if (((sflags[i]
+ & (SYSTEM_SFLAG + UNKNOWN_SFLAG + EXPORT_SFLAG
+ + INSF_SFLAG + USED_SFLAG + REPLACE_SFLAG)) == 0)
+ && (stypes[i] != OBJECT_T))
+ dbnu_warning(typename(stypes[i]), (char *) symbs[i], slines[i]);
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* These are arrays used only during story file (never module) creation, */
+/* and not allocated until then. */
+
+ int32 *individual_name_strings; /* Packed addresses of Z-encoded
+ strings of the names of the
+ properties: this is an array
+ indexed by the property ID */
+ int32 *action_name_strings; /* Ditto for actions */
+ int32 *attribute_name_strings; /* Ditto for attributes */
+ 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];
+ static char unknown_attribute[20] = "<unknown attribute>";
+
+ for (i=0; i<no_individual_properties; i++)
+ individual_name_strings[i] = 0;
+
+ if (module_switch) return;
+
+ veneer_mode = TRUE;
+
+ null_value = compile_string(unknown_attribute, FALSE, FALSE);
+ for (i=0; i<NUM_ATTR_BYTES*8; i++) attribute_name_strings[i] = null_value;
+
+ for (i=0; i<no_symbols; i++)
+ { t=stypes[i];
+ if ((t == INDIVIDUAL_PROPERTY_T) || (t == PROPERTY_T))
+ { if (sflags[i] & ALIASED_SFLAG)
+ { if (individual_name_strings[svals[i]] == 0)
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+
+ for (j=i+1, k=0; (j<no_symbols && k<3); j++)
+ { if ((stypes[j] == stypes[i])
+ && (svals[j] == svals[i]))
+ { sprintf(idname_string+strlen(idname_string),
+ "/%s", (char *) symbs[j]);
+ k++;
+ }
+ }
+
+ individual_name_strings[svals[i]]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+ else
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+
+ individual_name_strings[svals[i]]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+ if (t == ATTRIBUTE_T)
+ { if (sflags[i] & ALIASED_SFLAG)
+ { if (attribute_name_strings[svals[i]] == null_value)
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+
+ for (j=i+1, k=0; (j<no_symbols && k<3); j++)
+ { if ((stypes[j] == stypes[i])
+ && (svals[j] == svals[i]))
+ { sprintf(idname_string+strlen(idname_string),
+ "/%s", (char *) symbs[j]);
+ k++;
+ }
+ }
+
+ attribute_name_strings[svals[i]]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+ else
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+
+ attribute_name_strings[svals[i]]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+ if (sflags[i] & ACTION_SFLAG)
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+ idname_string[strlen(idname_string)-3] = 0;
+
+ if (debugfile_switch)
+ { debug_file_printf("<action>");
+ debug_file_printf
+ ("<identifier>##%s</identifier>", idname_string);
+ debug_file_printf("<value>%d</value>", svals[i]);
+ debug_file_printf("</action>");
+ }
+
+ action_name_strings[svals[i]]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+
+ for (i=0; i<no_symbols; i++)
+ { if (stypes[i] == FAKE_ACTION_T)
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+ idname_string[strlen(idname_string)-3] = 0;
+
+ action_name_strings[svals[i]
+ - ((grammar_version_number==1)?256:4096) + no_actions]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+
+ for (j=0; j<no_arrays; j++)
+ { i = array_symbols[j];
+ sprintf(idname_string, "%s", (char *) symbs[i]);
+
+ array_name_strings[j]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ if (define_INFIX_switch)
+ { for (i=0; i<no_symbols; i++)
+ { if (stypes[i] == GLOBAL_VARIABLE_T)
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+ array_name_strings[no_arrays + svals[i] -16]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+
+ for (i=0; i<no_named_routines; i++)
+ { sprintf(idname_string, "%s", (char *) symbs[named_routine_symbols[i]]);
+ array_name_strings[no_arrays + no_globals + i]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+
+ for (i=0, no_named_constants=0; i<no_symbols; i++)
+ { if (((stypes[i] == OBJECT_T) || (stypes[i] == CLASS_T)
+ || (stypes[i] == CONSTANT_T))
+ && ((sflags[i] & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
+ { sprintf(idname_string, "%s", (char *) symbs[i]);
+ array_name_strings[no_arrays + no_globals + no_named_routines
+ + no_named_constants++]
+ = compile_string(idname_string, FALSE, FALSE);
+ }
+ }
+ }
+
+ veneer_mode = FALSE;
+}
+/* ------------------------------------------------------------------------- */
+/* Creating symbols */
+/* ------------------------------------------------------------------------- */
+
+static void assign_symbol_base(int index, int32 value, int type)
+{ svals[index] = value;
+ stypes[index] = type;
+ if (sflags[index] & UNKNOWN_SFLAG)
+ { sflags[index] &= (~UNKNOWN_SFLAG);
+ if (is_systemfile()) sflags[index] |= INSF_SFLAG;
+ slines[index] = get_brief_location(&ErrorReport);
+ }
+}
+
+extern void assign_symbol(int index, int32 value, int type)
+{
+ if (!glulx_mode) {
+ assign_symbol_base(index, value, type);
+ }
+ else {
+ smarks[index] = 0;
+ assign_symbol_base(index, value, type);
+ }
+}
+
+extern void assign_marked_symbol(int index, int marker, int32 value, int type)
+{
+ if (!glulx_mode) {
+ assign_symbol_base(index, (int32)marker*0x10000 + (value % 0x10000),
+ type);
+ }
+ else {
+ smarks[index] = marker;
+ assign_symbol_base(index, value, type);
+ }
+}
+
+static void emit_debug_information_for_predefined_symbol
+ (char *name, int32 symbol, int32 value, int type)
+{ if (debugfile_switch)
+ { switch (type)
+ { case CONSTANT_T:
+ debug_file_printf("<constant>");
+ debug_file_printf("<identifier>%s</identifier>", name);
+ write_debug_symbol_optional_backpatch(symbol);
+ debug_file_printf("</constant>");
+ break;
+ case GLOBAL_VARIABLE_T:
+ debug_file_printf("<global-variable>");
+ debug_file_printf("<identifier>%s</identifier>", name);
+ debug_file_printf("<address>");
+ write_debug_global_backpatch(value);
+ debug_file_printf("</address>");
+ debug_file_printf("</global-variable>");
+ break;
+ case OBJECT_T:
+ if (value)
+ { compiler_error("Non-nothing object predefined");
+ }
+ debug_file_printf("<object>");
+ debug_file_printf("<identifier>%s</identifier>", name);
+ debug_file_printf("<value>0</value>");
+ debug_file_printf("</object>");
+ break;
+ case ATTRIBUTE_T:
+ debug_file_printf("<attribute>");
+ debug_file_printf("<identifier>%s</identifier>", name);
+ debug_file_printf("<value>%d</value>", value);
+ debug_file_printf("</attribute>");
+ break;
+ case PROPERTY_T:
+ case INDIVIDUAL_PROPERTY_T:
+ debug_file_printf("<property>");
+ debug_file_printf("<identifier>%s</identifier>", name);
+ debug_file_printf("<value>%d</value>", value);
+ debug_file_printf("</property>");
+ break;
+ default:
+ compiler_error
+ ("Unable to emit debug information for predefined symbol");
+ break;
+ }
+ }
+}
+
+static void create_symbol(char *p, int32 value, int type)
+{ int i = symbol_index(p, -1);
+ svals[i] = value; stypes[i] = type; slines[i] = blank_brief_location;
+ sflags[i] = USED_SFLAG + SYSTEM_SFLAG;
+ emit_debug_information_for_predefined_symbol(p, i, value, type);
+}
+
+static void create_rsymbol(char *p, int value, int type)
+{ int i = symbol_index(p, -1);
+ svals[i] = value; stypes[i] = type; slines[i] = blank_brief_location;
+ sflags[i] = USED_SFLAG + SYSTEM_SFLAG + REDEFINABLE_SFLAG;
+ emit_debug_information_for_predefined_symbol(p, i, value, type);
+}
+
+static void stockup_symbols(void)
+{
+ if (!glulx_mode)
+ create_symbol("TARGET_ZCODE", 0, CONSTANT_T);
+ else
+ create_symbol("TARGET_GLULX", 0, CONSTANT_T);
+
+ create_symbol("nothing", 0, OBJECT_T);
+ create_symbol("name", 1, PROPERTY_T);
+
+ create_symbol("true", 1, CONSTANT_T);
+ create_symbol("false", 0, CONSTANT_T);
+
+ /* Glulx defaults to GV2; Z-code to GV1 */
+ if (!glulx_mode)
+ create_rsymbol("Grammar__Version", 1, CONSTANT_T);
+ else
+ create_rsymbol("Grammar__Version", 2, CONSTANT_T);
+ grammar_version_symbol = symbol_index("Grammar__Version", -1);
+
+ if (module_switch)
+ create_rsymbol("MODULE_MODE",0, CONSTANT_T);
+
+ if (runtime_error_checking_switch)
+ create_rsymbol("STRICT_MODE",0, CONSTANT_T);
+
+ if (define_DEBUG_switch)
+ create_rsymbol("DEBUG", 0, CONSTANT_T);
+
+ if (define_USE_MODULES_switch)
+ create_rsymbol("USE_MODULES",0, CONSTANT_T);
+
+ if (define_INFIX_switch)
+ { create_rsymbol("INFIX", 0, CONSTANT_T);
+ create_symbol("infix__watching", 0, ATTRIBUTE_T);
+ }
+
+ create_symbol("WORDSIZE", WORDSIZE, CONSTANT_T);
+ create_symbol("DICT_ENTRY_BYTES", DICT_ENTRY_BYTE_LENGTH, CONSTANT_T);
+ if (!glulx_mode) {
+ create_symbol("DICT_WORD_SIZE", ((version_number==3)?4:6), CONSTANT_T);
+ create_symbol("NUM_ATTR_BYTES", ((version_number==3)?4:6), CONSTANT_T);
+ }
+ else {
+ create_symbol("DICT_WORD_SIZE", DICT_WORD_SIZE, CONSTANT_T);
+ create_symbol("DICT_CHAR_SIZE", DICT_CHAR_SIZE, CONSTANT_T);
+ if (DICT_CHAR_SIZE != 1)
+ create_symbol("DICT_IS_UNICODE", 1, CONSTANT_T);
+ create_symbol("NUM_ATTR_BYTES", NUM_ATTR_BYTES, CONSTANT_T);
+ create_symbol("GOBJFIELD_CHAIN", GOBJFIELD_CHAIN(), CONSTANT_T);
+ create_symbol("GOBJFIELD_NAME", GOBJFIELD_NAME(), CONSTANT_T);
+ create_symbol("GOBJFIELD_PROPTAB", GOBJFIELD_PROPTAB(), CONSTANT_T);
+ create_symbol("GOBJFIELD_PARENT", GOBJFIELD_PARENT(), CONSTANT_T);
+ create_symbol("GOBJFIELD_SIBLING", GOBJFIELD_SIBLING(), CONSTANT_T);
+ create_symbol("GOBJFIELD_CHILD", GOBJFIELD_CHILD(), CONSTANT_T);
+ create_symbol("GOBJ_EXT_START", 1+NUM_ATTR_BYTES+6*WORDSIZE, CONSTANT_T);
+ create_symbol("GOBJ_TOTAL_LENGTH", 1+NUM_ATTR_BYTES+6*WORDSIZE+GLULX_OBJECT_EXT_BYTES, CONSTANT_T);
+ create_symbol("INDIV_PROP_START", INDIV_PROP_START, CONSTANT_T);
+ }
+
+ if (!glulx_mode) {
+ create_symbol("temp_global", 255, GLOBAL_VARIABLE_T);
+ create_symbol("temp__global2", 254, GLOBAL_VARIABLE_T);
+ create_symbol("temp__global3", 253, GLOBAL_VARIABLE_T);
+ create_symbol("temp__global4", 252, GLOBAL_VARIABLE_T);
+ create_symbol("self", 251, GLOBAL_VARIABLE_T);
+ create_symbol("sender", 250, GLOBAL_VARIABLE_T);
+ create_symbol("sw__var", 249, GLOBAL_VARIABLE_T);
+
+ create_symbol("sys__glob0", 16, GLOBAL_VARIABLE_T);
+ create_symbol("sys__glob1", 17, GLOBAL_VARIABLE_T);
+ create_symbol("sys__glob2", 18, GLOBAL_VARIABLE_T);
+
+ create_symbol("create", 64, INDIVIDUAL_PROPERTY_T);
+ create_symbol("recreate", 65, INDIVIDUAL_PROPERTY_T);
+ create_symbol("destroy", 66, INDIVIDUAL_PROPERTY_T);
+ create_symbol("remaining", 67, INDIVIDUAL_PROPERTY_T);
+ create_symbol("copy", 68, INDIVIDUAL_PROPERTY_T);
+ create_symbol("call", 69, INDIVIDUAL_PROPERTY_T);
+ create_symbol("print", 70, INDIVIDUAL_PROPERTY_T);
+ create_symbol("print_to_array",71, INDIVIDUAL_PROPERTY_T);
+ }
+ else {
+ /* In Glulx, these system globals are entered in order, not down
+ from 255. */
+ create_symbol("temp_global", MAX_LOCAL_VARIABLES+0,
+ GLOBAL_VARIABLE_T);
+ create_symbol("temp__global2", MAX_LOCAL_VARIABLES+1,
+ GLOBAL_VARIABLE_T);
+ create_symbol("temp__global3", MAX_LOCAL_VARIABLES+2,
+ GLOBAL_VARIABLE_T);
+ create_symbol("temp__global4", MAX_LOCAL_VARIABLES+3,
+ GLOBAL_VARIABLE_T);
+ create_symbol("self", MAX_LOCAL_VARIABLES+4,
+ GLOBAL_VARIABLE_T);
+ create_symbol("sender", MAX_LOCAL_VARIABLES+5,
+ GLOBAL_VARIABLE_T);
+ create_symbol("sw__var", MAX_LOCAL_VARIABLES+6,
+ GLOBAL_VARIABLE_T);
+
+ /* These are almost certainly meaningless, and can be removed. */
+ create_symbol("sys__glob0", MAX_LOCAL_VARIABLES+7,
+ GLOBAL_VARIABLE_T);
+ create_symbol("sys__glob1", MAX_LOCAL_VARIABLES+8,
+ GLOBAL_VARIABLE_T);
+ create_symbol("sys__glob2", MAX_LOCAL_VARIABLES+9,
+ GLOBAL_VARIABLE_T);
+
+ /* value of statusline_flag to be written later */
+ create_symbol("sys_statusline_flag", MAX_LOCAL_VARIABLES+10,
+ GLOBAL_VARIABLE_T);
+
+ /* These are created in order, but not necessarily at a fixed
+ value. */
+ create_symbol("create", INDIV_PROP_START+0,
+ INDIVIDUAL_PROPERTY_T);
+ create_symbol("recreate", INDIV_PROP_START+1,
+ INDIVIDUAL_PROPERTY_T);
+ create_symbol("destroy", INDIV_PROP_START+2,
+ INDIVIDUAL_PROPERTY_T);
+ create_symbol("remaining", INDIV_PROP_START+3,
+ INDIVIDUAL_PROPERTY_T);
+ create_symbol("copy", INDIV_PROP_START+4,
+ INDIVIDUAL_PROPERTY_T);
+ create_symbol("call", INDIV_PROP_START+5,
+ INDIVIDUAL_PROPERTY_T);
+ create_symbol("print", INDIV_PROP_START+6,
+ INDIVIDUAL_PROPERTY_T);
+ create_symbol("print_to_array",INDIV_PROP_START+7,
+ INDIVIDUAL_PROPERTY_T);
+
+ /* Floating-point constants. Note that FLOAT_NINFINITY is not
+ -FLOAT_INFINITY, because float negation doesn't work that
+ way. Also note that FLOAT_NAN is just one of many possible
+ "not-a-number" values. */
+ create_symbol("FLOAT_INFINITY", 0x7F800000, CONSTANT_T);
+ create_symbol("FLOAT_NINFINITY", 0xFF800000, CONSTANT_T);
+ create_symbol("FLOAT_NAN", 0x7FC00000, CONSTANT_T);
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* The symbol replacement table. This is needed only for the */
+/* "Replace X Y" directive. */
+/* ------------------------------------------------------------------------- */
+
+extern void add_symbol_replacement_mapping(int original, int renamed)
+{
+ int ix;
+
+ if (original == renamed) {
+ error_named("A routine cannot be 'Replace'd to itself:", (char *)symbs[original]);
+ return;
+ }
+
+ if (symbol_replacements_count == symbol_replacements_size) {
+ int oldsize = symbol_replacements_size;
+ if (symbol_replacements_size == 0)
+ symbol_replacements_size = 4;
+ else
+ symbol_replacements_size *= 2;
+ my_recalloc(&symbol_replacements, sizeof(value_pair_t), oldsize,
+ symbol_replacements_size, "symbol replacement table");
+ }
+
+ /* If the original form is already in our table, report an error.
+ Same goes if the replaced form is already in the table as an
+ original. (Other collision cases have already been
+ detected.) */
+
+ for (ix=0; ix<symbol_replacements_count; ix++) {
+ if (original == symbol_replacements[ix].original_symbol) {
+ error_named("A routine cannot be 'Replace'd to more than one new name:", (char *)symbs[original]);
+ }
+ if (renamed == symbol_replacements[ix].original_symbol) {
+ error_named("A routine cannot be 'Replace'd to a 'Replace'd name:", (char *)symbs[original]);
+ }
+ }
+
+ symbol_replacements[symbol_replacements_count].original_symbol = original;
+ symbol_replacements[symbol_replacements_count].renamed_symbol = renamed;
+ symbol_replacements_count++;
+}
+
+extern int find_symbol_replacement(int *value)
+{
+ int changed = FALSE;
+ int ix;
+
+ if (!symbol_replacements)
+ return FALSE;
+
+ for (ix=0; ix<symbol_replacements_count; ix++) {
+ if (*value == symbol_replacements[ix].original_symbol) {
+ *value = symbol_replacements[ix].renamed_symbol;
+ changed = TRUE;
+ }
+ }
+
+ return changed;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The dead-function removal optimization. */
+/* ------------------------------------------------------------------------- */
+
+int track_unused_routines; /* set if either WARN_UNUSED_ROUTINES or
+ OMIT_UNUSED_ROUTINES is nonzero */
+int df_dont_note_global_symbols; /* temporarily set at times in parsing */
+static int df_tables_closed; /* set at end of compiler pass */
+
+typedef struct df_function_struct df_function_t;
+typedef struct df_reference_struct df_reference_t;
+
+struct df_function_struct {
+ char *name; /* borrowed reference, generally to the symbs[] table */
+ brief_location source_line; /* copied from routine_starts_line */
+ int sysfile; /* does this occur in a system file? */
+ uint32 address; /* function offset in zcode_area (not the final address) */
+ uint32 newaddress; /* function offset after stripping */
+ uint32 length;
+ int usage;
+ df_reference_t *refs; /* chain of references made *from* this function */
+ int processed;
+
+ df_function_t *funcnext; /* in forward functions order */
+ df_function_t *todonext; /* in the todo chain */
+ df_function_t *next; /* in the hash table */
+};
+
+struct df_reference_struct {
+ uint32 address; /* function offset in zcode_area (not the final address) */
+ int symbol; /* index in symbols array */
+
+ df_reference_t *refsnext; /* in the function's refs chain */
+ df_reference_t *next; /* in the hash table */
+};
+
+/* Bitmask flags for how functions are used: */
+#define DF_USAGE_GLOBAL (1<<0) /* In a global variable, array, etc */
+#define DF_USAGE_EMBEDDED (1<<1) /* An anonymous function in a property */
+#define DF_USAGE_MAIN (1<<2) /* Main() or Main__() */
+#define DF_USAGE_FUNCTION (1<<3) /* Used from another used function */
+
+#define DF_FUNCTION_HASH_BUCKETS (1023)
+
+/* Table of all compiled functions. (Only created if track_unused_routines
+ is set.) This is a hash table. */
+static df_function_t **df_functions;
+/* List of all compiled functions, in address order. The first entry
+ has address DF_NOT_IN_FUNCTION, and stands in for the global namespace. */
+static df_function_t *df_functions_head;
+static df_function_t *df_functions_tail;
+/* Used during output_file(), to track how far the code-area output has
+ gotten. */
+static df_function_t *df_iterator;
+
+/* Array of all compiled functions in address order. (Does not include
+ the global namespace entry.) This is generated only if needed. */
+static df_function_t **df_functions_sorted;
+static int df_functions_sorted_count;
+
+#define DF_NOT_IN_FUNCTION ((uint32)0xFFFFFFFF)
+#define DF_SYMBOL_HASH_BUCKETS (4095)
+
+/* Map of what functions reference what other functions. (Only created if
+ track_unused_routines is set.) */
+static df_reference_t **df_symbol_map;
+
+/* Globals used while a function is being compiled. When a function
+ *isn't* being compiled, df_current_function_addr will be DF_NOT_IN_FUNCTION
+ and df_current_function will refer to the global namespace record. */
+static df_function_t *df_current_function;
+static char *df_current_function_name;
+static uint32 df_current_function_addr;
+
+/* Size totals for compiled code. These are only meaningful if
+ track_unused_routines is true. (If we're only doing WARN_UNUSED_ROUTINES,
+ these values will be set, but the "after" value will not affect the
+ final game file.) */
+uint32 df_total_size_before_stripping;
+uint32 df_total_size_after_stripping;
+
+/* When we begin compiling a function, call this to note that fact.
+ Any symbol referenced from now on will be associated with the function.
+*/
+extern void df_note_function_start(char *name, uint32 address,
+ int embedded_flag, brief_location source_line)
+{
+ df_function_t *func;
+ int bucket;
+
+ if (df_tables_closed)
+ error("Internal error in stripping: Tried to start a new function after tables were closed.");
+
+ /* We retain the name only for debugging output. Note that embedded
+ functions all show up as "<embedded>" -- their "obj.prop" name
+ never gets stored in permanent memory. */
+ df_current_function_name = name;
+ df_current_function_addr = address;
+
+ func = my_malloc(sizeof(df_function_t), "df function entry");
+ memset(func, 0, sizeof(df_function_t));
+ func->name = name;
+ func->address = address;
+ func->source_line = source_line;
+ func->sysfile = (address == DF_NOT_IN_FUNCTION || is_systemfile());
+ /* An embedded function is stored in an object property, so we
+ consider it to be used a priori. */
+ if (embedded_flag)
+ func->usage |= DF_USAGE_EMBEDDED;
+
+ if (!df_functions_head) {
+ df_functions_head = func;
+ df_functions_tail = func;
+ }
+ else {
+ df_functions_tail->funcnext = func;
+ df_functions_tail = func;
+ }
+
+ bucket = address % DF_FUNCTION_HASH_BUCKETS;
+ func->next = df_functions[bucket];
+ df_functions[bucket] = func;
+
+ df_current_function = func;
+}
+
+/* When we're done compiling a function, call this. Any symbol referenced
+ from now on will be associated with the global namespace.
+*/
+extern void df_note_function_end(uint32 endaddress)
+{
+ df_current_function->length = endaddress - df_current_function->address;
+
+ df_current_function_name = NULL;
+ df_current_function_addr = DF_NOT_IN_FUNCTION;
+ df_current_function = df_functions_head; /* the global namespace */
+}
+
+/* Find the function record for a given address. (Addresses are offsets
+ in zcode_area.)
+*/
+static df_function_t *df_function_for_address(uint32 address)
+{
+ int bucket = address % DF_FUNCTION_HASH_BUCKETS;
+ df_function_t *func;
+ for (func = df_functions[bucket]; func; func = func->next) {
+ if (func->address == address)
+ return func;
+ }
+ return NULL;
+}
+
+/* Whenever a function is referenced, we call this to note who called it.
+*/
+extern void df_note_function_symbol(int symbol)
+{
+ int bucket, symtype;
+ df_reference_t *ent;
+
+ /* If the compiler pass is over, looking up symbols does not create
+ a global reference. */
+ if (df_tables_closed)
+ return;
+ /* In certain cases during parsing, looking up symbols does not
+ create a global reference. (For example, when reading the name
+ of a function being defined.) */
+ if (df_dont_note_global_symbols)
+ return;
+
+ /* We are only interested in functions, or forward-declared symbols
+ that might turn out to be functions. */
+ symtype = stypes[symbol];
+ if (symtype != ROUTINE_T && symtype != CONSTANT_T)
+ return;
+ if (symtype == CONSTANT_T && !(sflags[symbol] & UNKNOWN_SFLAG))
+ return;
+
+ bucket = (df_current_function_addr ^ (uint32)symbol) % DF_SYMBOL_HASH_BUCKETS;
+ for (ent = df_symbol_map[bucket]; ent; ent = ent->next) {
+ if (ent->address == df_current_function_addr && ent->symbol == symbol)
+ return;
+ }
+
+ /* Create a new reference entry in df_symbol_map. */
+ ent = my_malloc(sizeof(df_reference_t), "df symbol map entry");
+ ent->address = df_current_function_addr;
+ ent->symbol = symbol;
+ ent->next = df_symbol_map[bucket];
+ df_symbol_map[bucket] = ent;
+
+ /* Add the reference to the function's entry as well. */
+ /* The current function is the most recently added, so it will be
+ at the top of its bucket. That makes this call fast. Unless
+ we're in global scope, in which case it might be slower.
+ (I suppose we could cache the df_function_t pointer of the
+ current function, to speed things up.) */
+ if (!df_current_function || df_current_function_addr != df_current_function->address)
+ compiler_error("DF: df_current_function does not match current address.");
+ ent->refsnext = df_current_function->refs;
+ df_current_function->refs = ent;
+}
+
+/* This does the hard work of figuring out what functions are truly dead.
+ It's called near the end of run_pass() in inform.c.
+*/
+extern void locate_dead_functions(void)
+{
+ df_function_t *func, *tofunc;
+ df_reference_t *ent;
+ int ix;
+
+ if (!track_unused_routines)
+ compiler_error("DF: locate_dead_functions called, but function references have not been mapped");
+
+ df_tables_closed = TRUE;
+ df_current_function = NULL;
+
+ /* Note that Main__ was tagged as global implicitly during
+ compile_initial_routine(). Main was tagged during
+ issue_unused_warnings(). But for the sake of thoroughness,
+ we'll mark them specially. */
+
+ ix = symbol_index("Main__", -1);
+ if (stypes[ix] == ROUTINE_T) {
+ uint32 addr = svals[ix] * (glulx_mode ? 1 : scale_factor);
+ tofunc = df_function_for_address(addr);
+ if (tofunc)
+ tofunc->usage |= DF_USAGE_MAIN;
+ }
+ ix = symbol_index("Main", -1);
+ if (stypes[ix] == ROUTINE_T) {
+ uint32 addr = svals[ix] * (glulx_mode ? 1 : scale_factor);
+ tofunc = df_function_for_address(addr);
+ if (tofunc)
+ tofunc->usage |= DF_USAGE_MAIN;
+ }
+
+ /* Go through all the functions referenced at the global level;
+ mark them as used. */
+
+ func = df_functions_head;
+ if (!func || func->address != DF_NOT_IN_FUNCTION)
+ compiler_error("DF: Global namespace entry is not at the head of the chain.");
+
+ for (ent = func->refs; ent; ent=ent->refsnext) {
+ uint32 addr;
+ int symbol = ent->symbol;
+ if (stypes[symbol] != ROUTINE_T)
+ continue;
+ addr = svals[symbol] * (glulx_mode ? 1 : scale_factor);
+ tofunc = df_function_for_address(addr);
+ if (!tofunc) {
+ error_named("Internal error in stripping: global ROUTINE_T symbol is not found in df_function map:", (char *)symbs[symbol]);
+ continue;
+ }
+ /* A function may be marked here more than once. That's fine. */
+ tofunc->usage |= DF_USAGE_GLOBAL;
+ }
+
+ /* Perform a breadth-first search through functions, starting with
+ the ones that are known to be used at the top level. */
+ {
+ df_function_t *todo, *todotail;
+ df_function_t *func;
+ todo = NULL;
+ todotail = NULL;
+
+ for (func = df_functions_head; func; func = func->funcnext) {
+ if (func->address == DF_NOT_IN_FUNCTION)
+ continue;
+ if (func->usage == 0)
+ continue;
+ if (!todo) {
+ todo = func;
+ todotail = func;
+ }
+ else {
+ todotail->todonext = func;
+ todotail = func;
+ }
+ }
+
+ /* todo is a linked list of functions which are known to be
+ used. If a function's usage field is nonzero, it must be
+ either be on the todo list or have come off already (in
+ which case processed will be set). */
+
+ while (todo) {
+ /* Pop the next function. */
+ func = todo;
+ todo = todo->todonext;
+ if (!todo)
+ todotail = NULL;
+
+ if (func->processed)
+ error_named("Internal error in stripping: function has been processed twice:", func->name);
+
+ /* Go through the function's symbol references. Any
+ reference to a routine, push it into the todo list (if
+ it isn't there already). */
+
+ for (ent = func->refs; ent; ent=ent->refsnext) {
+ uint32 addr;
+ int symbol = ent->symbol;
+ if (stypes[symbol] != ROUTINE_T)
+ continue;
+ addr = svals[symbol] * (glulx_mode ? 1 : scale_factor);
+ tofunc = df_function_for_address(addr);
+ if (!tofunc) {
+ error_named("Internal error in stripping: function ROUTINE_T symbol is not found in df_function map:", (char *)symbs[symbol]);
+ continue;
+ }
+ if (tofunc->usage)
+ continue;
+
+ /* Not yet known to be used. Add it to the todo list. */
+ tofunc->usage |= DF_USAGE_FUNCTION;
+ if (!todo) {
+ todo = tofunc;
+ todotail = tofunc;
+ }
+ else {
+ todotail->todonext = tofunc;
+ todotail = tofunc;
+ }
+ }
+
+ func->processed = TRUE;
+ }
+ }
+
+ /* Go through all functions; figure out how much space is consumed,
+ with and without useless functions. */
+
+ {
+ df_function_t *func;
+
+ df_total_size_before_stripping = 0;
+ df_total_size_after_stripping = 0;
+
+ for (func = df_functions_head; func; func = func->funcnext) {
+ if (func->address == DF_NOT_IN_FUNCTION)
+ continue;
+
+ if (func->address != df_total_size_before_stripping)
+ compiler_error("DF: Address gap in function list");
+
+ df_total_size_before_stripping += func->length;
+ if (func->usage) {
+ func->newaddress = df_total_size_after_stripping;
+ df_total_size_after_stripping += func->length;
+ }
+
+ if (!glulx_mode && (df_total_size_after_stripping % scale_factor != 0))
+ compiler_error("DF: New function address is not aligned");
+
+ if (WARN_UNUSED_ROUTINES && !func->usage) {
+ if (!func->sysfile || WARN_UNUSED_ROUTINES >= 2)
+ uncalled_routine_warning("Routine", func->name, func->source_line);
+ }
+ }
+ }
+
+ /* df_measure_hash_table_usage(); */
+}
+
+/* Given an original function address, return where it winds up after
+ unused-function stripping. The function must not itself be unused.
+
+ Both the input and output are offsets, and already scaled by
+ scale_factor.
+
+ This is used by the backpatching system.
+*/
+extern uint32 df_stripped_address_for_address(uint32 addr)
+{
+ df_function_t *func;
+
+ if (!track_unused_routines)
+ compiler_error("DF: df_stripped_address_for_address called, but function references have not been mapped");
+
+ if (!glulx_mode)
+ func = df_function_for_address(addr*scale_factor);
+ else
+ func = df_function_for_address(addr);
+
+ if (!func) {
+ compiler_error("DF: Unable to find function while backpatching");
+ return 0;
+ }
+ if (!func->usage)
+ compiler_error("DF: Tried to backpatch a function address which should be stripped");
+
+ if (!glulx_mode)
+ return func->newaddress / scale_factor;
+ else
+ return func->newaddress;
+}
+
+/* Given an address in the function area, return where it winds up after
+ unused-function stripping. The address can be a function or anywhere
+ within the function. If the address turns out to be in a stripped
+ function, returns 0 (and sets *stripped).
+
+ The input and output are offsets, but *not* scaled.
+
+ This is only used by the debug-file system.
+*/
+uint32 df_stripped_offset_for_code_offset(uint32 offset, int *stripped)
+{
+ df_function_t *func;
+ int count;
+
+ if (!track_unused_routines)
+ compiler_error("DF: df_stripped_offset_for_code_offset called, but function references have not been mapped");
+
+ if (!df_functions_sorted) {
+ /* To do this efficiently, we need a binary-searchable table. Fine,
+ we'll make one. Include both used and unused functions. */
+
+ for (func = df_functions_head, count = 0; func; func = func->funcnext) {
+ if (func->address == DF_NOT_IN_FUNCTION)
+ continue;
+ count++;
+ }
+ df_functions_sorted_count = count;
+
+ df_functions_sorted = my_calloc(sizeof(df_function_t *), df_functions_sorted_count, "df function sorted table");
+
+ for (func = df_functions_head, count = 0; func; func = func->funcnext) {
+ if (func->address == DF_NOT_IN_FUNCTION)
+ continue;
+ df_functions_sorted[count] = func;
+ count++;
+ }
+ }
+
+ /* Do a binary search. Maintain beg <= res < end, where res is the
+ function containing the desired address. */
+ int beg = 0;
+ int end = df_functions_sorted_count;
+
+ /* Set stripped flag until we decide on a non-stripped function. */
+ *stripped = TRUE;
+
+ while (1) {
+ if (beg >= end) {
+ error("DF: offset_for_code_offset: Could not locate address.");
+ return 0;
+ }
+ if (beg+1 == end) {
+ func = df_functions_sorted[beg];
+ if (func->usage == 0)
+ return 0;
+ *stripped = FALSE;
+ return func->newaddress + (offset - func->address);
+ }
+ int new = (beg + end) / 2;
+ if (new <= beg || new >= end)
+ compiler_error("DF: binary search went off the rails");
+
+ func = df_functions_sorted[new];
+ if (offset >= func->address) {
+ if (offset < func->address+func->length) {
+ /* We don't need to loop further; decide here. */
+ if (func->usage == 0)
+ return 0;
+ *stripped = FALSE;
+ return func->newaddress + (offset - func->address);
+ }
+ beg = new;
+ }
+ else {
+ end = new;
+ }
+ }
+}
+
+/* The output_file() routines in files.c have to run down the list of
+ functions, deciding who is in and who is out. But I don't want to
+ export the df_function_t list structure. Instead, I provide this
+ silly iterator pair. Set it up with df_prepare_function_iterate();
+ then repeatedly call df_next_function_iterate().
+*/
+
+extern void df_prepare_function_iterate(void)
+{
+ df_iterator = df_functions_head;
+ if (!df_iterator || df_iterator->address != DF_NOT_IN_FUNCTION)
+ compiler_error("DF: Global namespace entry is not at the head of the chain.");
+ if (!df_iterator->funcnext || df_iterator->funcnext->address != 0)
+ compiler_error("DF: First function entry is not second in the chain.");
+}
+
+/* This returns the end of the next function, and whether the next function
+ is used (live).
+*/
+extern uint32 df_next_function_iterate(int *funcused)
+{
+ if (df_iterator)
+ df_iterator = df_iterator->funcnext;
+ if (!df_iterator) {
+ *funcused = TRUE;
+ return df_total_size_before_stripping+1;
+ }
+ *funcused = (df_iterator->usage != 0);
+ return df_iterator->address + df_iterator->length;
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_symbols_vars(void)
+{
+ symbs = NULL;
+ svals = NULL;
+ smarks = NULL;
+ stypes = NULL;
+ sflags = NULL;
+ next_entry = NULL;
+ start_of_list = NULL;
+
+ symbol_name_space_chunks = NULL;
+ no_symbol_name_space_chunks = 0;
+ symbols_free_space=NULL;
+ symbols_ceiling=symbols_free_space;
+
+ no_symbols = 0;
+
+ symbol_replacements = NULL;
+ symbol_replacements_count = 0;
+ symbol_replacements_size = 0;
+
+ make_case_conversion_grid();
+
+ track_unused_routines = (WARN_UNUSED_ROUTINES || OMIT_UNUSED_ROUTINES);
+ df_tables_closed = FALSE;
+ df_symbol_map = NULL;
+ df_functions = NULL;
+ df_functions_head = NULL;
+ df_functions_tail = NULL;
+ df_current_function = NULL;
+ df_functions_sorted = NULL;
+ df_functions_sorted_count = 0;
+}
+
+extern void symbols_begin_pass(void)
+{
+ df_total_size_before_stripping = 0;
+ df_total_size_after_stripping = 0;
+ df_dont_note_global_symbols = FALSE;
+ df_iterator = NULL;
+}
+
+extern void symbols_allocate_arrays(void)
+{
+ symbs = my_calloc(sizeof(char *), MAX_SYMBOLS, "symbols");
+ svals = my_calloc(sizeof(int32), MAX_SYMBOLS, "symbol values");
+ if (glulx_mode)
+ smarks = my_calloc(sizeof(int), MAX_SYMBOLS, "symbol markers");
+ slines = my_calloc(sizeof(brief_location), MAX_SYMBOLS, "symbol lines");
+ stypes = my_calloc(sizeof(char), MAX_SYMBOLS, "symbol types");
+ sflags = my_calloc(sizeof(int), MAX_SYMBOLS, "symbol flags");
+ if (debugfile_switch)
+ { symbol_debug_backpatch_positions =
+ my_calloc(sizeof(maybe_file_position), MAX_SYMBOLS,
+ "symbol debug information backpatch positions");
+ replacement_debug_backpatch_positions =
+ my_calloc(sizeof(maybe_file_position), MAX_SYMBOLS,
+ "replacement debug information backpatch positions");
+ }
+ next_entry = my_calloc(sizeof(int), MAX_SYMBOLS,
+ "symbol linked-list forward links");
+ start_of_list = my_calloc(sizeof(int32), HASH_TAB_SIZE,
+ "hash code list beginnings");
+
+ symbol_name_space_chunks
+ = my_calloc(sizeof(char *), MAX_SYMBOL_CHUNKS, "symbol names chunk addresses");
+
+ if (track_unused_routines) {
+ df_tables_closed = FALSE;
+
+ df_symbol_map = my_calloc(sizeof(df_reference_t *), DF_SYMBOL_HASH_BUCKETS, "df symbol-map hash table");
+ memset(df_symbol_map, 0, sizeof(df_reference_t *) * DF_SYMBOL_HASH_BUCKETS);
+
+ df_functions = my_calloc(sizeof(df_function_t *), DF_FUNCTION_HASH_BUCKETS, "df function hash table");
+ memset(df_functions, 0, sizeof(df_function_t *) * DF_FUNCTION_HASH_BUCKETS);
+ df_functions_head = NULL;
+ df_functions_tail = NULL;
+
+ df_functions_sorted = NULL;
+ df_functions_sorted_count = 0;
+
+ df_note_function_start("<global namespace>", DF_NOT_IN_FUNCTION, FALSE, blank_brief_location);
+ df_note_function_end(DF_NOT_IN_FUNCTION);
+ /* Now df_current_function is df_functions_head. */
+ }
+
+ init_symbol_banks();
+ stockup_symbols();
+
+ /* Allocated as needed */
+ symbol_replacements = NULL;
+
+ /* Allocated during story file construction, not now */
+ individual_name_strings = NULL;
+ attribute_name_strings = NULL;
+ action_name_strings = NULL;
+ array_name_strings = NULL;
+}
+
+extern void symbols_free_arrays(void)
+{ int i;
+
+ for (i=0; i<no_symbol_name_space_chunks; i++)
+ my_free(&(symbol_name_space_chunks[i]),
+ "symbol names chunk");
+
+ my_free(&symbol_name_space_chunks, "symbol names chunk addresses");
+
+ my_free(&symbs, "symbols");
+ my_free(&svals, "symbol values");
+ my_free(&smarks, "symbol markers");
+ my_free(&slines, "symbol lines");
+ my_free(&stypes, "symbol types");
+ my_free(&sflags, "symbol flags");
+ if (debugfile_switch)
+ { my_free
+ (&symbol_debug_backpatch_positions,
+ "symbol debug information backpatch positions");
+ my_free
+ (&replacement_debug_backpatch_positions,
+ "replacement debug information backpatch positions");
+ }
+ my_free(&next_entry, "symbol linked-list forward links");
+ my_free(&start_of_list, "hash code list beginnings");
+
+ if (symbol_replacements)
+ my_free(&symbol_replacements, "symbol replacement table");
+
+ if (df_symbol_map) {
+ for (i=0; i<DF_SYMBOL_HASH_BUCKETS; i++) {
+ df_reference_t *ent = df_symbol_map[i];
+ while (ent) {
+ df_reference_t *next = ent->next;
+ my_free(&ent, "df symbol map entry");
+ ent = next;
+ }
+ }
+ my_free(&df_symbol_map, "df symbol-map hash table");
+ }
+ if (df_functions_sorted) {
+ my_free(&df_functions, "df function sorted table");
+ }
+ if (df_functions) {
+ for (i=0; i<DF_FUNCTION_HASH_BUCKETS; i++) {
+ df_function_t *func = df_functions[i];
+ while (func) {
+ df_function_t *next = func->next;
+ my_free(&func, "df function entry");
+ func = next;
+ }
+ }
+ my_free(&df_functions, "df function hash table");
+ }
+ df_functions_head = NULL;
+ df_functions_tail = NULL;
+
+ if (individual_name_strings != NULL)
+ my_free(&individual_name_strings, "property name strings");
+ if (action_name_strings != NULL)
+ my_free(&action_name_strings, "action name strings");
+ if (attribute_name_strings != NULL)
+ my_free(&attribute_name_strings, "attribute name strings");
+ if (array_name_strings != NULL)
+ my_free(&array_name_strings, "array name strings");
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "syntax" : Syntax analyser and compiler */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+static char *lexical_source;
+
+int no_syntax_lines; /* Syntax line count */
+
+static void begin_syntax_line(int statement_mode)
+{ no_syntax_lines++;
+ next_token_begins_syntax_line = TRUE;
+
+ clear_expression_space();
+ if (statement_mode)
+ { statements.enabled = TRUE;
+ conditions.enabled = TRUE;
+ local_variables.enabled = TRUE;
+ system_functions.enabled = TRUE;
+
+ misc_keywords.enabled = FALSE;
+ directive_keywords.enabled = FALSE;
+ directives.enabled = FALSE;
+ segment_markers.enabled = FALSE;
+ opcode_names.enabled = FALSE;
+ }
+ else
+ { directives.enabled = TRUE;
+ segment_markers.enabled = TRUE;
+
+ statements.enabled = FALSE;
+ misc_keywords.enabled = FALSE;
+ directive_keywords.enabled = FALSE;
+ local_variables.enabled = FALSE;
+ system_functions.enabled = FALSE;
+ conditions.enabled = FALSE;
+ opcode_names.enabled = FALSE;
+ }
+
+ sequence_point_follows = TRUE;
+
+ if (debugfile_switch)
+ { get_next_token();
+ statement_debug_location = get_token_location();
+ put_token_back();
+ }
+}
+
+extern void panic_mode_error_recovery(void)
+{
+ /* Consume tokens until the next semicolon (or end of file).
+ This is typically called after a syntax error, in hopes of
+ getting parsing back on track. */
+
+ while ((token_type != EOF_TT)
+ && ((token_type != SEP_TT)||(token_value != SEMICOLON_SEP)))
+
+ get_next_token();
+}
+
+extern void get_next_token_with_directives(void)
+{
+ /* A higher-level version of get_next_token(), which detects and
+ obeys directives such as #ifdef/#ifnot/#endif. (The # sign is
+ required in this case.)
+
+ This is called while parsing a long construct, such as Class or
+ Object, where we want to support internal #ifdefs. (Although
+ function-parsing predates this and doesn't make use of it.)
+
+ (Technically this permits *any* #-directive, which means you
+ can define global variables or properties or what-have-you in
+ the middle of an object. You can do that in the middle of an
+ object, too. Don't. It's about as well-supported as Wile E.
+ Coyote one beat before the plummet-lines kick in.) */
+
+ int directives_save, segment_markers_save, statements_save;
+
+ while (TRUE)
+ {
+ get_next_token();
+
+ /* If the first token is not a '#', return it directly. */
+ if ((token_type != SEP_TT) || (token_value != HASH_SEP))
+ return;
+
+ /* Save the lexer flags, and set up for directive parsing. */
+ directives_save = directives.enabled;
+ segment_markers_save = segment_markers.enabled;
+ statements_save = statements.enabled;
+
+ directives.enabled = TRUE;
+ segment_markers.enabled = FALSE;
+ statements.enabled = FALSE;
+ conditions.enabled = FALSE;
+ local_variables.enabled = FALSE;
+ misc_keywords.enabled = FALSE;
+ system_functions.enabled = FALSE;
+
+ get_next_token();
+
+ if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
+ { error("It is illegal to nest a routine inside an object using '#['");
+ return;
+ }
+
+ if (token_type == DIRECTIVE_TT)
+ parse_given_directive(TRUE);
+ else
+ { ebf_error("directive", token_text);
+ 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.)
+ */
+ 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;
+ }
+}
+
+extern void parse_program(char *source)
+{
+ lexical_source = source;
+ while (parse_directive(FALSE)) ;
+}
+
+extern int parse_directive(int internal_flag)
+{
+ /* Internal_flag is FALSE if the directive is encountered normally,
+ TRUE if encountered with a # prefix inside a routine or object
+ definition.
+
+ Returns: TRUE if program continues, FALSE if end of file reached. */
+
+ int routine_symbol, rep_symbol;
+ int is_renamed;
+
+ begin_syntax_line(FALSE);
+ get_next_token();
+
+ if (token_type == EOF_TT) return(FALSE);
+
+ if ((token_type == SEP_TT) && (token_value == HASH_SEP))
+ get_next_token();
+
+ if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
+ { if (internal_flag)
+ { error("It is illegal to nest routines using '#['");
+ return(TRUE);
+ }
+
+ directives.enabled = FALSE;
+ directive_keywords.enabled = FALSE;
+ segment_markers.enabled = FALSE;
+
+ /* The upcoming symbol is a definition; don't count it as a
+ top-level reference *to* the function. */
+ df_dont_note_global_symbols = TRUE;
+ get_next_token();
+ df_dont_note_global_symbols = FALSE;
+ if ((token_type != SYMBOL_TT)
+ || ((!(sflags[token_value] & UNKNOWN_SFLAG))
+ && (!(sflags[token_value] & REPLACE_SFLAG))))
+ { ebf_error("routine name", token_text);
+ return(FALSE);
+ }
+
+ routine_symbol = token_value;
+
+ rep_symbol = routine_symbol;
+ is_renamed = find_symbol_replacement(&rep_symbol);
+
+ if ((sflags[routine_symbol] & REPLACE_SFLAG)
+ && !is_renamed && (is_systemfile()))
+ { /* The function is definitely being replaced (system_file
+ always loses priority in a replacement) but is not
+ being renamed to something else. Skip its definition
+ entirely. */
+ dont_enter_into_symbol_table = TRUE;
+ do
+ { get_next_token();
+ } while (!((token_type == EOF_TT)
+ || ((token_type==SEP_TT)
+ && (token_value==CLOSE_SQUARE_SEP))));
+ dont_enter_into_symbol_table = FALSE;
+ if (token_type == EOF_TT) return FALSE;
+ }
+ else
+ { /* Parse the function definition and assign its symbol. */
+ assign_symbol(routine_symbol,
+ parse_routine(lexical_source, FALSE,
+ (char *) symbs[routine_symbol], FALSE, routine_symbol),
+ ROUTINE_T);
+ slines[routine_symbol] = routine_starts_line;
+ }
+
+ if (is_renamed) {
+ /* This function was subject to a "Replace X Y" directive.
+ The first time we see a definition for symbol X, we
+ copy it to Y -- that's the "original" form of the
+ function. */
+ if (svals[rep_symbol] == 0) {
+ assign_symbol(rep_symbol, svals[routine_symbol], ROUTINE_T);
+ }
+ }
+
+ get_next_token();
+ if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
+ { ebf_error("';' after ']'", token_text);
+ put_token_back();
+ }
+ return TRUE;
+ }
+
+ if ((token_type == SYMBOL_TT) && (stypes[token_value] == CLASS_T))
+ { if (internal_flag)
+ { error("It is illegal to nest an object in a routine using '#classname'");
+ return(TRUE);
+ }
+ sflags[token_value] |= USED_SFLAG;
+ make_object(FALSE, NULL, -1, -1, svals[token_value]);
+ return TRUE;
+ }
+
+ if (token_type != DIRECTIVE_TT)
+ { /* 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);
+ else
+ ebf_error("directive, '[' or class name", token_text);
+ panic_mode_error_recovery();
+ return TRUE;
+ }
+
+ return !(parse_given_directive(internal_flag));
+}
+
+static int switch_sign(void)
+{
+ if ((token_type == SEP_TT)&&(token_value == COLON_SEP)) return 1;
+ if ((token_type == SEP_TT)&&(token_value == COMMA_SEP)) return 2;
+ if ((token_type==MISC_KEYWORD_TT)&&(token_value==TO_MK)) return 3;
+ return 0;
+}
+
+static assembly_operand spec_stack[32];
+static int spec_type[32];
+
+static void compile_alternatives_z(assembly_operand switch_value, int n,
+ int stack_level, int label, int flag)
+{ switch(n)
+ { case 1:
+ assemblez_2_branch(je_zc, switch_value,
+ spec_stack[stack_level],
+ label, flag); return;
+ case 2:
+ assemblez_3_branch(je_zc, switch_value,
+ spec_stack[stack_level], spec_stack[stack_level+1],
+ label, flag); return;
+ case 3:
+ assemblez_4_branch(je_zc, switch_value,
+ spec_stack[stack_level], spec_stack[stack_level+1],
+ spec_stack[stack_level+2],
+ label, flag); return;
+ }
+}
+
+static void compile_alternatives_g(assembly_operand switch_value, int n,
+ int stack_level, int label, int flag)
+{
+ int the_zc = (flag) ? jeq_gc : jne_gc;
+
+ if (n == 1) {
+ assembleg_2_branch(the_zc, switch_value,
+ spec_stack[stack_level],
+ label);
+ }
+ else {
+ error("*** Cannot generate multi-equality tests in Glulx ***");
+ }
+}
+
+static void compile_alternatives(assembly_operand switch_value, int n,
+ int stack_level, int label, int flag)
+{
+ if (!glulx_mode)
+ compile_alternatives_z(switch_value, n, stack_level, label, flag);
+ else
+ compile_alternatives_g(switch_value, n, stack_level, label, flag);
+}
+
+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);
+
+ sequence_point_follows = FALSE;
+
+ do
+ { if (spec_sp == 32)
+ { error("At most 32 values can be given in a single 'switch' case");
+ panic_mode_error_recovery();
+ return;
+ }
+
+ if (action_switch)
+ { get_next_token();
+ if (token_type == SQ_TT || token_type == DQ_TT) {
+ ebf_error("action (or fake action) name", token_text);
+ 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);
+ }
+ }
+ else
+ spec_stack[spec_sp] =
+ code_generate(parse_expression(CONSTANT_CONTEXT), CONSTANT_CONTEXT, -1);
+
+ misc_keywords.enabled = TRUE;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+
+ spec_type[spec_sp++] = switch_sign();
+ switch(spec_type[spec_sp-1])
+ { case 0:
+ if (action_switch)
+ ebf_error("',' or ':'", token_text);
+ else ebf_error("',', ':' or 'to'", token_text);
+ panic_mode_error_recovery();
+ return;
+ case 1: goto GenSpecCode;
+ case 3: if (label_after == -1) label_after = next_label++;
+ }
+ } while(TRUE);
+
+ GenSpecCode:
+
+ if ((spec_sp > max_equality_args) && (label_after == -1))
+ label_after = next_label++;
+
+ if (label_after == -1)
+ { compile_alternatives(switch_value, spec_sp, 0, label, FALSE); return;
+ }
+
+ for (i=0; i<spec_sp;)
+ {
+ j=i; while ((j<spec_sp) && (spec_type[j] != 3)) j++;
+
+ if (j > i)
+ { if (j-i > max_equality_args) j=i+max_equality_args;
+
+ if (j == spec_sp)
+ compile_alternatives(switch_value, j-i, i, label, FALSE);
+ else
+ compile_alternatives(switch_value, j-i, i, label_after, TRUE);
+
+ i=j;
+ }
+ else
+ {
+ if (!glulx_mode) {
+ if (i == spec_sp - 2)
+ { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
+ label, TRUE);
+ assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
+ label, TRUE);
+ }
+ else
+ { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
+ next_label, TRUE);
+ assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
+ label_after, FALSE);
+ assemble_label_no(next_label++);
+ }
+ }
+ else {
+ if (i == spec_sp - 2)
+ { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
+ label);
+ assembleg_2_branch(jgt_gc, switch_value, spec_stack[i+1],
+ label);
+ }
+ else
+ { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
+ next_label);
+ assembleg_2_branch(jle_gc, switch_value, spec_stack[i+1],
+ label_after);
+ assemble_label_no(next_label++);
+ }
+ }
+ i = i+2;
+ }
+ }
+
+ assemble_label_no(label_after);
+}
+
+extern int32 parse_routine(char *source, int embedded_flag, char *name,
+ int veneer_flag, int r_symbol)
+{ int32 packed_address; int i; int debug_flag = FALSE;
+ int switch_clause_made = FALSE, default_clause_made = FALSE,
+ switch_label = 0;
+ debug_location_beginning beginning_debug_location =
+ get_token_location_beginning();
+
+ /* (switch_label needs no initialisation here, but it prevents some
+ compilers from issuing warnings) */
+
+ if ((source != lexical_source) || (veneer_flag))
+ { lexical_source = source;
+ restart_lexer(lexical_source, name);
+ }
+
+ no_locals = 0;
+
+ for (i=0;i<MAX_LOCAL_VARIABLES-1;i++) local_variables.keywords[i] = "";
+
+ do
+ { statements.enabled = TRUE;
+ dont_enter_into_symbol_table = TRUE;
+ get_next_token();
+ dont_enter_into_symbol_table = FALSE;
+ if ((token_type == SEP_TT) && (token_value == TIMES_SEP)
+ && (no_locals == 0) && (!debug_flag))
+ { debug_flag = TRUE; continue;
+ }
+
+ if (token_type != DQ_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);
+ panic_mode_error_recovery();
+ break;
+ }
+
+ if (no_locals == MAX_LOCAL_VARIABLES-1)
+ { error_numbered("Too many local variables for a routine; max is",
+ MAX_LOCAL_VARIABLES-1);
+ panic_mode_error_recovery();
+ break;
+ }
+
+ for (i=0;i<no_locals;i++)
+ if (strcmpcis(token_text, local_variables.keywords[i])==0)
+ error_named("Local variable defined twice:", token_text);
+ local_variables.keywords[no_locals++] = token_text;
+ } while(TRUE);
+
+ construct_local_variable_tables();
+
+ if ((trace_fns_setting==3)
+ || ((trace_fns_setting==2) && (veneer_mode==FALSE))
+ || ((trace_fns_setting==1) && (is_systemfile()==FALSE)))
+ debug_flag = TRUE;
+ if ((embedded_flag == FALSE) && (veneer_mode == FALSE) && debug_flag)
+ sflags[r_symbol] |= STAR_SFLAG;
+
+ packed_address = assemble_routine_header(no_locals, debug_flag,
+ name, embedded_flag, r_symbol);
+
+ do
+ { begin_syntax_line(TRUE);
+
+ get_next_token();
+
+ if (token_type == EOF_TT)
+ { ebf_error("']'", token_text);
+ assemble_routine_end
+ (embedded_flag,
+ get_token_location_end(beginning_debug_location));
+ put_token_back();
+ break;
+ }
+
+ if ((token_type == SEP_TT)
+ && (token_value == CLOSE_SQUARE_SEP))
+ { if (switch_clause_made && (!default_clause_made))
+ assemble_label_no(switch_label);
+ directives.enabled = TRUE;
+ sequence_point_follows = TRUE;
+ get_next_token();
+ assemble_routine_end
+ (embedded_flag,
+ get_token_location_end(beginning_debug_location));
+ put_token_back();
+ break;
+ }
+
+ if ((token_type == STATEMENT_TT) && (token_value == SDEFAULT_CODE))
+ { if (default_clause_made)
+ error("Multiple 'default' clauses defined in same 'switch'");
+ default_clause_made = TRUE;
+
+ if (switch_clause_made)
+ { if (!execution_never_reaches_here)
+ { sequence_point_follows = FALSE;
+ if (!glulx_mode)
+ assemblez_0((embedded_flag)?rfalse_zc:rtrue_zc);
+ else
+ assembleg_1(return_gc,
+ ((embedded_flag)?zero_operand:one_operand));
+ }
+ assemble_label_no(switch_label);
+ }
+ switch_clause_made = TRUE;
+
+ get_next_token();
+ if ((token_type == SEP_TT) &&
+ (token_value == COLON_SEP)) continue;
+ ebf_error("':' after 'default'", token_text);
+ panic_mode_error_recovery();
+ continue;
+ }
+
+ /* Only check for the form of a case switch if the initial token
+ isn't double-quoted text, as that would mean it was a print_ret
+ statement: this is a mild ambiguity in the grammar.
+ Action statements also cannot be cases. */
+
+ if ((token_type != DQ_TT) && (token_type != SEP_TT))
+ { get_next_token();
+ if (switch_sign() > 0)
+ { assembly_operand AO;
+ 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;
+ if (!glulx_mode)
+ assemblez_0((embedded_flag)?rfalse_zc:rtrue_zc);
+ else
+ assembleg_1(return_gc,
+ ((embedded_flag)?zero_operand:one_operand));
+ }
+ assemble_label_no(switch_label);
+ }
+
+ switch_label = next_label++;
+ switch_clause_made = TRUE;
+ put_token_back(); put_token_back();
+
+ if (!glulx_mode) {
+ INITAOTV(&AO, VARIABLE_OT, 249);
+ }
+ else {
+ INITAOTV(&AO, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+6); /* sw__var */
+ }
+ parse_switch_spec(AO, switch_label, TRUE);
+
+ continue;
+ }
+ else
+ { put_token_back(); put_token_back(); get_next_token();
+ sequence_point_follows = TRUE;
+ }
+ }
+
+ parse_statement(-1, -1);
+
+ } while (TRUE);
+
+ return packed_address;
+}
+
+extern void parse_code_block(int break_label, int continue_label,
+ int switch_rule)
+{ int switch_clause_made = FALSE, default_clause_made = FALSE, switch_label = 0,
+ unary_minus_flag;
+
+ begin_syntax_line(TRUE);
+ get_next_token();
+
+ if (token_type == SEP_TT && token_value == OPEN_BRACE_SEP)
+ { do
+ { begin_syntax_line(TRUE);
+ get_next_token();
+ if (token_type == SEP_TT && token_value == CLOSE_BRACE_SEP)
+ { if (switch_clause_made && (!default_clause_made))
+ assemble_label_no(switch_label);
+ return;
+ }
+ if (token_type == EOF_TT)
+ { ebf_error("'}'", token_text); return; }
+
+ if (switch_rule != 0)
+ {
+ /* Within a 'switch' block */
+
+ if ((token_type==STATEMENT_TT)&&(token_value==SDEFAULT_CODE))
+ { if (default_clause_made)
+ error("Multiple 'default' clauses defined in same 'switch'");
+ default_clause_made = TRUE;
+
+ if (switch_clause_made)
+ { if (!execution_never_reaches_here)
+ { sequence_point_follows = FALSE;
+ assemble_jump(break_label);
+ }
+ assemble_label_no(switch_label);
+ }
+ switch_clause_made = TRUE;
+
+ get_next_token();
+ if ((token_type == SEP_TT) &&
+ (token_value == COLON_SEP)) continue;
+ ebf_error("':' after 'default'", token_text);
+ panic_mode_error_recovery();
+ continue;
+ }
+
+ /* Decide: is this an ordinary statement, or the start
+ of a new case? */
+
+ if (token_type == DQ_TT) goto NotASwitchCase;
+
+ unary_minus_flag
+ = ((token_type == SEP_TT)&&(token_value == MINUS_SEP));
+ if (unary_minus_flag) get_next_token();
+
+ /* Now read the token _after_ any possible constant:
+ if that's a 'to', ',' or ':' then we have a case */
+
+ misc_keywords.enabled = TRUE;
+ get_next_token();
+ misc_keywords.enabled = FALSE;
+
+ if (switch_sign() > 0)
+ { assembly_operand AO;
+
+ 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;
+ put_token_back(); put_token_back();
+ if (unary_minus_flag) put_token_back();
+
+ AO = temp_var1;
+ parse_switch_spec(AO, switch_label, FALSE);
+ continue;
+ }
+ else
+ { put_token_back(); put_token_back();
+ if (unary_minus_flag) put_token_back();
+ get_next_token();
+ }
+ }
+
+ if ((switch_rule != 0) && (!switch_clause_made))
+ ebf_error("switch value", token_text);
+
+ NotASwitchCase:
+ sequence_point_follows = TRUE;
+ parse_statement(break_label, continue_label);
+ }
+ while(TRUE);
+ }
+
+ if (switch_rule != 0)
+ ebf_error("braced code block after 'switch'", token_text);
+
+ parse_statement(break_label, continue_label);
+ return;
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_syntax_vars(void)
+{
+}
+
+extern void syntax_begin_pass(void)
+{ no_syntax_lines = 0;
+}
+
+extern void syntax_allocate_arrays(void)
+{
+}
+
+extern void syntax_free_arrays(void)
+{
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "tables" : Constructs the story file or module (the output) up to the */
+/* end of dynamic memory, gluing together all the required */
+/* tables. */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+uchar *zmachine_paged_memory; /* Where we shall store the story file
+ constructed (contains all of paged
+ memory, i.e. all but code and the
+ static strings: allocated only when
+ we know how large it needs to be,
+ at the end of the compilation pass */
+
+/* In Glulx, zmachine_paged_memory contains all of RAM -- i.e. all but
+ the header, the code, and the static strings. */
+
+/* ------------------------------------------------------------------------- */
+/* Offsets of various areas in the Z-machine: these are set to nominal */
+/* values before the compilation pass, and to their calculated final */
+/* values only when construct_storyfile() happens. These are then used to */
+/* backpatch the incorrect values now existing in the Z-machine which */
+/* used these nominal values. */
+/* Most of the nominal values are 0x800 because this is guaranteed to */
+/* be assembled as a long constant if it's needed in code, since the */
+/* largest possible value of scale_factor is 8 and 0x800/8 = 256. */
+/* */
+/* In Glulx, I use 0x12345 instead of 0x800. This will always be a long */
+/* (32-bit) constant, since there's no scale_factor. */
+/* ------------------------------------------------------------------------- */
+
+int32 code_offset,
+ actions_offset,
+ preactions_offset,
+ dictionary_offset,
+ adjectives_offset,
+ variables_offset,
+ strings_offset,
+ class_numbers_offset,
+ individuals_offset,
+ identifier_names_offset,
+ array_names_offset,
+ prop_defaults_offset,
+ prop_values_offset,
+ static_memory_offset,
+ attribute_names_offset,
+ action_names_offset,
+ fake_action_names_offset,
+ routine_names_offset,
+ constant_names_offset,
+ routines_array_offset,
+ constants_array_offset,
+ routine_flags_array_offset,
+ global_names_offset,
+ global_flags_array_offset,
+ array_flags_array_offset;
+int32 arrays_offset,
+ object_tree_offset,
+ grammar_table_offset,
+ abbreviations_offset; /* Glulx */
+
+int32 Out_Size, Write_Code_At, Write_Strings_At;
+int32 RAM_Size, Write_RAM_At; /* Glulx */
+
+/* ------------------------------------------------------------------------- */
+/* Story file header settings. (Written to in "directs.c" and "asm.c".) */
+/* ------------------------------------------------------------------------- */
+
+int release_number, /* Release number game is to have */
+ statusline_flag; /* Either TIME_STYLE or SCORE_STYLE */
+
+int serial_code_given_in_program /* If TRUE, a Serial directive has */
+ = FALSE; /* specified this 6-digit serial code */
+char serial_code_buffer[7]; /* (overriding the usual date-stamp) */
+int flags2_requirements[16]; /* An array of which bits in Flags 2 of
+ the header will need to be set:
+ e.g. if the save_undo / restore_undo
+ opcodes are ever assembled, we have
+ to set the "games want UNDO" bit.
+ Values are 0 or 1. */
+
+/* ------------------------------------------------------------------------- */
+/* Construct story/module file (up to code area start). */
+/* */
+/* (To understand what follows, you really need to look at the run-time */
+/* system's specification, the Z-Machine Standards document.) */
+/* ------------------------------------------------------------------------- */
+
+extern void write_serial_number(char *buffer)
+{
+ /* Note that this function may require modification for "ANSI" compilers
+ which do not provide the standard time functions: what is needed is
+ the ability to work out today's date */
+
+ time_t tt; tt=time(0);
+ if (serial_code_given_in_program)
+ strcpy(buffer, serial_code_buffer);
+ else
+#ifdef TIME_UNAVAILABLE
+ sprintf(buffer,"970000");
+#else
+ strftime(buffer,10,"%y%m%d",localtime(&tt));
+#endif
+}
+
+static void percentage(char *name, int32 x, int32 total)
+{ printf(" %-20s %2d.%d%%\n",name,x*100/total,(x*1000/total)%10);
+}
+
+static char *version_name(int v)
+{
+ if (!glulx_mode) {
+ switch(v)
+ { case 3: return "Standard";
+ case 4: return "Plus";
+ case 5: return "Advanced";
+ case 6: return "Graphical";
+ case 8: return "Extended";
+ }
+ return "experimental format";
+ }
+ else {
+ return "Glulx";
+ }
+}
+
+static int32 rough_size_of_paged_memory_z(void)
+{
+ /* This function calculates a modest over-estimate of the amount of
+ memory required to store the Z-machine's paged memory area
+ (that is, everything up to the start of the code area). */
+
+ int32 total, i;
+
+ ASSERT_ZCODE();
+
+ total = 64 /* header */
+ + 2 + subtract_pointers(low_strings_top, low_strings)
+ /* low strings pool */
+ + 6*32; /* abbreviations table */
+
+ total += 8; /* header extension table */
+ if (ZCODE_HEADER_EXT_WORDS>3) total += (ZCODE_HEADER_EXT_WORDS-3)*2;
+
+ if (alphabet_modified) total += 78; /* character set table */
+
+ if (zscii_defn_modified) /* Unicode translation table */
+ total += 2 + 2*zscii_high_water_mark;
+
+ total += 2*((version_number==3)?31:63) /* property default values */
+ + no_objects*((version_number==3)?9:14) /* object tree table */
+ + properties_table_size /* property values of objects */
+ + (no_classes+1)*(module_switch?4:2)
+ /* class object numbers table */
+ + no_symbols*2 /* names of numerous things */
+ + individuals_length /* tables of prop variables */
+ + dynamic_array_area_size; /* variables and arrays */
+
+ for (i=0; i<no_Inform_verbs; i++)
+ total += 2 + 1 + /* address of grammar table, */
+ /* number of grammar lines */
+ ((grammar_version_number == 1)?
+ (8*Inform_verbs[i].lines):0); /* grammar lines */
+
+ if (grammar_version_number != 1)
+ total += grammar_lines_top; /* size of grammar lines area */
+
+ total += 2 + 4*no_adjectives /* adjectives table */
+ + 2*no_actions /* action routines */
+ + 2*no_grammar_token_routines; /* general parsing routines */
+
+ total += (subtract_pointers(dictionary_top, dictionary)) /* dictionary */
+ + ((module_switch)?30:0); /* module map */
+
+ total += scale_factor*0x100 /* maximum null bytes before code */
+ + 1000; /* fudge factor (in case the above is wrong) */
+
+ return(total);
+}
+
+static int32 rough_size_of_paged_memory_g(void)
+{
+ /* This function calculates a modest over-estimate of the amount of
+ memory required to store the machine's paged memory area
+ (that is, everything up to the start of the code area). */
+
+ int32 total;
+
+ ASSERT_GLULX();
+
+ /* No header for us! */
+ total = 1000; /* bit of a fudge factor */
+
+ total += dynamic_array_area_size; /* arrays and global variables */
+
+ total += no_objects * OBJECT_BYTE_LENGTH; /* object tables */
+ total += properties_table_size; /* property tables */
+ total += no_properties * 4; /* property defaults table */
+
+ total += 4 + no_classes * 4; /* class prototype object numbers */
+
+ total += 32; /* address/length of the identifier tables */
+ total += no_properties * 4;
+ total += (no_individual_properties-INDIV_PROP_START) * 4;
+ total += (NUM_ATTR_BYTES*8) * 4;
+ total += (no_actions + no_fake_actions) * 4;
+ total += 4 + no_arrays * 4;
+
+ total += 4 + no_Inform_verbs * 4; /* index of grammar tables */
+ total += grammar_lines_top; /* grammar tables */
+
+ total += 4 + no_actions * 4; /* actions functions table */
+
+ total += 4;
+ total += subtract_pointers(dictionary_top, dictionary);
+
+ while (total % GPAGESIZE)
+ total++;
+
+ return(total);
+}
+
+static void construct_storyfile_z(void)
+{ uchar *p;
+ int32 i, j, k, l, mark, objs, strings_length, code_length,
+ limit=0, excess=0, extend_offset=0, headerext_length=0;
+ int32 globals_at=0, link_table_at=0, dictionary_at=0, actions_at=0, preactions_at=0,
+ abbrevs_at=0, prop_defaults_at=0, object_tree_at=0, object_props_at=0,
+ map_of_module=0, grammar_table_at=0, charset_at=0, headerext_at=0,
+ terminating_chars_at=0, unicode_at=0, id_names_length=0;
+ int skip_backpatching = FALSE;
+ char *output_called = (module_switch)?"module":"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");
+
+ 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");
+
+ /* Foolish code to make this routine compile on all ANSI compilers */
+
+ p = (uchar *) zmachine_paged_memory;
+
+ /* In what follows, the "mark" will move upwards in memory: at various
+ points its value will be recorded for milestones like
+ "dictionary table start". It begins at 0x40, just after the header */
+
+ mark = 0x40;
+
+ /* ----------------- Low Strings and Abbreviations -------------------- */
+
+ p[mark]=0x80; p[mark+1]=0; mark+=2; /* Start the low strings pool
+ with a useful default string, " " */
+
+ for (i=0; i+low_strings<low_strings_top; mark++, i++) /* Low strings pool */
+ p[0x42+i]=low_strings[i];
+
+ abbrevs_at = mark;
+ for (i=0; i<3*32; i++) /* Initially all 96 entries */
+ { p[mark++]=0; p[mark++]=0x20; /* are set to " " */
+ }
+ for (i=0; i<no_abbreviations; i++) /* Write any abbreviations */
+ { j=abbrev_values[i]; /* into banks 2 and 3 */
+ p[abbrevs_at+64+2*i]=j/256; /* (bank 1 is reserved for */
+ p[abbrevs_at+65+2*i]=j%256; /* "variable strings") */
+ }
+
+ /* ------------------- Header extension table ------------------------- */
+
+ headerext_at = mark;
+ headerext_length = ZCODE_HEADER_EXT_WORDS;
+ if (zscii_defn_modified) {
+ /* Need at least 3 words for unicode table address */
+ if (headerext_length < 3)
+ headerext_length = 3;
+ }
+ if (ZCODE_HEADER_FLAGS_3) {
+ /* Need at least 4 words for the flags-3 field (ZSpec 1.1) */
+ if (headerext_length < 4)
+ headerext_length = 4;
+ }
+ p[mark++] = 0; p[mark++] = headerext_length;
+ for (i=0; i<headerext_length; i++)
+ { p[mark++] = 0; p[mark++] = 0;
+ }
+
+ /* -------------------- Z-character set table ------------------------- */
+
+ if (alphabet_modified)
+ { charset_at = mark;
+ for (i=0;i<3;i++) for (j=0;j<26;j++)
+ { if (alphabet[i][j] == '~') p[mark++] = '\"';
+ else p[mark++] = alphabet[i][j];
+ }
+ }
+
+ /* ------------------ Unicode translation table ----------------------- */
+
+ unicode_at = 0;
+ if (zscii_defn_modified)
+ { unicode_at = mark;
+ p[mark++] = zscii_high_water_mark;
+ for (i=0;i<zscii_high_water_mark;i++)
+ { j = zscii_to_unicode(155 + i);
+ if (j < 0 || j > 0xFFFF) {
+ error("Z-machine Unicode translation table cannot contain characters beyond $FFFF.");
+ }
+ p[mark++] = j/256; p[mark++] = j%256;
+ }
+ }
+
+ /* -------------------- Objects and Properties ------------------------ */
+
+ /* The object table must be word-aligned. The Z-machine spec does not
+ require this, but the RA__Pr() veneer routine does. See
+ http://inform7.com/mantis/view.php?id=1712.
+ */
+ while ((mark%2) != 0) p[mark++]=0;
+
+ prop_defaults_at = mark;
+
+ p[mark++]=0; p[mark++]=0;
+
+ for (i=2; i< ((version_number==3)?32:64); i++)
+ { p[mark++]=prop_default_value[i]/256;
+ p[mark++]=prop_default_value[i]%256;
+ }
+
+ object_tree_at = mark;
+
+ mark += ((version_number==3)?9:14)*no_objects;
+
+ object_props_at = mark;
+
+ for (i=0; i<properties_table_size; i++)
+ p[mark+i]=properties_table[i];
+
+ for (i=0, objs=object_tree_at; i<no_objects; i++)
+ {
+ if (version_number == 3)
+ { p[objs]=objectsz[i].atts[0];
+ p[objs+1]=objectsz[i].atts[1];
+ p[objs+2]=objectsz[i].atts[2];
+ p[objs+3]=objectsz[i].atts[3];
+ p[objs+4]=objectsz[i].parent;
+ p[objs+5]=objectsz[i].next;
+ p[objs+6]=objectsz[i].child;
+ p[objs+7]=mark/256;
+ p[objs+8]=mark%256;
+ objs+=9;
+ }
+ else
+ { p[objs]=objectsz[i].atts[0];
+ p[objs+1]=objectsz[i].atts[1];
+ p[objs+2]=objectsz[i].atts[2];
+ p[objs+3]=objectsz[i].atts[3];
+ p[objs+4]=objectsz[i].atts[4];
+ p[objs+5]=objectsz[i].atts[5];
+ p[objs+6]=(objectsz[i].parent)/256;
+ p[objs+7]=(objectsz[i].parent)%256;
+ p[objs+8]=(objectsz[i].next)/256;
+ p[objs+9]=(objectsz[i].next)%256;
+ p[objs+10]=(objectsz[i].child)/256;
+ p[objs+11]=(objectsz[i].child)%256;
+ if (!module_switch)
+ { p[objs+12]=mark/256;
+ p[objs+13]=mark%256;
+ }
+ else
+ { p[objs+12]=objectsz[i].propsize/256;
+ p[objs+13]=objectsz[i].propsize%256;
+ }
+ objs+=14;
+ }
+ mark+=objectsz[i].propsize;
+ }
+
+ /* ----------- Table of Class Prototype Object Numbers ---------------- */
+
+ class_numbers_offset = mark;
+ for (i=0; i<no_classes; i++)
+ { p[mark++] = class_object_numbers[i]/256;
+ p[mark++] = class_object_numbers[i]%256;
+ if (module_switch)
+ { p[mark++] = class_begins_at[i]/256;
+ p[mark++] = class_begins_at[i]%256;
+ }
+ }
+ p[mark++] = 0;
+ p[mark++] = 0;
+
+ /* ------------------- Table of Identifier Names ---------------------- */
+
+ identifier_names_offset = mark;
+
+ if (!module_switch)
+ { p[mark++] = no_individual_properties/256;
+ p[mark++] = no_individual_properties%256;
+ for (i=1; i<no_individual_properties; i++)
+ { p[mark++] = individual_name_strings[i]/256;
+ p[mark++] = individual_name_strings[i]%256;
+ }
+
+ attribute_names_offset = mark;
+ for (i=0; i<48; i++)
+ { p[mark++] = attribute_name_strings[i]/256;
+ p[mark++] = attribute_name_strings[i]%256;
+ }
+
+ action_names_offset = mark;
+ fake_action_names_offset = mark + 2*no_actions;
+ for (i=0; i<no_actions + no_fake_actions; i++)
+ { p[mark++] = action_name_strings[i]/256;
+ p[mark++] = action_name_strings[i]%256;
+ }
+
+ array_names_offset = mark;
+ global_names_offset = mark + 2*no_arrays;
+ routine_names_offset = global_names_offset + 2*no_globals;
+ constant_names_offset = routine_names_offset + 2*no_named_routines;
+ for (i=0; i<no_arrays + no_globals
+ + no_named_routines + no_named_constants; i++)
+ { if ((i == no_arrays) && (define_INFIX_switch == FALSE)) break;
+ p[mark++] = array_name_strings[i]/256;
+ p[mark++] = array_name_strings[i]%256;
+ }
+
+ id_names_length = (mark - identifier_names_offset)/2;
+ }
+ routine_flags_array_offset = mark;
+
+ if (define_INFIX_switch)
+ { for (i=0, k=1, l=0; i<no_named_routines; i++)
+ { if (sflags[named_routine_symbols[i]] & STAR_SFLAG) l=l+k;
+ k=k*2;
+ if (k==256) { p[mark++] = l; k=1; l=0; }
+ }
+ if (k!=1) p[mark++]=l;
+ }
+
+ /* ---------------- Table of Indiv Property Values -------------------- */
+
+ individuals_offset = mark;
+ for (i=0; i<individuals_length; i++)
+ p[mark++] = individuals_table[i];
+
+ /* ----------------- Variables and Dynamic Arrays --------------------- */
+
+ globals_at = mark;
+
+ for (i=0; i<dynamic_array_area_size; i++)
+ p[mark++] = dynamic_array_area[i];
+
+ for (i=0; i<240; i++)
+ { j=global_initial_value[i];
+ p[globals_at+i*2] = j/256; p[globals_at+i*2+1] = j%256;
+ }
+
+ /* ------------------ Terminating Characters Table -------------------- */
+
+ if (version_number >= 5)
+ { terminating_chars_at = mark;
+ for (i=0; i<no_termcs; i++) p[mark++] = terminating_characters[i];
+ p[mark++] = 0;
+ }
+
+ /* ------------------------ Grammar Table ----------------------------- */
+
+ if (grammar_version_number > 2)
+ { warning("This version of Inform is unable to produce the grammar \
+table format requested (producing number 2 format instead)");
+ grammar_version_number = 2;
+ }
+
+ grammar_table_at = mark;
+
+ mark = mark + no_Inform_verbs*2;
+
+ 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);
+ p[mark++] = Inform_verbs[i].lines;
+ for (j=0; j<Inform_verbs[i].lines; j++)
+ { k = Inform_verbs[i].l[j];
+ if (grammar_version_number == 1)
+ { int m, n;
+ p[mark+7] = grammar_lines[k+1];
+ for (m=1;m<=6;m++) p[mark + m] = 0;
+ k = k + 2; m = 1; n = 0;
+ while ((grammar_lines[k] != 15) && (m<=6))
+ { p[mark + m] = grammar_lines[k];
+ if (grammar_lines[k] < 180) n++;
+ m++; k = k + 3;
+ }
+ p[mark] = n;
+ mark = mark + 8;
+ }
+ else
+ { int tok;
+ p[mark++] = grammar_lines[k++];
+ p[mark++] = grammar_lines[k++];
+ for (;;)
+ { tok = grammar_lines[k++];
+ p[mark++] = tok;
+ if (tok == 15) break;
+ p[mark++] = grammar_lines[k++];
+ p[mark++] = grammar_lines[k++];
+ }
+ }
+ }
+ }
+
+ /* ------------------- Actions and Preactions ------------------------- */
+ /* (The term "preactions" is traditional: Inform uses the preactions */
+ /* table for a different purpose than Infocom used to.) */
+ /* The values are written later, when the Z-code offset is known. */
+ /* -------------------------------------------------------------------- */
+
+ actions_at = mark;
+ mark += no_actions*2;
+
+ preactions_at = mark;
+ if (grammar_version_number == 1)
+ mark += no_grammar_token_routines*2;
+
+ /* ----------------------- Adjectives Table --------------------------- */
+
+ if (grammar_version_number == 1)
+ { p[mark]=0; p[mark+1]=no_adjectives; mark+=2; /* To assist "infodump" */
+ adjectives_offset = mark;
+ dictionary_offset = mark + 4*no_adjectives;
+
+ for (i=0; i<no_adjectives; i++)
+ { j = final_dict_order[adjectives[no_adjectives-i-1]]
+ *((version_number==3)?7:9)
+ + dictionary_offset + 7;
+ p[mark++]=j/256; p[mark++]=j%256; p[mark++]=0;
+ p[mark++]=(256-no_adjectives+i);
+ }
+ }
+ else
+ { p[mark]=0; p[mark+1]=0; mark+=2;
+ adjectives_offset = mark;
+ dictionary_offset = mark;
+ }
+
+ /* ------------------------- Dictionary ------------------------------- */
+
+ dictionary_at=mark;
+
+ dictionary[0]=3; dictionary[1]='.'; /* Non-space characters which */
+ dictionary[2]=','; /* force words apart */
+ dictionary[3]='"';
+
+ dictionary[4]=(version_number==3)?7:9; /* Length of each entry */
+ dictionary[5]=(dict_entries/256); /* Number of entries */
+ dictionary[6]=(dict_entries%256);
+
+ for (i=0; i<7; i++) p[mark++] = dictionary[i];
+
+ for (i=0; i<dict_entries; i++)
+ { k = 7 + i*((version_number==3)?7:9);
+ j = mark + final_dict_order[i]*((version_number==3)?7:9);
+ for (l = 0; l<((version_number==3)?7:9); l++)
+ p[j++] = dictionary[k++];
+ }
+ mark += dict_entries * ((version_number==3)?7:9);
+
+ /* ------------------------- Module Map ------------------------------- */
+
+ if (module_switch)
+ { map_of_module = mark; /* Filled in below */
+ mark += 30;
+ }
+
+ /* ----------------- A gap before the code area ----------------------- */
+ /* (so that it will start at an exact packed address and so that all */
+ /* routine packed addresses are >= 256, hence long constants) */
+ /* -------------------------------------------------------------------- */
+
+ while ((mark%length_scale_factor) != 0) p[mark++]=0;
+ while (mark < (scale_factor*0x100)) p[mark++]=0;
+ if (oddeven_packing_switch)
+ while ((mark%(scale_factor*2)) != 0) p[mark++]=0;
+
+ if (mark > 0x0FFFE)
+ { error("This program has overflowed the maximum readable-memory \
+size of the Z-machine format. See the memory map below: the start \
+of the area marked \"above readable memory\" must be brought down to $FFFE \
+or less.");
+ memory_map_switch = TRUE;
+ /* Backpatching the grammar tables requires us to trust some of the */
+ /* addresses we've written into Z-machine memory, but they may have */
+ /* been truncated to 16 bits, so we can't do it. */
+ skip_backpatching = TRUE;
+ }
+
+ /* -------------------------- Code Area ------------------------------- */
+ /* (From this point on we don't write any more into the "p" buffer.) */
+ /* -------------------------------------------------------------------- */
+
+ Write_Code_At = mark;
+ if (!OMIT_UNUSED_ROUTINES) {
+ code_length = zmachine_pc;
+ }
+ else {
+ if (zmachine_pc != df_total_size_before_stripping)
+ compiler_error("Code size does not match (zmachine_pc and df_total_size).");
+ code_length = df_total_size_after_stripping;
+ }
+ mark += code_length;
+
+ /* ------------------ Another synchronising gap ----------------------- */
+
+ if (oddeven_packing_switch)
+ { if (module_switch)
+ while ((mark%(scale_factor*2)) != 0) mark++;
+ else
+ while ((mark%(scale_factor*2)) != scale_factor) mark++;
+ }
+ else
+ while ((mark%scale_factor) != 0) mark++;
+
+ /* ------------------------- Strings Area ----------------------------- */
+
+ Write_Strings_At = mark;
+ strings_length = static_strings_extent;
+ mark += strings_length;
+
+ /* --------------------- Module Linking Data -------------------------- */
+
+ if (module_switch)
+ { link_table_at = mark; mark += link_data_size;
+ mark += zcode_backpatch_size;
+ mark += zmachine_backpatch_size;
+ }
+
+ /* --------------------- Is the file too big? ------------------------- */
+
+ Out_Size = mark;
+
+ switch(version_number)
+ { case 3: excess = Out_Size-((int32) 0x20000L); limit = 128; break;
+ case 4:
+ case 5: excess = Out_Size-((int32) 0x40000L); limit = 256; break;
+ case 6:
+ case 7:
+ case 8: excess = Out_Size-((int32) 0x80000L); limit = 512; break;
+ }
+
+ if (module_switch)
+ { excess = Out_Size-((int32) 0x10000L); limit=64;
+ }
+
+ if (excess > 0)
+ { char memory_full_error[80];
+ sprintf(memory_full_error,
+ "The %s exceeds version-%d limit (%dK) by %d bytes",
+ output_called, version_number, limit, excess);
+ fatalerror(memory_full_error);
+ }
+
+ /* --------------------------- Offsets -------------------------------- */
+
+ dictionary_offset = dictionary_at;
+ variables_offset = globals_at;
+ actions_offset = actions_at;
+ preactions_offset = preactions_at;
+ prop_defaults_offset = prop_defaults_at;
+ prop_values_offset = object_props_at;
+ static_memory_offset = grammar_table_at;
+ grammar_table_offset = grammar_table_at;
+
+ if (extend_memory_map)
+ { extend_offset=256;
+ if (no_objects+9 > extend_offset) extend_offset=no_objects+9;
+ while ((extend_offset%length_scale_factor) != 0) extend_offset++;
+ /* Not sure why above line is necessary, but oddeven_packing
+ * will need extend_offset to be even */
+ code_offset = extend_offset*scale_factor;
+ if (oddeven_packing_switch)
+ strings_offset = code_offset + scale_factor;
+ else
+ strings_offset = code_offset + (Write_Strings_At-Write_Code_At);
+
+ /* With the extended memory model, need to specifically check that we
+ * haven't overflowed the packed address range for routines or strings.
+ * With the standard memory model, we only need the earlier total size
+ * check.
+ */
+ excess = code_length + code_offset - (scale_factor*((int32) 0x10000L));
+ if (excess > 0)
+ { char code_full_error[80];
+ sprintf(code_full_error,
+ "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,
+ "The strings area limit has been exceeded by %d bytes",
+ excess);
+ else
+ sprintf(strings_full_error,
+ "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
+ { code_offset = Write_Code_At;
+ strings_offset = Write_Strings_At;
+ }
+
+ /* --------------------------- The Header ----------------------------- */
+
+ for (i=0; i<=0x3f; i++) p[i]=0; /* Begin with 64 blank bytes */
+
+ p[0] = version_number; /* Version number */
+ p[1] = statusline_flag*2; /* Bit 1 of Flags 1: statusline style */
+ p[2] = (release_number/256);
+ p[3] = (release_number%256); /* Release */
+ p[4] = (Write_Code_At/256);
+ p[5] = (Write_Code_At%256); /* End of paged memory */
+ if (version_number==6)
+ { j=code_offset/scale_factor; /* Packed address of "Main__" */
+ p[6]=(j/256); p[7]=(j%256);
+ }
+ else
+ { j=Write_Code_At+1; /* Initial PC value (bytes) */
+ p[6]=(j/256); p[7]=(j%256); /* (first opcode in "Main__") */
+ }
+ p[8] = (dictionary_at/256); p[9]=(dictionary_at%256); /* Dictionary */
+ p[10]=prop_defaults_at/256; p[11]=prop_defaults_at%256; /* Objects */
+ p[12]=(globals_at/256); p[13]=(globals_at%256); /* Dynamic area */
+ p[14]=(grammar_table_at/256);
+ p[15]=(grammar_table_at%256); /* Grammar */
+ for (i=0, j=0, k=1;i<16;i++, k=k*2) /* Flags 2 as needed for any */
+ j+=k*flags2_requirements[i]; /* unusual opcodes assembled */
+ p[16]=j/256; p[17]=j%256;
+ write_serial_number((char *) (p+18)); /* Serial number: 6 chars of ASCII */
+ p[24]=abbrevs_at/256;
+ p[25]=abbrevs_at%256; /* Abbreviations table */
+ p[26]=0; p[27]=0; /* Length of file to be filled in "files.c" */
+ p[28]=0; p[29]=0; /* Checksum to be filled in "files.c" */
+
+ if (extend_memory_map)
+ { j=(Write_Code_At - extend_offset*scale_factor)/length_scale_factor;
+ p[40]=j/256; p[41]=j%256; /* Routines offset */
+ if (oddeven_packing_switch)
+ j=(Write_Strings_At - extend_offset*scale_factor)/length_scale_factor;
+ p[42]=j/256; p[43]=j%256; /* = Strings offset */
+ }
+
+ if (version_number >= 5)
+ { p[46] = terminating_chars_at/256; /* Terminating characters table */
+ p[47] = terminating_chars_at%256;
+ }
+
+ if (alphabet_modified)
+ { j = charset_at;
+ p[52]=j/256; p[53]=j%256; } /* Character set table address */
+
+ j = headerext_at;
+ p[54] = j/256; p[55] = j%256; /* Header extension table address */
+
+ p[60] = '0' + ((RELEASE_NUMBER/100)%10);
+ p[61] = '.';
+ p[62] = '0' + ((RELEASE_NUMBER/10)%10);
+ p[63] = '0' + RELEASE_NUMBER%10;
+
+ /* ------------------------ Header Extension -------------------------- */
+
+ /* The numbering in the spec is a little weird -- it's headerext_length
+ words *after* the initial length word. We follow the spec numbering
+ in this switch statement, so the count is 1-based. */
+ for (i=1; i<=headerext_length; i++) {
+ switch (i) {
+ case 3:
+ j = unicode_at; /* Unicode translation table address */
+ break;
+ case 4:
+ j = ZCODE_HEADER_FLAGS_3; /* Flags 3 word */
+ break;
+ default:
+ j = 0;
+ break;
+ }
+ p[headerext_at+2*i+0] = j / 256;
+ p[headerext_at+2*i+1] = j % 256;
+ }
+
+ /* ----------------- The Header: Extras for modules ------------------- */
+
+ if (module_switch)
+ { p[0]=p[0]+64;
+ p[1]=MODULE_VERSION_NUMBER;
+ p[6]=map_of_module/256;
+ p[7]=map_of_module%256;
+
+ mark = map_of_module; /* Module map format: */
+
+ p[mark++]=object_tree_at/256; /* 0: Object tree addr */
+ p[mark++]=object_tree_at%256;
+ p[mark++]=object_props_at/256; /* 2: Prop values addr */
+ p[mark++]=object_props_at%256;
+ p[mark++]=(Write_Strings_At/scale_factor)/256; /* 4: Static strs */
+ p[mark++]=(Write_Strings_At/scale_factor)%256;
+ p[mark++]=class_numbers_offset/256; /* 6: Class nos addr */
+ p[mark++]=class_numbers_offset%256;
+ p[mark++]=individuals_offset/256; /* 8: Indiv prop values */
+ p[mark++]=individuals_offset%256;
+ p[mark++]=individuals_length/256; /* 10: Length of table */
+ p[mark++]=individuals_length%256;
+ p[mark++]=no_symbols/256; /* 12: No of symbols */
+ p[mark++]=no_symbols%256;
+ p[mark++]=no_individual_properties/256; /* 14: Max property no */
+ p[mark++]=no_individual_properties%256;
+ p[mark++]=no_objects/256; /* 16: No of objects */
+ p[mark++]=no_objects%256;
+ i = link_table_at;
+ p[mark++]=i/256; /* 18: Import/exports */
+ p[mark++]=i%256;
+ p[mark++]=link_data_size/256; /* 20: Size of */
+ p[mark++]=link_data_size%256;
+ i += link_data_size;
+ p[mark++]=i/256; /* 22: Code backpatch */
+ p[mark++]=i%256;
+ p[mark++]=zcode_backpatch_size/256; /* 24: Size of */
+ p[mark++]=zcode_backpatch_size%256;
+ i += zcode_backpatch_size;
+ p[mark++]=i/256; /* 26: Image backpatch */
+ p[mark++]=i%256;
+ p[mark++]=zmachine_backpatch_size/256; /* 28: Size of */
+ p[mark++]=zmachine_backpatch_size%256;
+
+ /* Further space in this table is reserved for future use */
+ }
+
+ /* ---- Backpatch the Z-machine, now that all information is in ------- */
+
+ if (!module_switch && !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;
+ }
+
+ mark = actions_at;
+ for (i=0; i<no_actions; i++)
+ { j=action_byte_offset[i];
+ if (OMIT_UNUSED_ROUTINES)
+ j = df_stripped_address_for_address(j);
+ j += code_offset/scale_factor;
+ p[mark++]=j/256; p[mark++]=j%256;
+ }
+
+ if (grammar_version_number == 1)
+ { mark = preactions_at;
+ for (i=0; i<no_grammar_token_routines; i++)
+ { j=grammar_token_routine[i];
+ if (OMIT_UNUSED_ROUTINES)
+ j = df_stripped_address_for_address(j);
+ j += code_offset/scale_factor;
+ p[mark++]=j/256; p[mark++]=j%256;
+ }
+ }
+ else
+ { for (l = 0; l<no_Inform_verbs; l++)
+ { k = grammar_table_at + 2*l;
+ i = p[k]*256 + p[k+1];
+ for (j = p[i++]; j>0; j--)
+ { int topbits; int32 value;
+ i = i + 2;
+ while (p[i] != 15)
+ { topbits = (p[i]/0x40) & 3;
+ value = p[i+1]*256 + p[i+2];
+ switch(topbits)
+ { case 1:
+ value = final_dict_order[value]
+ *((version_number==3)?7:9)
+ + dictionary_offset + 7;
+ break;
+ case 2:
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset/scale_factor;
+ break;
+ }
+ p[i+1] = value/256; p[i+2] = value%256;
+ i = i + 3;
+ }
+ i++;
+ }
+ }
+ }
+ }
+
+ /* ---- From here on, it's all reportage: construction is finished ---- */
+
+ if (statistics_switch)
+ { int32 k_long, rate; char *k_str="";
+ k_long=(Out_Size/1024);
+ if ((Out_Size-1024*k_long) >= 512) { k_long++; k_str=""; }
+ else if ((Out_Size-1024*k_long) > 0) { k_str=".5"; }
+ if (total_bytes_trans == 0) rate = 0;
+ else rate=total_bytes_trans*1000/total_chars_trans;
+
+ { printf("In:\
+%3d source code files %6d syntactic lines\n\
+%6d textual lines %8ld characters ",
+ total_input_files, no_syntax_lines,
+ total_source_line_count, (long int) total_chars_read);
+ if (character_set_unicode) printf("(UTF-8)\n");
+ else if (character_set_setting == 0) printf("(plain ASCII)\n");
+ else
+ { printf("(ISO 8859-%d %s)\n", character_set_setting,
+ name_of_iso_set(character_set_setting));
+ }
+
+ printf("Allocated:\n\
+%6d symbols (maximum %4d) %8ld bytes of memory\n\
+Out: Version %d \"%s\" %s %d.%c%c%c%c%c%c (%ld%sK long):\n",
+ no_symbols, MAX_SYMBOLS,
+ (long int) malloced_bytes,
+ version_number,
+ version_name(version_number),
+ output_called,
+ release_number, p[18], p[19], p[20], p[21], p[22], p[23],
+ (long int) k_long, k_str);
+
+ printf("\
+%6d classes (maximum %3d) %6d objects (maximum %3d)\n\
+%6d global vars (maximum 233) %6d variable/array space (maximum %d)\n",
+ no_classes, MAX_CLASSES,
+ no_objects, ((version_number==3)?255:(MAX_OBJECTS-1)),
+ no_globals,
+ dynamic_array_area_size, MAX_STATIC_DATA);
+
+ printf(
+"%6d verbs (maximum %3d) %6d dictionary entries (maximum %d)\n\
+%6d grammar lines (version %d) %6d grammar tokens (unlimited)\n\
+%6d actions (maximum %3d) %6d attributes (maximum %2d)\n\
+%6d common props (maximum %2d) %6d individual props (unlimited)\n",
+ no_Inform_verbs, MAX_VERBS,
+ dict_entries, MAX_DICT_ENTRIES,
+ no_grammar_lines, grammar_version_number,
+ no_grammar_tokens,
+ no_actions, MAX_ACTIONS,
+ no_attributes, ((version_number==3)?32:48),
+ no_properties-2, ((version_number==3)?30:62),
+ no_individual_properties - 64);
+
+ if (track_unused_routines)
+ {
+ uint32 diff = df_total_size_before_stripping - df_total_size_after_stripping;
+ printf(
+"%6ld bytes of Z-code %6ld unused bytes %s (%.1f%%)\n",
+ (long int) df_total_size_before_stripping, (long int) diff,
+ (OMIT_UNUSED_ROUTINES ? "stripped out" : "detected"),
+ 100 * (float)diff / (float)df_total_size_before_stripping);
+ }
+
+ printf(
+"%6ld characters used in text %6ld bytes compressed (rate %d.%3ld)\n\
+%6d abbreviations (maximum %d) %6d routines (unlimited)\n\
+%6ld instructions of Z-code %6d sequence points\n\
+%6ld bytes readable memory used (maximum 65536)\n\
+%6ld bytes used in Z-machine %6ld bytes free in Z-machine\n",
+ (long int) total_chars_trans,
+ (long int) total_bytes_trans,
+ (total_chars_trans>total_bytes_trans)?0:1,
+ (long int) rate,
+ no_abbreviations, MAX_ABBREVS,
+ no_routines,
+ (long int) no_instructions, no_sequence_points,
+ (long int) Write_Code_At,
+ (long int) Out_Size,
+ (long int)
+ (((long int) (limit*1024L)) - ((long int) Out_Size)));
+
+ }
+ }
+
+ if (offsets_switch)
+ {
+ { printf(
+"\nOffsets in %s:\n\
+%05lx Synonyms %05lx Defaults %05lx Objects %05lx Properties\n\
+%05lx Variables %05lx Parse table %05lx Actions %05lx Preactions\n\
+%05lx Adjectives %05lx Dictionary %05lx Code %05lx Strings\n",
+ output_called,
+ (long int) abbrevs_at,
+ (long int) prop_defaults_at,
+ (long int) object_tree_at,
+ (long int) object_props_at,
+ (long int) globals_at,
+ (long int) grammar_table_at,
+ (long int) actions_at,
+ (long int) preactions_at,
+ (long int) adjectives_offset,
+ (long int) dictionary_at,
+ (long int) Write_Code_At,
+ (long int) Write_Strings_At);
+ if (module_switch)
+ printf("%05lx Linking data\n",(long int) link_table_at);
+ }
+ }
+
+ if (debugfile_switch)
+ { begin_writing_debug_sections();
+ write_debug_section("abbreviations", 64);
+ write_debug_section("abbreviations table", abbrevs_at);
+ write_debug_section("header extension", headerext_at);
+ if (alphabet_modified)
+ { write_debug_section("alphabets table", charset_at);
+ }
+ if (zscii_defn_modified)
+ { write_debug_section("Unicode table", unicode_at);
+ }
+ write_debug_section("property defaults", prop_defaults_at);
+ write_debug_section("object tree", object_tree_at);
+ write_debug_section("common properties", object_props_at);
+ write_debug_section("class numbers", class_numbers_offset);
+ write_debug_section("identifier names", identifier_names_offset);
+ write_debug_section("individual properties", individuals_offset);
+ write_debug_section("global variables", globals_at);
+ write_debug_section("array space", globals_at+480);
+ write_debug_section("grammar table", grammar_table_at);
+ write_debug_section("actions table", actions_at);
+ write_debug_section("parsing routines", preactions_at);
+ write_debug_section("adjectives table", adjectives_offset);
+ write_debug_section("dictionary", dictionary_at);
+ write_debug_section("code area", Write_Code_At);
+ write_debug_section("strings area", Write_Strings_At);
+ end_writing_debug_sections(Out_Size);
+ }
+
+ if (memory_map_switch)
+ {
+ {
+printf("Dynamic +---------------------+ 00000\n");
+printf("memory | header |\n");
+printf(" +---------------------+ 00040\n");
+printf(" | abbreviations |\n");
+printf(" + - - - - - - - - - - + %05lx\n", (long int) abbrevs_at);
+printf(" | abbreviations table |\n");
+printf(" +---------------------+ %05lx\n", (long int) headerext_at);
+printf(" | header extension |\n");
+ if (alphabet_modified)
+ {
+printf(" + - - - - - - - - - - + %05lx\n", (long int) charset_at);
+printf(" | alphabets table |\n");
+ }
+ if (zscii_defn_modified)
+ {
+printf(" + - - - - - - - - - - + %05lx\n", (long int) unicode_at);
+printf(" | Unicode table |\n");
+ }
+printf(" +---------------------+ %05lx\n",
+ (long int) prop_defaults_at);
+printf(" | property defaults |\n");
+printf(" + - - - - - - - - - - + %05lx\n", (long int) object_tree_at);
+printf(" | objects |\n");
+printf(" + - - - - - - - - - - + %05lx\n",
+ (long int) object_props_at);
+printf(" | object short names, |\n");
+printf(" | common prop values |\n");
+printf(" + - - - - - - - - - - + %05lx\n",
+ (long int) class_numbers_offset);
+printf(" | class numbers table |\n");
+printf(" + - - - - - - - - - - + %05lx\n",
+ (long int) identifier_names_offset);
+printf(" | symbol names table |\n");
+printf(" + - - - - - - - - - - + %05lx\n",
+ (long int) individuals_offset);
+printf(" | indiv prop values |\n");
+printf(" +---------------------+ %05lx\n", (long int) globals_at);
+printf(" | global variables |\n");
+printf(" + - - - - - - - - - - + %05lx\n",
+ ((long int) globals_at)+480L);
+printf(" | arrays |\n");
+printf(" +=====================+ %05lx\n",
+ (long int) grammar_table_at);
+printf("Readable| grammar table |\n");
+printf("memory + - - - - - - - - - - + %05lx\n", (long int) actions_at);
+printf(" | actions |\n");
+printf(" + - - - - - - - - - - + %05lx\n", (long int) preactions_at);
+printf(" | parsing routines |\n");
+printf(" + - - - - - - - - - - + %05lx\n",
+ (long int) adjectives_offset);
+printf(" | adjectives |\n");
+printf(" +---------------------+ %05lx\n", (long int) dictionary_at);
+printf(" | dictionary |\n");
+if (module_switch)
+{
+printf(" + - - - - - - - - - - + %05lx\n",
+ (long int) map_of_module);
+printf(" | map of module addrs |\n");
+}
+printf(" +=====================+ %05lx\n", (long int) Write_Code_At);
+printf("Above | Z-code |\n");
+printf("readable+---------------------+ %05lx\n",
+ (long int) Write_Strings_At);
+printf("memory | strings |\n");
+if (module_switch)
+{
+printf(" +=====================+ %05lx\n", (long int) link_table_at);
+printf(" | module linking data |\n");
+}
+printf(" +---------------------+ %05lx\n", (long int) Out_Size);
+ }
+ }
+ if (percentages_switch)
+ { printf("Approximate percentage breakdown of %s:\n",
+ output_called);
+ percentage("Z-code", code_length,Out_Size);
+ if (module_switch)
+ percentage("Linking data", link_data_size,Out_Size);
+ percentage("Static strings", strings_length,Out_Size);
+ percentage("Dictionary", Write_Code_At-dictionary_at,Out_Size);
+ percentage("Objects", globals_at-prop_defaults_at,Out_Size);
+ percentage("Globals", grammar_table_at-globals_at,Out_Size);
+ percentage("Parsing tables", dictionary_at-grammar_table_at,Out_Size);
+ percentage("Header and synonyms", prop_defaults_at,Out_Size);
+ percentage("Total of save area", grammar_table_at,Out_Size);
+ percentage("Total of text", total_bytes_trans,Out_Size);
+ }
+ if (frequencies_switch)
+ {
+ { printf("How frequently abbreviations were used, and roughly\n");
+ printf("how many bytes they saved: ('_' denotes spaces)\n");
+ for (i=0; i<no_abbreviations; i++)
+ { 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,abbrev_freqs[i],
+ 2*((abbrev_freqs[i]-1)*abbrev_quality[i])/3);
+ if ((i%3)==2) printf("\n");
+ }
+ if ((i%3)!=0) printf("\n");
+ if (no_abbreviations==0) printf("None were declared.\n");
+ }
+ }
+}
+
+static void construct_storyfile_g(void)
+{ uchar *p;
+ int32 i, j, k, l, mark, strings_length, limit;
+ int32 globals_at, dictionary_at, actions_at, preactions_at,
+ abbrevs_at, prop_defaults_at, object_tree_at, object_props_at,
+ grammar_table_at, charset_at, headerext_at,
+ unicode_at, arrays_at;
+ int32 threespaces, code_length;
+ char *output_called = (module_switch)?"module":"story file";
+
+ ASSERT_GLULX();
+
+ 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), NUM_ATTR_BYTES*8,
+ "attribute name strings");
+ array_name_strings =
+ my_calloc(sizeof(int32),
+ no_symbols,
+ "array name strings");
+
+ write_the_identifier_names();
+ threespaces = compile_string(" ", FALSE, FALSE);
+
+ compress_game_text();
+
+ /* 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");
+
+ /* Foolish code to make this routine compile on all ANSI compilers */
+
+ p = (uchar *) zmachine_paged_memory;
+
+ /* In what follows, the "mark" will move upwards in memory: at various
+ points its value will be recorded for milestones like
+ "dictionary table start". It begins at 0x40, just after the header */
+
+ /* Ok, our policy here will be to set the *_at values all relative
+ to RAM. That's so we can write into zmachine_paged_memory[mark]
+ and actually hit what we're aiming at.
+ All the *_offset values will be set to true Glulx machine
+ addresses. */
+
+ /* To get our bearings, figure out where the strings and code are. */
+ /* We start with two words, which conventionally identify the
+ memory layout. This is why the code starts eight bytes after
+ the header. */
+ Write_Code_At = GLULX_HEADER_SIZE + GLULX_STATIC_ROM_SIZE;
+ if (!OMIT_UNUSED_ROUTINES) {
+ code_length = zmachine_pc;
+ }
+ else {
+ if (zmachine_pc != df_total_size_before_stripping)
+ compiler_error("Code size does not match (zmachine_pc and df_total_size).");
+ code_length = df_total_size_after_stripping;
+ }
+ Write_Strings_At = Write_Code_At + code_length;
+ strings_length = compression_table_size + compression_string_size;
+
+ /* Now figure out where RAM starts. */
+ Write_RAM_At = Write_Strings_At + strings_length;
+ /* The Write_RAM_At boundary must be a multiple of GPAGESIZE. */
+ while (Write_RAM_At % GPAGESIZE)
+ Write_RAM_At++;
+
+ /* Now work out all those RAM positions. */
+ mark = 0;
+
+ /* ----------------- Variables and Dynamic Arrays --------------------- */
+
+ globals_at = mark;
+ for (i=0; i<no_globals; i++) {
+ j = global_initial_value[i];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ arrays_at = mark;
+ for (i=MAX_GLOBAL_VARIABLES*4; i<dynamic_array_area_size; i++)
+ p[mark++] = dynamic_array_area[i];
+
+ /* -------------------------- Dynamic Strings -------------------------- */
+
+ abbrevs_at = mark;
+ WriteInt32(p+mark, no_dynamic_strings);
+ mark += 4;
+ for (i=0; i<no_dynamic_strings; i++) {
+ j = Write_Strings_At + compressed_offsets[threespaces-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ /* ---------------- Various Things I'm Not Sure About ------------------ */
+ /* Actually, none of these are relevant to Glulx. */
+ headerext_at = mark;
+ charset_at = 0;
+ if (alphabet_modified)
+ charset_at = mark;
+ unicode_at = 0;
+ if (zscii_defn_modified)
+ unicode_at = mark;
+
+ /* -------------------- Objects and Properties ------------------------ */
+
+ object_tree_at = mark;
+
+ object_props_at = mark + no_objects*OBJECT_BYTE_LENGTH;
+
+ for (i=0; i<no_objects; i++) {
+ int32 objmark = mark;
+ p[mark++] = 0x70; /* type byte -- object */
+ for (j=0; j<NUM_ATTR_BYTES; j++) {
+ p[mark++] = objectatts[i*NUM_ATTR_BYTES+j];
+ }
+ for (j=0; j<6; j++) {
+ int32 val = 0;
+ switch (j) {
+ case 0: /* next object in the linked list. */
+ if (i == no_objects-1)
+ val = 0;
+ else
+ val = Write_RAM_At + objmark + OBJECT_BYTE_LENGTH;
+ break;
+ case 1: /* hardware name address */
+ val = Write_Strings_At + compressed_offsets[objectsg[i].shortname-1];
+ break;
+ case 2: /* property table address */
+ val = Write_RAM_At + object_props_at + objectsg[i].propaddr;
+ break;
+ case 3: /* parent */
+ if (objectsg[i].parent == 0)
+ val = 0;
+ else
+ val = Write_RAM_At + object_tree_at +
+ (OBJECT_BYTE_LENGTH*(objectsg[i].parent-1));
+ break;
+ case 4: /* sibling */
+ if (objectsg[i].next == 0)
+ val = 0;
+ else
+ val = Write_RAM_At + object_tree_at +
+ (OBJECT_BYTE_LENGTH*(objectsg[i].next-1));
+ break;
+ case 5: /* child */
+ if (objectsg[i].child == 0)
+ val = 0;
+ else
+ val = Write_RAM_At + object_tree_at +
+ (OBJECT_BYTE_LENGTH*(objectsg[i].child-1));
+ break;
+ }
+ p[mark++] = (val >> 24) & 0xFF;
+ p[mark++] = (val >> 16) & 0xFF;
+ p[mark++] = (val >> 8) & 0xFF;
+ p[mark++] = (val) & 0xFF;
+ }
+
+ for (j=0; j<GLULX_OBJECT_EXT_BYTES; j++) {
+ p[mark++] = 0;
+ }
+ }
+
+ if (object_props_at != mark)
+ error("*** Object table was impossible length ***");
+
+ for (i=0; i<properties_table_size; i++)
+ p[mark+i]=properties_table[i];
+
+ for (i=0; i<no_objects; i++) {
+ int32 tableaddr = object_props_at + objectsg[i].propaddr;
+ int32 tablelen = ReadInt32(p+tableaddr);
+ tableaddr += 4;
+ for (j=0; j<tablelen; j++) {
+ k = ReadInt32(p+tableaddr+4);
+ k += (Write_RAM_At + object_props_at);
+ WriteInt32(p+tableaddr+4, k);
+ tableaddr += 10;
+ }
+ }
+
+ mark += properties_table_size;
+
+ prop_defaults_at = mark;
+ for (i=0; i<no_properties; i++) {
+ k = prop_default_value[i];
+ WriteInt32(p+mark, k);
+ mark += 4;
+ }
+
+ /* ----------- Table of Class Prototype Object Numbers ---------------- */
+
+ class_numbers_offset = mark;
+ for (i=0; i<no_classes; i++) {
+ j = Write_RAM_At + object_tree_at +
+ (OBJECT_BYTE_LENGTH*(class_object_numbers[i]-1));
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+ WriteInt32(p+mark, 0);
+ mark += 4;
+
+ /* -------------------- Table of Property Names ------------------------ */
+
+ /* We try to format this bit with some regularity...
+ address of common properties
+ number of common properties
+ address of indiv properties
+ number of indiv properties (counted from INDIV_PROP_START)
+ address of attributes
+ number of attributes (always NUM_ATTR_BYTES*8)
+ address of actions
+ number of actions
+ */
+
+ identifier_names_offset = mark;
+ mark += 32; /* eight pairs of values, to be filled in. */
+
+ WriteInt32(p+identifier_names_offset+0, Write_RAM_At + mark);
+ WriteInt32(p+identifier_names_offset+4, no_properties);
+ for (i=0; i<no_properties; i++) {
+ j = individual_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ WriteInt32(p+identifier_names_offset+8, Write_RAM_At + mark);
+ WriteInt32(p+identifier_names_offset+12,
+ no_individual_properties-INDIV_PROP_START);
+ for (i=INDIV_PROP_START; i<no_individual_properties; i++) {
+ j = individual_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ WriteInt32(p+identifier_names_offset+16, Write_RAM_At + mark);
+ WriteInt32(p+identifier_names_offset+20, NUM_ATTR_BYTES*8);
+ for (i=0; i<NUM_ATTR_BYTES*8; i++) {
+ j = attribute_name_strings[i];
+ if (j)
+ j = Write_Strings_At + compressed_offsets[j-1];
+ WriteInt32(p+mark, j);
+ 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 ----------------------------- */
+
+ if (grammar_version_number != 2)
+ { warning("This version of Inform is unable to produce the grammar \
+table format requested (producing number 2 format instead)");
+ grammar_version_number = 2;
+ }
+
+ grammar_table_at = mark;
+
+ WriteInt32(p+mark, no_Inform_verbs);
+ mark += 4;
+
+ mark += no_Inform_verbs*4;
+
+ for (i=0; i<no_Inform_verbs; i++) {
+ j = mark + Write_RAM_At;
+ WriteInt32(p+(grammar_table_at+4+i*4), j);
+ p[mark++] = Inform_verbs[i].lines;
+ for (j=0; j<Inform_verbs[i].lines; j++) {
+ int tok;
+ k = Inform_verbs[i].l[j];
+ p[mark++] = grammar_lines[k++];
+ p[mark++] = grammar_lines[k++];
+ p[mark++] = grammar_lines[k++];
+ for (;;) {
+ tok = grammar_lines[k++];
+ p[mark++] = tok;
+ if (tok == 15) break;
+ p[mark++] = grammar_lines[k++];
+ p[mark++] = grammar_lines[k++];
+ p[mark++] = grammar_lines[k++];
+ p[mark++] = grammar_lines[k++];
+ }
+ }
+ }
+
+ /* ------------------- Actions and Preactions ------------------------- */
+
+ actions_at = mark;
+ WriteInt32(p+mark, no_actions);
+ mark += 4;
+ mark += no_actions*4;
+ /* Values to be written in later. */
+
+ if (DICT_CHAR_SIZE != 1) {
+ /* If the dictionary is Unicode, we'd like it to be word-aligned. */
+ while (mark % 4)
+ p[mark++]=0;
+ }
+
+ preactions_at = mark;
+ adjectives_offset = mark;
+ dictionary_offset = mark;
+
+ /* ------------------------- Dictionary ------------------------------- */
+
+ dictionary_at = mark;
+
+ WriteInt32(dictionary+0, dict_entries);
+ for (i=0; i<4; i++)
+ p[mark+i] = dictionary[i];
+
+ for (i=0; i<dict_entries; i++) {
+ k = 4 + i*DICT_ENTRY_BYTE_LENGTH;
+ j = mark + 4 + final_dict_order[i]*DICT_ENTRY_BYTE_LENGTH;
+ for (l=0; l<DICT_ENTRY_BYTE_LENGTH; l++)
+ p[j++] = dictionary[k++];
+ }
+ mark += 4 + dict_entries * DICT_ENTRY_BYTE_LENGTH;
+
+ /* -------------------------- All Data -------------------------------- */
+
+ /* The end-of-RAM boundary must be a multiple of GPAGESIZE. */
+ while (mark % GPAGESIZE)
+ p[mark++]=0;
+
+ RAM_Size = mark;
+
+ Out_Size = Write_RAM_At + RAM_Size;
+ limit=1024*1024;
+
+ /* --------------------------- Offsets -------------------------------- */
+
+ dictionary_offset = Write_RAM_At + dictionary_at;
+ variables_offset = Write_RAM_At + globals_at;
+ arrays_offset = Write_RAM_At + arrays_at;
+ actions_offset = Write_RAM_At + actions_at;
+ preactions_offset = Write_RAM_At + preactions_at;
+ prop_defaults_offset = Write_RAM_At + prop_defaults_at;
+ object_tree_offset = Write_RAM_At + object_tree_at;
+ prop_values_offset = Write_RAM_At + object_props_at;
+ static_memory_offset = Write_RAM_At + grammar_table_at;
+ grammar_table_offset = Write_RAM_At + grammar_table_at;
+ abbreviations_offset = Write_RAM_At + abbrevs_at;
+
+ code_offset = Write_Code_At;
+ strings_offset = Write_Strings_At;
+
+ /* --------------------------- The Header ----------------------------- */
+
+ /* ------ Backpatch the machine, now that all information is in ------- */
+
+ if (!module_switch)
+ { backpatch_zmachine_image_g();
+
+ mark = actions_at + 4;
+ for (i=0; i<no_actions; i++) {
+ j = action_byte_offset[i];
+ if (OMIT_UNUSED_ROUTINES)
+ j = df_stripped_address_for_address(j);
+ j += code_offset;
+ WriteInt32(p+mark, j);
+ mark += 4;
+ }
+
+ for (l = 0; l<no_Inform_verbs; l++) {
+ k = grammar_table_at + 4 + 4*l;
+ i = ((p[k] << 24) | (p[k+1] << 16) | (p[k+2] << 8) | (p[k+3]));
+ i -= Write_RAM_At;
+ for (j = p[i++]; j>0; j--) {
+ int topbits;
+ int32 value;
+ i = i + 3;
+ while (p[i] != 15) {
+ topbits = (p[i]/0x40) & 3;
+ value = ((p[i+1] << 24) | (p[i+2] << 16)
+ | (p[i+3] << 8) | (p[i+4]));
+ switch(topbits) {
+ case 1:
+ value = dictionary_offset + 4
+ + final_dict_order[value]*DICT_ENTRY_BYTE_LENGTH;
+ break;
+ case 2:
+ if (OMIT_UNUSED_ROUTINES)
+ value = df_stripped_address_for_address(value);
+ value += code_offset;
+ break;
+ }
+ WriteInt32(p+(i+1), value);
+ i = i + 5;
+ }
+ i++;
+ }
+ }
+
+ }
+
+ /* ---- From here on, it's all reportage: construction is finished ---- */
+
+ if (statistics_switch)
+ { int32 k_long, rate; char *k_str="";
+ k_long=(Out_Size/1024);
+ if ((Out_Size-1024*k_long) >= 512) { k_long++; k_str=""; }
+ else if ((Out_Size-1024*k_long) > 0) { k_str=".5"; }
+ if (strings_length == 0) rate = 0;
+ else rate=strings_length*1000/total_chars_trans;
+
+ { printf("In:\
+%3d source code files %6d syntactic lines\n\
+%6d textual lines %8ld characters ",
+ total_input_files, no_syntax_lines,
+ total_source_line_count, (long int) total_chars_read);
+ if (character_set_unicode) printf("(UTF-8)\n");
+ else if (character_set_setting == 0) printf("(plain ASCII)\n");
+ else
+ { printf("(ISO 8859-%d %s)\n", character_set_setting,
+ name_of_iso_set(character_set_setting));
+ }
+
+ {char serialnum[8];
+ write_serial_number(serialnum);
+ printf("Allocated:\n\
+%6d symbols (maximum %4d) %8ld bytes of memory\n\
+Out: %s %s %d.%c%c%c%c%c%c (%ld%sK long):\n",
+ no_symbols, MAX_SYMBOLS,
+ (long int) malloced_bytes,
+ version_name(version_number),
+ output_called,
+ release_number,
+ serialnum[0], serialnum[1], serialnum[2],
+ serialnum[3], serialnum[4], serialnum[5],
+ (long int) k_long, k_str);
+ }
+
+ printf("\
+%6d classes (maximum %3d) %6d objects (maximum %3d)\n\
+%6d global vars (maximum %3d) %6d variable/array space (maximum %d)\n",
+ no_classes, MAX_CLASSES,
+ no_objects, MAX_OBJECTS,
+ no_globals, MAX_GLOBAL_VARIABLES,
+ dynamic_array_area_size, MAX_STATIC_DATA);
+
+ printf(
+"%6d verbs (maximum %3d) %6d dictionary entries (maximum %d)\n\
+%6d grammar lines (version %d) %6d grammar tokens (unlimited)\n\
+%6d actions (maximum %3d) %6d attributes (maximum %2d)\n\
+%6d common props (maximum %3d) %6d individual props (unlimited)\n",
+ no_Inform_verbs, MAX_VERBS,
+ dict_entries, MAX_DICT_ENTRIES,
+ no_grammar_lines, grammar_version_number,
+ no_grammar_tokens,
+ no_actions, MAX_ACTIONS,
+ no_attributes, NUM_ATTR_BYTES*8,
+ no_properties, INDIV_PROP_START,
+ no_individual_properties - INDIV_PROP_START);
+
+ if (track_unused_routines)
+ {
+ uint32 diff = df_total_size_before_stripping - df_total_size_after_stripping;
+ printf(
+"%6ld bytes of code %6ld unused bytes %s (%.1f%%)\n",
+ (long int) df_total_size_before_stripping, (long int) diff,
+ (OMIT_UNUSED_ROUTINES ? "stripped out" : "detected"),
+ 100 * (float)diff / (float)df_total_size_before_stripping);
+ }
+
+ printf(
+"%6ld characters used in text %6ld bytes compressed (rate %d.%3ld)\n\
+%6d abbreviations (maximum %d) %6d routines (unlimited)\n\
+%6ld instructions of code %6d sequence points\n\
+%6ld bytes writable memory used %6ld bytes read-only memory used\n\
+%6ld bytes used in machine %10ld bytes free in machine\n",
+ (long int) total_chars_trans,
+ (long int) strings_length,
+ (total_chars_trans>strings_length)?0:1,
+ (long int) rate,
+ no_abbreviations, MAX_ABBREVS,
+ no_routines,
+ (long int) no_instructions, no_sequence_points,
+ (long int) (Out_Size - Write_RAM_At),
+ (long int) Write_RAM_At,
+ (long int) Out_Size,
+ (long int)
+ (((long int) (limit*1024L)) - ((long int) Out_Size)));
+
+ }
+ }
+
+ if (offsets_switch)
+ {
+ { printf(
+"\nOffsets in %s:\n\
+%05lx Synonyms %05lx Defaults %05lx Objects %05lx Properties\n\
+%05lx Variables %05lx Parse table %05lx Actions %05lx Preactions\n\
+%05lx Adjectives %05lx Dictionary %05lx Code %05lx Strings\n",
+ output_called,
+ (long int) abbrevs_at,
+ (long int) prop_defaults_at,
+ (long int) object_tree_at,
+ (long int) object_props_at,
+ (long int) globals_at,
+ (long int) grammar_table_at,
+ (long int) actions_at,
+ (long int) preactions_at,
+ (long int) adjectives_offset,
+ (long int) dictionary_at,
+ (long int) Write_Code_At,
+ (long int) Write_Strings_At);
+ }
+ }
+
+ if (debugfile_switch)
+ { begin_writing_debug_sections();
+ write_debug_section("memory layout id", GLULX_HEADER_SIZE);
+ write_debug_section("code area", Write_Code_At);
+ write_debug_section("string decoding table", Write_Strings_At);
+ write_debug_section("strings area",
+ Write_Strings_At + compression_table_size);
+ if (Write_Strings_At + strings_length < Write_RAM_At)
+ { write_debug_section
+ ("zero padding", Write_Strings_At + strings_length);
+ }
+ if (globals_at)
+ { compiler_error("Failed assumption that globals are at start of "
+ "Glulx RAM");
+ }
+ write_debug_section("global variables", Write_RAM_At + globals_at);
+ write_debug_section("array space", Write_RAM_At + arrays_at);
+ write_debug_section("abbreviations table", Write_RAM_At + abbrevs_at);
+ write_debug_section("object tree", Write_RAM_At + object_tree_at);
+ write_debug_section("common properties",
+ Write_RAM_At + object_props_at);
+ write_debug_section("property defaults",
+ Write_RAM_At + prop_defaults_at);
+ write_debug_section("class numbers",
+ Write_RAM_At + class_numbers_offset);
+ write_debug_section("identifier names",
+ Write_RAM_At + identifier_names_offset);
+ write_debug_section("grammar table", Write_RAM_At + grammar_table_at);
+ write_debug_section("actions table", Write_RAM_At + actions_at);
+ write_debug_section("dictionary", Write_RAM_At + dictionary_at);
+ if (MEMORY_MAP_EXTENSION)
+ { write_debug_section("zero padding", Out_Size);
+ }
+ end_writing_debug_sections(Out_Size + MEMORY_MAP_EXTENSION);
+ }
+
+ if (memory_map_switch)
+ {
+
+ {
+printf(" +---------------------+ 000000\n");
+printf("Read- | header |\n");
+printf(" only +=====================+ %06lx\n", (long int) GLULX_HEADER_SIZE);
+printf("memory | memory layout id |\n");
+printf(" +---------------------+ %06lx\n", (long int) Write_Code_At);
+printf(" | code |\n");
+printf(" +---------------------+ %06lx\n",
+ (long int) Write_Strings_At);
+printf(" | string decode table |\n");
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) Write_Strings_At + compression_table_size);
+printf(" | strings |\n");
+printf(" +=====================+ %06lx\n",
+ (long int) (Write_RAM_At+globals_at));
+printf("Dynamic | global variables |\n");
+printf("memory + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+arrays_at));
+printf(" | arrays |\n");
+printf(" +---------------------+ %06lx\n",
+ (long int) (Write_RAM_At+abbrevs_at));
+printf(" | printing variables |\n");
+ if (alphabet_modified)
+ {
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+charset_at));
+printf(" | alphabets table |\n");
+ }
+ if (zscii_defn_modified)
+ {
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+unicode_at));
+printf(" | Unicode table |\n");
+ }
+printf(" +---------------------+ %06lx\n",
+ (long int) (Write_RAM_At+object_tree_at));
+printf(" | objects |\n");
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+object_props_at));
+printf(" | property values |\n");
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+prop_defaults_at));
+printf(" | property defaults |\n");
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+class_numbers_offset));
+printf(" | class numbers table |\n");
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+identifier_names_offset));
+printf(" | id names table |\n");
+printf(" +---------------------+ %06lx\n",
+ (long int) (Write_RAM_At+grammar_table_at));
+printf(" | grammar table |\n");
+printf(" + - - - - - - - - - - + %06lx\n",
+ (long int) (Write_RAM_At+actions_at));
+printf(" | actions |\n");
+printf(" +---------------------+ %06lx\n",
+ (long int) dictionary_offset);
+printf(" | dictionary |\n");
+ if (MEMORY_MAP_EXTENSION == 0)
+ {
+printf(" +---------------------+ %06lx\n", (long int) Out_Size);
+ }
+ else
+ {
+printf(" +=====================+ %06lx\n", (long int) Out_Size);
+printf("Runtime | (empty) |\n");
+printf(" extn +---------------------+ %06lx\n", (long int) Out_Size+MEMORY_MAP_EXTENSION);
+ }
+
+ }
+
+ }
+
+
+ if (percentages_switch)
+ { printf("Approximate percentage breakdown of %s:\n",
+ output_called);
+ percentage("Code", code_length,Out_Size);
+ if (module_switch)
+ percentage("Linking data", link_data_size,Out_Size);
+ percentage("Static strings", strings_length,Out_Size);
+ percentage("Dictionary", Write_Code_At-dictionary_at,Out_Size);
+ percentage("Objects", globals_at-prop_defaults_at,Out_Size);
+ percentage("Globals", grammar_table_at-globals_at,Out_Size);
+ percentage("Parsing tables", dictionary_at-grammar_table_at,Out_Size);
+ percentage("Header and synonyms", prop_defaults_at,Out_Size);
+ percentage("Total of save area", grammar_table_at,Out_Size);
+ percentage("Total of text", strings_length,Out_Size);
+ }
+ if (frequencies_switch)
+ {
+ { printf("How frequently abbreviations were used, and roughly\n");
+ printf("how many bytes they saved: ('_' denotes spaces)\n");
+ for (i=0; i<no_abbreviations; i++)
+ { 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,abbrev_freqs[i],
+ 2*((abbrev_freqs[i]-1)*abbrev_quality[i])/3);
+ if ((i%3)==2) printf("\n");
+ }
+ if ((i%3)!=0) printf("\n");
+ if (no_abbreviations==0) printf("None were declared.\n");
+ }
+ }
+}
+
+extern void construct_storyfile(void)
+{
+ if (!glulx_mode)
+ construct_storyfile_z();
+ else
+ construct_storyfile_g();
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_tables_vars(void)
+{
+ release_number = 1;
+ statusline_flag = SCORE_STYLE;
+
+ zmachine_paged_memory = NULL;
+
+ if (!glulx_mode) {
+ code_offset = 0x800;
+ actions_offset = 0x800;
+ preactions_offset = 0x800;
+ dictionary_offset = 0x800;
+ adjectives_offset = 0x800;
+ variables_offset = 0;
+ strings_offset = 0xc00;
+ individuals_offset=0x800;
+ identifier_names_offset=0x800;
+ class_numbers_offset = 0x800;
+ arrays_offset = 0x0800; /* only used in Glulx, but might as well set */
+ }
+ else {
+ code_offset = 0x12345;
+ actions_offset = 0x12345;
+ preactions_offset = 0x12345;
+ dictionary_offset = 0x12345;
+ adjectives_offset = 0x12345;
+ variables_offset = 0x12345;
+ arrays_offset = 0x12345;
+ strings_offset = 0x12345;
+ individuals_offset=0x12345;
+ identifier_names_offset=0x12345;
+ class_numbers_offset = 0x12345;
+ }
+}
+
+extern void tables_begin_pass(void)
+{
+}
+
+extern void tables_allocate_arrays(void)
+{
+}
+
+extern void tables_free_arrays(void)
+{
+ /* Allocation for this array happens in construct_storyfile() above */
+
+ my_free(&zmachine_paged_memory,"output buffer");
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "text" : Text translation, the abbreviations optimiser, the dictionary */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+uchar *low_strings, *low_strings_top; /* Start and next free byte in the low
+ strings pool */
+
+int32 static_strings_extent; /* Number of bytes of static strings
+ made so far */
+memory_block static_strings_area; /* Used if (!temporary_files_switch) to
+ hold the static strings area so far */
+
+static uchar *strings_holding_area; /* Area holding translated strings
+ until they are moved into either
+ a temporary file, or the
+ static_strings_area below */
+
+char *all_text, *all_text_top; /* Start and next byte free in (large)
+ text buffer holding the entire text
+ of the game, when it is being
+ recorded */
+int put_strings_in_low_memory, /* When TRUE, put static strings in
+ the low strings pool at 0x100 rather
+ than in the static strings area */
+ is_abbreviation, /* When TRUE, the string being trans
+ is itself an abbreviation string
+ so can't make use of abbreviations */
+ abbrevs_lookup_table_made, /* The abbreviations lookup table is
+ constructed when the first non-
+ abbreviation string is translated:
+ this flag is TRUE after that */
+ abbrevs_lookup[256]; /* Once this has been constructed,
+ abbrevs_lookup[n] = the smallest
+ number of any abbreviation beginning
+ with ASCII character n, or -1
+ if none of the abbreviations do */
+int no_abbreviations; /* No of abbreviations defined so far */
+uchar *abbreviations_at; /* Memory to hold the text of any
+ abbreviation strings declared */
+/* ------------------------------------------------------------------------- */
+/* Glulx string compression storage */
+/* ------------------------------------------------------------------------- */
+
+int no_strings; /* No of strings in static strings
+ area. */
+int no_dynamic_strings; /* No. of @.. string escapes used
+ (actually, the highest value used
+ plus one) */
+int no_unicode_chars; /* Number of distinct Unicode chars
+ used. (Beyond 0xFF.) */
+
+static int MAX_CHARACTER_SET; /* Number of possible entities */
+huffentity_t *huff_entities; /* The list of entities (characters,
+ abbreviations, @.. escapes, and
+ the terminator) */
+static huffentity_t **hufflist; /* Copy of the list, for sorting */
+
+int no_huff_entities; /* The number of entities in the list */
+int huff_unicode_start; /* Position in the list where Unicode
+ chars begin. */
+int huff_abbrev_start; /* Position in the list where string
+ abbreviations begin. */
+int huff_dynam_start; /* Position in the list where @..
+ entities begin. */
+int huff_entity_root; /* The position in the list of the root
+ entry (when considering the table
+ as a tree). */
+
+int done_compression; /* Has the game text been compressed? */
+int32 compression_table_size; /* Length of the Huffman table, in
+ bytes */
+int32 compression_string_size; /* Length of the compressed string
+ data, in bytes */
+int32 *compressed_offsets; /* The beginning of every string in
+ the game, relative to the beginning
+ of the Huffman table. (So entry 0
+ is equal to compression_table_size)*/
+
+#define UNICODE_HASH_BUCKETS (64)
+unicode_usage_t *unicode_usage_entries;
+static unicode_usage_t *unicode_usage_hash[UNICODE_HASH_BUCKETS];
+
+static int unicode_entity_index(int32 unicode);
+
+/* ------------------------------------------------------------------------- */
+/* Abbreviation arrays */
+/* ------------------------------------------------------------------------- */
+
+int *abbrev_values;
+int *abbrev_quality;
+int *abbrev_freqs;
+
+/* ------------------------------------------------------------------------- */
+
+int32 total_chars_trans, /* Number of ASCII chars of text in */
+ total_bytes_trans, /* Number of bytes of Z-code text out */
+ zchars_trans_in_last_string; /* Number of Z-chars in last string:
+ needed only for abbrev efficiency
+ calculation in "directs.c" */
+static int32 total_zchars_trans, /* Number of Z-chars of text out
+ (only used to calculate the above) */
+ no_chars_transcribed; /* Number of ASCII chars written to
+ the text transcription area (used
+ for the -r and -u switches) */
+
+static int zchars_out_buffer[3], /* During text translation, a buffer of
+ 3 Z-chars at a time: when it's full
+ these are written as a 2-byte word */
+ zob_index; /* Index (0 to 2) into it */
+
+static unsigned char *text_out_pc; /* The "program counter" during text
+ translation: the next address to
+ write Z-coded text output to */
+
+static unsigned char *text_out_limit; /* The upper limit of text_out_pc
+ during text translation */
+
+static int text_out_overflow; /* During text translation, becomes
+ true if text_out_pc tries to pass
+ text_out_limit */
+
+/* ------------------------------------------------------------------------- */
+/* For variables/arrays used by the dictionary manager, see below */
+/* ------------------------------------------------------------------------- */
+
+/* ------------------------------------------------------------------------- */
+/* Prepare the abbreviations lookup table (used to speed up abbreviation */
+/* detection in text translation). We first bubble-sort the abbrevs into */
+/* alphabetical order (this is necessary for the detection algorithm to */
+/* to work). Since the table is only prepared once, and for a table */
+/* of size at most 96, there's no point using an efficient sort algorithm. */
+/* ------------------------------------------------------------------------- */
+
+static void make_abbrevs_lookup(void)
+{ int bubble_sort, j, k, l; char p[MAX_ABBREV_LENGTH]; 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;
+ if (strcmp(p1,p2)<0)
+ { strcpy(p,p1); strcpy(p1,p2); strcpy(p2,p);
+ l=abbrev_values[j]; abbrev_values[j]=abbrev_values[k];
+ abbrev_values[k]=l;
+ l=abbrev_quality[j]; abbrev_quality[j]=abbrev_quality[k];
+ abbrev_quality[k]=l;
+ bubble_sort = TRUE;
+ }
+ }
+ } while (bubble_sort);
+
+ for (j=no_abbreviations-1; j>=0; j--)
+ { p1=(char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
+ abbrevs_lookup[(uchar)p1[0]]=j;
+ abbrev_freqs[j]=0;
+ }
+ abbrevs_lookup_table_made = TRUE;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Search the abbreviations lookup table (a routine which must be fast). */
+/* The source text to compare is text[i], text[i+1], ... and this routine */
+/* is only called if text[i] is indeed the first character of at least one */
+/* abbreviation, "from" begin the least index into the abbreviations table */
+/* of an abbreviation for which text[i] is the first character. Recall */
+/* that the abbrevs table is in alphabetical order. */
+/* */
+/* The return value is -1 if there is no match. If there is a match, the */
+/* text to be abbreviated out is over-written by a string of null chars */
+/* with "ASCII" value 1, and the abbreviation number is returned. */
+/* */
+/* In Glulx, we *do not* do this overwriting with 1's. */
+/* ------------------------------------------------------------------------- */
+
+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 (k=2; p[k]!=0; k++)
+ if (text[i+k]!=p[k]) goto NotMatched;
+ if (!glulx_mode) {
+ for (k=0; p[k]!=0; k++) text[i+k]=1;
+ }
+ abbrev_freqs[j]++;
+ return(j);
+ NotMatched: ;
+ }
+ }
+ return(-1);
+}
+
+extern void make_abbreviation(char *text)
+{
+ strcpy((char *)abbreviations_at
+ + no_abbreviations*MAX_ABBREV_LENGTH, text);
+
+ is_abbreviation = TRUE;
+ abbrev_values[no_abbreviations] = compile_string(text, TRUE, TRUE);
+ is_abbreviation = FALSE;
+
+ /* The quality is the number of Z-chars saved by using this */
+ /* abbreviation: note that it takes 2 Z-chars to print it. */
+
+ abbrev_quality[no_abbreviations++] = zchars_trans_in_last_string - 2;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The front end routine for text translation */
+/* ------------------------------------------------------------------------- */
+
+extern int32 compile_string(char *b, int in_low_memory, int is_abbrev)
+{ int i, j; uchar *c;
+
+ is_abbreviation = is_abbrev;
+
+ /* Put into the low memory pool (at 0x100 in the Z-machine) of strings */
+ /* which may be wanted as possible entries in the abbreviations table */
+
+ if (!glulx_mode && in_low_memory)
+ { j=subtract_pointers(low_strings_top,low_strings);
+ low_strings_top=translate_text(low_strings_top, low_strings+MAX_LOW_STRINGS, b);
+ if (!low_strings_top)
+ memoryerror("MAX_LOW_STRINGS", MAX_LOW_STRINGS);
+ is_abbreviation = FALSE;
+ return(0x21+(j/2));
+ }
+
+ if (glulx_mode && done_compression)
+ compiler_error("Tried to add a string after compression was done.");
+
+ c = translate_text(strings_holding_area, strings_holding_area+MAX_STATIC_STRINGS, b);
+ if (!c)
+ memoryerror("MAX_STATIC_STRINGS",MAX_STATIC_STRINGS);
+
+ i = subtract_pointers(c, strings_holding_area);
+
+ /* Insert null bytes as needed to ensure that the next static string */
+ /* also occurs at an address expressible as a packed address */
+
+ if (!glulx_mode) {
+ int textalign;
+ if (oddeven_packing_switch)
+ textalign = scale_factor*2;
+ else
+ textalign = scale_factor;
+ while ((i%textalign)!=0)
+ {
+ if (i+2 > MAX_STATIC_STRINGS)
+ memoryerror("MAX_STATIC_STRINGS",MAX_STATIC_STRINGS);
+ i+=2; *c++ = 0; *c++ = 0;
+ }
+ }
+
+ j = static_strings_extent;
+
+ if (temporary_files_switch)
+ for (c=strings_holding_area; c<strings_holding_area+i;
+ c++, static_strings_extent++)
+ fputc(*c,Temp1_fp);
+ else
+ for (c=strings_holding_area; c<strings_holding_area+i;
+ c++, static_strings_extent++)
+ write_byte_to_memory_block(&static_strings_area,
+ static_strings_extent, *c);
+
+ is_abbreviation = FALSE;
+
+ if (!glulx_mode) {
+ return(j/scale_factor);
+ }
+ else {
+ /* The marker value is a one-based string number. (We reserve zero
+ to mean "not a string at all". */
+ return (++no_strings);
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Output a single Z-character into the buffer, and flush it if full */
+/* ------------------------------------------------------------------------- */
+
+static void write_z_char_z(int i)
+{ uint32 j;
+ ASSERT_ZCODE();
+ total_zchars_trans++;
+ zchars_out_buffer[zob_index++]=(i%32);
+ if (zob_index!=3) return;
+ zob_index=0;
+ j= zchars_out_buffer[0]*0x0400 + zchars_out_buffer[1]*0x0020
+ + zchars_out_buffer[2];
+ if (text_out_pc+2 > text_out_limit) {
+ text_out_overflow = TRUE;
+ return;
+ }
+ text_out_pc[0] = j/256; text_out_pc[1] = j%256; text_out_pc+=2;
+ total_bytes_trans+=2;
+}
+
+static void write_zscii(int zsc)
+{
+ int lookup_value, in_alphabet;
+
+ if (zsc==' ')
+ { write_z_char_z(0);
+ return;
+ }
+
+ if (zsc < 0x100) lookup_value = zscii_to_alphabet_grid[zsc];
+
+ else lookup_value = -1;
+
+ if (lookup_value >= 0)
+ { alphabet_used[lookup_value] = 'Y';
+ in_alphabet = lookup_value/26;
+ if (in_alphabet==1) write_z_char_z(4); /* SHIFT to A1 */
+ if (in_alphabet==2) write_z_char_z(5); /* SHIFT to A2 */
+ write_z_char_z(lookup_value%26 + 6);
+ }
+ else
+ { write_z_char_z(5); write_z_char_z(6);
+ write_z_char_z(zsc/32); write_z_char_z(zsc%32);
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Finish a Z-coded string, padding out with Z-char 5s if necessary and */
+/* setting the "end" bit on the final 2-byte word */
+/* ------------------------------------------------------------------------- */
+
+static void end_z_chars(void)
+{ unsigned char *p;
+ zchars_trans_in_last_string=total_zchars_trans-zchars_trans_in_last_string;
+ while (zob_index!=0) write_z_char_z(5);
+ p=(unsigned char *) text_out_pc;
+ *(p-2)= *(p-2)+128;
+}
+
+/* Glulx handles this much more simply -- compression is done elsewhere. */
+static void write_z_char_g(int i)
+{
+ ASSERT_GLULX();
+ if (text_out_pc+1 > text_out_limit) {
+ text_out_overflow = TRUE;
+ return;
+ }
+ total_zchars_trans++;
+ text_out_pc[0] = i;
+ text_out_pc++;
+ total_bytes_trans++;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The main routine "text.c" provides to the rest of Inform: the text */
+/* translator. p is the address to write output to, s_text the source text */
+/* and the return value is the next free address to write output to. */
+/* The return value will not exceed p_limit. If the translation tries to */
+/* overflow this boundary, the return value will be NULL (and you should */
+/* display an error). */
+/* Note that the source text may be corrupted by this routine. */
+/* ------------------------------------------------------------------------- */
+
+extern uchar *translate_text(uchar *p, uchar *p_limit, char *s_text)
+{ int i, j, k, in_alphabet, lookup_value;
+ int32 unicode; int zscii;
+ unsigned char *text_in;
+
+ /* Cast the input and output streams to unsigned char: text_out_pc will
+ advance as bytes of Z-coded text are written, but text_in doesn't */
+
+ text_in = (unsigned char *) s_text;
+ text_out_pc = (unsigned char *) p;
+ text_out_limit = (unsigned char *) p_limit;
+ text_out_overflow = FALSE;
+
+ /* Remember the Z-chars total so that later we can subtract to find the
+ number of Z-chars translated on this string */
+
+ zchars_trans_in_last_string = total_zchars_trans;
+
+ /* Start with the Z-characters output buffer empty */
+
+ zob_index=0;
+
+ /* If this is the first text translated since the abbreviations were
+ declared, and if some were declared, then it's time to make the
+ lookup table for abbreviations
+
+ (Except: we don't if the text being translated is itself
+ the text of an abbreviation currently being defined) */
+
+ if ((!abbrevs_lookup_table_made) && (no_abbreviations > 0)
+ && (!is_abbreviation))
+ make_abbrevs_lookup();
+
+ /* If we're storing the whole game text to memory, then add this text */
+
+ if ((!is_abbreviation) && (store_the_text))
+ { no_chars_transcribed += strlen(s_text)+2;
+ if (no_chars_transcribed >= MAX_TRANSCRIPT_SIZE)
+ memoryerror("MAX_TRANSCRIPT_SIZE", MAX_TRANSCRIPT_SIZE);
+ sprintf(all_text_top, "%s\n\n", s_text);
+ all_text_top += strlen(all_text_top);
+ }
+
+ if (transcript_switch && (!veneer_mode))
+ write_to_transcript_file(s_text);
+
+ if (!glulx_mode) {
+
+ /* The empty string of Z-text is illegal, since it can't carry an end
+ bit: so we translate an empty string of ASCII text to just the
+ pad character 5. Printing this causes nothing to appear on screen. */
+
+ if (text_in[0]==0) write_z_char_z(5);
+
+ /* Loop through the characters of the null-terminated input text: note
+ that if 1 is written over a character in the input text, it is
+ afterwards ignored */
+
+ for (i=0; text_in[i]!=0; i++)
+ { total_chars_trans++;
+
+ /* Contract ". " into ". " if double-space-removing switch set:
+ likewise "? " and "! " if the setting is high enough */
+
+ if ((double_space_setting >= 1)
+ && (text_in[i+1]==' ') && (text_in[i+2]==' '))
+ { if (text_in[i]=='.') text_in[i+2]=1;
+ if (double_space_setting >= 2)
+ { if (text_in[i]=='?') text_in[i+2]=1;
+ if (text_in[i]=='!') text_in[i+2]=1;
+ }
+ }
+
+ /* Try abbreviations if the economy switch set */
+
+ if ((economy_switch) && (!is_abbreviation)
+ && ((k=abbrevs_lookup[text_in[i]])!=-1))
+ { if ((j=try_abbreviations_from(text_in, i, k))!=-1)
+ { if (j<32) { write_z_char_z(2); write_z_char_z(j); }
+ else { write_z_char_z(3); write_z_char_z(j-32); }
+ }
+ }
+
+ /* If Unicode switch set, use text_to_unicode to perform UTF-8
+ decoding */
+ if (character_set_unicode && (text_in[i] & 0x80))
+ { unicode = text_to_unicode((char *) (text_in+i));
+ zscii = unicode_to_zscii(unicode);
+ if (zscii != 5) write_zscii(zscii);
+ else
+ { unicode_char_error(
+ "Character can only be used if declared in \
+advance as part of 'Zcharacter table':", unicode);
+ }
+ i += textual_form_length - 1;
+ continue;
+ }
+
+ /* '@' is the escape character in Inform string notation: the various
+ possibilities are:
+
+ (printing only)
+ @@decimalnumber : write this ZSCII char (0 to 1023)
+ @twodigits : write the abbreviation string with this
+ decimal number
+
+ (any string context)
+ @accentcode : this accented character: e.g.,
+ for @'e write an E-acute
+ @{...} : this Unicode char (in hex) */
+
+ if (text_in[i]=='@')
+ { if (text_in[i+1]=='@')
+ {
+ /* @@... */
+
+ i+=2; j=atoi((char *) (text_in+i));
+ switch(j)
+ { /* Prevent ~ and ^ from being translated to double-quote
+ and new-line, as they ordinarily would be */
+
+ case 94: write_z_char_z(5); write_z_char_z(6);
+ write_z_char_z(94/32); write_z_char_z(94%32);
+ break;
+ case 126: write_z_char_z(5); write_z_char_z(6);
+ write_z_char_z(126/32); write_z_char_z(126%32);
+ break;
+
+ default: write_zscii(j); break;
+ }
+ while (isdigit(text_in[i])) i++; i--;
+ }
+ else if (isdigit(text_in[i+1])!=0)
+ { int d1, d2;
+
+ /* @.. */
+
+ d1 = character_digit_value[text_in[i+1]];
+ d2 = character_digit_value[text_in[i+2]];
+ if ((d1 == 127) || (d1 >= 10) || (d2 == 127) || (d2 >= 10))
+ error("'@..' must have two decimal digits");
+ else
+ { i+=2;
+ write_z_char_z(1); write_z_char_z(d1*10 + d2);
+ }
+ }
+ else
+ {
+ /* A string escape specifying an unusual character */
+
+ unicode = text_to_unicode((char *) (text_in+i));
+ zscii = unicode_to_zscii(unicode);
+ if (zscii != 5) write_zscii(zscii);
+ else
+ { unicode_char_error(
+ "Character can only be used if declared in \
+advance as part of 'Zcharacter table':", unicode);
+ }
+ i += textual_form_length - 1;
+ }
+ }
+ else
+ { /* Skip a character which has been over-written with the null
+ value 1 earlier on */
+
+ if (text_in[i]!=1)
+ { if (text_in[i]==' ') write_z_char_z(0);
+ else
+ { j = (int) text_in[i];
+ lookup_value = iso_to_alphabet_grid[j];
+ if (lookup_value < 0)
+ { /* The character isn't in the standard alphabets, so
+ we have to use the ZSCII 4-Z-char sequence */
+
+ if (lookup_value == -5)
+ { /* Character isn't in the ZSCII set at all */
+
+ unicode = iso_to_unicode(j);
+ unicode_char_error(
+ "Character can only be used if declared in \
+advance as part of 'Zcharacter table':", unicode);
+ write_zscii(0x200 + unicode/0x100);
+ write_zscii(0x300 + unicode%0x100);
+ }
+ else write_zscii(-lookup_value);
+ }
+ else
+ { /* The character is in one of the standard alphabets:
+ write a SHIFT to temporarily change alphabet if
+ it isn't in alphabet 0, then write the Z-char */
+
+ alphabet_used[lookup_value] = 'Y';
+ in_alphabet = lookup_value/26;
+ if (in_alphabet==1) write_z_char_z(4); /* SHIFT to A1 */
+ if (in_alphabet==2) write_z_char_z(5); /* SHIFT to A2 */
+ write_z_char_z(lookup_value%26 + 6);
+ }
+ }
+ }
+ }
+ }
+
+ /* Flush the Z-characters output buffer and set the "end" bit */
+
+ end_z_chars();
+
+ }
+ else {
+
+ /* The text storage here is, of course, temporary. Compression
+ will occur when we're finished compiling, so that all the
+ clever Huffman stuff will work.
+ In the stored text, we use "@@" to indicate @,
+ "@0" to indicate a zero byte,
+ "@ANNNN" to indicate an abbreviation,
+ "@DNNNN" to indicate a dynamic string thing.
+ "@UNNNN" to indicate a four-byte Unicode value (0x100 or higher).
+ (NNNN is a four-digit hex number using the letters A-P... an
+ ugly representation but a convenient one.)
+ */
+
+ for (i=0; text_in[i]!=0; i++) {
+
+ /* Contract ". " into ". " if double-space-removing switch set:
+ likewise "? " and "! " if the setting is high enough. */
+ if ((double_space_setting >= 1)
+ && (text_in[i+1]==' ') && (text_in[i+2]==' ')) {
+ if (text_in[i]=='.'
+ || (double_space_setting >= 2
+ && (text_in[i]=='?' || text_in[i]=='!'))) {
+ text_in[i+1] = text_in[i];
+ i++;
+ }
+ }
+
+ total_chars_trans++;
+
+ /* Try abbreviations if the economy switch set. We have to be in
+ compression mode too, since the abbreviation mechanism is part
+ of string decompression. */
+
+ 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;
+ i += (strlen(cx)-1);
+ write_z_char_g('@');
+ write_z_char_g('A');
+ write_z_char_g('A' + ((j >>12) & 0x0F));
+ write_z_char_g('A' + ((j >> 8) & 0x0F));
+ write_z_char_g('A' + ((j >> 4) & 0x0F));
+ write_z_char_g('A' + ((j ) & 0x0F));
+ }
+ else if (text_in[i] == '@') {
+ if (text_in[i+1]=='@') {
+ /* An ASCII code */
+ i+=2; j=atoi((char *) (text_in+i));
+ if (j == '@' || j == '\0') {
+ write_z_char_g('@');
+ if (j == 0) {
+ j = '0';
+ if (!compression_switch)
+ warning("Ascii @@0 will prematurely terminate non-compressed \
+string.");
+ }
+ }
+ write_z_char_g(j);
+ while (isdigit(text_in[i])) i++; i--;
+ }
+ else if (isdigit(text_in[i+1])) {
+ int d1, d2;
+ d1 = character_digit_value[text_in[i+1]];
+ d2 = character_digit_value[text_in[i+2]];
+ if ((d1 == 127) || (d1 >= 10) || (d2 == 127) || (d2 >= 10)) {
+ error("'@..' must have two decimal digits");
+ }
+ else {
+ if (!compression_switch)
+ warning("'@..' print variable will not work in non-compressed \
+string; substituting ' '.");
+ i += 2;
+ j = d1*10 + d2;
+ if (j >= MAX_DYNAMIC_STRINGS) {
+ memoryerror("MAX_DYNAMIC_STRINGS", MAX_DYNAMIC_STRINGS);
+ j = 0;
+ }
+ if (j+1 >= no_dynamic_strings)
+ no_dynamic_strings = j+1;
+ write_z_char_g('@');
+ write_z_char_g('D');
+ write_z_char_g('A' + ((j >>12) & 0x0F));
+ write_z_char_g('A' + ((j >> 8) & 0x0F));
+ write_z_char_g('A' + ((j >> 4) & 0x0F));
+ write_z_char_g('A' + ((j ) & 0x0F));
+ }
+ }
+ else {
+ unicode = text_to_unicode((char *) (text_in+i));
+ i += textual_form_length - 1;
+ if (unicode == '@' || unicode == '\0') {
+ write_z_char_g('@');
+ write_z_char_g(unicode ? '@' : '0');
+ }
+ else if (unicode >= 0 && unicode < 256) {
+ write_z_char_g(unicode);
+ }
+ else {
+ if (!compression_switch) {
+ warning("Unicode characters will not work in non-compressed \
+string; substituting '?'.");
+ write_z_char_g('?');
+ }
+ else {
+ j = unicode_entity_index(unicode);
+ write_z_char_g('@');
+ write_z_char_g('U');
+ write_z_char_g('A' + ((j >>12) & 0x0F));
+ write_z_char_g('A' + ((j >> 8) & 0x0F));
+ write_z_char_g('A' + ((j >> 4) & 0x0F));
+ write_z_char_g('A' + ((j ) & 0x0F));
+ }
+ }
+ }
+ }
+ else if (text_in[i] == '^')
+ write_z_char_g(0x0A);
+ else if (text_in[i] == '~')
+ write_z_char_g('"');
+ else if (character_set_unicode) {
+ if (text_in[i] & 0x80) {
+ unicode = text_to_unicode((char *) (text_in+i));
+ i += textual_form_length - 1;
+ if (unicode >= 0 && unicode < 256) {
+ write_z_char_g(unicode);
+ }
+ else {
+ if (!compression_switch) {
+ warning("Unicode characters will not work in non-compressed \
+string; substituting '?'.");
+ write_z_char_g('?');
+ }
+ else {
+ j = unicode_entity_index(unicode);
+ write_z_char_g('@');
+ write_z_char_g('U');
+ write_z_char_g('A' + ((j >>12) & 0x0F));
+ write_z_char_g('A' + ((j >> 8) & 0x0F));
+ write_z_char_g('A' + ((j >> 4) & 0x0F));
+ write_z_char_g('A' + ((j ) & 0x0F));
+ }
+ }
+ }
+ else {
+ write_z_char_g(text_in[i]);
+ }
+ }
+ else {
+ unicode = iso_to_unicode_grid[text_in[i]];
+ if (unicode >= 0 && unicode < 256) {
+ write_z_char_g(unicode);
+ }
+ else {
+ if (!compression_switch) {
+ warning("Unicode characters will not work in non-compressed \
+string; substituting '?'.");
+ write_z_char_g('?');
+ }
+ else {
+ j = unicode_entity_index(unicode);
+ write_z_char_g('@');
+ write_z_char_g('U');
+ write_z_char_g('A' + ((j >>12) & 0x0F));
+ write_z_char_g('A' + ((j >> 8) & 0x0F));
+ write_z_char_g('A' + ((j >> 4) & 0x0F));
+ write_z_char_g('A' + ((j ) & 0x0F));
+ }
+ }
+ }
+ }
+ write_z_char_g(0);
+
+ }
+
+ if (text_out_overflow)
+ return NULL;
+ else
+ return((uchar *) text_out_pc);
+}
+
+static int unicode_entity_index(int32 unicode)
+{
+ unicode_usage_t *uptr;
+ int j;
+ int buck = unicode % UNICODE_HASH_BUCKETS;
+
+ for (uptr = unicode_usage_hash[buck]; uptr; uptr=uptr->next) {
+ if (uptr->ch == unicode)
+ break;
+ }
+ if (uptr) {
+ j = (uptr - unicode_usage_entries);
+ }
+ else {
+ if (no_unicode_chars >= MAX_UNICODE_CHARS) {
+ memoryerror("MAX_UNICODE_CHARS", MAX_UNICODE_CHARS);
+ j = 0;
+ }
+ else {
+ j = no_unicode_chars;
+ no_unicode_chars++;
+ uptr = unicode_usage_entries + j;
+ uptr->ch = unicode;
+ uptr->next = unicode_usage_hash[buck];
+ unicode_usage_hash[buck] = uptr;
+ }
+ }
+
+ return j;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Glulx compression code */
+/* ------------------------------------------------------------------------- */
+
+
+static void compress_makebits(int entnum, int depth, int prevbit,
+ huffbitlist_t *bits);
+
+/* The compressor. This uses the usual Huffman compression algorithm. */
+void compress_game_text()
+{
+ int entities=0, branchstart, branches;
+ int numlive;
+ int32 lx;
+ int jx;
+ int ch;
+ int32 ix;
+ huffbitlist_t bits;
+
+ if (compression_switch) {
+
+ /* How many entities have we currently got? Well, 256 plus the
+ string-terminator plus Unicode chars plus abbrevations plus
+ dynamic strings. */
+ entities = 256+1;
+ huff_unicode_start = entities;
+ entities += no_unicode_chars;
+ huff_abbrev_start = entities;
+ if (economy_switch)
+ entities += no_abbreviations;
+ huff_dynam_start = entities;
+ entities += no_dynamic_strings;
+
+ if (entities > MAX_CHARACTER_SET)
+ memoryerror("MAX_CHARACTER_SET",MAX_CHARACTER_SET);
+
+ /* Characters */
+ for (jx=0; jx<256; jx++) {
+ huff_entities[jx].type = 2;
+ huff_entities[jx].count = 0;
+ huff_entities[jx].u.ch = jx;
+ }
+ /* Terminator */
+ huff_entities[256].type = 1;
+ huff_entities[256].count = 0;
+ for (jx=0; jx<no_unicode_chars; jx++) {
+ huff_entities[huff_unicode_start+jx].type = 4;
+ huff_entities[huff_unicode_start+jx].count = 0;
+ huff_entities[huff_unicode_start+jx].u.val = jx;
+ }
+ if (economy_switch) {
+ for (jx=0; jx<no_abbreviations; jx++) {
+ huff_entities[huff_abbrev_start+jx].type = 3;
+ huff_entities[huff_abbrev_start+jx].count = 0;
+ huff_entities[huff_abbrev_start+jx].u.val = jx;
+ }
+ }
+ for (jx=0; jx<no_dynamic_strings; jx++) {
+ huff_entities[huff_dynam_start+jx].type = 9;
+ huff_entities[huff_dynam_start+jx].count = 0;
+ huff_entities[huff_dynam_start+jx].u.val = jx;
+ }
+ }
+ else {
+ /* No compression; use defaults that will make it easy to check
+ for errors. */
+ no_huff_entities = 257;
+ huff_unicode_start = 257;
+ huff_abbrev_start = 257;
+ huff_dynam_start = 257+MAX_ABBREVS;
+ compression_table_size = 0;
+ }
+
+ if (temporary_files_switch) {
+ fclose(Temp1_fp);
+ Temp1_fp=fopen(Temp1_Name,"rb");
+ if (Temp1_fp==NULL)
+ fatalerror("I/O failure: couldn't reopen temporary file 1");
+ }
+
+ if (compression_switch) {
+
+ for (lx=0, ix=0; lx<no_strings; lx++) {
+ int escapelen=0, escapetype=0;
+ int done=FALSE;
+ int32 escapeval=0;
+ while (!done) {
+ if (temporary_files_switch)
+ ch = fgetc(Temp1_fp);
+ else
+ ch = read_byte_from_memory_block(&static_strings_area, ix);
+ ix++;
+ if (ix > static_strings_extent || ch < 0)
+ compiler_error("Read too much not-yet-compressed text.");
+ if (escapelen == -1) {
+ escapelen = 0;
+ if (ch == '@') {
+ ch = '@';
+ }
+ else if (ch == '0') {
+ ch = '\0';
+ }
+ else if (ch == 'A' || ch == 'D' || ch == 'U') {
+ escapelen = 4;
+ escapetype = ch;
+ escapeval = 0;
+ continue;
+ }
+ else {
+ compiler_error("Strange @ escape in processed text.");
+ }
+ }
+ else if (escapelen) {
+ escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
+ escapelen--;
+ if (escapelen == 0) {
+ if (escapetype == 'A') {
+ ch = huff_abbrev_start+escapeval;
+ }
+ else if (escapetype == 'D') {
+ ch = huff_dynam_start+escapeval;
+ }
+ else if (escapetype == 'U') {
+ ch = huff_unicode_start+escapeval;
+ }
+ else {
+ compiler_error("Strange @ escape in processed text.");
+ }
+ }
+ else
+ continue;
+ }
+ else {
+ if (ch == '@') {
+ escapelen = -1;
+ continue;
+ }
+ if (ch == 0) {
+ ch = 256;
+ done = TRUE;
+ }
+ }
+ huff_entities[ch].count++;
+ }
+ }
+
+ numlive = 0;
+ for (jx=0; jx<entities; jx++) {
+ if (huff_entities[jx].count) {
+ hufflist[numlive] = &(huff_entities[jx]);
+ numlive++;
+ }
+ }
+
+ branchstart = entities;
+ branches = 0;
+
+ while (numlive > 1) {
+ int best1, best2;
+ int best1num, best2num;
+ huffentity_t *bran;
+
+ if (hufflist[0]->count < hufflist[1]->count) {
+ best1 = 0;
+ best2 = 1;
+ }
+ else {
+ best2 = 0;
+ best1 = 1;
+ }
+
+ best1num = hufflist[best1]->count;
+ best2num = hufflist[best2]->count;
+
+ for (jx=2; jx<numlive; jx++) {
+ if (hufflist[jx]->count < best1num) {
+ best2 = best1;
+ best2num = best1num;
+ best1 = jx;
+ best1num = hufflist[best1]->count;
+ }
+ else if (hufflist[jx]->count < best2num) {
+ best2 = jx;
+ best2num = hufflist[best2]->count;
+ }
+ }
+
+ bran = &(huff_entities[branchstart+branches]);
+ branches++;
+ bran->type = 0;
+ bran->count = hufflist[best1]->count + hufflist[best2]->count;
+ bran->u.branch[0] = (hufflist[best1] - huff_entities);
+ bran->u.branch[1] = (hufflist[best2] - huff_entities);
+ hufflist[best1] = bran;
+ if (best2 < numlive-1) {
+ memmove(&(hufflist[best2]), &(hufflist[best2+1]),
+ ((numlive-1) - best2) * sizeof(huffentity_t *));
+ }
+ numlive--;
+ }
+
+ huff_entity_root = (hufflist[0] - huff_entities);
+
+ for (ix=0; ix<MAXHUFFBYTES; ix++)
+ bits.b[ix] = 0;
+ compression_table_size = 12;
+
+ no_huff_entities = 0; /* compress_makebits will total this up */
+ compress_makebits(huff_entity_root, 0, -1, &bits);
+ }
+
+ /* Now, sadly, we have to compute the size of the string section,
+ without actually doing the compression. */
+ compression_string_size = 0;
+
+ if (temporary_files_switch) {
+ fseek(Temp1_fp, 0, SEEK_SET);
+ }
+
+ if (no_strings >= MAX_NUM_STATIC_STRINGS)
+ memoryerror("MAX_NUM_STATIC_STRINGS", MAX_NUM_STATIC_STRINGS);
+
+ for (lx=0, ix=0; lx<no_strings; lx++) {
+ int escapelen=0, escapetype=0;
+ int done=FALSE;
+ int32 escapeval=0;
+ jx = 0;
+ compressed_offsets[lx] = compression_table_size + compression_string_size;
+ compression_string_size++; /* for the type byte */
+ while (!done) {
+ if (temporary_files_switch)
+ ch = fgetc(Temp1_fp);
+ else
+ ch = read_byte_from_memory_block(&static_strings_area, ix);
+ ix++;
+ if (ix > static_strings_extent || ch < 0)
+ compiler_error("Read too much not-yet-compressed text.");
+ if (escapelen == -1) {
+ escapelen = 0;
+ if (ch == '@') {
+ ch = '@';
+ }
+ else if (ch == '0') {
+ ch = '\0';
+ }
+ else if (ch == 'A' || ch == 'D' || ch == 'U') {
+ escapelen = 4;
+ escapetype = ch;
+ escapeval = 0;
+ continue;
+ }
+ else {
+ compiler_error("Strange @ escape in processed text.");
+ }
+ }
+ else if (escapelen) {
+ escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
+ escapelen--;
+ if (escapelen == 0) {
+ if (escapetype == 'A') {
+ ch = huff_abbrev_start+escapeval;
+ }
+ else if (escapetype == 'D') {
+ ch = huff_dynam_start+escapeval;
+ }
+ else if (escapetype == 'U') {
+ ch = huff_unicode_start+escapeval;
+ }
+ else {
+ compiler_error("Strange @ escape in processed text.");
+ }
+ }
+ else
+ continue;
+ }
+ else {
+ if (ch == '@') {
+ escapelen = -1;
+ continue;
+ }
+ if (ch == 0) {
+ ch = 256;
+ done = TRUE;
+ }
+ }
+
+ if (compression_switch) {
+ jx += huff_entities[ch].depth;
+ compression_string_size += (jx/8);
+ jx = (jx % 8);
+ }
+ else {
+ if (ch >= huff_dynam_start) {
+ compression_string_size += 3;
+ }
+ else if (ch >= huff_unicode_start) {
+ compiler_error("Abbreviation/Unicode in non-compressed string \
+should be impossible.");
+ }
+ else
+ compression_string_size += 1;
+ }
+ }
+ if (compression_switch && jx)
+ compression_string_size++;
+ }
+
+ done_compression = TRUE;
+}
+
+static void compress_makebits(int entnum, int depth, int prevbit,
+ huffbitlist_t *bits)
+{
+ huffentity_t *ent = &(huff_entities[entnum]);
+ char *cx;
+
+ no_huff_entities++;
+ ent->addr = compression_table_size;
+ ent->depth = depth;
+ ent->bits = *bits;
+ if (depth > 0) {
+ if (prevbit)
+ ent->bits.b[(depth-1) / 8] |= (1 << ((depth-1) % 8));
+ }
+
+ switch (ent->type) {
+ case 0:
+ compression_table_size += 9;
+ compress_makebits(ent->u.branch[0], depth+1, 0, &ent->bits);
+ compress_makebits(ent->u.branch[1], depth+1, 1, &ent->bits);
+ break;
+ case 1:
+ compression_table_size += 1;
+ break;
+ case 2:
+ compression_table_size += 2;
+ break;
+ case 3:
+ cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
+ compression_table_size += (1 + 1 + strlen(cx));
+ break;
+ case 4:
+ case 9:
+ compression_table_size += 5;
+ break;
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* The abbreviations optimiser */
+/* */
+/* This is a very complex, memory and time expensive algorithm to */
+/* approximately solve the problem of which abbreviation strings would */
+/* minimise the total number of Z-chars to which the game text translates. */
+/* It is in some ways a quite separate program but remains inside Inform */
+/* for compatibility with previous releases. */
+/* ------------------------------------------------------------------------- */
+
+typedef struct tlb_s
+{ char text[4];
+ int32 intab, occurrences;
+} tlb;
+static tlb *tlbtab;
+static int32 no_occs;
+
+static int32 *grandtable;
+static int32 *grandflags;
+typedef struct optab_s
+{ int32 length;
+ int32 popularity;
+ int32 score;
+ int32 location;
+ char text[MAX_ABBREV_LENGTH];
+} optab;
+static optab *bestyet, *bestyet2;
+
+static int pass_no;
+
+static char *sub_buffer;
+
+static void optimise_pass(void)
+{ int32 i; int t1, t2;
+ int32 j, j2, k, nl, matches, noflags, score, min, minat=0, x, scrabble, c;
+ for (i=0; i<256; i++) bestyet[i].length=0;
+ for (i=0; i<no_occs; i++)
+ { if ((*(tlbtab[i].text)!=(int) '\n')&&(tlbtab[i].occurrences!=0))
+ {
+#ifdef MAC_FACE
+ if (i%((**g_pm_hndl).linespercheck) == 0)
+ { ProcessEvents (&g_proc);
+ if (g_proc != true)
+ { free_arrays();
+ if (store_the_text)
+ my_free(&all_text,"transcription text");
+ longjmp (g_fallback, 1);
+ }
+ }
+#endif
+ printf("Pass %d, %4ld/%ld '%s' (%ld occurrences) ",
+ pass_no, (long int) i, (long int) no_occs, tlbtab[i].text,
+ (long int) tlbtab[i].occurrences);
+ t1=(int) (time(0));
+ 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<=62))
+ { nl++;
+ for (j2=0; j2<nl; j2++)
+ if (all_text[grandtable[tlbtab[i].intab+j]+j2]=='\n')
+ goto FinishEarly;
+ matches=0;
+ for (j2=j; j2<tlbtab[i].occurrences; j2++)
+ { if (grandflags[j2]==1)
+ { x=grandtable[tlbtab[i].intab+j2]
+ - grandtable[tlbtab[i].intab+j];
+ if (((x>-nl)&&(x<nl))
+ || (memcmp(all_text+grandtable[tlbtab[i].intab+j],
+ all_text+grandtable[tlbtab[i].intab+j2],
+ nl)!=0))
+ { grandflags[j2]=0; noflags--; }
+ else matches++;
+ }
+ }
+ scrabble=0;
+ for (k=0; k<nl; k++)
+ { scrabble++;
+ c=all_text[grandtable[tlbtab[i].intab+j+k]];
+ if (c!=(int) ' ')
+ { if (iso_to_alphabet_grid[c]<0)
+ scrabble+=2;
+ else
+ if (iso_to_alphabet_grid[c]>=26)
+ scrabble++;
+ }
+ }
+ score=(matches-1)*(scrabble-2);
+ min=score;
+ for (j2=0; j2<256; j2++)
+ { if ((nl==bestyet[j2].length)
+ && (memcmp(all_text+bestyet[j2].location,
+ all_text+grandtable[tlbtab[i].intab+j],
+ nl)==0))
+ { j2=256; min=score; }
+ else
+ { if (bestyet[j2].score<min)
+ { min=bestyet[j2].score; minat=j2;
+ }
+ }
+ }
+ if (min!=score)
+ { bestyet[minat].score=score;
+ bestyet[minat].length=nl;
+ bestyet[minat].location=grandtable[tlbtab[i].intab+j];
+ bestyet[minat].popularity=matches;
+ for (j2=0; j2<nl; j2++) sub_buffer[j2]=
+ all_text[bestyet[minat].location+j2];
+ sub_buffer[nl]=0;
+ }
+ }
+ FinishEarly: ;
+ }
+ t2=((int) time(0)) - t1;
+ printf(" (%d seconds)\n",t2);
+ }
+ }
+}
+
+static int any_overlap(char *s1, char *s2)
+{ int a, b, i, j, flag;
+ a=strlen(s1); b=strlen(s2);
+ for (i=1-b; i<a; i++)
+ { flag=0;
+ for (j=0; j<b; j++)
+ if ((0<=i+j)&&(i+j<=a-1))
+ if (s1[i+j]!=s2[j]) flag=1;
+ if (flag==0) return(1);
+ }
+ return(0);
+}
+
+#define MAX_TLBS 8000
+
+extern void optimise_abbreviations(void)
+{ int32 i, j, t, max=0, MAX_GTABLE;
+ int32 j2, selected, available, maxat=0, nl;
+ tlb test;
+
+ printf("Beginning calculation of optimal abbreviations...\n");
+
+ pass_no = 0;
+ tlbtab=my_calloc(sizeof(tlb), MAX_TLBS, "tlb table"); no_occs=0;
+ sub_buffer=my_calloc(sizeof(char), 4000, "sub_buffer");
+ for (i=0; i<MAX_TLBS; i++) tlbtab[i].occurrences=0;
+
+ bestyet=my_calloc(sizeof(optab), 256, "bestyet");
+ bestyet2=my_calloc(sizeof(optab), 64, "bestyet2");
+
+ bestyet2[0].text[0]='.';
+ bestyet2[0].text[1]=' ';
+ bestyet2[0].text[2]=0;
+
+ bestyet2[1].text[0]=',';
+ bestyet2[1].text[1]=' ';
+ bestyet2[1].text[2]=0;
+
+ for (i=0; all_text+i<all_text_top; i++)
+ {
+ if ((all_text[i]=='.') && (all_text[i+1]==' ') && (all_text[i+2]==' '))
+ { all_text[i]='\n'; all_text[i+1]='\n'; all_text[i+2]='\n';
+ bestyet2[0].popularity++;
+ }
+
+ if ((all_text[i]=='.') && (all_text[i+1]==' '))
+ { all_text[i]='\n'; all_text[i+1]='\n';
+ bestyet2[0].popularity++;
+ }
+
+ if ((all_text[i]==',') && (all_text[i+1]==' '))
+ { all_text[i]='\n'; all_text[i+1]='\n';
+ bestyet2[1].popularity++;
+ }
+ }
+
+ MAX_GTABLE=subtract_pointers(all_text_top,all_text)+1;
+ grandtable=my_calloc(4*sizeof(int32), MAX_GTABLE/4, "grandtable");
+
+ for (i=0, t=0; all_text+i<all_text_top; i++)
+ { test.text[0]=all_text[i];
+ test.text[1]=all_text[i+1];
+ test.text[2]=all_text[i+2];
+ test.text[3]=0;
+ if ((test.text[0]=='\n')||(test.text[1]=='\n')||(test.text[2]=='\n'))
+ goto DontKeep;
+ for (j=0; j<no_occs; j++)
+ if (strcmp(test.text,tlbtab[j].text)==0)
+ goto DontKeep;
+ test.occurrences=0;
+ for (j=i+3; all_text+j<all_text_top; j++)
+ {
+#ifdef MAC_FACE
+ if (j%((**g_pm_hndl).linespercheck) == 0)
+ { ProcessEvents (&g_proc);
+ if (g_proc != true)
+ { free_arrays();
+ if (store_the_text)
+ my_free(&all_text,"transcription text");
+ longjmp (g_fallback, 1);
+ }
+ }
+#endif
+ if ((all_text[i]==all_text[j])
+ && (all_text[i+1]==all_text[j+1])
+ && (all_text[i+2]==all_text[j+2]))
+ { grandtable[t+test.occurrences]=j;
+ test.occurrences++;
+ if (t+test.occurrences==MAX_GTABLE)
+ { printf("All %ld cross-references used\n",
+ (long int) MAX_GTABLE);
+ goto Built;
+ }
+ }
+ }
+ if (test.occurrences>=2)
+ { tlbtab[no_occs]=test;
+ tlbtab[no_occs].intab=t; t+=tlbtab[no_occs].occurrences;
+ if (max<tlbtab[no_occs].occurrences)
+ max=tlbtab[no_occs].occurrences;
+ no_occs++;
+ if (no_occs==MAX_TLBS)
+ { printf("All %d three-letter-blocks used\n",
+ MAX_TLBS);
+ goto Built;
+ }
+ }
+ DontKeep: ;
+ }
+
+ Built:
+ grandflags=my_calloc(sizeof(int), max, "grandflags");
+
+
+ printf("Cross-reference table (%ld entries) built...\n",
+ (long int) no_occs);
+ /* for (i=0; i<no_occs; i++)
+ printf("%4d %4d '%s' %d\n",i,tlbtab[i].intab,tlbtab[i].text,
+ tlbtab[i].occurrences);
+ */
+
+ for (i=0; i<64; i++) bestyet2[i].length=0; selected=2;
+ available=256;
+ while ((available>0)&&(selected<64))
+ { printf("Pass %d\n", ++pass_no);
+
+ optimise_pass();
+ available=0;
+ for (i=0; i<256; i++)
+ if (bestyet[i].score!=0)
+ { available++;
+ nl=bestyet[i].length;
+ for (j2=0; j2<nl; j2++) bestyet[i].text[j2]=
+ all_text[bestyet[i].location+j2];
+ bestyet[i].text[nl]=0;
+ }
+
+ /* printf("End of pass results:\n");
+ printf("\nno score freq string\n");
+ for (i=0; i<256; i++)
+ if (bestyet[i].score>0)
+ printf("%02d: %4d %4d '%s'\n", i, bestyet[i].score,
+ bestyet[i].popularity, bestyet[i].text);
+ */
+
+ do
+ { max=0;
+ for (i=0; i<256; i++)
+ if (max<bestyet[i].score)
+ { max=bestyet[i].score;
+ maxat=i;
+ }
+
+ if (max>0)
+ { bestyet2[selected++]=bestyet[maxat];
+
+ printf(
+ "Selection %2ld: '%s' (repeated %ld times, scoring %ld)\n",
+ (long int) selected,bestyet[maxat].text,
+ (long int) bestyet[maxat].popularity,
+ (long int) bestyet[maxat].score);
+
+ test.text[0]=bestyet[maxat].text[0];
+ test.text[1]=bestyet[maxat].text[1];
+ test.text[2]=bestyet[maxat].text[2];
+ test.text[3]=0;
+
+ for (i=0; i<no_occs; i++)
+ if (strcmp(test.text,tlbtab[i].text)==0)
+ break;
+
+ for (j=0; j<tlbtab[i].occurrences; j++)
+ { if (memcmp(bestyet[maxat].text,
+ all_text+grandtable[tlbtab[i].intab+j],
+ bestyet[maxat].length)==0)
+ { for (j2=0; j2<bestyet[maxat].length; j2++)
+ all_text[grandtable[tlbtab[i].intab+j]+j2]='\n';
+ }
+ }
+
+ for (i=0; i<256; i++)
+ if ((bestyet[i].score>0)&&
+ (any_overlap(bestyet[maxat].text,bestyet[i].text)==1))
+ { bestyet[i].score=0;
+ /* printf("Discarding '%s' as overlapping\n",
+ bestyet[i].text); */
+ }
+ }
+ } while ((max>0)&&(available>0)&&(selected<64));
+ }
+
+ printf("\nChosen abbreviations (in Inform syntax):\n\n");
+ for (i=0; i<selected; i++)
+ printf("Abbreviate \"%s\";\n", bestyet2[i].text);
+
+ text_free_arrays();
+}
+
+/* ------------------------------------------------------------------------- */
+/* The dictionary manager begins here. */
+/* */
+/* Speed is extremely important in these algorithms. If a linear-time */
+/* routine were used to search the dictionary words so far built up, then */
+/* Inform would crawl. */
+/* */
+/* Instead, the dictionary is stored as a binary tree, which is kept */
+/* balanced with the red-black algorithm. */
+/* ------------------------------------------------------------------------- */
+/* A dictionary table similar to the Z-machine format is kept: there is a */
+/* 7-byte header (left blank here to be filled in at the */
+/* construct_storyfile() stage in "tables.c") and then a sequence of */
+/* records, one per word, in the form */
+/* */
+/* <Z-coded text> <flags> <verbnumber> <adjectivenumber> */
+/* 4 or 6 bytes byte byte byte */
+/* */
+/* For Glulx, the form is instead: (But see below about Unicode-valued */
+/* dictionaries and my heinie.) */
+/* */
+/* <plain text> <flags> <verbnumber> <adjectivenumber> */
+/* DICT_WORD_SIZE short short short */
+/* */
+/* These records are stored in "accession order" (i.e. in order of their */
+/* first being received by these routines) and only alphabetically sorted */
+/* by construct_storyfile() (using the array below). */
+/* ------------------------------------------------------------------------- */
+/* */
+/* Further notes about the data fields... */
+/* The flags are currently: */
+/* bit 0: word is used as a verb (in verb grammar) */
+/* bit 1: word is used as a meta verb */
+/* bit 2: word is plural (set by '//p') */
+/* bit 3: word is used as a preposition (in verb grammar) */
+/* bit 6: set for all verbs, but not used by the parser? */
+/* bit 7: word is used as a noun (set for every word that appears in */
+/* code or in an object property) */
+/* */
+/* In grammar version 2, the third field (adjectivenumber) is unused (and */
+/* zero). */
+/* */
+/* The compiler generates special constants #dict_par1, #dict_par2, */
+/* #dict_par3 to refer to the byte offsets of the three fields. In */
+/* Z-code v3, these are 4/5/6; in v4+, they are 6/7/8. In Glulx, they */
+/* are $DICT_WORD_SIZE+2/4/6, referring to the *low* bytes of the three */
+/* fields. (The high bytes are $DICT_WORD_SIZE+1/3/5.) */
+/* ------------------------------------------------------------------------- */
+
+uchar *dictionary, /* (These two pointers are externally
+ used only in "tables.c" when
+ building the story-file) */
+ *dictionary_top; /* Pointer to next free record */
+
+int dict_entries; /* Total number of records entered */
+
+/* ------------------------------------------------------------------------- */
+/* dict_word is a typedef for a struct of 6 unsigned chars (defined in */
+/* "header.h"): it holds the (4 or) 6 bytes of Z-coded text of a word. */
+/* Usefully, because the PAD character 5 is < all alphabetic characters, */
+/* alphabetic order corresponds to numeric order. For this reason, the */
+/* dict_word is called the "sort code" of the original text word. */
+/* */
+/* ###- In modifying the compiler, I've 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.) */
+/* */
+/* ###- 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).*/
+/* Then we store the 32-bit character value big-endian. This lets us */
+/* continue to compare arrays bytewise, which is a nice simplification. */
+/* ------------------------------------------------------------------------- */
+
+extern int compare_sorts(uchar *d1, uchar *d2)
+{ int i;
+ for (i=0; i<DICT_WORD_BYTES; i++)
+ if (d1[i]!=d2[i]) return((int)(d1[i]) - (int)(d2[i]));
+ /* (since memcmp(d1, d2, DICT_WORD_BYTES); runs into a bug on some Unix
+ libraries) */
+ return(0);
+}
+
+extern void copy_sorts(uchar *d1, uchar *d2)
+{ int i;
+ for (i=0; i<DICT_WORD_BYTES; i++)
+ d1[i] = d2[i];
+}
+
+static uchar prepared_sort[MAX_DICT_WORD_BYTES]; /* Holds the sort code
+ of current word */
+
+static int number_and_case;
+
+/* Also used by verbs.c */
+static void dictionary_prepare_z(char *dword, uchar *optresult)
+{ int i, j, k, k2, wd[13]; int32 tot;
+
+ /* A rapid text translation algorithm using only the simplified rules
+ applying to the text of dictionary entries: first produce a sequence
+ of 6 (v3) or 9 (v4+) Z-characters */
+
+ number_and_case = 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;
+ default:
+ error_named("Expected 'p' after '//' \
+to give number of dictionary word", dword);
+ break;
+ }
+ }
+ break;
+ }
+ if (i>=9) break;
+
+ k=(int) dword[j];
+ if (k==(int) '\'')
+ warning_named("Obsolete usage: use the ^ character for the \
+apostrophe in", dword);
+ if (k==(int) '^') k=(int) '\'';
+ if (k=='\"') k='~';
+
+ if (k==(int) '@' || (character_set_unicode && (k & 0x80)))
+ { int unicode = text_to_unicode(dword+j);
+ if ((unicode < 128) && isupper(unicode)) unicode = tolower(unicode);
+ k = unicode_to_zscii(unicode);
+ j += textual_form_length - 1;
+ if ((k == 5) || (k >= 0x100))
+ { unicode_char_error(
+ "Character can be printed but not input:", unicode);
+ k = '?';
+ }
+ k2 = zscii_to_alphabet_grid[(uchar) k];
+ }
+ else
+ { if (isupper(k)) k = tolower(k);
+ k2 = iso_to_alphabet_grid[(uchar) k];
+ }
+
+ if (k2 < 0)
+ { if ((k2 == -5) || (k2 <= -0x100))
+ 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;
+ k2 = -k2;
+ wd[i++] = k2/32; wd[i] = k2%32;
+ }
+ }
+ else
+ { alphabet_used[k2] = 'Y';
+ if ((k2/26)!=0)
+ wd[i++]=3+(k2/26); /* Change alphabet for symbols */
+ wd[i]=6+(k2%26); /* Write the Z character */
+ }
+ }
+
+ /* Fill up to the end of the dictionary block with PAD characters */
+
+ for (; i<9; i++) wd[i]=5;
+
+ /* The array of Z-chars is converted to three 2-byte blocks */
+
+ tot = wd[2] + wd[1]*(1<<5) + wd[0]*(1<<10);
+ prepared_sort[1]=tot%0x100;
+ prepared_sort[0]=(tot/0x100)%0x100;
+ tot = wd[5] + wd[4]*(1<<5) + wd[3]*(1<<10);
+ prepared_sort[3]=tot%0x100;
+ prepared_sort[2]=(tot/0x100)%0x100;
+ tot = wd[8] + wd[7]*(1<<5) + wd[6]*(1<<10);
+ prepared_sort[5]=tot%0x100;
+ prepared_sort[4]=(tot/0x100)%0x100;
+
+ /* Set the "end bit" on the 2nd (in v3) or the 3rd (v4+) 2-byte block */
+
+ if (version_number==3) prepared_sort[2]+=0x80;
+ else prepared_sort[4]+=0x80;
+
+ if (optresult) copy_sorts(optresult, prepared_sort);
+}
+
+/* Also used by verbs.c */
+static void dictionary_prepare_g(char *dword, uchar *optresult)
+{
+ int i, j, k;
+ int32 unicode;
+
+ number_and_case = 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;
+ default:
+ error_named("Expected 'p' after '//' \
+to give gender or number of dictionary word", dword);
+ break;
+ }
+ }
+ break;
+ }
+ if (i>=DICT_WORD_SIZE) break;
+
+ k= ((unsigned char *)dword)[j];
+ if (k=='\'')
+ warning_named("Obsolete usage: use the ^ character for the \
+apostrophe in", dword);
+ if (k=='^')
+ k='\'';
+ if (k=='~') /* as in iso_to_alphabet_grid */
+ k='\"';
+
+ if (k=='@' || (character_set_unicode && (k & 0x80))) {
+ unicode = text_to_unicode(dword+j);
+ j += textual_form_length - 1;
+ }
+ else {
+ unicode = iso_to_unicode_grid[k];
+ }
+
+ if (DICT_CHAR_SIZE != 1 || (unicode >= 0 && unicode < 256)) {
+ k = unicode;
+ }
+ else {
+ error("The dictionary cannot contain Unicode characters beyond Latin-1. \
+Define DICT_CHAR_SIZE=4 for a Unicode-compatible dictionary.");
+ k = '?';
+ }
+
+ if (k >= (unsigned)'A' && k <= (unsigned)'Z')
+ k += ('a' - 'A');
+
+ if (DICT_CHAR_SIZE == 1) {
+ 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 (DICT_CHAR_SIZE == 1) {
+ for (; i<DICT_WORD_SIZE; i++)
+ prepared_sort[i] = 0;
+ }
+ else {
+ for (; i<DICT_WORD_SIZE; i++) {
+ prepared_sort[4*i] = 0;
+ prepared_sort[4*i+1] = 0;
+ prepared_sort[4*i+2] = 0;
+ prepared_sort[4*i+3] = 0;
+ }
+ }
+
+ if (optresult) copy_sorts(optresult, prepared_sort);
+}
+
+extern void dictionary_prepare(char *dword, uchar *optresult)
+{
+ if (!glulx_mode)
+ dictionary_prepare_z(dword, optresult);
+ else
+ dictionary_prepare_g(dword, optresult);
+}
+
+/* ------------------------------------------------------------------------- */
+/* The arrays below are all concerned with the problem of alphabetically */
+/* sorting the dictionary during the compilation pass. */
+/* Note that it is not enough simply to apply qsort to the dictionary at */
+/* the end of the pass: we need to ensure that no duplicates are ever */
+/* created. */
+/* */
+/* dict_sort_codes[n] the sort code of record n: i.e., of the nth */
+/* word to be entered into the dictionary, where */
+/* n counts upward from 0 */
+/* (n is also called the "accession number") */
+/* */
+/* The tree structure encodes an ordering. The special value VACANT means */
+/* "no node here": otherwise, node numbers are the same as accession */
+/* numbers. At all times, "root" holds the node number of the top of the */
+/* tree; each node has up to two branches, such that the subtree of the */
+/* left branch is always alphabetically before what's at the node, and */
+/* the subtree to the right is always after; and all branches are coloured */
+/* either "black" or "red". These colours are used to detect points where */
+/* the tree is growing asymmetrically (and therefore becoming inefficient */
+/* to search). */
+/* ------------------------------------------------------------------------- */
+
+#define RED 'r'
+#define BLACK 'b'
+#define VACANT -1
+
+static int root;
+typedef struct dict_tree_node_s
+{ int branch[2]; /* Branch 0 is "left", 1 is "right" */
+ char colour; /* The colour of the branch to the parent */
+} dict_tree_node;
+
+static dict_tree_node *dtree;
+
+int *final_dict_order;
+static uchar *dict_sort_codes;
+
+static void dictionary_begin_pass(void)
+{
+ /* Leave room for the 7-byte header (added in "tables.c" much later) */
+ /* Glulx has a 4-byte header instead. */
+
+ if (!glulx_mode)
+ dictionary_top=dictionary+7;
+ else
+ dictionary_top=dictionary+4;
+
+ root = VACANT;
+ dict_entries = 0;
+}
+
+static int fdo_count;
+static void recursively_sort(int node)
+{ if (dtree[node].branch[0] != VACANT)
+ recursively_sort(dtree[node].branch[0]);
+ final_dict_order[node] = fdo_count++;
+ if (dtree[node].branch[1] != VACANT)
+ recursively_sort(dtree[node].branch[1]);
+}
+
+extern void sort_dictionary(void)
+{ int i;
+ if (module_switch)
+ { for (i=0; i<dict_entries; i++)
+ final_dict_order[i] = i;
+ return;
+ }
+
+ if (root != VACANT)
+ { fdo_count = 0; recursively_sort(root);
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* If "dword" is in the dictionary, return its accession number plus 1; */
+/* If not, return 0. */
+/* ------------------------------------------------------------------------- */
+
+static int dictionary_find(char *dword)
+{ int at = root, n;
+
+ dictionary_prepare(dword, NULL);
+
+ while (at != VACANT)
+ { n = compare_sorts(prepared_sort, dict_sort_codes+at*DICT_WORD_BYTES);
+ if (n==0) return at + 1;
+ if (n>0) at = dtree[at].branch[1]; else at = dtree[at].branch[0];
+ }
+ return 0;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Add "dword" to the dictionary with (x,y,z) as its data fields; unless */
+/* it already exists, in which case OR the data with (x,y,z) */
+/* */
+/* 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)
+{ 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);
+
+ dictionary_prepare(dword, NULL);
+
+ if (root == VACANT)
+ { root = 0; goto CreateEntry;
+ }
+ while (TRUE)
+ {
+ n = compare_sorts(prepared_sort, dict_sort_codes+at*DICT_WORD_BYTES);
+ if (n==0)
+ {
+ if (!glulx_mode) {
+ p = dictionary+7 + at*(3+res) + res;
+ p[0]=(p[0])|x; p[1]=(p[1])|y; p[2]=(p[2])|z;
+ if (x & 128) p[0] = (p[0])|number_and_case;
+ }
+ 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;
+ }
+ return at;
+ }
+ if (n>0) r=1; else r=0;
+
+ a = dtree[at].branch[0]; b = dtree[at].branch[1];
+ if ((a != VACANT) && (dtree[a].colour == RED) &&
+ (b != VACANT) && (dtree[b].colour == RED))
+ { dtree[a].colour = BLACK;
+ dtree[b].colour = BLACK;
+
+ dtree[at].colour = RED;
+
+ /* A tree rotation may be needed to avoid two red links in a row:
+ e.g.
+ ggf (or else gf is root) ggf (or f is root)
+ | |
+ gf f
+ / \(red) / \ (both red)
+ f becomes gf at
+ / \(red) / \ / \
+ at
+ / \
+
+ In effect we rehang the "gf" subtree from "f".
+ See the Technical Manual for further details.
+ */
+
+ if ((f != VACANT) && (gf != VACANT) && (dtree[f].colour == RED))
+ {
+ if (fr == gfr)
+ { if (ggf == VACANT) root = f; else dtree[ggf].branch[ggfr] = f;
+ dtree[gf].branch[gfr] = dtree[f].branch[1-fr];
+ dtree[f].branch[1-fr] = gf;
+ dtree[f].colour = BLACK;
+ dtree[gf].colour = RED;
+ gf = ggf; gfr = ggfr;
+ }
+ else
+ { if (ggf == VACANT) root = at; else dtree[ggf].branch[ggfr] = at;
+ dtree[at].colour = BLACK;
+ dtree[gf].colour = RED;
+ dtree[f].branch[fr] = dtree[at].branch[gfr];
+ dtree[gf].branch[gfr] = dtree[at].branch[fr];
+ dtree[at].branch[gfr] = f;
+ dtree[at].branch[fr] = gf;
+
+ r = 1-r; n = at; if (r==fr) at = f; else at = gf;
+ f = n; gf = ggf; fr = 1-r; gfr = ggfr;
+ }
+ }
+ }
+
+ if (dtree[at].branch[r] == VACANT)
+ { dtree[at].colour = RED;
+
+ if ((f != VACANT) && (gf != VACANT) && (dtree[f].colour == RED))
+ { if (fr == gfr)
+ { if (ggf == VACANT) root = f; else dtree[ggf].branch[ggfr] = f;
+ dtree[gf].branch[gfr] = dtree[f].branch[1-fr];
+ dtree[f].branch[1-fr] = gf;
+ dtree[f].colour = BLACK;
+ dtree[gf].colour = RED;
+ }
+ else
+ { if (ggf == VACANT) root = at; else dtree[ggf].branch[ggfr] = at;
+ dtree[at].colour = BLACK;
+ dtree[gf].colour = RED;
+ dtree[f].branch[fr] = dtree[at].branch[gfr];
+ dtree[gf].branch[gfr] = dtree[at].branch[fr];
+ dtree[at].branch[gfr] = f;
+ dtree[at].branch[fr] = gf;
+
+ r = 1-r; n = at; if (r==fr) at = f; else at = gf;
+ f = n; gf = ggf;
+ }
+ }
+ dtree[at].branch[r] = dict_entries;
+ goto CreateEntry;
+ }
+ ggf = gf; gf = f; f = at; at = dtree[at].branch[r];
+ ggfr = gfr; gfr = fr; fr = r;
+ }
+
+ CreateEntry:
+
+ if (dict_entries==MAX_DICT_ENTRIES)
+ memoryerror("MAX_DICT_ENTRIES",MAX_DICT_ENTRIES);
+
+ dtree[dict_entries].branch[0] = VACANT;
+ dtree[dict_entries].branch[1] = VACANT;
+ dtree[dict_entries].colour = BLACK;
+
+ /* Address in Inform's own dictionary table to write the record to */
+
+ if (!glulx_mode) {
+
+ p = dictionary + (3+res)*dict_entries + 7;
+
+ /* So copy in the 4 (or 6) bytes of Z-coded text and the 3 data
+ bytes */
+
+ p[0]=prepared_sort[0]; p[1]=prepared_sort[1];
+ 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; p[res+2]=z;
+ if (x & 128) p[res] = (p[res])|number_and_case;
+
+ dictionary_top += res+3;
+
+ }
+ else {
+ int i;
+ p = dictionary + 4 + DICT_ENTRY_BYTE_LENGTH*dict_entries;
+ p[0] = 0x60; /* type byte -- dict word */
+
+ p += DICT_CHAR_SIZE;
+ for (i=0; i<DICT_WORD_BYTES; i++)
+ 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;
+
+ dictionary_top += DICT_ENTRY_BYTE_LENGTH;
+
+ }
+
+ copy_sorts(dict_sort_codes+dict_entries*DICT_WORD_BYTES, prepared_sort);
+
+ return dict_entries++;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Used in "tables.c" for "Extend ... only", to renumber a verb-word to a */
+/* new verb syntax of its own. (Otherwise existing verb-words never */
+/* change their verb-numbers.) */
+/* ------------------------------------------------------------------------- */
+
+extern void dictionary_set_verb_number(char *dword, int to)
+{ int i; uchar *p;
+ int res=((version_number==3)?4:6);
+ i=dictionary_find(dword);
+ if (i!=0)
+ {
+ if (!glulx_mode) {
+ p=dictionary+7+(i-1)*(3+res)+res;
+ p[1]=to;
+ }
+ else {
+ p=dictionary+4 + (i-1)*DICT_ENTRY_BYTE_LENGTH + DICT_ENTRY_FLAG_POS;
+ p[2]=to/256; p[3]=to%256;
+ }
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Tracing code for the dictionary: used not only by "trace" and text */
+/* transcription, but also (in the case of "word_to_ascii") in a vital */
+/* by the linker. */
+/* ------------------------------------------------------------------------- */
+
+static char *d_show_to;
+static int d_show_total;
+
+static void show_char(char c)
+{ if (d_show_to == NULL) printf("%c", c);
+ else
+ { int i = strlen(d_show_to);
+ d_show_to[i] = c; d_show_to[i+1] = 0;
+ }
+}
+
+extern void word_to_ascii(uchar *p, char *results)
+{ int i, shift, cc, zchar; uchar encoded_word[9];
+ encoded_word[0] = (((int) p[0])&0x7c)/4;
+ encoded_word[1] = 8*(((int) p[0])&0x3) + (((int) p[1])&0xe0)/32;
+ encoded_word[2] = ((int) p[1])&0x1f;
+ encoded_word[3] = (((int) p[2])&0x7c)/4;
+ encoded_word[4] = 8*(((int) p[2])&0x3) + (((int) p[3])&0xe0)/32;
+ encoded_word[5] = ((int) p[3])&0x1f;
+ if (version_number > 3)
+ { encoded_word[6] = (((int) p[4])&0x7c)/4;
+ encoded_word[7] = 8*(((int) p[4])&0x3) + (((int) p[5])&0xe0)/32;
+ encoded_word[8] = ((int) p[5])&0x1f;
+ }
+
+ shift = 0; cc = 0;
+ for (i=0; i< ((version_number==3)?6:9); i++)
+ { zchar = encoded_word[i];
+
+ if (zchar == 4) shift = 1;
+ else
+ if (zchar == 5) shift = 2;
+ else
+ { if ((shift == 2) && (zchar == 6))
+ { zchar = 32*encoded_word[i+1] + encoded_word[i+2];
+ i += 2;
+ if ((zchar>=32) && (zchar<=126))
+ results[cc++] = zchar;
+ else
+ { zscii_to_text(results+cc, zchar);
+ cc = strlen(results);
+ }
+ }
+ else
+ { zscii_to_text(results+cc, (alphabet[shift])[zchar-6]);
+ cc = strlen(results);
+ }
+ shift = 0;
+ }
+ }
+ results[cc] = 0;
+}
+
+static void recursively_show_z(int node)
+{ int i, cprinted, flags; uchar *p;
+ char textual_form[32];
+ int res = (version_number == 3)?4:6;
+
+ if (dtree[node].branch[0] != VACANT)
+ recursively_show_z(dtree[node].branch[0]);
+
+ p = (uchar *)dictionary + 7 + (3+res)*node;
+
+ word_to_ascii(p, textual_form);
+
+ for (cprinted = 0; textual_form[cprinted]!=0; cprinted++)
+ show_char(textual_form[cprinted]);
+ for (; cprinted < 4 + ((version_number==3)?6:9); cprinted++)
+ show_char(' ');
+
+ if (d_show_to == NULL)
+ { for (i=0; i<3+res; i++) printf("%02x ",p[i]);
+
+ flags = (int) p[res];
+ if (flags & 128)
+ { printf("noun ");
+ if (flags & 4) printf("p"); else printf(" ");
+ printf(" ");
+ }
+ else printf(" ");
+ if (flags & 8)
+ { if (grammar_version_number == 1)
+ printf("preposition:%d ", (int) p[res+2]);
+ else
+ printf("preposition ");
+ }
+ if ((flags & 3) == 3) printf("metaverb:%d ", (int) p[res+1]);
+ else if ((flags & 3) == 1) printf("verb:%d ", (int) p[res+1]);
+ printf("\n");
+ }
+
+ if (d_show_total++ == 5)
+ { d_show_total = 0;
+ if (d_show_to != NULL)
+ { write_to_transcript_file(d_show_to);
+ d_show_to[0] = 0;
+ }
+ }
+
+ if (dtree[node].branch[1] != VACANT)
+ recursively_show_z(dtree[node].branch[1]);
+}
+
+static void recursively_show_g(int node)
+{
+ warning("### Glulx dictionary-show not yet implemented.\n");
+}
+
+static void show_alphabet(int i)
+{ int j, c; char chartext[8];
+
+ for (j=0; j<26; j++)
+ { c = alphabet[i][j];
+
+ if (alphabet_used[26*i+j] == 'N') printf("("); else printf(" ");
+
+ zscii_to_text(chartext, c);
+ printf("%s", chartext);
+
+ if (alphabet_used[26*i+j] == 'N') printf(")"); else printf(" ");
+ }
+ printf("\n");
+}
+
+extern void show_dictionary(void)
+{ printf("Dictionary contains %d entries:\n",dict_entries);
+ if (dict_entries != 0)
+ { d_show_total = 0; d_show_to = NULL;
+ if (!glulx_mode)
+ recursively_show_z(root);
+ else
+ recursively_show_g(root);
+ }
+ printf("\nZ-machine alphabet entries:\n");
+ show_alphabet(0);
+ show_alphabet(1);
+ show_alphabet(2);
+}
+
+extern void write_dictionary_to_transcript(void)
+{ char d_buffer[81];
+
+ sprintf(d_buffer, "\n[Dictionary contains %d entries:]\n", dict_entries);
+
+ d_buffer[0] = 0; write_to_transcript_file(d_buffer);
+
+ if (dict_entries != 0)
+ { d_show_total = 0; d_show_to = d_buffer;
+ if (!glulx_mode)
+ recursively_show_z(root);
+ else
+ recursively_show_g(root);
+ }
+ if (d_show_total != 0) write_to_transcript_file(d_buffer);
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_text_vars(void)
+{ int j;
+ bestyet = NULL;
+ bestyet2 = NULL;
+ tlbtab = NULL;
+ grandtable = NULL;
+ grandflags = NULL;
+ no_chars_transcribed = 0;
+ is_abbreviation = FALSE;
+ put_strings_in_low_memory = FALSE;
+
+ for (j=0; j<256; j++) abbrevs_lookup[j] = -1;
+
+ total_zchars_trans = 0;
+
+ dtree = NULL;
+ final_dict_order = NULL;
+ dict_sort_codes = NULL;
+ dict_entries=0;
+
+ initialise_memory_block(&static_strings_area);
+}
+
+extern void text_begin_pass(void)
+{ abbrevs_lookup_table_made = FALSE;
+ no_abbreviations=0;
+ total_chars_trans=0; total_bytes_trans=0;
+ if (store_the_text) all_text_top=all_text;
+ dictionary_begin_pass();
+ low_strings_top = low_strings;
+
+ static_strings_extent = 0;
+ no_strings = 0;
+ no_dynamic_strings = 0;
+ no_unicode_chars = 0;
+}
+
+/* Note: for allocation and deallocation of all_the_text, see inform.c */
+
+extern void text_allocate_arrays(void)
+{ abbreviations_at = my_malloc(MAX_ABBREVS*MAX_ABBREV_LENGTH,
+ "abbreviations");
+ abbrev_values = my_calloc(sizeof(int), MAX_ABBREVS, "abbrev values");
+ abbrev_quality = my_calloc(sizeof(int), MAX_ABBREVS, "abbrev quality");
+ abbrev_freqs = my_calloc(sizeof(int), MAX_ABBREVS, "abbrev freqs");
+
+ dtree = my_calloc(sizeof(dict_tree_node), MAX_DICT_ENTRIES,
+ "red-black tree for dictionary");
+ final_dict_order = my_calloc(sizeof(int), MAX_DICT_ENTRIES,
+ "final dictionary ordering table");
+ dict_sort_codes = my_calloc(DICT_WORD_BYTES, MAX_DICT_ENTRIES,
+ "dictionary sort codes");
+
+ if (!glulx_mode)
+ dictionary = my_malloc(9*MAX_DICT_ENTRIES+7,
+ "dictionary");
+ else
+ dictionary = my_malloc(DICT_ENTRY_BYTE_LENGTH*MAX_DICT_ENTRIES+4,
+ "dictionary");
+
+ strings_holding_area
+ = my_malloc(MAX_STATIC_STRINGS,"static strings holding area");
+ low_strings = my_malloc(MAX_LOW_STRINGS,"low (abbreviation) strings");
+
+ huff_entities = NULL;
+ hufflist = NULL;
+ unicode_usage_entries = NULL;
+ done_compression = FALSE;
+ compression_table_size = 0;
+ compressed_offsets = NULL;
+
+ MAX_CHARACTER_SET = 0;
+
+ if (glulx_mode) {
+ if (compression_switch) {
+ int ix;
+ MAX_CHARACTER_SET = 257 + MAX_ABBREVS + MAX_DYNAMIC_STRINGS
+ + MAX_UNICODE_CHARS;
+ huff_entities = my_calloc(sizeof(huffentity_t), MAX_CHARACTER_SET*2+1,
+ "huffman entities");
+ hufflist = my_calloc(sizeof(huffentity_t *), MAX_CHARACTER_SET,
+ "huffman node list");
+ unicode_usage_entries = my_calloc(sizeof(unicode_usage_t),
+ MAX_UNICODE_CHARS, "unicode entity entries");
+ for (ix=0; ix<UNICODE_HASH_BUCKETS; ix++)
+ unicode_usage_hash[ix] = NULL;
+ }
+ compressed_offsets = my_calloc(sizeof(int32), MAX_NUM_STATIC_STRINGS,
+ "static strings index table");
+ }
+}
+
+extern void text_free_arrays(void)
+{
+ my_free(&strings_holding_area, "static strings holding area");
+ my_free(&low_strings, "low (abbreviation) strings");
+ my_free(&abbreviations_at, "abbreviations");
+ my_free(&abbrev_values, "abbrev values");
+ my_free(&abbrev_quality, "abbrev quality");
+ my_free(&abbrev_freqs, "abbrev freqs");
+
+ my_free(&dtree, "red-black tree for dictionary");
+ my_free(&final_dict_order, "final dictionary ordering table");
+ my_free(&dict_sort_codes, "dictionary sort codes");
+
+ my_free(&dictionary,"dictionary");
+
+ my_free(&compressed_offsets, "static strings index table");
+ my_free(&hufflist, "huffman node list");
+ my_free(&huff_entities, "huffman entities");
+ my_free(&unicode_usage_entries, "unicode entity entities");
+
+ deallocate_memory_block(&static_strings_area);
+}
+
+extern void ao_free_arrays(void)
+{ my_free (&tlbtab,"tlb table");
+ my_free (&sub_buffer,"sub_buffer");
+ my_free (&bestyet,"bestyet");
+ my_free (&bestyet2,"bestyet2");
+ my_free (&grandtable,"grandtable");
+ my_free (&grandflags,"grandflags");
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "veneer" : Compiling the run-time "veneer" of any routines invoked */
+/* by the compiler (e.g. DefArt) which the program doesn't */
+/* provide */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+int veneer_mode; /* Is the code currently being
+ compiled from the veneer? */
+
+static debug_locations null_debug_locations =
+ { { 0, 0, 0, 0, 0, 0, 0 }, NULL, 0 };
+
+extern void compile_initial_routine(void)
+{
+ /* The first routine present in memory in any Inform game, beginning
+ at the code area start position, always has 0 local variables
+ (since the interpreter begins execution with an empty stack frame):
+ and it must "quit" rather than "return".
+
+ In order not to impose these restrictions on "Main", we compile a
+ trivial routine consisting of a call to "Main" followed by "quit". */
+
+ int32 j;
+ assembly_operand AO;
+
+ j = symbol_index("Main__", -1);
+ assign_symbol(j,
+ assemble_routine_header(0, FALSE, "Main__", FALSE, j),
+ ROUTINE_T);
+ sflags[j] |= SYSTEM_SFLAG + USED_SFLAG;
+ if (trace_fns_setting==3) sflags[j] |= STAR_SFLAG;
+
+ if (!glulx_mode) {
+
+ INITAOTV(&AO, LONG_CONSTANT_OT, 0);
+ AO.marker = MAIN_MV;
+
+ sequence_point_follows = FALSE;
+
+ if (version_number > 3)
+ assemblez_1_to(call_vs_zc, AO, temp_var1);
+ else
+ assemblez_1_to(call_zc, AO, temp_var1);
+
+ assemblez_0(quit_zc);
+
+ }
+ else {
+
+ INITAOTV(&AO, CONSTANT_OT, 0);
+ AO.marker = MAIN_MV;
+
+ sequence_point_follows = FALSE;
+
+ assembleg_3(call_gc, AO, zero_operand, zero_operand);
+ assembleg_1(return_gc, zero_operand);
+
+ }
+
+ assemble_routine_end(FALSE, null_debug_locations);
+}
+
+/* ------------------------------------------------------------------------- */
+/* The rest of the veneer is applied at the end of the pass, as required. */
+/* ------------------------------------------------------------------------- */
+
+static int veneer_routine_needs_compilation[VENEER_ROUTINES];
+int32 veneer_routine_address[VENEER_ROUTINES];
+static int veneer_symbols_base;
+
+#define VR_UNUSED 0
+#define VR_CALLED 1
+#define VR_COMPILED 2
+
+typedef struct VeneerRoutine_s
+{ char *name;
+ char *source1;
+ char *source2;
+ char *source3;
+ char *source4;
+ char *source5;
+ char *source6;
+} VeneerRoutine;
+
+static char *veneer_source_area;
+
+static VeneerRoutine VRs_z[VENEER_ROUTINES] =
+{
+ /* Box__Routine: the only veneer routine used in the implementation of
+ an actual statement ("box", of course), written in a
+ hybrid of Inform and assembly language. Note the
+ transcription of the box text to the transcript
+ output stream (-1, or $ffff). */
+
+ { "Box__Routine",
+ "maxw table n w w2 line lc t;\
+ n = table --> 0;\
+ @add n 6 -> sp;\
+ @split_window sp;\
+ @set_window 1;\
+ w = 0 -> 33;\
+ if (w == 0) w=80;\
+ w2 = (w - maxw)/2;\
+ style reverse;\
+ @sub w2 2 -> w;\
+ line = 5;\
+ lc = 1;\
+ @set_cursor 4 w;\
+ spaces maxw + 4;",
+ "do\
+ { @set_cursor line w;\
+ spaces maxw + 4;\
+ @set_cursor line w2;\
+ t = table --> lc;\
+ if (t~=0) print (string) t;\
+ line++; lc++;\
+ } until (lc > n);\
+ @set_cursor line w;\
+ spaces maxw + 4;\
+ @buffer_mode 1;\
+ style roman;\
+ @set_window 0;\
+ @split_window 1;\
+ @output_stream $ffff;\
+ print \"[ \";\
+ lc = 1;",
+ "do\
+ { w = table --> lc;\
+ if (w ~= 0) print (string) w;\
+ lc++;\
+ if (lc > n)\
+ { print \"]^^\";\
+ break;\
+ }\
+ print \"^ \";\
+ } until (false);\
+ @output_stream 1;\
+ ]", "", "", ""
+ },
+
+ /* This batch of routines is expected to be defined (rather better) by
+ the Inform library: these minimal forms here are provided to prevent
+ tiny non-library-using programs from failing to compile when certain
+ legal syntaxes (such as <<Action a b>>;) are used. */
+
+ { "R_Process",
+ "a b c d; print \"Action <\", a, \" \", b, \" \", c;\
+ if (d) print \", \", d; print \">^\";\
+ ]", "", "", "", "", ""
+ },
+ { "DefArt",
+ "obj; print \"the \", obj; ]", "", "", "", "", ""
+ },
+ { "InDefArt",
+ "obj; print \"a \", obj; ]", "", "", "", "", ""
+ },
+ { "CDefArt",
+ "obj; print \"The \", obj; ]", "", "", "", "", ""
+ },
+ { "CInDefArt",
+ "obj; print \"A \", obj; ]", "", "", "", "", ""
+ },
+ { "PrintShortName",
+ "obj; switch(metaclass(obj))\
+ { 0: print \"nothing\";\
+ Object: @print_obj obj;\
+ Class: print \"class \"; @print_obj obj;\
+ Routine: print \"(routine at \", obj, \")\";\
+ String: print \"(string at \", obj, \")\";\
+ } ]", "", "", "", "", ""
+ },
+ { "EnglishNumber",
+ "obj; print obj; ]", "", "", "", "", ""
+ },
+ { "Print__PName",
+ "prop p size cla i;\
+ if (prop & $c000)\
+ { cla = #classes_table-->(prop & $ff);\
+ print (name) cla, \"::\";\
+ if ((prop & $8000) == 0) prop = (prop & $3f00)/$100;\
+ else\
+ { prop = (prop & $7f00)/$100;\
+ i = cla.3;\
+ while ((i-->0 ~= 0) && (prop>0))\
+ { i = i + i->2 + 3;\
+ prop--;\
+ }\
+ prop = (i-->0) & $7fff;\
+ }\
+ }",
+ "p = #identifiers_table;\
+ size = p-->0;\
+ if (prop<=0 || prop>=size || p-->prop==0)\
+ print \"<number \", prop, \">\";\
+ else print (string) p-->prop;\
+ ]", "", "", "", ""
+ },
+
+ /* The remaining routines make up the run-time half of the object
+ orientation system, and need never be present for Inform 5 programs. */
+
+ {
+ /* WV__Pr: write a value to the property for the given
+ object having the given identifier */
+
+ "WV__Pr",
+ "obj identifier value x;\
+ x = obj..&identifier;\
+ if (x==0) { RT__Err(\"write to\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,value);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,value);\
+ #endif; #endif;\
+ x-->0 = value;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RV__Pr: read a value from the property for the given
+ object having the given identifier */
+
+ "RV__Pr",
+ "obj identifier x;\
+ x = obj..&identifier;\
+ if (x==0)\
+ { if (identifier >= 1 && identifier < 64 && obj.#identifier <= 2)\
+ return obj.identifier;\
+ RT__Err(\"read\", obj, identifier); return; }\
+ if (obj..#identifier > 2) RT__Err(\"read\", obj, identifier, 2);\
+ return x-->0;\
+ ]", "", "", "", "", ""
+ },
+ { /* CA__Pr: call, that is, print-or-run-or-read, a property:
+ this exactly implements obj..prop(...). Note that
+ classes (members of Class) have 5 built-in properties
+ inherited from Class: create, recreate, destroy,
+ remaining and copy. Implementing these here prevents
+ the need for a full metaclass inheritance scheme. */
+
+ "CA__Pr",
+ "obj id a b c d e f x y z s s2 n m;\
+ if (obj < 1 || obj > #largest_object-255)\
+ { switch(Z__Region(obj))\
+ { 2: if (id == call)\
+ { s = sender; sender = self; self = obj;\
+ #ifdef action;sw__var=action;#endif;\
+ x = indirect(obj, a, b, c, d, e, f);\
+ self = sender; sender = s; return x; }\
+ jump Call__Error;",
+ "3: if (id == print) { @print_paddr obj; rtrue; }\
+ if (id == print_to_array)\
+ { @output_stream 3 a; @print_paddr obj; @output_stream -3;\
+ return a-->0; }\
+ jump Call__Error;\
+ }\
+ jump Call__Error;\
+ }\
+ @check_arg_count 3 ?~A__x;y++;@check_arg_count 4 ?~A__x;y++;\
+ @check_arg_count 5 ?~A__x;y++;@check_arg_count 6 ?~A__x;y++;\
+ @check_arg_count 7 ?~A__x;y++;@check_arg_count 8 ?~A__x;y++;.A__x;",
+ "#ifdef INFIX;if (obj has infix__watching) n=1;#endif;\
+ #ifdef DEBUG;if (debug_flag & 1 ~= 0) n=1;#endif;\
+ if (n==1) {\
+ #ifdef DEBUG;n=debug_flag & 1; debug_flag=debug_flag-n;#endif;\
+ print \"[ ~\", (name) obj, \"~.\", (property) id, \"(\";\
+ switch(y) { 1: print a; 2: print a,\",\",b; 3: print a,\",\",b,\",\",c;\
+ 4: print a,\",\",b,\",\",c,\",\",d;\
+ 5: print a,\",\",b,\",\",c,\",\",d,\",\",e;\
+ 6: print a,\",\",b,\",\",c,\",\",d,\",\",e,\",\",f; }\
+ print \") ]^\";\
+ #ifdef DEBUG;debug_flag = debug_flag + n;#endif;\
+ }",
+ "if (id > 0 && id < 64)\
+ { x = obj.&id; if (x==0) { x=$000a-->0 + 2*(id-1); n=2; }\
+ else n = obj.#id; }\
+ else\
+ { if (id>=64 && id<69 && obj in Class)\
+ return Cl__Ms(obj,id,y,a,b,c,d);\
+ x = obj..&id;\
+ if (x == 0) { .Call__Error;\
+ RT__Err(\"send message\", obj, id); return; }\
+ n = 0->(x-1);\
+ if (id&$C000==$4000)\
+ switch (n&$C0) { 0: n=1; $40: n=2; $80: n=n&$3F; }\
+ }",
+ "for (:2*m<n:m++)\
+ { if (x-->m==$ffff) rfalse;\
+ switch(Z__Region(x-->m))\
+ { 2: s = sender; sender = self; self = obj; s2 = sw__var;\
+ #ifdef LibSerial;\
+ if (id==life) sw__var=reason_code; else sw__var=action;\
+ #endif;\
+ switch(y) { 0: z = indirect(x-->m); 1: z = indirect(x-->m, a);\
+ 2: z = indirect(x-->m, a, b); 3: z = indirect(x-->m, a, b, c);",
+ "4: z = indirect(x-->m, a, b, c, d); 5:z = indirect(x-->m, a, b, c, d, e);\
+ 6: z = indirect(x-->m, a, b, c, d, e, f); }\
+ self = sender; sender = s; sw__var = s2;\
+ if (z ~= 0) return z;\
+ 3: print_ret (string) x-->m;\
+ default: return x-->m;\
+ }\
+ }\
+ rfalse;\
+ ]"
+ },
+ {
+ /* IB__Pr: ++(individual property) */
+
+ "IB__Pr",
+ "obj identifier x;\
+ x = obj..&identifier;\
+ if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)+1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
+ #endif; #endif;\
+ return ++(x-->0);\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* IA__Pr: (individual property)++ */
+
+ "IA__Pr",
+ "obj identifier x;\
+ x = obj..&identifier;\
+ if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15))\
+ RT__TrPS(obj,identifier,(x-->0)+1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
+ #endif; #endif;\
+ return (x-->0)++;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* DB__Pr: --(individual property) */
+
+ "DB__Pr",
+ "obj identifier x;\
+ x = obj..&identifier;\
+ if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #endif; #endif;\
+ return --(x-->0);\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* DA__Pr: (individual property)-- */
+
+ "DA__Pr",
+ "obj identifier x;\
+ x = obj..&identifier;\
+ if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #endif; #endif;\
+ return (x-->0)--;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RA__Pr: read the address of a property value for a given object,
+ returning 0 if it doesn't provide this individual
+ property */
+
+ "RA__Pr",
+ "obj identifier i otherid cla;\
+ if (obj==0) rfalse;\
+ if (identifier<64 && identifier>0) return obj.&identifier;\
+ if (identifier & $8000 ~= 0)\
+ { cla = #classes_table-->(identifier & $ff);\
+ if (cla.&3 == 0) rfalse;\
+ if (~~(obj ofclass cla)) rfalse;\
+ identifier = (identifier & $7f00) / $100;\
+ i = cla.3;\
+ while (identifier>0)\
+ { identifier--;\
+ i = i + i->2 + 3;\
+ }\
+ return i+3;\
+ }",
+ "if (identifier & $4000 ~= 0)\
+ { cla = #classes_table-->(identifier & $ff);\
+ identifier = (identifier & $3f00) / $100;\
+ if (~~(obj ofclass cla)) rfalse; i=0-->5;\
+ if (cla == 2) return i+2*identifier-2;\
+ i = 0-->((i+124+cla*14)/2);\
+ i = CP__Tab(i + 2*(0->i) + 1, -1)+6;\
+ return CP__Tab(i, identifier);\
+ }\
+ if (obj.&3 == 0) rfalse;\
+ if (obj in 1)\
+ { if (identifier<64 || identifier>=72) rfalse;\
+ }",
+ "if (self == obj)\
+ otherid = identifier | $8000;\
+ i = obj.3;\
+ while (i-->0 ~= 0)\
+ { if (i-->0 == identifier or otherid)\
+ return i+3;\
+ i = i + i->2 + 3;\
+ }\
+ rfalse;\
+ ]", "", "", ""
+ },
+ {
+ /* RL__Pr: read the property length of an individual property value,
+ returning 0 if it isn't provided by the given object */
+
+ "RL__Pr",
+ "obj identifier x;\
+ if (identifier<64 && identifier>0) return obj.#identifier;\
+ x = obj..&identifier;\
+ if (x==0) rfalse;\
+ if (identifier&$C000==$4000)\
+ switch (((x-1)->0)&$C0)\
+ { 0: return 1; $40: return 2; $80: return ((x-1)->0)&$3F; }\
+ return (x-1)->0;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RA__Sc: implement the "superclass" (::) operator,
+ returning an identifier */
+
+ "RA__Sc",
+ "cla identifier otherid i j k;\
+ if (cla notin 1 && cla > 4)\
+ { RT__Err(\"be a '::' superclass\", cla, -1); rfalse; }\
+ if (self ofclass cla) otherid = identifier | $8000;\
+ for (j=0: #classes_table-->j ~= 0: j++)\
+ { if (cla==#classes_table-->j)\
+ { if (identifier < 64) return $4000 + identifier*$100 + j;\
+ if (cla.&3 == 0) break;\
+ i = cla.3;",
+ "while (i-->0 ~= 0)\
+ { if (i-->0 == identifier or otherid)\
+ return $8000 + k*$100 + j;\
+ i = i + i->2 + 3;\
+ k++;\
+ }\
+ break;\
+ }\
+ }\
+ RT__Err(\"make use of\", cla, identifier);\
+ rfalse;\
+ ]", "", "", "", ""
+ },
+ {
+ /* OP__Pr: test whether or not given object provides individual
+ property with the given identifier code */
+
+ "OP__Pr",
+ "obj identifier;\
+ if (obj<1 || obj > (#largest_object-255))\
+ { if (identifier ~= print or print_to_array or call) rfalse;\
+ switch(Z__Region(obj))\
+ { 2: if (identifier == call) rtrue;\
+ 3: if (identifier == print or print_to_array) rtrue;\
+ }\
+ rfalse;\
+ }",
+ "if (identifier<64)\
+ { if (obj.&identifier ~= 0) rtrue;\
+ rfalse;\
+ }\
+ if (obj..&identifier ~= 0) rtrue;\
+ if (identifier<72 && obj in 1) rtrue;\
+ rfalse;\
+ ]", "", "", "", ""
+ },
+ {
+ /* OC__Cl: test whether or not given object is of the given class */
+
+ "OC__Cl",
+ "obj cla j a n;\
+ if (obj<1 || obj > (#largest_object-255))\
+ { if (cla ~= 3 or 4) rfalse;\
+ if (Z__Region(obj) == cla-1) rtrue;\
+ rfalse;\
+ }\
+ if (cla == 1) {\
+ if (obj<=4) rtrue;\
+ if (obj in 1) rtrue;\
+ rfalse;\
+ } else if (cla == 2) {\
+ if (obj<=4) rfalse;\
+ if (obj in 1) rfalse;\
+ rtrue;\
+ } else if (cla == 3 or 4) {\
+ rfalse;\
+ }",
+ "if (cla notin 1) { RT__Err(\"apply 'ofclass' for\", cla, -1);rfalse;}\
+ @get_prop_addr obj 2 -> a;\
+ if (a==0) rfalse;\
+ @get_prop_len a -> n;\
+ for (j=0: j<n/2: j++)\
+ { if (a-->j == cla) rtrue;\
+ }\
+ rfalse;\
+ ]", "", "", "", ""
+ },
+ { /* Copy__Primitive: routine to "deep copy" objects */
+
+ "Copy__Primitive",
+ "o1 o2 a1 a2 n m l size identifier;\
+ for (n=0:n<48:n++)\
+ { if (o2 has n) give o1 n;\
+ else give o1 ~n;\
+ }\
+ for (n=1:n<64:n++) if (n~=2 or 3)\
+ { a1 = o1.&n; a2 = o2.&n; size = o1.#n;\
+ if (a1~=0 && a2~=0 && size==o2.#n)\
+ { for (m=0:m<size:m++) a1->m=a2->m;\
+ }\
+ }",
+ "if (o1.&3 == 0 || o2.&3 == 0) return;\
+ for (n=o2.3: n-->0 ~= 0: n = n + size + 3)\
+ { identifier = n-->0;\
+ size = n->2;\
+ for (m=o1.3: m-->0 ~= 0: m = m + m->2 + 3)\
+ if ((identifier & $7fff == (m-->0) & $7fff) && size==m->2)\
+ for (l=3: l<size+3: l++) m->l = n->l;\
+ }\
+ ]", "", "", "", ""
+ },
+ { /* RT__Err: for run-time errors occurring in the above: e.g.,
+ an attempt to write to a non-existent individual
+ property */
+
+ "RT__Err",
+ "crime obj id size p q;\
+ print \"^[** Programming error: \";\
+ if (crime<0) jump RErr;\
+ if (crime==1) { print \"class \"; @print_obj obj;\
+ \": 'create' can have 0 to 3 parameters only **]\";}\
+ if (crime == 32) \"objectloop broken because the object \",\
+ (name) obj, \" was moved while the loop passed through it **]\";\
+ if (crime == 33) \"tried to print (char) \", obj,\
+ \", which is not a valid ZSCII character code for output **]\";\
+ if (crime == 34) \"tried to print (address) on something not the \",\
+ \"byte address of a string **]\";\
+ if (crime == 35) \"tried to print (string) on something not a \",\
+ \"string **]\";\
+ if (crime == 36) \"tried to print (object) on something not an \",\
+ \"object or class **]\";",
+ "if (crime < 32) { print \"tried to \";\
+ if (crime >= 28) { if (crime==28 or 29) print \"read from \";\
+ else print \"write to \";\
+ if (crime==29 or 31) print \"-\"; print \"->\", obj,\
+ \" 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\" (-->)\";\
+ \" array ~\", (string) #array_names_offset-->p,\
+ \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
+ if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
+ else print \"write\"; print \" outside memory using \";\
+ switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
+ if (crime < 4) print \"test \"; else\
+ if (crime < 12 || crime > 20) print \"find the \"; else\
+ if (crime < 14) print \"use \";\
+ if (crime==20) \"divide by zero **]\"; print \"~\";\
+ switch(crime) {\
+ 2: print \"in~ or ~notin\"; 3: print \"has~ or ~hasnt\";\
+ 4: print \"parent\"; 5: print \"eldest\"; 6: print \"child\";\
+ 7: print \"younger\"; 8: print \"sibling\"; 9: print \"children\";\
+ 10: print \"youngest\"; 11: print \"elder\";\
+ 12: print \"objectloop\"; 13: print \"}~ at end of ~objectloop\";\
+ 14: \"give~ an attribute to \", (name) obj, \" **]\";\
+ 15: \"remove~ \", (name) obj, \" **]\";",
+ "16,17,18: print \"move~ \", (name) obj, \" to \", (name) id;\
+ if (crime==18) { print \", which would make a loop: \",(name) obj;\
+ p=id; if (p==obj) p=obj;\
+ else do { print \" in \", (name) p; p=parent(p);} until (p==obj);\
+ \" in \", (name) p, \" **]\"; }\
+ \" **]\"; 19: \"give~ or test ~has~ or ~hasnt~ with a non-attribute"\
+ " on the object \",(name) obj,\" **]\";\
+ 21: print \".&\"; 22: print \".#\"; 23: print \".\"; }\
+ \"~ of \", (name) obj, \" **]\"; }",
+ ".RErr; if (obj>=0 && obj<=(#largest_object-255)) {\
+ if (obj && obj in Class) print \"class \";\
+ if (obj) @print_obj obj;else print \"nothing\";print\" \";}\
+ print \"(object number \", obj, \") \";\
+ if (id<0) print \"is not of class \", (name) -id;",
+ "else if (size) print \"has a property \", (property) id,\
+ \", but it is longer than 2 bytes so you cannot use ~.~\";\
+ else\
+ { print \" has no property \", (property) id;\
+ p = #identifiers_table;\
+ size = p-->0;\
+ if (id<0 || id>=size)\
+ print \" (and nor has any other object)\";\
+ }\
+ print \" to \", (string) crime, \" **]^\";\
+ ]", ""
+ },
+ { /* Z__Region: Determines whether a value is:
+ 1 an object number
+ 2 a code address
+ 3 a string address
+ 0 none of the above */
+
+ "Z__Region",
+ "addr top;\
+ if (addr==0 or -1) rfalse;\
+ top = addr;\
+ #IfV5; #iftrue (#version_number == 6) || (#version_number == 7);\
+ @log_shift addr $FFFF -> top; #Endif; #Endif;\
+ if (Unsigned__Compare(top, $001A-->0) >= 0) rfalse;\
+ if (addr>=1 && addr<=(#largest_object-255)) rtrue;\
+ #iftrue #oddeven_packing;\
+ @test addr 1 ?~NotString;\
+ if (Unsigned__Compare(addr, #strings_offset)<0) rfalse;\
+ return 3;\
+ .NotString;\
+ if (Unsigned__Compare(addr, #code_offset)<0) rfalse;\
+ return 2;\
+ #ifnot;\
+ if (Unsigned__Compare(addr, #strings_offset)>=0) return 3;\
+ if (Unsigned__Compare(addr, #code_offset)>=0) return 2;\
+ rfalse;\
+ #endif;\
+ ]", "", "", "", "", ""
+ },
+ { /* Unsigned__Compare: returns 1 if x>y, 0 if x=y, -1 if x<y */
+
+ "Unsigned__Compare",
+ "x y u v;\
+ if (x==y) return 0;\
+ if (x<0 && y>=0) return 1;\
+ if (x>=0 && y<0) return -1;\
+ u = x&$7fff; v= y&$7fff;\
+ if (u>v) return 1;\
+ return -1;\
+ ]", "", "", "", "", ""
+ },
+ { /* Meta__class: returns the metaclass of an object */
+
+ "Meta__class",
+ "obj;\
+ switch(Z__Region(obj))\
+ { 2: return Routine;\
+ 3: return String;\
+ 1: if (obj in 1 || obj <= 4) return Class;\
+ return Object;\
+ }\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+ { /* CP__Tab: searches a common property table for the given
+ identifier, thus imitating the get_prop_addr opcode.
+ Returns 0 if not provided, except:
+ if the identifier supplied is -1, then returns
+ the address of the first byte after the table. */
+
+ "CP__Tab",
+ "x id n l;\
+ while ((n=0->x) ~= 0)\
+ { if (n & $80) { x++; l = (0->x) & $3f; }\
+ else { if (n & $40) l=2; else l=1; }\
+ x++;\
+ if ((n & $3f) == id) return x;\
+ x = x + l;\
+ }\
+ 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;\
+ switch(id)\
+ { create:\
+ if (children(obj)<=1) rfalse; x=child(obj);\
+ remove x; if (x provides create) { if (y==0) x..create();\
+ if (y==1) x..create(a); if (y==2) x..create(a,b);\
+ if (y>3) RT__Err(1,obj); if (y>=3) x..create(a,b,c);}\
+ return x;\
+ recreate:\
+ if (~~(a ofclass obj))\
+ { RT__Err(\"recreate\", a, -obj); rfalse; }\
+ Copy__Primitive(a, child(obj));\
+ if (a provides create) { if (y==1) a..create();\
+ if (y==2) a..create(b); if (y==3) a..create(b,c);\
+ if (y>4) RT__Err(1,obj); if (y>=4) a..create(b,c,d);\
+ } rfalse;",
+ "destroy:\
+ if (~~(a ofclass obj))\
+ { RT__Err(\"destroy\", a, -obj); rfalse; }\
+ if (a provides destroy) a..destroy();\
+ Copy__Primitive(a, child(obj));\
+ move a to obj; rfalse;\
+ remaining:\
+ return children(obj)-1;",
+ "copy:\
+ if (~~(a ofclass obj))\
+ { RT__Err(\"copy\", a, -obj); rfalse; }\
+ if (~~(b ofclass obj))\
+ { RT__Err(\"copy\", b, -obj); rfalse; }\
+ Copy__Primitive(a, b); rfalse;\
+ }\
+ ]", "", "", ""
+ },
+ { /* RT__ChT: check at run-time that a proposed object move is legal
+ cause error and do nothing if not; otherwise move */
+
+ "RT__ChT",
+ "obj1 obj2 x;\
+ if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
+ return RT__Err(16,obj1,obj2);\
+ if (obj2<5 || obj2>(#largest_object-255) || obj2 in 1)\
+ return RT__Err(17,obj1,obj2);",
+ "x=obj2; while (x~=0) { if (x==obj1) return RT__Err(18,obj1,obj2); \
+ x=parent(x); }\
+ #ifdef INFIX;\
+ if (obj1 has infix__watching\
+ || obj2 has infix__watching || (debug_flag & 15))\
+ print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15)\
+ print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
+ #endif; #endif;\
+ @insert_obj obj1 obj2; ]", "", "", "", ""
+ },
+ { /* RT__ChR: check at run-time that a proposed object remove is legal
+ cause error and do nothing if not; otherwise remove */
+
+ "RT__ChR",
+ "obj1;\
+ if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
+ return RT__Err(15,obj1);",
+ "#ifdef INFIX;\
+ if (obj1 has infix__watching || (debug_flag & 15))\
+ print \"[Removing \", (name) obj1, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15)\
+ print \"[Removing \", (name) obj1, \"]^\";\
+ #endif; #endif;\
+ @remove_obj obj1; ]", "", "", "", ""
+ },
+ { /* RT__ChG: check at run-time that a proposed attr give is legal
+ cause error and do nothing if not; otherwise give */
+
+ "RT__ChG",
+ "obj1 a;\
+ if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
+ return RT__Err(14,obj1); if (a<0 || a>=48) return RT__Err(19,obj1);\
+ if (obj1 has a) return;",
+ "#ifdef INFIX;\
+ if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
+ print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (a ~= workflag && debug_flag & 15)\
+ print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
+ #endif; #endif;\
+ @set_attr obj1 a; ]", "", "", "", ""
+ },
+ { /* RT__ChGt: check at run-time that a proposed attr give ~ is legal
+ cause error and do nothing if not; otherwise give */
+
+ "RT__ChGt",
+ "obj1 a;\
+ if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
+ return RT__Err(14,obj1); if (a<0 || a>=48) return RT__Err(19,obj1);\
+ if (obj1 hasnt a) return;",
+ "#ifdef INFIX;\
+ if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
+ print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (a ~= workflag && debug_flag & 15)\
+ print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
+ #endif; #endif;\
+ @clear_attr obj1 a; ]", "", "", "", ""
+ },
+ { /* RT__ChPS: check at run-time that a proposed property set is legal
+ cause error and do nothing if not; otherwise make it */
+
+ "RT__ChPS",
+ "obj prop val size;\
+ if (obj<5 || obj>(#largest_object-255) || obj in 1 || obj.&prop==0 || (size=obj.#prop)>2 )\
+ return RT__Err(\"set\", obj, prop, size);\
+ @put_prop obj prop val;",
+ "#ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,prop,val);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,prop,val);\
+ #endif; #endif;\
+ return val; ]", "", "", "", ""
+ },
+ { /* RT__ChPR: check at run-time that a proposed property read is legal
+ cause error and return 0 if not; otherwise read it */
+
+ "RT__ChPR",
+ "obj prop val size;\
+ if (obj<5 || obj>(#largest_object-255) || (size=obj.#prop)>2)\
+ {RT__Err(\"read\", obj, prop, size); obj=2;}\
+ @get_prop obj prop -> val;",
+ "return val; ]", "", "", "", ""
+ },
+ { /* RT__TrPS: trace property settings */
+
+ "RT__TrPS",
+ "obj prop val;\
+ print \"[Setting \",(name) obj,\".\",(property) prop,\
+ \" to \",val,\"]^\"; ]",
+ "", "", "", "", ""
+ },
+ { /* RT__ChLDB: check at run-time that it's safe to load a byte
+ and return the byte */
+
+ "RT__ChLDB",
+ "base offset a val;\
+ a=base+offset;if (Unsigned__Compare(a,#readable_memory_offset)>=0)\
+ return RT__Err(24);",
+ "@loadb base offset -> val;return val; ]", "", "", "", ""
+ },
+ { /* RT__ChLDW: check at run-time that it's safe to load a word
+ and return the word */
+
+ "RT__ChLDW",
+ "base offset a val;\
+ a=base+2*offset;if (Unsigned__Compare(a,#readable_memory_offset)>=0)\
+ return RT__Err(25);",
+ "@loadw base offset -> val;return val; ]", "", "", "", ""
+ },
+ { /* RT__ChSTB: check at run-time that it's safe to store a byte
+ and store it */
+
+ "RT__ChSTB",
+ "base offset val a f;\
+ a=base+offset;\
+ if (Unsigned__Compare(a,#array__start)>=0\
+ && Unsigned__Compare(a,#array__end)<0) f=1; else\
+ if (Unsigned__Compare(a,#cpv__start)>=0\
+ && Unsigned__Compare(a,#cpv__end)<0) f=1; else\
+ if (Unsigned__Compare(a,#ipv__start)>=0\
+ && Unsigned__Compare(a,#ipv__end)<0) f=1; else\
+ if (a==$0011) f=1;\
+ if (f==0) return RT__Err(26);",
+ "@storeb base offset val; ]", "", "", "", ""
+ },
+ { /* RT__ChSTW: check at run-time that it's safe to store a word
+ and store it */
+
+ "RT__ChSTW",
+ "base offset val a f;\
+ a=base+2*offset;\
+ if (Unsigned__Compare(a,#array__start)>=0\
+ && Unsigned__Compare(a,#array__end)<0) f=1; else\
+ if (Unsigned__Compare(a,#cpv__start)>=0\
+ && Unsigned__Compare(a,#cpv__end)<0) f=1; else\
+ if (Unsigned__Compare(a,#ipv__start)>=0\
+ && Unsigned__Compare(a,#ipv__end)<0) f=1; else\
+ if (a==$0010) f=1;\
+ if (f==0) return RT__Err(27);",
+ "@storew base offset val; ]", "", "", "", ""
+ },
+ { /* RT__ChPrintC: check at run-time that it's safe to print (char)
+ and do so */
+
+ "RT__ChPrintC",
+ "c fl;\
+ if (c==0 or 9 or 11 or 13) fl=1;\
+ if (c>=32 && c<=126) fl=1; if (c>=155 && c<=251) fl=1;\
+ if (fl==0) return RT__Err(33,c);",
+ "@print_char c; ]", "", "", "", ""
+ },
+ { /* RT__ChPrintA: check at run-time that it's safe to print (address)
+ and do so */
+
+ "RT__ChPrintA",
+ "a;\
+ if (Unsigned__Compare(a, #readable_memory_offset)>=0)\
+ return RT__Err(34);",
+ "@print_addr a; ]", "", "", "", ""
+ },
+ { /* RT__ChPrintS: check at run-time that it's safe to print (string)
+ and do so */
+
+ "RT__ChPrintS",
+ "a;\
+ if (Z__Region(a)~=3) return RT__Err(35);",
+ "@print_paddr a; ]", "", "", "", ""
+ },
+ { /* RT__ChPrintO: check at run-time that it's safe to print (object)
+ and do so */
+
+ "RT__ChPrintO",
+ "a;\
+ if (Z__Region(a)~=1) return RT__Err(36);",
+ "@print_obj a; ]", "", "", "", ""
+ }
+};
+
+static VeneerRoutine VRs_g[VENEER_ROUTINES] =
+{
+ {
+ /* Box__Routine: Display the given array of text as a box quote.
+ This is a very simple implementation; the library should provide
+ a fancier version.
+ */
+ "Box__Routine",
+ "maxwid arr ix;\
+ maxwid = 0;\
+ glk($0086, 7);\
+ for (ix=0 : ix<arr-->0 : ix++) {\
+ print (string) arr-->(ix+1);\
+ new_line;\
+ }\
+ glk($0086, 0);\
+ ]", "", "", "", "", ""
+ },
+
+ /* This batch of routines is expected to be defined (rather better) by
+ the Inform library: these minimal forms here are provided to prevent
+ tiny non-library-using programs from failing to compile when certain
+ legal syntaxes (such as <<Action a b>>;) are used. */
+
+ { "R_Process",
+ "a b c d; print \"Action <\", a, \" \", b, \" \", c;\
+ if (d) print \", \", d; print \">^\";\
+ ]", "", "", "", "", ""
+ },
+ { "DefArt",
+ "obj; print \"the \", obj; ]", "", "", "", "", ""
+ },
+ { "InDefArt",
+ "obj; print \"a \", obj; ]", "", "", "", "", ""
+ },
+ { "CDefArt",
+ "obj; print \"The \", obj; ]", "", "", "", "", ""
+ },
+ { "CInDefArt",
+ "obj; print \"A \", obj; ]", "", "", "", "", ""
+ },
+ { "PrintShortName",
+ "obj q; switch(metaclass(obj))\
+ { 0: print \"nothing\";\
+ Object: q = obj-->GOBJFIELD_NAME; @streamstr q;\
+ Class: print \"class \"; q = obj-->GOBJFIELD_NAME; @streamstr q;\
+ Routine: print \"(routine at \", obj, \")\";\
+ String: print \"(string at \", obj, \")\";\
+ } ]", "", "", "", "", ""
+ },
+ { "EnglishNumber",
+ "obj; print obj; ]", "", "", "", "", ""
+ },
+ {
+ /* Print__PName: Print the name of a property.
+ */
+ "Print__PName",
+ "prop ptab cla maxcom minind maxind str;\
+ if (prop & $FFFF0000) {\
+ cla = #classes_table-->(prop & $FFFF);\
+ print (name) cla, \"::\";\
+ @ushiftr prop 16 prop;\
+ }\
+ ptab = #identifiers_table;\
+ maxcom = ptab-->1;\
+ minind = INDIV_PROP_START;\
+ maxind = minind + ptab-->3;\
+ str = 0;\
+ if (prop >= 0 && prop < maxcom) {\
+ str = (ptab-->0)-->prop;\
+ }\
+ else if (prop >= minind && prop < maxind) {\
+ str = (ptab-->2)-->(prop-minind);\
+ }\
+ if (str)\
+ print (string) str;\
+ else\
+ print \"<number \", prop, \">\";\
+ ]", "", "", "", "", ""
+ },
+
+ /* The remaining routines make up the run-time half of the object
+ orientation system, and need never be present for Inform 5 programs. */
+
+ {
+ /* WV__Pr: Write a value to the property for the given object.
+ */
+ "WV__Pr",
+ "obj id val addr;\
+ addr = obj.&id;\
+ if (addr == 0) {\
+ RT__Err(\"write\", obj, id);\
+ return 0;\
+ }\
+ addr-->0 = val;\
+ return 0;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* RV__Pr: Read a value to the property for the given object.
+ */
+ "RV__Pr",
+ "obj id addr;\
+ addr = obj.&id;\
+ if (addr == 0) {\
+ if (id > 0 && id < INDIV_PROP_START) {\
+ return #cpv__start-->id;\
+ }\
+ RT__Err(\"read\", obj, id);\
+ return 0;\
+ }\
+ return addr-->0;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* CA__Pr: Call, that is, print-or-run-or-read, a property:
+ this exactly implements obj..prop(...). Note that
+ classes (members of Class) have 5 built-in properties
+ inherited from Class: create, recreate, destroy,
+ remaining and copy. Implementing these here prevents
+ the need for a full metaclass inheritance scheme.
+ */
+ "CA__Pr",
+ "_vararg_count obj id zr s s2 z addr len m val;\
+ @copy sp obj;\
+ @copy sp id;\
+ _vararg_count = _vararg_count - 2;\
+ zr = Z__Region(obj);\
+ if (zr == 2) {\
+ if (id == call) {\
+ s = sender; sender = self; self = obj;\
+ #ifdef action; sw__var=action; #endif;\
+ @call obj _vararg_count z;\
+ self = sender; sender = s;\
+ return z;\
+ }\
+ jump Call__Error;\
+ }",
+ " if (zr == 3) {\
+ if (id == print) {\
+ @streamstr obj; rtrue;\
+ }\
+ if (id == print_to_array) {\
+ if (_vararg_count >= 2) {\
+ @copy sp m;\
+ @copy sp len;\
+ }\
+ else {\
+ RT__Err(37); rfalse;\
+ }\
+ s2 = glk($0048);\
+ s = glk($0043, m+4, len-4, 1, 0);",
+ " if (s) {\
+ glk($0047, s);\
+ @streamstr obj;\
+ glk($0047, s2);\
+ @copy $ffffffff sp;\
+ @copy s sp;\
+ @glk $0044 2 0;\
+ @copy sp len;\
+ @copy sp 0;\
+ m-->0 = len;\
+ return len;\
+ }\
+ rfalse;\
+ }\
+ jump Call__Error;\
+ }",
+ " if (zr ~= 1)\
+ jump Call__Error;\
+ #ifdef DEBUG;#ifdef InformLibrary;\
+ if (debug_flag & 1 ~= 0) {\
+ debug_flag--;\
+ print \"[ ~\", (name) obj, \"~.\", (property) id, \"(\";\
+ @stkcopy _vararg_count;\
+ for (val=0 : val < _vararg_count : val++) {\
+ if (val) print \", \";\
+ @streamnum sp;\
+ }\
+ print \") ]^\";\
+ debug_flag++;\
+ }\
+ #endif;#endif;\
+ if (obj in Class) {\
+ switch (id) {\
+ remaining:\
+ return Cl__Ms(obj, id);\
+ copy:\
+ @copy sp m;\
+ @copy sp val;\
+ return Cl__Ms(obj, id, m, val);\
+ create, destroy, recreate:\
+ m = _vararg_count+2;\
+ @copy id sp;\
+ @copy obj sp;\
+ @call Cl__Ms m val;\
+ return val;\
+ }\
+ }",
+ " addr = obj.&id;\
+ if (addr == 0) {\
+ if (id > 0 && id < INDIV_PROP_START) {\
+ addr = #cpv__start + 4*id;\
+ len = 4;\
+ }\
+ else {\
+ jump Call__Error;\
+ }\
+ }\
+ else {\
+ len = obj.#id;\
+ }\
+ for (m=0 : 4*m<len : m++) {\
+ val = addr-->m;\
+ if (val == -1) rfalse;\
+ switch (Z__Region(val)) {\
+ 2:\
+ s = sender; sender = self; self = obj; s2 = sw__var;\
+ #ifdef LibSerial;\
+ if (id==life) sw__var=reason_code; else sw__var=action;\
+ #endif;",
+ " @stkcopy _vararg_count;\
+ @call val _vararg_count z;\
+ self = sender; sender = s; sw__var = s2;\
+ if (z ~= 0) return z;\
+ 3:\
+ @streamstr val;\
+ new_line;\
+ rtrue;\
+ default:\
+ return val;\
+ }\
+ }\
+ rfalse;\
+ .Call__Error;\
+ RT__Err(\"send message\", obj, id);\
+ rfalse;\
+ ]"
+ },
+ {
+ /* IB__Pr: ++(individual property) */
+
+ "IB__Pr",
+ "obj identifier x;\
+ x = obj.&identifier;\
+ if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)+1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
+ #endif; #endif;\
+ return ++(x-->0);\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* IA__Pr: (individual property)++ */
+
+ "IA__Pr",
+ "obj identifier x;\
+ x = obj.&identifier;\
+ if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15))\
+ RT__TrPS(obj,identifier,(x-->0)+1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
+ #endif; #endif;\
+ return (x-->0)++;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* DB__Pr: --(individual property) */
+
+ "DB__Pr",
+ "obj identifier x;\
+ x = obj.&identifier;\
+ if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #endif; #endif;\
+ return --(x-->0);\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* DA__Pr: (individual property)-- */
+
+ "DA__Pr",
+ "obj identifier x;\
+ x = obj.&identifier;\
+ if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
+ #endif; #endif;\
+ return (x-->0)--;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RA__Pr: Read the property address of a given property value.
+ Returns zero if it isn't provided by the object. This
+ understands all the same concerns as RL__Pr().
+ */
+ "RA__Pr",
+ "obj id cla prop ix;\
+ if (id & $FFFF0000) {\
+ cla = #classes_table-->(id & $FFFF);\
+ if (~~(obj ofclass cla)) return 0;\
+ @ushiftr id 16 id;\
+ obj = cla;\
+ }\
+ prop = CP__Tab(obj, id);\
+ if (prop==0) return 0;\
+ if (obj in Class && cla == 0) {\
+ if (id < INDIV_PROP_START || id >= INDIV_PROP_START+8)\
+ return 0;\
+ }\
+ if (self ~= obj) {\
+ @aloadbit prop 72 ix;\
+ if (ix) return 0;\
+ }\
+ return prop-->1;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* RL__Pr: Read the property length of a given property value.
+ Returns zero if it isn't provided by the object. This understands
+ inherited values (of the form class::prop) as well as simple
+ property ids and the special metaclass methods. It also knows
+ that private properties can only be read if (self == obj).
+ */
+ "RL__Pr",
+ "obj id cla prop ix;\
+ if (id & $FFFF0000) {\
+ cla = #classes_table-->(id & $FFFF);\
+ if (~~(obj ofclass cla)) return 0;\
+ @ushiftr id 16 id;\
+ obj = cla;\
+ }\
+ prop = CP__Tab(obj, id);\
+ if (prop==0) return 0;\
+ if (obj in Class && cla == 0) {\
+ if (id < INDIV_PROP_START || id >= INDIV_PROP_START+8)\
+ return 0;\
+ }\
+ if (self ~= obj) {\
+ @aloadbit prop 72 ix;\
+ if (ix) return 0;\
+ }\
+ @aloads prop 1 ix;\
+ return WORDSIZE * ix;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RA__Sc: Implement the \"superclass\" (::) operator. This
+ returns an compound property identifier, which is a
+ 32-bit value.
+ */
+ "RA__Sc",
+ "cla id j;\
+ if ((cla notin Class) && (cla ~= Class or String or Routine or Object)) {\
+ RT__Err(\"be a '::' superclass\", cla, -1);\
+ rfalse;\
+ }\
+ for (j=0 : #classes_table-->j ~= 0 : j++) {\
+ if (cla == #classes_table-->j) {\
+ return (id * $10000 + j);\
+ }\
+ }\
+ RT__Err(\"make use of\", cla, id);\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* OP__Pr: Test whether the given object provides the given property.
+ This winds up calling RA__Pr().
+ */
+ "OP__Pr",
+ "obj id zr;\
+ zr = Z__Region(obj);\
+ if (zr == 3) {\
+ if (id == print or print_to_array) rtrue;\
+ rfalse;\
+ }\
+ if (zr == 2) {\
+ if (id == call) rtrue;\
+ rfalse;\
+ }\
+ if (zr ~= 1) rfalse;\
+ if (id >= INDIV_PROP_START && id < INDIV_PROP_START+8) {\
+ if (obj in Class) rtrue;\
+ }\
+ if (obj.&id ~= 0)\
+ rtrue;\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* OC__Cl: Test whether the given object is of the given class.
+ (implements the OfClass operator.)
+ */
+ "OC__Cl",
+ "obj cla zr jx inlist inlistlen;\
+ zr = Z__Region(obj);\
+ if (zr == 3) {\
+ if (cla == String) rtrue;\
+ rfalse;\
+ }\
+ if (zr == 2) {\
+ if (cla == Routine) rtrue;\
+ rfalse;\
+ }\
+ if (zr ~= 1) rfalse;\
+ if (cla == Class) {\
+ if (obj in Class\
+ || obj == Class or String or Routine or Object)\
+ rtrue;\
+ rfalse;\
+ }\
+ if (cla == Object) {\
+ if (obj in Class\
+ || obj == Class or String or Routine or Object)\
+ rfalse;\
+ rtrue;\
+ }\
+ if (cla == String or Routine) rfalse;\
+ if (cla notin Class) {\
+ RT__Err(\"apply 'ofclass' for\", cla, -1);\
+ rfalse;\
+ }\
+ inlist = obj.&2;\
+ if (inlist == 0) rfalse;\
+ inlistlen = (obj.#2) / WORDSIZE;\
+ for (jx=0 : jx<inlistlen : jx++) {\
+ if (inlist-->jx == cla) rtrue;\
+ }\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* Copy__Primitive: Routine to \"deep copy\" objects.
+ */
+ "Copy__Primitive",
+ "o1 o2 p1 p2 pcount i j propid proplen val pa1 pa2;\
+ for (i=1 : i<=NUM_ATTR_BYTES : i++) {\
+ o1->i = o2->i;\
+ }\
+ p2 = o2-->GOBJFIELD_PROPTAB;\
+ pcount = p2-->0;\
+ p2 = p2+4;\
+ for (i=0 : i<pcount : i++) {\
+ @aloads p2 0 propid;\
+ @aloads p2 1 proplen;\
+ p1 = CP__Tab(o1, propid);\
+ if (p1) {\
+ @aloads p1 1 val;\
+ if (proplen == val) {\
+ @aloads p2 4 val;\
+ @astores p1 4 val;\
+ pa1 = p1-->1;\
+ pa2 = p2-->1;\
+ for (j=0 : j<proplen : j++)\
+ pa1-->j = pa2-->j;\
+ }\
+ }\
+ p2 = p2+10;\
+ }\
+ ]", "", "", "", "", ""
+ },
+ { /* RT__Err: for run-time errors occurring in the above: e.g.,
+ an attempt to write to a non-existent individual
+ property */
+
+ "RT__Err",
+ "crime obj id size p q;\
+ print \"^[** Programming error: \";\
+ if (crime<0) jump RErr;\
+ if (crime==1) { print \"class \"; q = obj-->GOBJFIELD_NAME; @streamstr q;\
+ \": 'create' can have 0 to 3 parameters only **]\";}\
+ if (crime == 40) \"tried to change printing variable \",\
+ obj, \"; must be 0 to \", #dynam_string_table-->0-1, \" **]\";\
+ if (crime == 32) \"objectloop broken because the object \",\
+ (name) obj, \" was moved while the loop passed through it **]\";\
+ if (crime == 33) \"tried to print (char) \", obj,\
+ \", which is not a valid Glk character code for output **]\";\
+ if (crime == 34) \"tried to print (address) on something not the \",\
+ \"address of a dict word **]\";\
+ if (crime == 35) \"tried to print (string) on something not a \",\
+ \"string **]\";\
+ if (crime == 36) \"tried to print (object) on something not an \",\
+ \"object or class **]\";\
+ if (crime == 37) \"tried to call Glulx print_to_array with only \",\
+ \"one argument **]\";",
+ "if (crime < 32) { print \"tried to \";\
+ if (crime >= 28) { if (crime==28 or 29) print \"read from \";\
+ else print \"write to \";\
+ if (crime==29 or 31) print \"-\"; print \"->\", obj,\
+ \" 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\" (-->)\";\
+ \" array ~\", (string) #array_names_offset-->(p+1),\
+ \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
+ if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
+ else print \"write\"; print \" outside memory using \";\
+ switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
+ if (crime < 4) print \"test \"; else\
+ if (crime < 12 || crime > 20) print \"find the \"; else\
+ if (crime < 14) print \"use \";\
+ if (crime==20) \"divide by zero **]\"; print \"~\";\
+ switch(crime) {\
+ 2: print \"in~ or ~notin\"; 3: print \"has~ or ~hasnt\";\
+ 4: print \"parent\"; 5: print \"eldest\"; 6: print \"child\";\
+ 7: print \"younger\"; 8: print \"sibling\"; 9: print \"children\";\
+ 10: print \"youngest\"; 11: print \"elder\";\
+ 12: print \"objectloop\"; 13: print \"}~ at end of ~objectloop\";\
+ 14: \"give~ an attribute to \", (name) obj, \" **]\";\
+ 15: \"remove~ \", (name) obj, \" **]\";",
+ "16,17,18: print \"move~ \", (name) obj, \" to \", (name) id;\
+ if (crime==18) { print \", which would make a loop: \",(name) obj;\
+ p=id; if (p==obj) p=obj;\
+ else do { print \" in \", (name) p; p=parent(p);} until (p==obj);\
+ \" in \", (name) p, \" **]\"; }\
+ \" **]\"; 19: \"give~ or test ~has~ or ~hasnt~ with a non-attribute"\
+ " on the object \",(name) obj,\" **]\";\
+ 21: print \".&\"; 22: print \".#\"; 23: print \".\"; }\
+ \"~ of \", (name) obj, \" **]\"; }",
+ ".RErr; if (obj==0 || obj->0>=$70 && obj->0<=$7F) {\
+ if (obj && obj in Class) print \"class \";\
+ if (obj) print (object) obj;else print \"nothing\";print\" \";}\
+ print \"(object number \", obj, \") \";\
+ if (id<0) print \"is not of class \", (name) -id;",
+ "else\
+ { print \" has no property \", (property) id;\
+ p = #identifiers_table;\
+ size = INDIV_PROP_START + p-->3;\
+ if (id<0 || id>=size)\
+ print \" (and nor has any other object)\";\
+ }\
+ print \" to \", (string) crime, \" **]^\";\
+ ]", ""
+ },
+ {
+ /* Z__Region: Determines whether a value is:
+ 1 an object number
+ 2 a code address
+ 3 a string address
+ 0 none of the above
+ */
+ "Z__Region",
+ "addr tb endmem;\
+ if (addr<36) rfalse;\
+ @getmemsize endmem;\
+ @jgeu addr endmem?outrange;\
+ tb=addr->0;\
+ if (tb >= $E0) return 3;\
+ if (tb >= $C0) return 2;\
+ if (tb >= $70 && tb <= $7F && addr >= (0-->2)) return 1;\
+ .outrange;\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+ { /* Unsigned__Compare: returns 1 if x>y, 0 if x=y, -1 if x<y */
+
+ "Unsigned__Compare",
+ "x y;\
+ @jleu x y ?lesseq;\
+ return 1;\
+ .lesseq;\
+ @jeq x y ?equal;\
+ return -1;\
+ .equal;\
+ return 0;\
+ ]", "", "", "", "", ""
+ },
+ { /* Meta__class: returns the metaclass of an object */
+
+ "Meta__class",
+ "obj;\
+ switch(Z__Region(obj))\
+ { 2: return Routine;\
+ 3: return String;\
+ 1: if (obj in Class\
+ || obj == Class or String or Routine or Object)\
+ return Class;\
+ return Object;\
+ }\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* CP__Tab: Search a property table for the given identifier.
+ The definition here is a bit different from the Z-code veneer.
+ This just searches the property table of obj for an entry with
+ the given identifier. It return the address of the property
+ entry, or 0 if nothing found. (Remember that the value returned
+ is not the address of the property *data*; it's the structure
+ which contains the address/length/flags.)
+ */
+ "CP__Tab",
+ "obj id otab max res;\
+ if (Z__Region(obj)~=1) {RT__Err(23, obj); rfalse;}\
+ otab = obj-->GOBJFIELD_PROPTAB;\
+ if (otab == 0) return 0;\
+ max = otab-->0;\
+ otab = otab+4;\
+ @binarysearch id 2 otab 10 max 0 0 res;\
+ return res;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* Cl__Ms: Implements the five message-receiving properties of
+ Classes.
+ */
+ "Cl__Ms",
+ "_vararg_count obj id a b x y;\
+ @copy sp obj;\
+ @copy sp id;\
+ _vararg_count = _vararg_count - 2;\
+ switch (id) {\
+ create:\
+ if (children(obj) <= 1) rfalse;\
+ x = child(obj);\
+ remove x;\
+ if (x provides create) {\
+ @copy create sp;\
+ @copy x sp;\
+ y = _vararg_count + 2;\
+ @call CA__Pr y 0;\
+ }\
+ return x;\
+ recreate:\
+ @copy sp a;\
+ _vararg_count--;\
+ if (~~(a ofclass obj)) {\
+ RT__Err(\"recreate\", a, -obj);\
+ rfalse;\
+ }\
+ if (a provides destroy)\
+ a.destroy();\
+ Copy__Primitive(a, child(obj));\
+ if (a provides create) {\
+ @copy create sp;\
+ @copy a sp;\
+ y = _vararg_count + 2;\
+ @call CA__Pr y 0;\
+ }\
+ rfalse;\
+ destroy:\
+ @copy sp a;\
+ _vararg_count--;\
+ if (~~(a ofclass obj)) {\
+ RT__Err(\"destroy\", a, -obj);\
+ rfalse;\
+ }\
+ if (a provides destroy)\
+ a.destroy();\
+ Copy__Primitive(a, child(obj));\
+ move a to obj;\
+ rfalse;\
+ remaining:\
+ return children(obj)-1;\
+ copy:\
+ @copy sp a;\
+ @copy sp b;\
+ _vararg_count = _vararg_count - 2;\
+ if (~~(a ofclass obj)) {\
+ RT__Err(\"copy\", a, -obj);\
+ rfalse;\
+ }\
+ if (~~(b ofclass obj)) {\
+ RT__Err(\"copy\", b, -obj);\
+ rfalse;\
+ }\
+ Copy__Primitive(a, b);\
+ rfalse;\
+ }\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RT__ChT: Check at run-time that a proposed object move is legal.
+ Cause error and do nothing if not; otherwise move
+ */
+ "RT__ChT",
+ "obj1 obj2 ix;\
+ if (obj1==0 || Z__Region(obj1)~=1\
+ || (obj1 == Class or String or Routine or Object) || obj1 in Class)\
+ return RT__Err(16, obj1, obj2);\
+ if (obj2==0 || Z__Region(obj2)~=1\
+ || (obj2 == Class or String or Routine or Object) || obj2 in Class)\
+ return RT__Err(17, obj1, obj2);\
+ ix = obj2;\
+ while (ix ~= 0) {\
+ if (ix==obj1) return RT__Err(18, obj1, obj2);\
+ ix = parent(ix);\
+ }\
+ #ifdef INFIX;\
+ if (obj1 has infix__watching\
+ || obj2 has infix__watching || (debug_flag & 15))\
+ print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15)\
+ print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
+ #endif; #endif;\
+ OB__Move(obj1, obj2);\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RT__ChR: Check at run-time that a proposed object remove is legal.
+ Cause error and do nothing if not; otherwise remove
+ */
+ "RT__ChR",
+ "obj1;\
+ if (obj1==0 || Z__Region(obj1)~=1\
+ || (obj1 == Class or String or Routine or Object) || obj1 in Class)\
+ return RT__Err(15, obj1);\
+ #ifdef INFIX;\
+ if (obj1 has infix__watching || (debug_flag & 15))\
+ print \"[Removing \", (name) obj1, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15)\
+ print \"[Removing \", (name) obj1, \"]^\";\
+ #endif; #endif;\
+ OB__Remove(obj1);\
+ ]", "", "", "", "", ""
+ },
+ { /* RT__ChG: check at run-time that a proposed attr give is legal
+ cause error and do nothing if not; otherwise give */
+
+ "RT__ChG",
+ "obj1 a;\
+ if (Z__Region(obj1) ~= 1) return RT__Err(14,obj1);\
+ if (obj1 in Class || obj1 == Class or String or Routine or Object)\
+ return RT__Err(14,obj1);\
+ if (a<0 || a>=NUM_ATTR_BYTES*8) return RT__Err(19,obj1);\
+ if (obj1 has a) return;",
+ "#ifdef INFIX;\
+ if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
+ print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (a ~= workflag && debug_flag & 15)\
+ print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
+ #endif; #endif;\
+ give obj1 a; ]", "", "", "", ""
+ },
+ { /* RT__ChGt: check at run-time that a proposed attr give ~ is legal
+ cause error and do nothing if not; otherwise give */
+
+ "RT__ChGt",
+ "obj1 a;\
+ if (Z__Region(obj1) ~= 1) return RT__Err(14,obj1);\
+ if (obj1 in Class || obj1 == Class or String or Routine or Object)\
+ return RT__Err(14,obj1);\
+ if (a<0 || a>=NUM_ATTR_BYTES*8) return RT__Err(19,obj1);\
+ if (obj1 hasnt a) return;",
+ "#ifdef INFIX;\
+ if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
+ print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
+ #ifnot; #ifdef DEBUG;\
+ if (a ~= workflag && debug_flag & 15)\
+ print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
+ #endif; #endif;\
+ give obj1 ~a; ]", "", "", "", ""
+ },
+ {
+ /* RT__ChPS: Check at run-time that a proposed property set is legal.
+ Cause error and do nothing if not; otherwise make it.
+ */
+ "RT__ChPS",
+ "obj prop val res;\
+ if (obj==0 || Z__Region(obj)~=1\
+ || (obj == Class or String or Routine or Object) || obj in Class)\
+ return RT__Err(\"set\", obj, prop);\
+ res = WV__Pr(obj, prop, val);\
+ #ifdef INFIX;\
+ if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,prop,val);\
+ #ifnot; #ifdef DEBUG;\
+ if (debug_flag & 15) RT__TrPS(obj,prop,val);\
+ #endif; #endif;\
+ return res;\
+ ]", "", "", "", "", ""
+ },
+ { /* RT__ChPR: check at run-time that a proposed property read is legal.
+ cause error and return 0 if not; otherwise read it */
+ "RT__ChPR",
+ "obj prop val;\
+ if (obj==0 or Class or String or Routine or Object || Z_Region(obj)~=1 )\
+ {RT__Err(\"read\", obj, prop); obj=2;}\
+ val = RV__Pr(obj, prop);",
+ "return val; ]", "", "", "", ""
+ },
+ { /* RT__TrPS: trace property settings */
+
+ "RT__TrPS",
+ "obj prop val;\
+ print \"[Setting \",(name) obj,\".\",(property) prop,\
+ \" to \",val,\"]^\"; ]",
+ "", "", "", "", ""
+ },
+ {
+ /* RT__ChLDB: Check at run-time that it's safe to load a byte
+ and return the byte.
+ */
+ "RT__ChLDB",
+ "base offset a b val;\
+ a=base+offset;\
+ @getmemsize b;\
+ if (Unsigned__Compare(a, b) >= 0)\
+ return RT__Err(24);\
+ @aloadb base offset val;\
+ return val;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* RT__ChLDW: Check at run-time that it's safe to load a word
+ and return the word
+ */
+ "RT__ChLDW",
+ "base offset a b val;\
+ a=base+WORDSIZE*offset;\
+ @getmemsize b;\
+ if (Unsigned__Compare(a, b) >= 0)\
+ return RT__Err(25);\
+ @aload base offset val;\
+ return val;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* RT__ChSTB: Check at run-time that it's safe to store a byte
+ and store it
+ */
+ "RT__ChSTB",
+ "base offset val a b;\
+ a=base+offset;\
+ @getmemsize b;\
+ if (Unsigned__Compare(a, b) >= 0) jump ChSTB_Fail;\
+ @aload 0 2 b;\
+ if (Unsigned__Compare(a, b) < 0) jump ChSTB_Fail;\
+ @astoreb base offset val;\
+ return;\
+ .ChSTB_Fail;\
+ return RT__Err(26);\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* RT__ChSTW: Check at run-time that it's safe to store a word
+ and store it
+ */
+ "RT__ChSTW",
+ "base offset val a b;\
+ a=base+WORDSIZE*offset;\
+ @getmemsize b;\
+ if (Unsigned__Compare(a, b) >= 0) jump ChSTW_Fail;\
+ @aload 0 2 b;\
+ if (Unsigned__Compare(a, b) < 0) jump ChSTW_Fail;\
+ @astore base offset val;\
+ return;\
+ .ChSTW_Fail;\
+ return RT__Err(27);\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* RT__ChPrintC: Check at run-time that it's safe to print (char)
+ and do so.
+ */
+ "RT__ChPrintC",
+ "c;\
+ if (c<10 || (c>10 && c<32) || (c>126 && c<160))\
+ return RT__Err(33,c);\
+ if (c>=0 && c<256)\
+ @streamchar c;\
+ else\
+ @streamunichar c;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* RT__ChPrintA: Check at run-time that it's safe to print (address)
+ and do so.
+ */
+ "RT__ChPrintA",
+ "addr endmem;\
+ if (addr<36)\
+ return RT__Err(34);\
+ @getmemsize endmem;\
+ if (Unsigned__Compare(addr, endmem) >= 0)\
+ return RT__Err(34);\
+ if (addr->0 ~= $60)\
+ return RT__Err(34);\
+ Print__Addr(addr);\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* Check at run-time that it's safe to print (string) and do so.
+ */
+ "RT__ChPrintS",
+ "str;\
+ if (Z__Region(str) ~= 3)\
+ return RT__Err(35);\
+ @streamstr str;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* Check at run-time that it's safe to print (object) and do so.
+ */
+ "RT__ChPrintO",
+ "obj;\
+ if (Z__Region(obj) ~= 1)\
+ return RT__Err(36);\
+ @aload obj GOBJFIELD_NAME sp; @streamstr sp;\
+ ]", "", "", "", "", ""
+ },
+ {
+ /* OB__Move: Move an object within the object tree. This does no
+ more error checking than the Z-code \"move\" opcode.
+ */
+ "OB__Move",
+ "obj dest par chi sib;\
+ par = obj-->GOBJFIELD_PARENT;\
+ if (par ~= 0) {\
+ chi = par-->GOBJFIELD_CHILD;\
+ if (chi == obj) {\
+ par-->GOBJFIELD_CHILD = obj-->GOBJFIELD_SIBLING;\
+ }\
+ else {\
+ while (1) {\
+ sib = chi-->GOBJFIELD_SIBLING;\
+ if (sib == obj)\
+ break;\
+ chi = sib;\
+ }\
+ chi-->GOBJFIELD_SIBLING = obj-->GOBJFIELD_SIBLING;\
+ }\
+ }\
+ obj-->GOBJFIELD_SIBLING = dest-->GOBJFIELD_CHILD;\
+ obj-->GOBJFIELD_PARENT = dest;\
+ dest-->GOBJFIELD_CHILD = obj;\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* OB__Remove: Remove an object from the tree. This does no
+ more error checking than the Z-code \"remove\" opcode.
+ */
+ "OB__Remove",
+ "obj par chi sib;\
+ par = obj-->GOBJFIELD_PARENT;\
+ if (par == 0)\
+ rfalse;\
+ chi = par-->GOBJFIELD_CHILD;\
+ if (chi == obj) {\
+ par-->GOBJFIELD_CHILD = obj-->GOBJFIELD_SIBLING;\
+ }\
+ else {\
+ while (1) {\
+ sib = chi-->GOBJFIELD_SIBLING;\
+ if (sib == obj)\
+ break;\
+ chi = sib;\
+ }\
+ chi-->GOBJFIELD_SIBLING = obj-->GOBJFIELD_SIBLING;\
+ }\
+ obj-->GOBJFIELD_SIBLING = 0;\
+ obj-->GOBJFIELD_PARENT = 0;\
+ rfalse;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* Print__Addr: Handle the print (address) statement. In Glulx,
+ this behaves differently than on the Z-machine; it can *only*
+ print dictionary words.
+ */
+ "Print__Addr",
+ "addr ix ch;\
+ if (addr->0 ~= $60) {\
+ print \"(\", addr, \": not dict word)\";\
+ return;\
+ }\
+ for (ix=1 : ix <= DICT_WORD_SIZE : ix++) {\
+ #ifndef DICT_IS_UNICODE;\
+ ch = addr->ix;\
+ #ifnot;\
+ ch = addr-->ix;\
+ #endif;\
+ if (ch == 0) return;\
+ print (char) ch;\
+ }\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* Glk__Wrap: This is a wrapper for the @glk opcode. It just passes
+ all its arguments into the Glk dispatcher, and returns the Glk
+ call result.
+ */
+ "Glk__Wrap",
+ "_vararg_count callid retval;\
+ @copy sp callid;\
+ _vararg_count = _vararg_count - 1;\
+ @glk callid _vararg_count retval;\
+ return retval;\
+ ]", "", "", "", "", ""
+ },
+
+ {
+ /* Dynam__String: Set dynamic string (printing variable) num to the
+ given val, which can be any string or function.
+ */
+ "Dynam__String",
+ "num val;\
+ if (num < 0 || num >= #dynam_string_table-->0)\
+ return RT__Err(40, num);\
+ (#dynam_string_table)-->(num+1) = val;\
+ ]", "", "", "", "", ""
+ }
+
+};
+
+
+static void mark_as_needed_z(int code)
+{
+ ASSERT_ZCODE();
+ if (veneer_routine_needs_compilation[code] == VR_UNUSED)
+ { veneer_routine_needs_compilation[code] = VR_CALLED;
+ /* Here each routine must mark every veneer routine it explicitly
+ calls as needed */
+ switch(code)
+ { case WV__Pr_VR:
+ mark_as_needed_z(RT__TrPS_VR);
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case RV__Pr_VR:
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case CA__Pr_VR:
+ mark_as_needed_z(Z__Region_VR);
+ mark_as_needed_z(Cl__Ms_VR);
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case IB__Pr_VR:
+ case IA__Pr_VR:
+ case DB__Pr_VR:
+ case DA__Pr_VR:
+ mark_as_needed_z(RT__Err_VR);
+ mark_as_needed_z(RT__TrPS_VR);
+ return;
+ case RA__Pr_VR:
+ mark_as_needed_z(CP__Tab_VR);
+ return;
+ case RA__Sc_VR:
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case OP__Pr_VR:
+ mark_as_needed_z(Z__Region_VR);
+ return;
+ case OC__Cl_VR:
+ mark_as_needed_z(Z__Region_VR);
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case Z__Region_VR:
+ mark_as_needed_z(Unsigned__Compare_VR);
+ return;
+ case Metaclass_VR:
+ mark_as_needed_z(Z__Region_VR);
+ return;
+ case Cl__Ms_VR:
+ mark_as_needed_z(RT__Err_VR);
+ mark_as_needed_z(Copy__Primitive_VR);
+ return;
+ case RT__ChR_VR:
+ case RT__ChT_VR:
+ case RT__ChG_VR:
+ case RT__ChGt_VR:
+ case RT__ChPR_VR:
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case RT__ChPS_VR:
+ mark_as_needed_z(RT__Err_VR);
+ mark_as_needed_z(RT__TrPS_VR);
+ return;
+ case RT__ChLDB_VR:
+ case RT__ChLDW_VR:
+ case RT__ChSTB_VR:
+ case RT__ChSTW_VR:
+ mark_as_needed_z(Unsigned__Compare_VR);
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case RT__ChPrintC_VR:
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case RT__ChPrintA_VR:
+ mark_as_needed_z(Unsigned__Compare_VR);
+ mark_as_needed_z(RT__Err_VR);
+ return;
+ case RT__ChPrintS_VR:
+ case RT__ChPrintO_VR:
+ mark_as_needed_z(RT__Err_VR);
+ mark_as_needed_z(Z__Region_VR);
+ return;
+ }
+ }
+}
+
+static void mark_as_needed_g(int code)
+{
+ ASSERT_GLULX();
+ if (veneer_routine_needs_compilation[code] == VR_UNUSED)
+ { veneer_routine_needs_compilation[code] = VR_CALLED;
+ /* Here each routine must mark every veneer routine it explicitly
+ calls as needed */
+ switch(code)
+ {
+ case PrintShortName_VR:
+ mark_as_needed_g(Metaclass_VR);
+ return;
+ case Print__Pname_VR:
+ mark_as_needed_g(PrintShortName_VR);
+ return;
+ case WV__Pr_VR:
+ mark_as_needed_g(RA__Pr_VR);
+ mark_as_needed_g(RT__TrPS_VR);
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case RV__Pr_VR:
+ mark_as_needed_g(RA__Pr_VR);
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case CA__Pr_VR:
+ mark_as_needed_g(RA__Pr_VR);
+ mark_as_needed_g(RL__Pr_VR);
+ mark_as_needed_g(PrintShortName_VR);
+ mark_as_needed_g(Print__Pname_VR);
+ mark_as_needed_g(Z__Region_VR);
+ mark_as_needed_g(Cl__Ms_VR);
+ mark_as_needed_g(Glk__Wrap_VR);
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case IB__Pr_VR:
+ case IA__Pr_VR:
+ case DB__Pr_VR:
+ case DA__Pr_VR:
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(RT__TrPS_VR);
+ return;
+ case RA__Pr_VR:
+ mark_as_needed_g(OC__Cl_VR);
+ mark_as_needed_g(CP__Tab_VR);
+ return;
+ case RL__Pr_VR:
+ mark_as_needed_g(OC__Cl_VR);
+ mark_as_needed_g(CP__Tab_VR);
+ return;
+ case RA__Sc_VR:
+ mark_as_needed_g(OC__Cl_VR);
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case OP__Pr_VR:
+ mark_as_needed_g(RA__Pr_VR);
+ mark_as_needed_g(Z__Region_VR);
+ return;
+ case OC__Cl_VR:
+ mark_as_needed_g(RA__Pr_VR);
+ mark_as_needed_g(RL__Pr_VR);
+ mark_as_needed_g(Z__Region_VR);
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case Copy__Primitive_VR:
+ mark_as_needed_g(CP__Tab_VR);
+ return;
+ case Z__Region_VR:
+ mark_as_needed_g(Unsigned__Compare_VR);
+ return;
+ case CP__Tab_VR:
+ case Metaclass_VR:
+ mark_as_needed_g(Z__Region_VR);
+ return;
+ case Cl__Ms_VR:
+ mark_as_needed_g(OC__Cl_VR);
+ mark_as_needed_g(OP__Pr_VR);
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(Copy__Primitive_VR);
+ mark_as_needed_g(OB__Remove_VR);
+ mark_as_needed_g(OB__Move_VR);
+ return;
+ case RT__ChG_VR:
+ case RT__ChGt_VR:
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case RT__ChR_VR:
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(Z__Region_VR);
+ mark_as_needed_g(OB__Remove_VR);
+ return;
+ case RT__ChT_VR:
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(Z__Region_VR);
+ mark_as_needed_g(OB__Move_VR);
+ return;
+ case RT__ChPS_VR:
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(RT__TrPS_VR);
+ mark_as_needed_g(WV__Pr_VR);
+ return;
+ case RT__ChPR_VR:
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(RV__Pr_VR); return;
+ case RT__ChLDB_VR:
+ case RT__ChLDW_VR:
+ case RT__ChSTB_VR:
+ case RT__ChSTW_VR:
+ mark_as_needed_g(Unsigned__Compare_VR);
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case RT__ChPrintC_VR:
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case RT__ChPrintA_VR:
+ mark_as_needed_g(Unsigned__Compare_VR);
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(Print__Addr_VR);
+ return;
+ case RT__ChPrintS_VR:
+ case RT__ChPrintO_VR:
+ mark_as_needed_g(RT__Err_VR);
+ mark_as_needed_g(Z__Region_VR);
+ return;
+ case Print__Addr_VR:
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ case Dynam__String_VR:
+ mark_as_needed_g(RT__Err_VR);
+ return;
+ }
+ }
+}
+
+extern assembly_operand veneer_routine(int code)
+{ assembly_operand AO;
+ if (!glulx_mode) {
+ INITAOTV(&AO, LONG_CONSTANT_OT, code);
+ AO.marker = VROUTINE_MV;
+ mark_as_needed_z(code);
+ }
+ else {
+ INITAOTV(&AO, CONSTANT_OT, code);
+ AO.marker = VROUTINE_MV;
+ mark_as_needed_g(code);
+ }
+ return(AO);
+}
+
+static void compile_symbol_table_routine(void)
+{ int32 j, nl, arrays_l, routines_l, constants_l;
+ assembly_operand AO, AO2, AO3;
+
+ /* Assign local var names for the benefit of the debugging information
+ file. */
+ local_variable_texts[0] = "dummy1";
+ local_variable_texts[1] = "dummy2";
+
+ veneer_mode = TRUE; j = symbol_index("Symb__Tab", -1);
+ assign_symbol(j,
+ assemble_routine_header(2, FALSE, "Symb__Tab", FALSE, j),
+ ROUTINE_T);
+ sflags[j] |= SYSTEM_SFLAG + USED_SFLAG;
+ if (trace_fns_setting==3) sflags[j] |= STAR_SFLAG;
+
+ if (!glulx_mode) {
+
+ if (define_INFIX_switch == FALSE)
+ { assemblez_0(rfalse_zc);
+ variable_usage[1] = TRUE;
+ variable_usage[2] = TRUE;
+ assemble_routine_end(FALSE, null_debug_locations);
+ veneer_mode = FALSE;
+ return;
+ }
+
+ INITAOTV(&AO, VARIABLE_OT, 1);
+ INITAOT(&AO2, SHORT_CONSTANT_OT);
+ INITAOT(&AO3, LONG_CONSTANT_OT);
+
+ arrays_l = next_label++;
+ routines_l = next_label++;
+ constants_l = next_label++;
+
+ sequence_point_follows = FALSE;
+ AO2.value = 1;
+ assemblez_2_branch(je_zc, AO, AO2, arrays_l, TRUE);
+ sequence_point_follows = FALSE;
+ AO2.value = 2;
+ assemblez_2_branch(je_zc, AO, AO2, routines_l, TRUE);
+ sequence_point_follows = FALSE;
+ AO2.value = 3;
+ assemblez_2_branch(je_zc, AO, AO2, constants_l, TRUE);
+ sequence_point_follows = FALSE;
+ assemblez_0(rtrue_zc);
+
+ assemble_label_no(arrays_l);
+ AO.value = 2;
+ for (j=0; j<no_arrays; j++)
+ { { AO2.value = j;
+ if (AO2.value<256) AO2.type = SHORT_CONSTANT_OT;
+ else AO2.type = LONG_CONSTANT_OT;
+ nl = next_label++;
+ sequence_point_follows = FALSE;
+ assemblez_2_branch(je_zc, AO, AO2, nl, FALSE);
+ AO3.value = array_sizes[j];
+ AO3.marker = 0;
+ assemblez_store(temp_var2, AO3);
+ AO3.value = array_types[j];
+ if (sflags[array_symbols[j]] & (INSF_SFLAG+SYSTEM_SFLAG))
+ AO3.value = AO3.value + 16;
+ AO3.marker = 0;
+ assemblez_store(temp_var3, AO3);
+ AO3.value = svals[array_symbols[j]];
+ AO3.marker = ARRAY_MV;
+ assemblez_1(ret_zc, AO3);
+ assemble_label_no(nl);
+ }
+ }
+ sequence_point_follows = FALSE;
+ assemblez_0(rtrue_zc);
+ assemble_label_no(routines_l);
+ for (j=0; j<no_named_routines; j++)
+ { AO2.value = j;
+ if (AO2.value<256) AO2.type = SHORT_CONSTANT_OT;
+ else AO2.type = LONG_CONSTANT_OT;
+ nl = next_label++;
+ sequence_point_follows = FALSE;
+ assemblez_2_branch(je_zc, AO, AO2, nl, FALSE);
+ AO3.value = 0;
+ if (sflags[named_routine_symbols[j]]
+ & (INSF_SFLAG+SYSTEM_SFLAG)) AO3.value = 16;
+ AO3.marker = 0;
+ assemblez_store(temp_var3, AO3);
+ AO3.value = svals[named_routine_symbols[j]];
+ AO3.marker = IROUTINE_MV;
+ assemblez_1(ret_zc, AO3);
+ assemble_label_no(nl);
+ }
+ sequence_point_follows = FALSE;
+ assemblez_0(rtrue_zc);
+
+ assemble_label_no(constants_l);
+ for (j=0, no_named_constants=0; j<no_symbols; j++)
+ { if (((stypes[j] == OBJECT_T) || (stypes[j] == CLASS_T)
+ || (stypes[j] == CONSTANT_T))
+ && ((sflags[j] & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
+ { AO2.value = no_named_constants++;
+ if (AO2.value<256) AO2.type = SHORT_CONSTANT_OT;
+ else AO2.type = LONG_CONSTANT_OT;
+ nl = next_label++;
+ sequence_point_follows = FALSE;
+ assemblez_2_branch(je_zc, AO, AO2, nl, FALSE);
+ AO3.value = 0;
+ if (stypes[j] == OBJECT_T) AO3.value = 2;
+ if (stypes[j] == CLASS_T) AO3.value = 1;
+ if (sflags[j] & (INSF_SFLAG+SYSTEM_SFLAG))
+ AO3.value = AO3.value + 16;
+ AO3.marker = 0;
+ assemblez_store(temp_var3, AO3);
+ AO3.value = j;
+ AO3.marker = SYMBOL_MV;
+ assemblez_1(ret_zc, AO3);
+ assemble_label_no(nl);
+ }
+ }
+ no_named_constants = 0; AO3.marker = 0;
+
+ sequence_point_follows = FALSE;
+ assemblez_0(rfalse_zc);
+ variable_usage[1] = TRUE;
+ variable_usage[2] = TRUE;
+ assemble_routine_end(FALSE, null_debug_locations);
+ veneer_mode = FALSE;
+ }
+ else {
+
+ if (define_INFIX_switch == FALSE)
+ { assembleg_1(return_gc, zero_operand);
+ variable_usage[1] = TRUE;
+ variable_usage[2] = TRUE;
+ assemble_routine_end(FALSE, null_debug_locations);
+ veneer_mode = FALSE;
+ return;
+ }
+
+ error("*** Infix symbol-table routine is not yet implemented. ***");
+ }
+}
+
+extern void compile_veneer(void)
+{ int i, j, try_veneer_again;
+ VeneerRoutine *VRs;
+
+ if (module_switch) return;
+
+ VRs = (!glulx_mode) ? VRs_z : VRs_g;
+
+ /* Called at the end of the pass to insert as much of the veneer as is
+ needed and not elsewhere compiled. */
+
+ veneer_symbols_base = no_symbols;
+
+ /* for (i=0; i<VENEER_ROUTINES; i++)
+ printf("%s %d %d %d %d %d %d\n", VRs[i].name,
+ strlen(VRs[i].source1), strlen(VRs[i].source2),
+ strlen(VRs[i].source3), strlen(VRs[i].source4),
+ strlen(VRs[i].source5), strlen(VRs[i].source6)); */
+
+ try_veneer_again = TRUE;
+ while (try_veneer_again)
+ { 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);
+ if (sflags[j] & UNKNOWN_SFLAG)
+ { veneer_mode = TRUE;
+ strcpy(veneer_source_area, VRs[i].source1);
+ strcat(veneer_source_area, VRs[i].source2);
+ strcat(veneer_source_area, VRs[i].source3);
+ strcat(veneer_source_area, VRs[i].source4);
+ strcat(veneer_source_area, VRs[i].source5);
+ strcat(veneer_source_area, VRs[i].source6);
+ assign_symbol(j,
+ parse_routine(veneer_source_area, FALSE,
+ VRs[i].name, TRUE, j),
+ ROUTINE_T);
+ veneer_mode = FALSE;
+ if (trace_fns_setting==3) sflags[j] |= STAR_SFLAG;
+ }
+ else
+ { if (stypes[j] != ROUTINE_T)
+ error_named("The following name is reserved by Inform for its \
+own use as a routine name; you can use it as a routine name yourself (to \
+override the standard definition) but cannot use it for anything else:",
+ VRs[i].name);
+ else
+ sflags[j] |= USED_SFLAG;
+ }
+ veneer_routine_address[i] = svals[j];
+ veneer_routine_needs_compilation[i] = VR_COMPILED;
+ try_veneer_again = TRUE;
+ }
+ }
+ }
+
+ compile_symbol_table_routine();
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_veneer_vars(void)
+{
+}
+
+extern void veneer_begin_pass(void)
+{ int i;
+ veneer_mode = FALSE;
+ for (i=0; i<VENEER_ROUTINES; i++)
+ { veneer_routine_needs_compilation[i] = VR_UNUSED;
+ veneer_routine_address[i] = 0;
+ }
+}
+
+extern void veneer_allocate_arrays(void)
+{ veneer_source_area = my_malloc(16384, "veneer source code area");
+}
+
+extern void veneer_free_arrays(void)
+{ my_free(&veneer_source_area, "veneer source code area");
+}
+
+/* ========================================================================= */
--- /dev/null
+/* ------------------------------------------------------------------------- */
+/* "verbs" : Manages actions and grammar tables; parses the directives */
+/* Verb and Extend. */
+/* */
+/* Copyright (c) Graham Nelson 1993 - 2018 */
+/* */
+/* This file is part of Inform. */
+/* */
+/* Inform is free software: you can redistribute it and/or modify */
+/* it under the terms of the GNU General Public License as published by */
+/* the Free Software Foundation, either version 3 of the License, or */
+/* (at your option) any later version. */
+/* */
+/* Inform is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+/* */
+/* You should have received a copy of the GNU General Public License */
+/* along with Inform. If not, see https://gnu.org/licenses/ */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#include "header.h"
+
+int grammar_version_number; /* 1 for pre-Inform 6.06 table format */
+int32 grammar_version_symbol; /* Index of "Grammar__Version"
+ within symbols table */
+
+/* ------------------------------------------------------------------------- */
+/* Actions. */
+/* ------------------------------------------------------------------------- */
+/* Array defined below: */
+/* */
+/* int32 action_byte_offset[n] The (byte) offset in the Z-machine */
+/* code area of the ...Sub routine */
+/* for action n. (NB: This is left */
+/* blank until the end of the */
+/* compilation pass.) */
+/* int32 action_symbol[n] The symbol table index of the n-th */
+/* action's name. */
+/* ------------------------------------------------------------------------- */
+
+int no_actions, /* Number of actions made so far */
+ no_fake_actions; /* Number of fake actions made so far */
+
+/* ------------------------------------------------------------------------- */
+/* Adjectives. (The term "adjective" is traditional; they are mainly */
+/* prepositions, such as "onto".) */
+/* ------------------------------------------------------------------------- */
+/* Arrays defined below: */
+/* */
+/* int32 adjectives[n] Byte address of dictionary entry */
+/* for the nth adjective */
+/* dict_word adjective_sort_code[n] Dictionary sort code of nth adj */
+/* ------------------------------------------------------------------------- */
+
+int no_adjectives; /* Number of adjectives made so far */
+
+/* ------------------------------------------------------------------------- */
+/* Verbs. Note that Inform-verbs are not quite the same as English verbs: */
+/* for example the English verbs "take" and "drop" both normally */
+/* correspond in a game's dictionary to the same Inform verb. An */
+/* Inform verb is essentially a list of grammar lines. */
+/* ------------------------------------------------------------------------- */
+/* Arrays defined below: */
+/* */
+/* verbt Inform_verbs[n] The n-th grammar line sequence: */
+/* see "header.h" for the definition */
+/* of the typedef struct verbt */
+/* int32 grammar_token_routine[n] The byte offset from start of code */
+/* area of the n-th one */
+/* ------------------------------------------------------------------------- */
+
+int no_Inform_verbs, /* Number of Inform-verbs made so far */
+ no_grammar_token_routines; /* Number of routines given in tokens */
+
+/* ------------------------------------------------------------------------- */
+/* We keep a list of English verb-words known (e.g. "take" or "eat") and */
+/* which Inform-verbs they correspond to. (This list is needed for some */
+/* of the grammar extension operations.) */
+/* The format of this list is a sequence of variable-length records: */
+/* */
+/* Byte offset to start of next record (1 byte) */
+/* Inform verb number this word corresponds to (1 byte) */
+/* The English verb-word (reduced to lower case), null-terminated */
+/* ------------------------------------------------------------------------- */
+
+static char *English_verb_list, /* First byte of first record */
+ *English_verb_list_top; /* Next byte free for new record */
+
+static int English_verb_list_size; /* Size of the list in bytes
+ (redundant but convenient) */
+
+/* ------------------------------------------------------------------------- */
+/* Arrays used by this file */
+/* ------------------------------------------------------------------------- */
+
+ verbt *Inform_verbs;
+ uchar *grammar_lines;
+ int32 grammar_lines_top;
+ int no_grammar_lines, no_grammar_tokens;
+
+ int32 *action_byte_offset,
+ *action_symbol,
+ *grammar_token_routine,
+ *adjectives;
+ static uchar *adjective_sort_code;
+
+/* ------------------------------------------------------------------------- */
+/* Tracing for compiler maintenance */
+/* ------------------------------------------------------------------------- */
+
+extern void list_verb_table(void)
+{ int i;
+ for (i=0; i<no_Inform_verbs; i++)
+ printf("Verb %2d has %d lines\n", i, Inform_verbs[i].lines);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Actions. */
+/* ------------------------------------------------------------------------- */
+
+static void new_action(char *b, int c)
+{
+ /* Called whenever a new action (or fake action) is created (either
+ by using make_action above, or the Fake_Action directive, or by
+ the linker). At present just a hook for some tracing code. */
+
+ if (printprops_switch)
+ printf("Action '%s' is numbered %d\n",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];
+ 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);
+ panic_mode_error_recovery(); return;
+ }
+
+ snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", token_text);
+ i = symbol_index(action_sub, -1);
+
+ if (!(sflags[i] & UNKNOWN_SFLAG))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("new fake action name", token_text);
+ panic_mode_error_recovery(); return;
+ }
+
+ assign_symbol(i, ((grammar_version_number==1)?256:4096)+no_fake_actions++,
+ FAKE_ACTION_T);
+
+ new_action(token_text, i);
+
+ if (debugfile_switch)
+ { debug_file_printf("<fake-action>");
+ debug_file_printf("<identifier>##%s</identifier>", token_text);
+ debug_file_printf("<value>%d</value>", svals[i]);
+ get_next_token();
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ put_token_back();
+ debug_file_printf("</fake-action>");
+ }
+
+ return;
+}
+
+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];
+ int j;
+ assembly_operand AO;
+
+ snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", name);
+ j = symbol_index(action_sub, -1);
+
+ if (stypes[j] == FAKE_ACTION_T)
+ { INITAO(&AO);
+ AO.value = svals[j];
+ if (!glulx_mode)
+ AO.type = LONG_CONSTANT_OT;
+ else
+ set_constant_ot(&AO);
+ sflags[j] |= USED_SFLAG;
+ return AO;
+ }
+
+ if (sflags[j] & UNKNOWN_SFLAG)
+ {
+ if (no_actions>=MAX_ACTIONS) memoryerror("MAX_ACTIONS",MAX_ACTIONS);
+ new_action(name, no_actions);
+ action_symbol[no_actions] = j;
+ assign_symbol(j, no_actions++, CONSTANT_T);
+ sflags[j] |= ACTION_SFLAG;
+ }
+ sflags[j] |= USED_SFLAG;
+
+ INITAO(&AO);
+ AO.value = svals[j];
+ AO.marker = ACTION_MV;
+ if (!glulx_mode) {
+ AO.type = (module_switch)?LONG_CONSTANT_OT:SHORT_CONSTANT_OT;
+ if (svals[j] >= 256) AO.type = LONG_CONSTANT_OT;
+ }
+ else {
+ AO.type = CONSTANT_OT;
+ }
+ return AO;
+}
+
+extern void find_the_actions(void)
+{ int i; int32 j;
+ char action_name[MAX_IDENTIFIER_LENGTH+4];
+ char action_sub[MAX_IDENTIFIER_LENGTH+4];
+
+ if (module_switch)
+ for (i=0; i<no_actions; i++) action_byte_offset[i] = 0;
+ else
+ for (i=0; i<no_actions; i++)
+ { strcpy(action_name, (char *) symbs[action_symbol[i]]);
+ action_name[strlen(action_name) - 3] = '\0'; /* remove "__A" */
+ strcpy(action_sub, action_name);
+ strcat(action_sub, "Sub");
+ j = symbol_index(action_sub, -1);
+ if (sflags[j] & UNKNOWN_SFLAG)
+ {
+ error_named_at("No ...Sub action routine found for action:", action_name, slines[action_symbol[i]]);
+ }
+ else
+ if (stypes[j] != ROUTINE_T)
+ {
+ error_named_at("No ...Sub action routine found for action:", action_name, slines[action_symbol[i]]);
+ error_named_at("-- ...Sub symbol found, but not a routine:", action_sub, slines[j]);
+ }
+ else
+ { action_byte_offset[i] = svals[j];
+ sflags[j] |= USED_SFLAG;
+ }
+ }
+}
+
+/* ------------------------------------------------------------------------- */
+/* Adjectives. */
+/* ------------------------------------------------------------------------- */
+
+static int make_adjective(char *English_word)
+{
+ /* Returns adjective number of the English word supplied, creating
+ a new adjective number if need be.
+
+ Note that (partly for historical reasons) adjectives are numbered
+ from 0xff downwards. (And partly to make them stand out as tokens.)
+
+ This routine is used only in grammar version 1: the corresponding
+ table is left empty in GV2. */
+
+ int i;
+ uchar new_sort_code[MAX_DICT_WORD_BYTES];
+
+ if (no_adjectives >= MAX_ADJECTIVES)
+ memoryerror("MAX_ADJECTIVES", MAX_ADJECTIVES);
+
+ dictionary_prepare(English_word, new_sort_code);
+ for (i=0; i<no_adjectives; i++)
+ if (compare_sorts(new_sort_code,
+ adjective_sort_code+i*DICT_WORD_BYTES) == 0)
+ 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++);
+}
+
+/* ------------------------------------------------------------------------- */
+/* Parsing routines. */
+/* ------------------------------------------------------------------------- */
+
+static int make_parsing_routine(int32 routine_address)
+{
+ /* This routine is used only in grammar version 1: the corresponding
+ table is left empty in GV2. */
+
+ int l;
+ for (l=0; l<no_grammar_token_routines; l++)
+ if (grammar_token_routine[l] == routine_address)
+ return l;
+
+ grammar_token_routine[l] = routine_address;
+ return(no_grammar_token_routines++);
+}
+
+/* ------------------------------------------------------------------------- */
+/* The English-verb list. */
+/* ------------------------------------------------------------------------- */
+
+static int find_or_renumber_verb(char *English_verb, int *new_number)
+{
+ /* If new_number is null, returns the Inform-verb number which the
+ * given English verb causes, or -1 if the given verb is not in the
+ * dictionary */
+
+ /* If new_number is non-null, renumbers the Inform-verb number which
+ * English_verb matches in English_verb_list to account for the case
+ * when we are extending a verb. Returns 0 if successful, or -1 if
+ * the given verb is not in the dictionary (which shouldn't happen as
+ * get_verb has already run) */
+
+ char *p;
+ p=English_verb_list;
+ while (p < English_verb_list_top)
+ { if (strcmp(English_verb, p+3) == 0)
+ { if (new_number)
+ { p[1] = (*new_number)/256;
+ p[2] = (*new_number)%256;
+ return 0;
+ }
+ return(256*((uchar)p[1]))+((uchar)p[2]);
+ }
+ p=p+(uchar)p[0];
+ }
+ return(-1);
+}
+
+static void register_verb(char *English_verb, int number)
+{
+ /* Registers a new English verb as referring to the given Inform-verb
+ number. (See comments above for format of the list.) */
+ int entrysize;
+
+ if (find_or_renumber_verb(English_verb, NULL) != -1)
+ { error_named("Two different verb definitions refer to", English_verb);
+ return;
+ }
+
+ /* 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.) */
+ 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);
+ English_verb_list_size += entrysize;
+ if (English_verb_list_size >= MAX_VERBSPACE)
+ memoryerror("MAX_VERBSPACE", MAX_VERBSPACE);
+
+ English_verb_list_top[0] = entrysize;
+ English_verb_list_top[1] = number/256;
+ English_verb_list_top[2] = number%256;
+ strcpy(English_verb_list_top+3, English_verb);
+ English_verb_list_top += entrysize;
+}
+
+static int get_verb(void)
+{
+ /* Look at the last-read token: if it's the name of an English verb
+ understood by Inform, in double-quotes, then return the Inform-verb
+ that word refers to: otherwise give an error and return -1. */
+
+ int j;
+
+ if ((token_type == DQ_TT) || (token_type == SQ_TT))
+ { j = find_or_renumber_verb(token_text, NULL);
+ if (j==-1)
+ error_named("There is no previous grammar for the verb",
+ token_text);
+ return j;
+ }
+
+ ebf_error("an English verb in quotes", token_text);
+
+ return -1;
+}
+
+/* ------------------------------------------------------------------------- */
+/* Grammar lines for Verb/Extend directives. */
+/* ------------------------------------------------------------------------- */
+
+static int grammar_line(int verbnum, int line)
+{
+ /* Parse a grammar line, to be written into grammar_lines[mark] onward.
+
+ Syntax: * <token1> ... <token-n> -> <action>
+
+ is compiled to a table in the form:
+
+ <action number : word>
+ <token 1> ... <token n> <ENDIT>
+
+ where <ENDIT> is the byte 15, and each <token> is 3 bytes long.
+
+ If grammar_version_number is 1, the token holds
+
+ <bytecode> 00 00
+
+ and otherwise a GV2 token.
+
+ Return TRUE if grammar continues after the line, FALSE if the
+ directive comes to an end. */
+
+ int j, bytecode, mark; int32 wordcode;
+ int grammar_token, slash_mode, last_was_slash;
+ int reverse_action, TOKEN_SIZE;
+ debug_location_beginning beginning_debug_location =
+ get_token_location_beginning();
+
+ get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { discard_token_location(beginning_debug_location);
+ return FALSE;
+ }
+ if (!((token_type == SEP_TT) && (token_value == TIMES_SEP)))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("'*' divider", token_text);
+ panic_mode_error_recovery();
+ return FALSE;
+ }
+
+ /* Have we run out of lines or token space? */
+
+ if (line >= MAX_LINES_PER_VERB)
+ { discard_token_location(beginning_debug_location);
+ error("Too many lines of grammar for verb. This maximum is built \
+into Inform, so suggest rewriting grammar using general parsing routines");
+ return(FALSE);
+ }
+
+ /* Internally, a line can be up to 3*32 + 1 + 2 = 99 bytes long */
+ /* In Glulx, that's 5*32 + 4 = 164 bytes */
+
+ mark = grammar_lines_top;
+ if (!glulx_mode) {
+ if (mark + 100 >= MAX_LINESPACE)
+ { discard_token_location(beginning_debug_location);
+ memoryerror("MAX_LINESPACE", MAX_LINESPACE);
+ }
+ }
+ else {
+ if (mark + 165 >= MAX_LINESPACE)
+ { discard_token_location(beginning_debug_location);
+ memoryerror("MAX_LINESPACE", MAX_LINESPACE);
+ }
+ }
+
+ Inform_verbs[verbnum].l[line] = mark;
+
+ if (!glulx_mode) {
+ mark = mark + 2;
+ TOKEN_SIZE = 3;
+ }
+ else {
+ mark = mark + 3;
+ TOKEN_SIZE = 5;
+ }
+
+ grammar_token = 0; last_was_slash = TRUE; slash_mode = FALSE;
+ no_grammar_lines++;
+
+ do
+ { get_next_token();
+ bytecode = 0; wordcode = 0;
+ if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("'->' clause", token_text);
+ return FALSE;
+ }
+ if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
+ { if (last_was_slash && (grammar_token>0))
+ ebf_error("grammar token", token_text);
+ break;
+ }
+
+ if (!last_was_slash) slash_mode = FALSE;
+ if ((token_type == SEP_TT) && (token_value == DIVIDE_SEP))
+ { 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);
+ else
+ { last_was_slash = TRUE;
+ slash_mode = TRUE;
+ if (((grammar_lines[mark-TOKEN_SIZE]) & 0x0f) != 2)
+ error("'/' can only be applied to prepositions");
+ grammar_lines[mark-TOKEN_SIZE] |= 0x20;
+ continue;
+ }
+ }
+ else last_was_slash = FALSE;
+
+ if ((token_type == DQ_TT) || (token_type == SQ_TT))
+ { if (grammar_version_number == 1)
+ bytecode = make_adjective(token_text);
+ else
+ { bytecode = 0x42;
+ wordcode = dictionary_add(token_text, 8, 0, 0);
+ }
+ }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==NOUN_DK))
+ { get_next_token();
+ if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
+ {
+ /* noun = <routine> */
+
+ get_next_token();
+ if ((token_type != SYMBOL_TT)
+ || (stypes[token_value] != ROUTINE_T))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("routine name after 'noun='", token_text);
+ panic_mode_error_recovery();
+ return FALSE;
+ }
+ if (grammar_version_number == 1)
+ bytecode
+ = 16 + make_parsing_routine(svals[token_value]);
+ else
+ { bytecode = 0x83;
+ wordcode = svals[token_value];
+ }
+ sflags[token_value] |= USED_SFLAG;
+ }
+ else
+ { put_token_back();
+ if (grammar_version_number == 1) bytecode=0;
+ else { bytecode = 1; wordcode = 0; }
+ }
+ }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==HELD_DK))
+ { if (grammar_version_number==1) bytecode=1;
+ else { bytecode=1; wordcode=1; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTI_DK))
+ { if (grammar_version_number==1) bytecode=2;
+ else { bytecode=1; wordcode=2; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTIHELD_DK))
+ { if (grammar_version_number==1) bytecode=3;
+ else { bytecode=1; wordcode=3; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTIEXCEPT_DK))
+ { if (grammar_version_number==1) bytecode=4;
+ else { bytecode=1; wordcode=4; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTIINSIDE_DK))
+ { if (grammar_version_number==1) bytecode=5;
+ else { bytecode=1; wordcode=5; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==CREATURE_DK))
+ { if (grammar_version_number==1) bytecode=6;
+ else { bytecode=1; wordcode=6; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==SPECIAL_DK))
+ { if (grammar_version_number==1) bytecode=7;
+ else { bytecode=1; wordcode=7; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==NUMBER_DK))
+ { if (grammar_version_number==1) bytecode=8;
+ else { bytecode=1; wordcode=8; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==TOPIC_DK))
+ { if (grammar_version_number==1)
+ error("The 'topic' token is only available if you \
+are using Library 6/3 or later");
+ else { bytecode=1; wordcode=9; } }
+ else if ((token_type==DIR_KEYWORD_TT)&&(token_value==SCOPE_DK))
+ {
+ /* scope = <routine> */
+
+ get_next_token();
+ if (!((token_type==SEP_TT)&&(token_value==SETEQUALS_SEP)))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("'=' after 'scope'", token_text);
+ panic_mode_error_recovery();
+ return FALSE;
+ }
+
+ get_next_token();
+ if ((token_type != SYMBOL_TT)
+ || (stypes[token_value] != ROUTINE_T))
+ { discard_token_location(beginning_debug_location);
+ ebf_error("routine name after 'scope='", token_text);
+ panic_mode_error_recovery();
+ return FALSE;
+ }
+
+ if (grammar_version_number == 1)
+ bytecode = 80 +
+ make_parsing_routine(svals[token_value]);
+ else { bytecode = 0x85; wordcode = svals[token_value]; }
+ sflags[token_value] |= USED_SFLAG;
+ }
+ else if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
+ { discard_token_location(beginning_debug_location);
+ error("'=' is only legal here as 'noun=Routine'");
+ panic_mode_error_recovery();
+ return FALSE;
+ }
+ else { /* <attribute> or <general-parsing-routine> tokens */
+
+ if ((token_type != SYMBOL_TT)
+ || ((stypes[token_value] != ATTRIBUTE_T)
+ && (stypes[token_value] != ROUTINE_T)))
+ { discard_token_location(beginning_debug_location);
+ error_named("No such grammar token as", token_text);
+ panic_mode_error_recovery();
+ return FALSE;
+ }
+ if (stypes[token_value]==ATTRIBUTE_T)
+ { if (grammar_version_number == 1)
+ bytecode = 128 + svals[token_value];
+ else { bytecode = 4; wordcode = svals[token_value]; }
+ }
+ else
+ { if (grammar_version_number == 1)
+ bytecode = 48 +
+ make_parsing_routine(svals[token_value]);
+ else { bytecode = 0x86; wordcode = svals[token_value]; }
+ }
+ sflags[token_value] |= USED_SFLAG;
+ }
+
+ grammar_token++; no_grammar_tokens++;
+ if ((grammar_version_number == 1) && (grammar_token > 6))
+ { if (grammar_token == 7)
+ warning("Grammar line cut short: you can only have up to 6 \
+tokens in any line (unless you're compiling with library 6/3 or later)");
+ }
+ else
+ { if (slash_mode)
+ { if (bytecode != 0x42)
+ error("'/' can only be applied to prepositions");
+ bytecode |= 0x10;
+ }
+ grammar_lines[mark++] = bytecode;
+ if (!glulx_mode) {
+ grammar_lines[mark++] = wordcode/256;
+ grammar_lines[mark++] = wordcode%256;
+ }
+ else {
+ grammar_lines[mark++] = ((wordcode >> 24) & 0xFF);
+ grammar_lines[mark++] = ((wordcode >> 16) & 0xFF);
+ grammar_lines[mark++] = ((wordcode >> 8) & 0xFF);
+ grammar_lines[mark++] = ((wordcode) & 0xFF);
+ }
+ }
+
+ } while (TRUE);
+
+ grammar_lines[mark++] = 15;
+ grammar_lines_top = mark;
+
+ dont_enter_into_symbol_table = TRUE;
+ get_next_token();
+ dont_enter_into_symbol_table = FALSE;
+
+ if (token_type != DQ_TT)
+ { discard_token_location(beginning_debug_location);
+ ebf_error("name of new or existing action", token_text);
+ panic_mode_error_recovery();
+ return FALSE;
+ }
+
+ { assembly_operand AO = action_of_name(token_text);
+ j = AO.value;
+ if (j >= ((grammar_version_number==1)?256:4096))
+ error_named("This is a fake action, not a real one:", token_text);
+ }
+
+ reverse_action = FALSE;
+ get_next_token();
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == REVERSE_DK))
+ { if (grammar_version_number == 1)
+ error("'reverse' actions can only be used with \
+Library 6/3 or later");
+ reverse_action = TRUE;
+ }
+ else put_token_back();
+
+ mark = Inform_verbs[verbnum].l[line];
+
+ if (debugfile_switch)
+ { debug_file_printf("<table-entry>");
+ debug_file_printf("<type>grammar line</type>");
+ debug_file_printf("<address>");
+ write_debug_grammar_backpatch(mark);
+ debug_file_printf("</address>");
+ debug_file_printf("<end-address>");
+ write_debug_grammar_backpatch(grammar_lines_top);
+ debug_file_printf("</end-address>");
+ write_debug_locations
+ (get_token_location_end(beginning_debug_location));
+ debug_file_printf("</table-entry>");
+ }
+
+ if (!glulx_mode) {
+ if (reverse_action)
+ j = j + 0x400;
+ grammar_lines[mark++] = j/256;
+ grammar_lines[mark++] = j%256;
+ }
+ else {
+ grammar_lines[mark++] = ((j >> 8) & 0xFF);
+ grammar_lines[mark++] = ((j) & 0xFF);
+ grammar_lines[mark++] = (reverse_action ? 1 : 0);
+ }
+
+ return TRUE;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The Verb directive: */
+/* */
+/* Verb [meta] "word-1" ... "word-n" | = "existing-English-verb" */
+/* | <grammar-line-1> ... <g-line-n> */
+/* */
+/* ------------------------------------------------------------------------- */
+
+extern void make_verb(void)
+{
+ /* Parse an entire Verb ... directive. */
+
+ int Inform_verb, meta_verb_flag=FALSE, verb_equals_form=FALSE;
+
+ char *English_verbs_given[32]; int no_given = 0, i;
+
+ directive_keywords.enabled = TRUE;
+
+ get_next_token();
+
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == META_DK))
+ { meta_verb_flag = TRUE;
+ get_next_token();
+ }
+
+ while ((token_type == DQ_TT) || (token_type == SQ_TT))
+ { English_verbs_given[no_given++] = token_text;
+ get_next_token();
+ }
+
+ if (no_given == 0)
+ { ebf_error("English verb in quotes", token_text);
+ panic_mode_error_recovery(); return;
+ }
+
+ if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
+ { verb_equals_form = TRUE;
+ get_next_token();
+ Inform_verb = get_verb();
+ if (Inform_verb == -1) return;
+ get_next_token();
+ if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
+ ebf_error("';' after English verb", token_text);
+ }
+ else
+ { Inform_verb = no_Inform_verbs;
+ if (no_Inform_verbs == MAX_VERBS)
+ memoryerror("MAX_VERBS",MAX_VERBS);
+ }
+
+ for (i=0; i<no_given; i++)
+ { dictionary_add(English_verbs_given[i],
+ 0x41 + ((meta_verb_flag)?0x02:0x00),
+ (glulx_mode)?(0xffff-Inform_verb):(0xff-Inform_verb), 0);
+ register_verb(English_verbs_given[i], Inform_verb);
+ }
+
+ if (!verb_equals_form)
+ { int lines = 0;
+ put_token_back();
+ while (grammar_line(no_Inform_verbs, lines++)) ;
+ Inform_verbs[no_Inform_verbs++].lines = --lines;
+ }
+
+ directive_keywords.enabled = FALSE;
+}
+
+/* ------------------------------------------------------------------------- */
+/* The Extend directive: */
+/* */
+/* Extend | only "verb-1" ... "verb-n" | <grammar-lines> */
+/* | "verb" | "replace" */
+/* | "first" */
+/* | "last" */
+/* */
+/* ------------------------------------------------------------------------- */
+
+#define EXTEND_REPLACE 1
+#define EXTEND_FIRST 2
+#define EXTEND_LAST 3
+
+extern void extend_verb(void)
+{
+ /* Parse an entire Extend ... directive. */
+
+ int Inform_verb = -1, k, l, lines, extend_mode;
+
+ directive_keywords.enabled = TRUE;
+ directives.enabled = FALSE;
+
+ get_next_token();
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == ONLY_DK))
+ { l = -1;
+ if (no_Inform_verbs == MAX_VERBS)
+ memoryerror("MAX_VERBS", MAX_VERBS);
+ while (get_next_token(),
+ ((token_type == DQ_TT) || (token_type == SQ_TT)))
+ { Inform_verb = get_verb();
+ if (Inform_verb == -1) return;
+ if ((l!=-1) && (Inform_verb!=l))
+ warning_named("Verb disagrees with previous verbs:", token_text);
+ l = Inform_verb;
+ dictionary_set_verb_number(token_text,
+ (glulx_mode)?(0xffff-no_Inform_verbs):(0xff-no_Inform_verbs));
+ /* make call to renumber verb in English_verb_list too */
+ if (find_or_renumber_verb(token_text, &no_Inform_verbs) == -1)
+ warning_named("Verb to extend not found in English_verb_list:",
+ token_text);
+ }
+
+ /* Copy the old Inform-verb into a new one which the list of
+ English-verbs given have had their dictionary entries modified
+ to point to */
+
+ Inform_verbs[no_Inform_verbs] = Inform_verbs[Inform_verb];
+ Inform_verb = no_Inform_verbs++;
+ }
+ else
+ { Inform_verb = get_verb();
+ if (Inform_verb == -1) return;
+ get_next_token();
+ }
+
+ /* Inform_verb now contains the number of the Inform-verb to extend... */
+
+ extend_mode = EXTEND_LAST;
+ if ((token_type == SEP_TT) && (token_value == TIMES_SEP))
+ put_token_back();
+ else
+ { extend_mode = 0;
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == REPLACE_DK))
+ extend_mode = EXTEND_REPLACE;
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == FIRST_DK))
+ extend_mode = EXTEND_FIRST;
+ if ((token_type == DIR_KEYWORD_TT) && (token_value == LAST_DK))
+ extend_mode = EXTEND_LAST;
+
+ if (extend_mode==0)
+ { ebf_error("'replace', 'last', 'first' or '*'", token_text);
+ extend_mode = EXTEND_LAST;
+ }
+ }
+
+ l = Inform_verbs[Inform_verb].lines;
+ lines = 0;
+ if (extend_mode == EXTEND_LAST) lines=l;
+ do
+ { if (extend_mode == EXTEND_FIRST)
+ for (k=l; k>0; k--)
+ Inform_verbs[Inform_verb].l[k+lines]
+ = Inform_verbs[Inform_verb].l[k-1+lines];
+ } while (grammar_line(Inform_verb, lines++));
+
+ if (extend_mode == EXTEND_FIRST)
+ { Inform_verbs[Inform_verb].lines = l+lines-1;
+ for (k=0; k<l; k++)
+ Inform_verbs[Inform_verb].l[k+lines-1]
+ = Inform_verbs[Inform_verb].l[k+lines];
+ }
+ else Inform_verbs[Inform_verb].lines = --lines;
+
+ directive_keywords.enabled = FALSE;
+ directives.enabled = TRUE;
+}
+
+/* ========================================================================= */
+/* Data structure management routines */
+/* ------------------------------------------------------------------------- */
+
+extern void init_verbs_vars(void)
+{
+ no_fake_actions = 0;
+ no_actions = 0;
+ no_grammar_lines = 0;
+ no_grammar_tokens = 0;
+ English_verb_list_size = 0;
+
+ Inform_verbs = NULL;
+ action_byte_offset = NULL;
+ grammar_token_routine = NULL;
+ adjectives = NULL;
+ adjective_sort_code = NULL;
+ English_verb_list = NULL;
+
+ if (!glulx_mode)
+ grammar_version_number = 1;
+ else
+ grammar_version_number = 2;
+}
+
+extern void verbs_begin_pass(void)
+{
+ no_Inform_verbs=0; no_adjectives=0;
+ no_grammar_token_routines=0;
+ no_actions=0;
+
+ no_fake_actions=0;
+ grammar_lines_top = 0;
+}
+
+extern void verbs_allocate_arrays(void)
+{
+ Inform_verbs = my_calloc(sizeof(verbt), MAX_VERBS, "verbs");
+ grammar_lines = my_malloc(MAX_LINESPACE, "grammar lines");
+ action_byte_offset = my_calloc(sizeof(int32), MAX_ACTIONS, "actions");
+ action_symbol = my_calloc(sizeof(int32), MAX_ACTIONS,
+ "action symbols");
+ grammar_token_routine = my_calloc(sizeof(int32), MAX_ACTIONS,
+ "grammar token routines");
+ adjectives = my_calloc(sizeof(int32), MAX_ADJECTIVES,
+ "adjectives");
+ adjective_sort_code = my_calloc(DICT_WORD_BYTES, MAX_ADJECTIVES,
+ "adjective sort codes");
+
+ English_verb_list = my_malloc(MAX_VERBSPACE, "register of verbs");
+ English_verb_list_top = English_verb_list;
+}
+
+extern void verbs_free_arrays(void)
+{
+ my_free(&Inform_verbs, "verbs");
+ my_free(&grammar_lines, "grammar lines");
+ my_free(&action_byte_offset, "actions");
+ my_free(&action_symbol, "action symbols");
+ my_free(&grammar_token_routine, "grammar token routines");
+ my_free(&adjectives, "adjectives");
+ my_free(&adjective_sort_code, "adjective sort codes");
+ my_free(&English_verb_list, "register of verbs");
+}
+
+/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "states" : Statement translator */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-static int match_colon(void)
-{ get_next_token();
- if (token_type == SEP_TT)
- { if (token_value == SEMICOLON_SEP)
- warning("Unlike C, Inform uses ':' to divide parts \
-of a 'for' loop specification: replacing ';' with ':'");
- else
- if (token_value != COLON_SEP)
- { ebf_error("':'", token_text);
- panic_mode_error_recovery();
- return(FALSE);
- }
- }
- else
- { ebf_error("':'", token_text);
- panic_mode_error_recovery();
- return(FALSE);
- }
- return(TRUE);
-}
-
-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);
-}
-
-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);
-}
-
-static void parse_action(void)
-{ int level = 1, args = 0, codegen_action;
- assembly_operand AO, AO2, AO3, AO4, AO5;
-
- /* An action statement has the form <ACTION NOUN SECOND, ACTOR>
- or <<ACTION NOUN SECOND, ACTOR>>. It simply compiles into a call
- to R_Process() with those four arguments. (The latter form,
- with double brackets, means "return true afterwards".)
-
- The R_Process() function should be supplied by the library,
- although a stub is defined in the veneer.
-
- The NOUN, SECOND, and ACTOR arguments are optional. If not
- supplied, R_Process() will be called with fewer arguments.
- (But if you supply ACTOR, it must be preceded by a comma.
- <ACTION, ACTOR> is equivalent to <ACTION 0 0, ACTOR>.)
-
- To complicate life, the ACTION argument may be a bare action
- name or a parenthesized expression. (So <Take> is equivalent
- to <(##Take)>.) We have to peek at the first token, checking
- whether it's an open-paren, to distinguish these cases.
-
- You may ask why the ACTOR argument is last; the "natural"
- Inform ordering would be "<floyd, take ball>". True! Sadly,
- Inform's lexer isn't smart enough to parse this consistently,
- so we can't do it.
- */
-
- dont_enter_into_symbol_table = TRUE;
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == LESS_SEP))
- { level = 2; get_next_token();
- }
- dont_enter_into_symbol_table = FALSE;
-
- /* Peek at the next token; see if it's an open-paren. */
- if ((token_type==SEP_TT) && (token_value==OPENB_SEP))
- { put_token_back();
- AO2 = parse_expression(ACTION_Q_CONTEXT);
- codegen_action = TRUE;
- }
- else
- { codegen_action = FALSE;
- AO2 = action_of_name(token_text);
- }
-
- get_next_token();
- AO3 = zero_operand;
- AO4 = zero_operand;
- AO5 = zero_operand;
- if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
- { put_token_back();
- args = 1;
- AO3 = parse_expression(ACTION_Q_CONTEXT);
-
- get_next_token();
- }
- if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
- { put_token_back();
- args = 2;
- AO4 = parse_expression(QUANTITY_CONTEXT);
- get_next_token();
- }
- if (!((token_type == SEP_TT) && (token_value == GREATER_SEP || token_value == COMMA_SEP)))
- {
- ebf_error("',' or '>'", token_text);
- }
-
- if ((token_type == SEP_TT) && (token_value == COMMA_SEP))
- {
- if (!glulx_mode && (version_number < 4))
- {
- error("<x, y> syntax is not available in Z-code V3 or earlier");
- }
- args = 3;
- AO5 = parse_expression(QUANTITY_CONTEXT);
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
- {
- ebf_error("'>'", token_text);
- }
- }
-
- if (level == 2)
- { get_next_token();
- if (!((token_type == SEP_TT) && (token_value == GREATER_SEP)))
- { put_token_back();
- ebf_error("'>>'", token_text);
- }
- }
-
- if (!glulx_mode) {
-
- AO = veneer_routine(R_Process_VR);
-
- switch(args)
- { case 0:
- if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- if (version_number>=5)
- assemblez_2(call_2n_zc, AO, AO2);
- else
- if (version_number==4)
- assemblez_2_to(call_vs_zc, AO, AO2, temp_var1);
- else
- assemblez_2_to(call_zc, AO, AO2, temp_var1);
- break;
- case 1:
- AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
- if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- if (version_number>=5)
- assemblez_3(call_vn_zc, AO, AO2, AO3);
- else
- if (version_number==4)
- assemblez_3_to(call_vs_zc, AO, AO2, AO3, temp_var1);
- else
- assemblez_3_to(call_zc, AO, AO2, AO3, temp_var1);
- break;
- case 2:
- AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
- AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
- if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- if (version_number>=5)
- assemblez_4(call_vn_zc, AO, AO2, AO3, AO4);
- else
- if (version_number==4)
- assemblez_4_to(call_vs_zc, AO, AO2, AO3, AO4, temp_var1);
- else
- assemblez_4(call_zc, AO, AO2, AO3, AO4);
- break;
- case 3:
- AO5 = code_generate(AO5, QUANTITY_CONTEXT, -1);
- AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
- AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
- if (codegen_action) AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- if (version_number>=5)
- assemblez_5(call_vn2_zc, AO, AO2, AO3, AO4, AO5);
- else
- if (version_number==4)
- assemblez_5_to(call_vs2_zc, AO, AO2, AO3, AO4, AO5, temp_var1);
- /* if V3 or earlier, we've already displayed an error */
- break;
- break;
- }
-
- if (level == 2) assemblez_0(rtrue_zc);
-
- }
- else {
-
- AO = veneer_routine(R_Process_VR);
-
- switch (args) {
-
- case 0:
- if (codegen_action)
- AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- assembleg_call_1(AO, AO2, zero_operand);
- break;
-
- case 1:
- AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
- if (codegen_action)
- AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- assembleg_call_2(AO, AO2, AO3, zero_operand);
- break;
-
- case 2:
- AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
- AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
- if (codegen_action)
- AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- assembleg_call_3(AO, AO2, AO3, AO4, zero_operand);
- break;
-
- case 3:
- AO5 = code_generate(AO5, QUANTITY_CONTEXT, -1);
- if (!((AO5.type == LOCALVAR_OT) && (AO5.value == 0)))
- assembleg_store(stack_pointer, AO5);
- AO4 = code_generate(AO4, QUANTITY_CONTEXT, -1);
- if (!((AO4.type == LOCALVAR_OT) && (AO4.value == 0)))
- assembleg_store(stack_pointer, AO4);
- AO3 = code_generate(AO3, QUANTITY_CONTEXT, -1);
- if (!((AO3.type == LOCALVAR_OT) && (AO3.value == 0)))
- assembleg_store(stack_pointer, AO3);
- if (codegen_action)
- AO2 = code_generate(AO2, QUANTITY_CONTEXT, -1);
- if (!((AO2.type == LOCALVAR_OT) && (AO2.value == 0)))
- assembleg_store(stack_pointer, AO2);
- assembleg_3(call_gc, AO, four_operand, zero_operand);
- break;
- }
-
- if (level == 2)
- assembleg_1(return_gc, one_operand);
-
- }
-}
-
-extern int parse_label(void)
-{
- get_next_token();
-
- if ((token_type == SYMBOL_TT) &&
- (stypes[token_value] == LABEL_T))
- { sflags[token_value] |= USED_SFLAG;
- return(svals[token_value]);
- }
-
- if ((token_type == SYMBOL_TT) && (sflags[token_value] & UNKNOWN_SFLAG))
- { assign_symbol(token_value, next_label, LABEL_T);
- define_symbol_label(token_value);
- next_label++;
- sflags[token_value] |= CHANGE_SFLAG + USED_SFLAG;
- return(svals[token_value]);
- }
-
- ebf_error("label name", token_text);
- return 0;
-}
-
-static void parse_print_z(int finally_return)
-{ int count = 0; assembly_operand AO;
-
- /* print <printlist> -------------------------------------------------- */
- /* print_ret <printlist> ---------------------------------------------- */
- /* <literal-string> --------------------------------------------------- */
- /* */
- /* <printlist> is a comma-separated list of items: */
- /* */
- /* <literal-string> */
- /* <other-expression> */
- /* (char) <expression> */
- /* (address) <expression> */
- /* (string) <expression> */
- /* (a) <expression> */
- /* (the) <expression> */
- /* (The) <expression> */
- /* (name) <expression> */
- /* (number) <expression> */
- /* (property) <expression> */
- /* (<routine>) <expression> */
- /* (object) <expression> (for use in low-level code only) */
- /* --------------------------------------------------------------------- */
-
- do
- { AI.text = token_text;
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
- switch(token_type)
- { case DQ_TT:
- if (strlen(token_text) > 32)
- { INITAOT(&AO, LONG_CONSTANT_OT);
- AO.marker = STRING_MV;
- AO.value = compile_string(token_text, FALSE, FALSE);
- assemblez_1(print_paddr_zc, AO);
- if (finally_return)
- { get_next_token();
- if ((token_type == SEP_TT)
- && (token_value == SEMICOLON_SEP))
- { assemblez_0(new_line_zc);
- assemblez_0(rtrue_zc);
- return;
- }
- put_token_back();
- }
- break;
- }
- if (finally_return)
- { get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { assemblez_0(print_ret_zc); return;
- }
- put_token_back();
- }
- assemblez_0(print_zc);
- break;
-
- case SEP_TT:
- if (token_value == OPENB_SEP)
- { misc_keywords.enabled = TRUE;
- get_next_token();
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
- { assembly_operand AO1;
-
- put_token_back(); put_token_back();
- local_variables.enabled = FALSE;
- get_next_token();
- misc_keywords.enabled = FALSE;
- local_variables.enabled = TRUE;
-
- if ((token_type == STATEMENT_TT)
- &&(token_value == STRING_CODE))
- { token_type = MISC_KEYWORD_TT;
- token_value = STRING_MK;
- }
-
- switch(token_type)
- {
- case MISC_KEYWORD_TT:
- switch(token_value)
- { case CHAR_MK:
- if (runtime_error_checking_switch)
- { AO = veneer_routine(RT__ChPrintC_VR);
- goto PrintByRoutine;
- }
- get_next_token();
- AO1 = code_generate(
- parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- assemblez_1(print_char_zc, AO1);
- goto PrintTermDone;
- case ADDRESS_MK:
- if (runtime_error_checking_switch)
- { AO = veneer_routine(RT__ChPrintA_VR);
- goto PrintByRoutine;
- }
- get_next_token();
- AO1 = code_generate(
- parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- assemblez_1(print_addr_zc, AO1);
- goto PrintTermDone;
- case STRING_MK:
- if (runtime_error_checking_switch)
- { AO = veneer_routine(RT__ChPrintS_VR);
- goto PrintByRoutine;
- }
- get_next_token();
- AO1 = code_generate(
- parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- assemblez_1(print_paddr_zc, AO1);
- goto PrintTermDone;
- case OBJECT_MK:
- if (runtime_error_checking_switch)
- { AO = veneer_routine(RT__ChPrintO_VR);
- goto PrintByRoutine;
- }
- get_next_token();
- AO1 = code_generate(
- parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- assemblez_1(print_obj_zc, AO1);
- goto PrintTermDone;
- case THE_MK:
- AO = veneer_routine(DefArt_VR);
- goto PrintByRoutine;
- case AN_MK:
- case A_MK:
- AO = veneer_routine(InDefArt_VR);
- goto PrintByRoutine;
- case CAP_THE_MK:
- AO = veneer_routine(CDefArt_VR);
- goto PrintByRoutine;
- case CAP_A_MK:
- AO = veneer_routine(CInDefArt_VR);
- goto PrintByRoutine;
- case NAME_MK:
- AO = veneer_routine(PrintShortName_VR);
- goto PrintByRoutine;
- case NUMBER_MK:
- AO = veneer_routine(EnglishNumber_VR);
- goto PrintByRoutine;
- case PROPERTY_MK:
- AO = veneer_routine(Print__Pname_VR);
- goto PrintByRoutine;
- default:
- error_named("A reserved word was used as a print specification:",
- token_text);
- }
- break;
-
- case SYMBOL_TT:
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { INITAOT(&AO, LONG_CONSTANT_OT);
- AO.value = token_value;
- AO.marker = SYMBOL_MV;
- }
- else
- { INITAOT(&AO, LONG_CONSTANT_OT);
- AO.value = svals[token_value];
- AO.marker = IROUTINE_MV;
- if (stypes[token_value] != ROUTINE_T)
- ebf_error("printing routine name", token_text);
- }
- sflags[token_value] |= USED_SFLAG;
-
- PrintByRoutine:
-
- get_next_token();
- if (version_number >= 5)
- assemblez_2(call_2n_zc, AO,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- else if (version_number == 4)
- assemblez_2_to(call_vs_zc, AO,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1), temp_var1);
- else
- assemblez_2_to(call_zc, AO,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1), temp_var1);
- goto PrintTermDone;
-
- default: ebf_error("print specification", token_text);
- get_next_token();
- assemblez_1(print_num_zc,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- goto PrintTermDone;
- }
- }
- put_token_back(); put_token_back(); put_token_back();
- misc_keywords.enabled = FALSE;
- assemblez_1(print_num_zc,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- break;
- }
-
- default:
- put_token_back(); misc_keywords.enabled = FALSE;
- assemblez_1(print_num_zc,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- break;
- }
-
- PrintTermDone: misc_keywords.enabled = FALSE;
-
- count++;
- 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);
- panic_mode_error_recovery(); return;
- }
- else get_next_token();
- } while(TRUE);
-
- if (count == 0) ebf_error("something to print", token_text);
- if (finally_return)
- { assemblez_0(new_line_zc);
- assemblez_0(rtrue_zc);
- }
-}
-
-static void parse_print_g(int finally_return)
-{ int count = 0; assembly_operand AO, AO2;
-
- /* print <printlist> -------------------------------------------------- */
- /* print_ret <printlist> ---------------------------------------------- */
- /* <literal-string> --------------------------------------------------- */
- /* */
- /* <printlist> is a comma-separated list of items: */
- /* */
- /* <literal-string> */
- /* <other-expression> */
- /* (char) <expression> */
- /* (address) <expression> */
- /* (string) <expression> */
- /* (a) <expression> */
- /* (A) <expression> */
- /* (the) <expression> */
- /* (The) <expression> */
- /* (name) <expression> */
- /* (number) <expression> */
- /* (property) <expression> */
- /* (<routine>) <expression> */
- /* (object) <expression> (for use in low-level code only) */
- /* --------------------------------------------------------------------- */
-
- do
- {
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) break;
- switch(token_type)
- { case DQ_TT:
- /* We can't compile a string into the instruction,
- so this always goes into the string area. */
- { INITAOT(&AO, CONSTANT_OT);
- AO.marker = STRING_MV;
- AO.value = compile_string(token_text, FALSE, FALSE);
- assembleg_1(streamstr_gc, AO);
- if (finally_return)
- { get_next_token();
- if ((token_type == SEP_TT)
- && (token_value == SEMICOLON_SEP))
- { INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
- assembleg_1(streamchar_gc, AO);
- INITAOTV(&AO, BYTECONSTANT_OT, 1);
- assembleg_1(return_gc, AO);
- return;
- }
- put_token_back();
- }
- break;
- }
- break;
-
- case SEP_TT:
- if (token_value == OPENB_SEP)
- { misc_keywords.enabled = TRUE;
- get_next_token();
- 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;
- get_next_token();
- misc_keywords.enabled = FALSE;
- local_variables.enabled = TRUE;
-
- if ((token_type == STATEMENT_TT)
- &&(token_value == STRING_CODE))
- { token_type = MISC_KEYWORD_TT;
- token_value = STRING_MK;
- }
-
- switch(token_type)
- {
- case MISC_KEYWORD_TT:
- switch(token_value)
- { case CHAR_MK:
- if (runtime_error_checking_switch)
- { AO = veneer_routine(RT__ChPrintC_VR);
- goto PrintByRoutine;
- }
- get_next_token();
- 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);
- }
- INITAOTV(&AO2, HALFCONSTANT_OT, 0x100);
- assembleg_2_branch(jgeu_gc, AO1, AO2,
- ln = next_label++);
- ln2 = next_label++;
- assembleg_1(streamchar_gc, AO1);
- assembleg_jump(ln2);
- assemble_label_no(ln);
- assembleg_1(streamunichar_gc, AO1);
- assemble_label_no(ln2);
- goto PrintTermDone;
- case ADDRESS_MK:
- if (runtime_error_checking_switch)
- AO = veneer_routine(RT__ChPrintA_VR);
- else
- AO = veneer_routine(Print__Addr_VR);
- goto PrintByRoutine;
- case STRING_MK:
- if (runtime_error_checking_switch)
- { AO = veneer_routine(RT__ChPrintS_VR);
- goto PrintByRoutine;
- }
- get_next_token();
- AO1 = code_generate(
- parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- assembleg_1(streamstr_gc, AO1);
- goto PrintTermDone;
- case OBJECT_MK:
- if (runtime_error_checking_switch)
- { AO = veneer_routine(RT__ChPrintO_VR);
- goto PrintByRoutine;
- }
- get_next_token();
- AO1 = code_generate(
- parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- INITAOT(&AO2, BYTECONSTANT_OT);
- AO2.value = GOBJFIELD_NAME();
- assembleg_3(aload_gc, AO1, AO2,
- stack_pointer);
- assembleg_1(streamstr_gc, stack_pointer);
- goto PrintTermDone;
- case THE_MK:
- AO = veneer_routine(DefArt_VR);
- goto PrintByRoutine;
- case AN_MK:
- case A_MK:
- AO = veneer_routine(InDefArt_VR);
- goto PrintByRoutine;
- case CAP_THE_MK:
- AO = veneer_routine(CDefArt_VR);
- goto PrintByRoutine;
- case CAP_A_MK:
- AO = veneer_routine(CInDefArt_VR);
- goto PrintByRoutine;
- case NAME_MK:
- AO = veneer_routine(PrintShortName_VR);
- goto PrintByRoutine;
- case NUMBER_MK:
- AO = veneer_routine(EnglishNumber_VR);
- goto PrintByRoutine;
- case PROPERTY_MK:
- AO = veneer_routine(Print__Pname_VR);
- goto PrintByRoutine;
- default:
- error_named("A reserved word was used as a print specification:",
- token_text);
- }
- break;
-
- case SYMBOL_TT:
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { INITAOT(&AO, CONSTANT_OT);
- AO.value = token_value;
- AO.marker = SYMBOL_MV;
- }
- else
- { INITAOT(&AO, CONSTANT_OT);
- AO.value = svals[token_value];
- AO.marker = IROUTINE_MV;
- if (stypes[token_value] != ROUTINE_T)
- ebf_error("printing routine name", token_text);
- }
- sflags[token_value] |= USED_SFLAG;
-
- PrintByRoutine:
-
- get_next_token();
- INITAOT(&AO2, ZEROCONSTANT_OT);
- assembleg_call_1(AO,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1),
- AO2);
- goto PrintTermDone;
-
- default: ebf_error("print specification", token_text);
- get_next_token();
- assembleg_1(streamnum_gc,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- goto PrintTermDone;
- }
- }
- put_token_back(); put_token_back(); put_token_back();
- misc_keywords.enabled = FALSE;
- assembleg_1(streamnum_gc,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- break;
- }
-
- default:
- put_token_back(); misc_keywords.enabled = FALSE;
- assembleg_1(streamnum_gc,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- break;
- }
-
- PrintTermDone: misc_keywords.enabled = FALSE;
-
- count++;
- 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);
- panic_mode_error_recovery(); return;
- }
- else get_next_token();
- } while(TRUE);
-
- if (count == 0) ebf_error("something to print", token_text);
- if (finally_return)
- {
- INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
- assembleg_1(streamchar_gc, AO);
- INITAOTV(&AO, BYTECONSTANT_OT, 1);
- assembleg_1(return_gc, AO);
- }
-}
-
-static void parse_statement_z(int break_label, int continue_label)
-{ int ln, ln2, ln3, ln4, flag;
- assembly_operand AO, AO2, AO3, AO4;
- debug_location spare_debug_location1, spare_debug_location2;
-
- ASSERT_ZCODE();
-
- if ((token_type == SEP_TT) && (token_value == PROPERTY_SEP))
- { /* That is, a full stop, signifying a label */
-
- get_next_token();
- if (token_type == SYMBOL_TT)
- {
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { assign_symbol(token_value, next_label, LABEL_T);
- sflags[token_value] |= USED_SFLAG;
- assemble_label_no(next_label);
- define_symbol_label(token_value);
- next_label++;
- }
- else
- { if (stypes[token_value] != LABEL_T) goto LabelError;
- if (sflags[token_value] & CHANGE_SFLAG)
- { sflags[token_value] &= (~(CHANGE_SFLAG));
- assemble_label_no(svals[token_value]);
- define_symbol_label(token_value);
- }
- else error_named("Duplicate definition of label:", token_text);
- }
-
- get_next_token();
- if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- put_token_back(); return;
- }
-
- /* Interesting point of Inform grammar: a statement can only
- consist solely of a label when it is immediately followed
- by a "}". */
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == CLOSE_BRACE_SEP))
- { put_token_back(); return;
- }
- statement_debug_location = get_token_location();
- parse_statement(break_label, continue_label);
- return;
- }
- LabelError: ebf_error("label name", token_text);
- }
-
- if ((token_type == SEP_TT) && (token_value == HASH_SEP))
- { parse_directive(TRUE);
- parse_statement(break_label, continue_label); return;
- }
-
- if ((token_type == SEP_TT) && (token_value == AT_SEP))
- { parse_assembly(); return;
- }
-
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
-
- if (token_type == DQ_TT)
- { parse_print_z(TRUE); return;
- }
-
- if ((token_type == SEP_TT) && (token_value == LESS_SEP))
- { parse_action(); goto StatementTerminator; }
-
- if (token_type == EOF_TT)
- { ebf_error("statement", token_text); return; }
-
- if (token_type != STATEMENT_TT)
- { put_token_back();
- AO = parse_expression(VOID_CONTEXT);
- code_generate(AO, VOID_CONTEXT, -1);
- if (vivc_flag) { panic_mode_error_recovery(); return; }
- goto StatementTerminator;
- }
-
- statements.enabled = FALSE;
-
- switch(token_value)
- {
- /* -------------------------------------------------------------------- */
- /* box <string-1> ... <string-n> -------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case BOX_CODE:
- if (version_number == 3)
- warning("The 'box' statement has no effect in a version 3 game");
- INITAOT(&AO3, LONG_CONSTANT_OT);
- AO3.value = begin_table_array();
- AO3.marker = ARRAY_MV;
- ln = 0; ln2 = 0;
- do
- { get_next_token();
- 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);
- { int i, j;
- for (i=0, j=0; token_text[i] != 0; j++)
- if (token_text[i] == '@')
- { if (token_text[i+1] == '@')
- { i = i + 2;
- while (isdigit(token_text[i])) i++;
- }
- else
- { i++;
- if (token_text[i] != 0) i++;
- if (token_text[i] != 0) i++;
- }
- }
- else i++;
- if (j > ln2) ln2 = j;
- }
- put_token_back();
- array_entry(ln++,parse_expression(CONSTANT_CONTEXT));
- } while (TRUE);
- finish_array(ln);
- if (ln == 0)
- error("No lines of text given for 'box' display");
-
- if (version_number == 3) return;
-
- INITAOTV(&AO2, SHORT_CONSTANT_OT, ln2);
- INITAOTV(&AO4, VARIABLE_OT, 255);
- assemblez_3_to(call_vs_zc, veneer_routine(Box__Routine_VR),
- AO2, AO3, AO4);
- return;
-
- /* -------------------------------------------------------------------- */
- /* break -------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case BREAK_CODE:
- if (break_label == -1)
- error("'break' can only be used in a loop or 'switch' block");
- else
- assemblez_jump(break_label);
- break;
-
- /* -------------------------------------------------------------------- */
- /* continue ----------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case CONTINUE_CODE:
- if (continue_label == -1)
- error("'continue' can only be used in a loop block");
- else
- assemblez_jump(continue_label);
- break;
-
- /* -------------------------------------------------------------------- */
- /* do <codeblock> until (<condition>) --------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case DO_CODE:
- assemble_label_no(ln = next_label++);
- ln2 = next_label++; ln3 = next_label++;
- parse_code_block(ln3, ln2, 0);
- statements.enabled = TRUE;
- get_next_token();
- if ((token_type == STATEMENT_TT)
- && (token_value == UNTIL_CODE))
- { assemble_label_no(ln2);
- match_open_bracket();
- AO = parse_expression(CONDITION_CONTEXT);
- match_close_bracket();
- code_generate(AO, CONDITION_CONTEXT, ln);
- }
- else error("'do' without matching 'until'");
-
- assemble_label_no(ln3);
- break;
-
- /* -------------------------------------------------------------------- */
- /* font on/off -------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case FONT_CODE:
- misc_keywords.enabled = TRUE;
- get_next_token();
- misc_keywords.enabled = FALSE;
- if ((token_type != MISC_KEYWORD_TT)
- || ((token_value != ON_MK)
- && (token_value != OFF_MK)))
- { ebf_error("'on' or 'off'", token_text);
- panic_mode_error_recovery();
- break;
- }
-
- if (version_number >= 5)
- { /* Use the V5 @set_font opcode, setting font 4
- (for font off) or 1 (for font on). */
- INITAOT(&AO, SHORT_CONSTANT_OT);
- if (token_value == ON_MK)
- AO.value = 1;
- else
- AO.value = 4;
- assemblez_1_to(set_font_zc, AO, temp_var1);
- break;
- }
-
- /* Set the fixed-pitch header bit. */
- INITAOTV(&AO, SHORT_CONSTANT_OT, 0);
- INITAOTV(&AO2, SHORT_CONSTANT_OT, 8);
- INITAOTV(&AO3, VARIABLE_OT, 255);
- assemblez_2_to(loadw_zc, AO, AO2, AO3);
-
- if (token_value == ON_MK)
- { INITAOTV(&AO4, LONG_CONSTANT_OT, 0xfffd);
- assemblez_2_to(and_zc, AO4, AO3, AO3);
- }
- else
- { INITAOTV(&AO4, SHORT_CONSTANT_OT, 2);
- assemblez_2_to(or_zc, AO4, AO3, AO3);
- }
-
- assemblez_3(storew_zc, AO, AO2, AO3);
- break;
-
- /* -------------------------------------------------------------------- */
- /* for (<initialisation> : <continue-condition> : <updating>) --------- */
- /* -------------------------------------------------------------------- */
-
- /* Note that it's legal for any or all of the three sections of a
- 'for' specification to be empty. This 'for' implementation
- often wastes 3 bytes with a redundant branch rather than keep
- expression parse trees for long periods (as previous versions
- of Inform did, somewhat crudely by simply storing the textual
- form of a 'for' loop). It is adequate for now. */
-
- case FOR_CODE:
- match_open_bracket();
- get_next_token();
-
- /* Initialisation code */
-
- if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
- { put_token_back();
- if (!((token_type==SEP_TT)&&(token_value==SUPERCLASS_SEP)))
- { sequence_point_follows = TRUE;
- statement_debug_location = get_token_location();
- code_generate(parse_expression(FORINIT_CONTEXT),
- VOID_CONTEXT, -1);
- }
- get_next_token();
- if ((token_type==SEP_TT)&&(token_value == SUPERCLASS_SEP))
- { get_next_token();
- if ((token_type==SEP_TT)&&(token_value == CLOSEB_SEP))
- { assemble_label_no(ln = next_label++);
- ln2 = next_label++;
- parse_code_block(ln2, ln, 0);
- sequence_point_follows = FALSE;
- if (!execution_never_reaches_here)
- assemblez_jump(ln);
- assemble_label_no(ln2);
- return;
- }
- AO.type = OMITTED_OT;
- goto ParseUpdate;
- }
- put_token_back();
- if (!match_colon()) break;
- }
-
- get_next_token();
- AO.type = OMITTED_OT;
- if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
- { put_token_back();
- spare_debug_location1 = get_token_location();
- AO = parse_expression(CONDITION_CONTEXT);
- if (!match_colon()) break;
- }
- get_next_token();
-
- ParseUpdate:
- AO2.type = OMITTED_OT; flag = 0;
- if (!((token_type==SEP_TT)&&(token_value==CLOSEB_SEP)))
- { put_token_back();
- spare_debug_location2 = get_token_location();
- AO2 = parse_expression(VOID_CONTEXT);
- match_close_bracket();
- flag = test_for_incdec(AO2);
- }
-
- ln = next_label++;
- ln2 = next_label++;
- ln3 = next_label++;
-
- if ((AO2.type == OMITTED_OT) || (flag != 0))
- {
- assemble_label_no(ln);
- if (flag==0) assemble_label_no(ln2);
-
- /* The "finished yet?" condition */
-
- if (AO.type != OMITTED_OT)
- { sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location1;
- code_generate(AO, CONDITION_CONTEXT, ln3);
- }
-
- }
- else
- {
- /* This is the jump which could be avoided with the aid
- of long-term expression storage */
-
- sequence_point_follows = FALSE;
- assemblez_jump(ln2);
-
- /* The "update" part */
-
- assemble_label_no(ln);
- sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location2;
- code_generate(AO2, VOID_CONTEXT, -1);
-
- assemble_label_no(ln2);
-
- /* The "finished yet?" condition */
-
- if (AO.type != OMITTED_OT)
- { sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location1;
- code_generate(AO, CONDITION_CONTEXT, ln3);
- }
- }
-
- if (flag != 0)
- {
- /* In this optimised case, update code is at the end
- of the loop block, so "continue" goes there */
-
- parse_code_block(ln3, ln2, 0);
- assemble_label_no(ln2);
-
- sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location2;
- if (flag > 0)
- { INITAOTV(&AO3, SHORT_CONSTANT_OT, flag);
- if (module_switch
- && (flag>=MAX_LOCAL_VARIABLES) && (flag<LOWEST_SYSTEM_VAR_NUMBER))
- AO3.marker = VARIABLE_MV;
- assemblez_1(inc_zc, AO3);
- }
- else
- { INITAOTV(&AO3, SHORT_CONSTANT_OT, -flag);
- if ((module_switch) && (flag>=MAX_LOCAL_VARIABLES)
- && (flag<LOWEST_SYSTEM_VAR_NUMBER))
- AO3.marker = VARIABLE_MV;
- assemblez_1(dec_zc, AO3);
- }
- assemblez_jump(ln);
- }
- else
- {
- /* In the unoptimised case, update code is at the
- start of the loop block, so "continue" goes there */
-
- parse_code_block(ln3, ln, 0);
- if (!execution_never_reaches_here)
- { sequence_point_follows = FALSE;
- assemblez_jump(ln);
- }
- }
-
- assemble_label_no(ln3);
- return;
-
- /* -------------------------------------------------------------------- */
- /* give <expression> [~]attr [, [~]attr [, ...]] ---------------------- */
- /* -------------------------------------------------------------------- */
-
- case GIVE_CODE:
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- if ((AO.type == VARIABLE_OT) && (AO.value == 0))
- { INITAOTV(&AO, SHORT_CONSTANT_OT, 252);
- if (version_number != 6) assemblez_1(pull_zc, AO);
- else assemblez_0_to(pull_zc, AO);
- AO.type = VARIABLE_OT;
- }
-
- do
- { get_next_token();
- if ((token_type == SEP_TT)&&(token_value == SEMICOLON_SEP))
- return;
- if ((token_type == SEP_TT)&&(token_value == ARTNOT_SEP))
- ln = clear_attr_zc;
- else
- { if ((token_type == SYMBOL_TT)
- && (stypes[token_value] != ATTRIBUTE_T))
- warning_named("This is not a declared Attribute:",
- token_text);
- ln = set_attr_zc;
- put_token_back();
- }
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- if (runtime_error_checking_switch)
- { ln2 = (ln==set_attr_zc)?RT__ChG_VR:RT__ChGt_VR;
- if (version_number >= 5)
- assemblez_3(call_vn_zc, veneer_routine(ln2),
- AO, AO2);
- else
- {
- assemblez_3_to(call_zc, veneer_routine(ln2),
- AO, AO2, temp_var1);
- }
- }
- else
- assemblez_2(ln, AO, AO2);
- } while(TRUE);
-
- /* -------------------------------------------------------------------- */
- /* if (<condition>) <codeblock> [else <codeblock>] -------------------- */
- /* -------------------------------------------------------------------- */
-
- case IF_CODE:
- flag = FALSE;
- ln2 = 0;
-
- match_open_bracket();
- AO = parse_expression(CONDITION_CONTEXT);
- match_close_bracket();
-
- statements.enabled = TRUE;
- get_next_token();
- if ((token_type == STATEMENT_TT)&&(token_value == RTRUE_CODE))
- ln = -4;
- else
- if ((token_type == STATEMENT_TT)&&(token_value == RFALSE_CODE))
- ln = -3;
- else
- { put_token_back();
- ln = next_label++;
- }
-
- code_generate(AO, CONDITION_CONTEXT, ln);
-
- if (ln >= 0) parse_code_block(break_label, continue_label, 0);
- else
- { get_next_token();
- if ((token_type != SEP_TT)
- || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- put_token_back();
- }
- }
-
- statements.enabled = TRUE;
- get_next_token();
- if ((token_type == STATEMENT_TT) && (token_value == ELSE_CODE))
- { flag = TRUE;
- if (ln >= 0)
- { ln2 = next_label++;
- if (!execution_never_reaches_here)
- { sequence_point_follows = FALSE;
- assemblez_jump(ln2);
- }
- }
- }
- else put_token_back();
-
- if (ln >= 0) assemble_label_no(ln);
-
- if (flag)
- { parse_code_block(break_label, continue_label, 0);
- if (ln >= 0) assemble_label_no(ln2);
- }
-
- return;
-
- /* -------------------------------------------------------------------- */
- /* inversion ---------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case INVERSION_CODE:
- INITAOTV(&AO, SHORT_CONSTANT_OT, 0);
- INITAOT(&AO2, SHORT_CONSTANT_OT);
-
- AO2.value = 60;
- assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
- assemblez_1(print_char_zc, temp_var1);
- AO2.value = 61;
- assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
- assemblez_1(print_char_zc, temp_var1);
- AO2.value = 62;
- assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
- assemblez_1(print_char_zc, temp_var1);
- AO2.value = 63;
- assemblez_2_to(loadb_zc, AO, AO2, temp_var1);
- assemblez_1(print_char_zc, temp_var1);
- break;
-
- /* -------------------------------------------------------------------- */
- /* jump <label> ------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case JUMP_CODE:
- assemblez_jump(parse_label());
- break;
-
- /* -------------------------------------------------------------------- */
- /* move <expression> to <expression> ---------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case MOVE_CODE:
- misc_keywords.enabled = TRUE;
- AO = parse_expression(QUANTITY_CONTEXT);
-
- get_next_token();
- misc_keywords.enabled = FALSE;
- if ((token_type != MISC_KEYWORD_TT)
- || (token_value != TO_MK))
- { ebf_error("'to'", token_text);
- panic_mode_error_recovery();
- return;
- }
-
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- AO = code_generate(AO, QUANTITY_CONTEXT, -1);
- if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
- { if (version_number >= 5)
- assemblez_3(call_vn_zc, veneer_routine(RT__ChT_VR),
- AO, AO2);
- else
- { assemblez_3_to(call_zc, veneer_routine(RT__ChT_VR),
- AO, AO2, temp_var1);
- }
- }
- else
- assemblez_2(insert_obj_zc, AO, AO2);
- break;
-
- /* -------------------------------------------------------------------- */
- /* new_line ----------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case NEW_LINE_CODE: assemblez_0(new_line_zc); break;
-
- /* -------------------------------------------------------------------- */
- /* objectloop (<initialisation>) <codeblock> -------------------------- */
- /* -------------------------------------------------------------------- */
-
- case OBJECTLOOP_CODE:
-
- match_open_bracket();
- get_next_token();
- INITAOT(&AO, VARIABLE_OT);
- if (token_type == LOCAL_VARIABLE_TT)
- AO.value = token_value;
- else
- if ((token_type == SYMBOL_TT) &&
- (stypes[token_value] == GLOBAL_VARIABLE_T))
- AO.value = svals[token_value];
- else
- { ebf_error("'objectloop' variable", token_text);
- panic_mode_error_recovery(); break;
- }
- if ((module_switch) && (AO.value >= MAX_LOCAL_VARIABLES)
- && (AO.value < LOWEST_SYSTEM_VAR_NUMBER))
- AO.marker = VARIABLE_MV;
- misc_keywords.enabled = TRUE;
- get_next_token(); flag = TRUE;
- misc_keywords.enabled = FALSE;
- if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
- flag = FALSE;
-
- ln = 0;
- if ((token_type == MISC_KEYWORD_TT)
- && (token_value == NEAR_MK)) ln = 1;
- if ((token_type == MISC_KEYWORD_TT)
- && (token_value == FROM_MK)) ln = 2;
- if ((token_type == CND_TT) && (token_value == IN_COND))
- { get_next_token();
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
- ln = 3;
- put_token_back();
- put_token_back();
- }
-
- if (ln > 0)
- { /* Old style (Inform 5) objectloops: note that we
- implement objectloop (a in b) in the old way since
- this runs through objects in a different order from
- the new way, and there may be existing Inform code
- relying on this. */
- assembly_operand AO4;
- INITAO(&AO4);
-
- sequence_point_follows = TRUE;
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- match_close_bracket();
- if (ln == 1)
- { INITAOTV(&AO3, VARIABLE_OT, 0);
- if (runtime_error_checking_switch)
- AO2 = check_nonzero_at_runtime(AO2, -1,
- OBJECTLOOP_RTE);
- assemblez_1_to(get_parent_zc, AO2, AO3);
- assemblez_objcode(get_child_zc, AO3, AO3, -2, TRUE);
- AO2 = AO3;
- }
- if (ln == 3)
- { INITAOTV(&AO3, VARIABLE_OT, 0);
- if (runtime_error_checking_switch)
- { AO4 = AO2;
- AO2 = check_nonzero_at_runtime(AO2, -1,
- CHILD_RTE);
- }
- assemblez_objcode(get_child_zc, AO2, AO3, -2, TRUE);
- AO2 = AO3;
- }
- assemblez_store(AO, AO2);
- assemblez_1_branch(jz_zc, AO, ln2 = next_label++, TRUE);
- assemble_label_no(ln4 = next_label++);
- parse_code_block(ln2, ln3 = next_label++, 0);
- sequence_point_follows = FALSE;
- assemble_label_no(ln3);
- if (runtime_error_checking_switch)
- { AO2 = check_nonzero_at_runtime(AO, ln2,
- OBJECTLOOP2_RTE);
- if ((ln == 3)
- && ((AO4.type != VARIABLE_OT)||(AO4.value != 0))
- && ((AO4.type != VARIABLE_OT)
- ||(AO4.value != AO.value)))
- { assembly_operand en_ao;
- INITAOTV(&en_ao, SHORT_CONSTANT_OT, OBJECTLOOP_BROKEN_RTE);
- assemblez_2_branch(jin_zc, AO, AO4,
- next_label, TRUE);
- assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR),
- en_ao, AO);
- assemblez_jump(ln2);
- assemble_label_no(next_label++);
- }
- }
- else AO2 = AO;
- assemblez_objcode(get_sibling_zc, AO2, AO, ln4, TRUE);
- assemble_label_no(ln2);
- return;
- }
-
- sequence_point_follows = TRUE;
- INITAOTV(&AO2, SHORT_CONSTANT_OT, 1);
- assemblez_store(AO, AO2);
-
- assemble_label_no(ln = next_label++);
- ln2 = next_label++;
- ln3 = next_label++;
- if (flag)
- { put_token_back();
- put_token_back();
- sequence_point_follows = TRUE;
- code_generate(parse_expression(CONDITION_CONTEXT),
- CONDITION_CONTEXT, ln3);
- match_close_bracket();
- }
- parse_code_block(ln2, ln3, 0);
-
- sequence_point_follows = FALSE;
- assemble_label_no(ln3);
- assemblez_inc(AO);
- INITAOTV(&AO2, LONG_CONSTANT_OT, no_objects);
- AO2.marker = NO_OBJS_MV;
- assemblez_2_branch(jg_zc, AO, AO2, ln2, TRUE);
- assemblez_jump(ln);
- assemble_label_no(ln2);
- return;
-
- /* -------------------------------------------------------------------- */
- /* (see routine above) ------------------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case PRINT_CODE:
- get_next_token();
- parse_print_z(FALSE); return;
- case PRINT_RET_CODE:
- get_next_token();
- parse_print_z(TRUE); return;
-
- /* -------------------------------------------------------------------- */
- /* quit --------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case QUIT_CODE: assemblez_0(quit_zc); break;
-
- /* -------------------------------------------------------------------- */
- /* read <expression> <expression> [<Routine>] ------------------------- */
- /* -------------------------------------------------------------------- */
-
- case READ_CODE:
- INITAOTV(&AO, VARIABLE_OT, 252);
- assemblez_store(AO,
- code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1));
- if (version_number > 3)
- { INITAOTV(&AO3, SHORT_CONSTANT_OT, 1);
- INITAOTV(&AO4, SHORT_CONSTANT_OT, 0);
- assemblez_3(storeb_zc, AO, AO3, AO4);
- }
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- put_token_back();
- else
- { if (version_number == 3)
- error(
-"In Version 3 no status-line drawing routine can be given");
- else
- { assembly_operand AO5;
- /* Move the temp4 (buffer) value to the stack,
- since the routine might alter temp4. */
- assemblez_store(stack_pointer, AO);
- AO = stack_pointer;
- put_token_back();
- AO5 = parse_expression(CONSTANT_CONTEXT);
-
- if (version_number >= 5)
- assemblez_1(call_1n_zc, AO5);
- else
- assemblez_1_to(call_zc, AO5, temp_var1);
- }
- }
-
- if (version_number > 4)
- { assemblez_2_to(aread_zc, AO, AO2, temp_var1);
- }
- else assemblez_2(sread_zc, AO, AO2);
- break;
-
- /* -------------------------------------------------------------------- */
- /* remove <expression> ------------------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case REMOVE_CODE:
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
- { if (version_number >= 5)
- assemblez_2(call_2n_zc, veneer_routine(RT__ChR_VR),
- AO);
- else
- { assemblez_2_to(call_zc, veneer_routine(RT__ChR_VR),
- AO, temp_var1);
- }
- }
- else
- assemblez_1(remove_obj_zc, AO);
- break;
-
- /* -------------------------------------------------------------------- */
- /* restore <label> ---------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case RESTORE_CODE:
- if (version_number < 5)
- assemblez_0_branch(restore_zc, parse_label(), TRUE);
- else
- { INITAOTV(&AO2, SHORT_CONSTANT_OT, 2);
- assemblez_0_to(restore_zc, temp_var1);
- assemblez_2_branch(je_zc, temp_var1, AO2, parse_label(), TRUE);
- }
- break;
-
- /* -------------------------------------------------------------------- */
- /* return [<expression>] ---------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case RETURN_CODE:
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { assemblez_0(rtrue_zc); return; }
- put_token_back();
- AO = code_generate(parse_expression(RETURN_Q_CONTEXT),
- QUANTITY_CONTEXT, -1);
- if ((AO.type == SHORT_CONSTANT_OT) && (AO.value == 0)
- && (AO.marker == 0))
- { assemblez_0(rfalse_zc); break; }
- if ((AO.type == SHORT_CONSTANT_OT) && (AO.value == 1)
- && (AO.marker == 0))
- { assemblez_0(rtrue_zc); break; }
- if ((AO.type == VARIABLE_OT) && (AO.value == 0))
- { assemblez_0(ret_popped_zc); break; }
- assemblez_1(ret_zc, AO);
- break;
-
- /* -------------------------------------------------------------------- */
- /* rfalse ------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case RFALSE_CODE: assemblez_0(rfalse_zc); break;
-
- /* -------------------------------------------------------------------- */
- /* rtrue -------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case RTRUE_CODE: assemblez_0(rtrue_zc); break;
-
- /* -------------------------------------------------------------------- */
- /* save <label> ------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case SAVE_CODE:
- if (version_number < 5)
- assemblez_0_branch(save_zc, parse_label(), TRUE);
- else
- { INITAOTV(&AO, VARIABLE_OT, 255);
- assemblez_0_to(save_zc, AO);
- assemblez_1_branch(jz_zc, AO, parse_label(), FALSE);
- }
- break;
-
- /* -------------------------------------------------------------------- */
- /* spaces <expression> ------------------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case SPACES_CODE:
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- INITAOTV(&AO2, VARIABLE_OT, 255);
-
- assemblez_store(AO2, AO);
-
- INITAOTV(&AO, SHORT_CONSTANT_OT, 32);
- INITAOTV(&AO3, SHORT_CONSTANT_OT, 1);
-
- assemblez_2_branch(jl_zc, AO2, AO3, ln = next_label++, TRUE);
- assemble_label_no(ln2 = next_label++);
- assemblez_1(print_char_zc, AO);
- assemblez_dec(AO2);
- assemblez_1_branch(jz_zc, AO2, ln2, FALSE);
- assemble_label_no(ln);
- break;
-
- /* -------------------------------------------------------------------- */
- /* string <expression> <literal-string> ------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case STRING_CODE:
- INITAOTV(&AO, SHORT_CONSTANT_OT, 0);
- INITAOTV(&AO2, SHORT_CONSTANT_OT, 12);
- INITAOTV(&AO3, VARIABLE_OT, 252);
- assemblez_2_to(loadw_zc, AO, AO2, AO3);
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- get_next_token();
- if (token_type == DQ_TT)
- { INITAOT(&AO4, LONG_CONSTANT_OT);
- AO4.value = compile_string(token_text, TRUE, TRUE);
- }
- else
- { put_token_back();
- AO4 = parse_expression(CONSTANT_CONTEXT);
- }
- assemblez_3(storew_zc, AO3, AO2, AO4);
- break;
-
- /* -------------------------------------------------------------------- */
- /* style roman/reverse/bold/underline/fixed --------------------------- */
- /* -------------------------------------------------------------------- */
-
- case STYLE_CODE:
- if (version_number==3)
- { error(
-"The 'style' statement cannot be used for Version 3 games");
- panic_mode_error_recovery();
- break;
- }
-
- misc_keywords.enabled = TRUE;
- get_next_token();
- misc_keywords.enabled = FALSE;
- if ((token_type != MISC_KEYWORD_TT)
- || ((token_value != ROMAN_MK)
- && (token_value != REVERSE_MK)
- && (token_value != BOLD_MK)
- && (token_value != UNDERLINE_MK)
- && (token_value != FIXED_MK)))
- { ebf_error(
-"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
- token_text);
- panic_mode_error_recovery();
- break;
- }
-
- INITAOT(&AO, SHORT_CONSTANT_OT);
- switch(token_value)
- { case ROMAN_MK: AO.value = 0; break;
- case REVERSE_MK: AO.value = 1; break;
- case BOLD_MK: AO.value = 2; break;
- case UNDERLINE_MK: AO.value = 4; break;
- case FIXED_MK: AO.value = 8; break;
- }
- assemblez_1(set_text_style_zc, AO); break;
-
- /* -------------------------------------------------------------------- */
- /* switch (<expression>) <codeblock> ---------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case SWITCH_CODE:
- match_open_bracket();
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- match_close_bracket();
-
- INITAOTV(&AO2, VARIABLE_OT, 255);
- assemblez_store(AO2, AO);
-
- parse_code_block(ln = next_label++, continue_label, 1);
- assemble_label_no(ln);
- return;
-
- /* -------------------------------------------------------------------- */
- /* while (<condition>) <codeblock> ------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case WHILE_CODE:
- assemble_label_no(ln = next_label++);
- match_open_bracket();
-
- code_generate(parse_expression(CONDITION_CONTEXT),
- CONDITION_CONTEXT, ln2 = next_label++);
- match_close_bracket();
-
- parse_code_block(ln2, ln, 0);
- sequence_point_follows = FALSE;
- assemblez_jump(ln);
- assemble_label_no(ln2);
- return;
-
- /* -------------------------------------------------------------------- */
-
- case SDEFAULT_CODE:
- error("'default' without matching 'switch'"); break;
- case ELSE_CODE:
- error("'else' without matching 'if'"); break;
- case UNTIL_CODE:
- error("'until' without matching 'do'");
- panic_mode_error_recovery(); return;
- }
-
- StatementTerminator:
-
- get_next_token();
- if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- put_token_back();
- }
-}
-
-static void parse_statement_g(int break_label, int continue_label)
-{ int ln, ln2, ln3, ln4, flag, onstack;
- assembly_operand AO, AO2, AO3, AO4;
- debug_location spare_debug_location1, spare_debug_location2;
-
- ASSERT_GLULX();
-
- if ((token_type == SEP_TT) && (token_value == PROPERTY_SEP))
- { /* That is, a full stop, signifying a label */
-
- get_next_token();
- if (token_type == SYMBOL_TT)
- {
- if (sflags[token_value] & UNKNOWN_SFLAG)
- { assign_symbol(token_value, next_label, LABEL_T);
- sflags[token_value] |= USED_SFLAG;
- assemble_label_no(next_label);
- define_symbol_label(token_value);
- next_label++;
- }
- else
- { if (stypes[token_value] != LABEL_T) goto LabelError;
- if (sflags[token_value] & CHANGE_SFLAG)
- { sflags[token_value] &= (~(CHANGE_SFLAG));
- assemble_label_no(svals[token_value]);
- define_symbol_label(token_value);
- }
- else error_named("Duplicate definition of label:", token_text);
- }
-
- get_next_token();
- if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- put_token_back(); return;
- }
-
- /* Interesting point of Inform grammar: a statement can only
- consist solely of a label when it is immediately followed
- by a "}". */
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == CLOSE_BRACE_SEP))
- { put_token_back(); return;
- }
- /* The following line prevents labels from influencing the positions
- of sequence points. */
- statement_debug_location = get_token_location();
- parse_statement(break_label, continue_label);
- return;
- }
- LabelError: ebf_error("label name", token_text);
- }
-
- if ((token_type == SEP_TT) && (token_value == HASH_SEP))
- { parse_directive(TRUE);
- parse_statement(break_label, continue_label); return;
- }
-
- if ((token_type == SEP_TT) && (token_value == AT_SEP))
- { parse_assembly(); return;
- }
-
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) return;
-
- if (token_type == DQ_TT)
- { parse_print_g(TRUE); return;
- }
-
- if ((token_type == SEP_TT) && (token_value == LESS_SEP))
- { parse_action(); goto StatementTerminator; }
-
- if (token_type == EOF_TT)
- { ebf_error("statement", token_text); return; }
-
- if (token_type != STATEMENT_TT)
- { put_token_back();
- AO = parse_expression(VOID_CONTEXT);
- code_generate(AO, VOID_CONTEXT, -1);
- if (vivc_flag) { panic_mode_error_recovery(); return; }
- goto StatementTerminator;
- }
-
- statements.enabled = FALSE;
-
- switch(token_value)
- {
-
- /* -------------------------------------------------------------------- */
- /* box <string-1> ... <string-n> -------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case BOX_CODE:
- INITAOT(&AO3, CONSTANT_OT);
- AO3.value = begin_table_array();
- AO3.marker = ARRAY_MV;
- ln = 0; ln2 = 0;
- do
- { get_next_token();
- 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);
- { int i, j;
- for (i=0, j=0; token_text[i] != 0; j++)
- if (token_text[i] == '@')
- { if (token_text[i+1] == '@')
- { i = i + 2;
- while (isdigit(token_text[i])) i++;
- }
- else
- { i++;
- if (token_text[i] != 0) i++;
- if (token_text[i] != 0) i++;
- }
- }
- else i++;
- if (j > ln2) ln2 = j;
- }
- put_token_back();
- array_entry(ln++,parse_expression(CONSTANT_CONTEXT));
- } while (TRUE);
- finish_array(ln);
- if (ln == 0)
- error("No lines of text given for 'box' display");
-
- INITAO(&AO2);
- AO2.value = ln2; set_constant_ot(&AO2);
- assembleg_call_2(veneer_routine(Box__Routine_VR),
- AO2, AO3, zero_operand);
- return;
-
- /* -------------------------------------------------------------------- */
- /* break -------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case BREAK_CODE:
- if (break_label == -1)
- error("'break' can only be used in a loop or 'switch' block");
- else
- assembleg_jump(break_label);
- break;
-
- /* -------------------------------------------------------------------- */
- /* continue ----------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case CONTINUE_CODE:
- if (continue_label == -1)
- error("'continue' can only be used in a loop block");
- else
- assembleg_jump(continue_label);
- break;
-
- /* -------------------------------------------------------------------- */
- /* do <codeblock> until (<condition>) --------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case DO_CODE:
- assemble_label_no(ln = next_label++);
- ln2 = next_label++; ln3 = next_label++;
- parse_code_block(ln3, ln2, 0);
- statements.enabled = TRUE;
- get_next_token();
- if ((token_type == STATEMENT_TT)
- && (token_value == UNTIL_CODE))
- { assemble_label_no(ln2);
- match_open_bracket();
- AO = parse_expression(CONDITION_CONTEXT);
- match_close_bracket();
- code_generate(AO, CONDITION_CONTEXT, ln);
- }
- else error("'do' without matching 'until'");
-
- assemble_label_no(ln3);
- break;
-
- /* -------------------------------------------------------------------- */
- /* font on/off -------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case FONT_CODE:
- misc_keywords.enabled = TRUE;
- get_next_token();
- misc_keywords.enabled = FALSE;
- if ((token_type != MISC_KEYWORD_TT)
- || ((token_value != ON_MK)
- && (token_value != OFF_MK)))
- { ebf_error("'on' or 'off'", token_text);
- panic_mode_error_recovery();
- break;
- }
-
- /* Call glk_set_style(normal or preformatted) */
- INITAO(&AO);
- AO.value = 0x0086;
- set_constant_ot(&AO);
- if (token_value == ON_MK)
- AO2 = zero_operand;
- else
- AO2 = two_operand;
- assembleg_call_2(veneer_routine(Glk__Wrap_VR),
- AO, AO2, zero_operand);
- break;
-
- /* -------------------------------------------------------------------- */
- /* for (<initialisation> : <continue-condition> : <updating>) --------- */
- /* -------------------------------------------------------------------- */
-
- /* Note that it's legal for any or all of the three sections of a
- 'for' specification to be empty. This 'for' implementation
- often wastes 3 bytes with a redundant branch rather than keep
- expression parse trees for long periods (as previous versions
- of Inform did, somewhat crudely by simply storing the textual
- form of a 'for' loop). It is adequate for now. */
-
- case FOR_CODE:
- match_open_bracket();
- get_next_token();
-
- /* Initialisation code */
-
- if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
- { put_token_back();
- if (!((token_type==SEP_TT)&&(token_value==SUPERCLASS_SEP)))
- { sequence_point_follows = TRUE;
- statement_debug_location = get_token_location();
- code_generate(parse_expression(FORINIT_CONTEXT),
- VOID_CONTEXT, -1);
- }
- get_next_token();
- if ((token_type==SEP_TT)&&(token_value == SUPERCLASS_SEP))
- { get_next_token();
- if ((token_type==SEP_TT)&&(token_value == CLOSEB_SEP))
- { assemble_label_no(ln = next_label++);
- ln2 = next_label++;
- parse_code_block(ln2, ln, 0);
- sequence_point_follows = FALSE;
- if (!execution_never_reaches_here)
- assembleg_jump(ln);
- assemble_label_no(ln2);
- return;
- }
- AO.type = OMITTED_OT;
- goto ParseUpdate;
- }
- put_token_back();
- if (!match_colon()) break;
- }
-
- get_next_token();
- AO.type = OMITTED_OT;
- if (!((token_type==SEP_TT)&&(token_value==COLON_SEP)))
- { put_token_back();
- spare_debug_location1 = get_token_location();
- AO = parse_expression(CONDITION_CONTEXT);
- if (!match_colon()) break;
- }
- get_next_token();
-
- ParseUpdate:
- AO2.type = OMITTED_OT; flag = 0;
- if (!((token_type==SEP_TT)&&(token_value==CLOSEB_SEP)))
- { put_token_back();
- spare_debug_location2 = get_token_location();
- AO2 = parse_expression(VOID_CONTEXT);
- match_close_bracket();
- flag = test_for_incdec(AO2);
- }
-
- ln = next_label++;
- ln2 = next_label++;
- ln3 = next_label++;
-
- if ((AO2.type == OMITTED_OT) || (flag != 0))
- {
- assemble_label_no(ln);
- if (flag==0) assemble_label_no(ln2);
-
- /* The "finished yet?" condition */
-
- if (AO.type != OMITTED_OT)
- { sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location1;
- code_generate(AO, CONDITION_CONTEXT, ln3);
- }
-
- }
- else
- {
- /* This is the jump which could be avoided with the aid
- of long-term expression storage */
-
- sequence_point_follows = FALSE;
- assembleg_jump(ln2);
-
- /* The "update" part */
-
- assemble_label_no(ln);
- sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location2;
- code_generate(AO2, VOID_CONTEXT, -1);
-
- assemble_label_no(ln2);
-
- /* The "finished yet?" condition */
-
- if (AO.type != OMITTED_OT)
- { sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location1;
- code_generate(AO, CONDITION_CONTEXT, ln3);
- }
- }
-
- if (flag != 0)
- {
- /* In this optimised case, update code is at the end
- of the loop block, so "continue" goes there */
-
- parse_code_block(ln3, ln2, 0);
- assemble_label_no(ln2);
-
- sequence_point_follows = TRUE;
- statement_debug_location = spare_debug_location2;
- if (flag > 0)
- { INITAO(&AO3);
- AO3.value = flag;
- if (AO3.value >= MAX_LOCAL_VARIABLES)
- AO3.type = GLOBALVAR_OT;
- else
- AO3.type = LOCALVAR_OT;
- assembleg_3(add_gc, AO3, one_operand, AO3);
- }
- else
- { INITAO(&AO3);
- AO3.value = -flag;
- if (AO3.value >= MAX_LOCAL_VARIABLES)
- AO3.type = GLOBALVAR_OT;
- else
- AO3.type = LOCALVAR_OT;
- assembleg_3(sub_gc, AO3, one_operand, AO3);
- }
- assembleg_jump(ln);
- }
- else
- {
- /* In the unoptimised case, update code is at the
- start of the loop block, so "continue" goes there */
-
- parse_code_block(ln3, ln, 0);
- if (!execution_never_reaches_here)
- { sequence_point_follows = FALSE;
- assembleg_jump(ln);
- }
- }
-
- assemble_label_no(ln3);
- return;
-
- /* -------------------------------------------------------------------- */
- /* give <expression> [~]attr [, [~]attr [, ...]] ---------------------- */
- /* -------------------------------------------------------------------- */
-
- case GIVE_CODE:
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- if ((AO.type == LOCALVAR_OT) && (AO.value == 0))
- onstack = TRUE;
- else
- onstack = FALSE;
-
- do
- { get_next_token();
- if ((token_type == SEP_TT)
- && (token_value == SEMICOLON_SEP)) {
- if (onstack) {
- assembleg_2(copy_gc, stack_pointer, zero_operand);
- }
- return;
- }
- if ((token_type == SEP_TT)&&(token_value == ARTNOT_SEP))
- ln = 0;
- else
- { if ((token_type == SYMBOL_TT)
- && (stypes[token_value] != ATTRIBUTE_T))
- warning_named("This is not a declared Attribute:",
- token_text);
- ln = 1;
- put_token_back();
- }
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- if (runtime_error_checking_switch && (!veneer_mode))
- { ln2 = (ln ? RT__ChG_VR : RT__ChGt_VR);
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
- /* already on stack */
- }
- else {
- assembleg_store(stack_pointer, AO2);
- }
- if (onstack)
- assembleg_2(stkpeek_gc, one_operand, stack_pointer);
- else
- assembleg_store(stack_pointer, AO);
- assembleg_3(call_gc, veneer_routine(ln2), two_operand,
- zero_operand);
- }
- else {
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- AO2.value += 8;
- set_constant_ot(&AO2);
- }
- else {
- INITAOTV(&AO3, BYTECONSTANT_OT, 8);
- assembleg_3(add_gc, AO2, AO3, stack_pointer);
- AO2 = stack_pointer;
- }
- if (onstack) {
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
- assembleg_2(stkpeek_gc, one_operand,
- stack_pointer);
- else
- assembleg_2(stkpeek_gc, zero_operand,
- stack_pointer);
- }
- if (ln)
- AO3 = one_operand;
- else
- AO3 = zero_operand;
- assembleg_3(astorebit_gc, AO, AO2, AO3);
- }
- } while(TRUE);
-
- /* -------------------------------------------------------------------- */
- /* if (<condition>) <codeblock> [else <codeblock>] -------------------- */
- /* -------------------------------------------------------------------- */
-
- case IF_CODE:
- flag = FALSE;
- ln2 = 0;
-
- match_open_bracket();
- AO = parse_expression(CONDITION_CONTEXT);
- match_close_bracket();
-
- statements.enabled = TRUE;
- get_next_token();
- if ((token_type == STATEMENT_TT)&&(token_value == RTRUE_CODE))
- ln = -4;
- else
- if ((token_type == STATEMENT_TT)&&(token_value == RFALSE_CODE))
- ln = -3;
- else
- { put_token_back();
- ln = next_label++;
- }
-
- code_generate(AO, CONDITION_CONTEXT, ln);
-
- if (ln >= 0) parse_code_block(break_label, continue_label, 0);
- else
- { get_next_token();
- if ((token_type != SEP_TT)
- || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- put_token_back();
- }
- }
-
- statements.enabled = TRUE;
- get_next_token();
- if ((token_type == STATEMENT_TT) && (token_value == ELSE_CODE))
- { flag = TRUE;
- if (ln >= 0)
- { ln2 = next_label++;
- if (!execution_never_reaches_here)
- { sequence_point_follows = FALSE;
- assembleg_jump(ln2);
- }
- }
- }
- else put_token_back();
-
- if (ln >= 0) assemble_label_no(ln);
-
- if (flag)
- { parse_code_block(break_label, continue_label, 0);
- if (ln >= 0) assemble_label_no(ln2);
- }
-
- return;
-
- /* -------------------------------------------------------------------- */
- /* inversion ---------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case INVERSION_CODE:
- INITAOTV(&AO2, DEREFERENCE_OT, GLULX_HEADER_SIZE+8);
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
- AO2.value = GLULX_HEADER_SIZE+9;
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
- AO2.value = GLULX_HEADER_SIZE+10;
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
- AO2.value = GLULX_HEADER_SIZE+11;
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
-
- if (/* DISABLES CODE */ (0)) {
- INITAO(&AO);
- AO.value = '(';
- set_constant_ot(&AO);
- assembleg_1(streamchar_gc, AO);
- AO.value = 'G';
- set_constant_ot(&AO);
- assembleg_1(streamchar_gc, AO);
-
- AO2.value = GLULX_HEADER_SIZE+12;
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
- AO2.value = GLULX_HEADER_SIZE+13;
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
- AO2.value = GLULX_HEADER_SIZE+14;
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
- AO2.value = GLULX_HEADER_SIZE+15;
- assembleg_2(copyb_gc, AO2, stack_pointer);
- assembleg_1(streamchar_gc, stack_pointer);
-
- AO.marker = 0;
- AO.value = ')';
- set_constant_ot(&AO);
- assembleg_1(streamchar_gc, AO);
- }
-
- break;
-
- /* -------------------------------------------------------------------- */
- /* jump <label> ------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case JUMP_CODE:
- assembleg_jump(parse_label());
- break;
-
- /* -------------------------------------------------------------------- */
- /* move <expression> to <expression> ---------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case MOVE_CODE:
- misc_keywords.enabled = TRUE;
- AO = parse_expression(QUANTITY_CONTEXT);
-
- get_next_token();
- misc_keywords.enabled = FALSE;
- if ((token_type != MISC_KEYWORD_TT)
- || (token_value != TO_MK))
- { ebf_error("'to'", token_text);
- panic_mode_error_recovery();
- return;
- }
-
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- AO = code_generate(AO, QUANTITY_CONTEXT, -1);
- if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
- assembleg_call_2(veneer_routine(RT__ChT_VR), AO, AO2,
- zero_operand);
- else
- assembleg_call_2(veneer_routine(OB__Move_VR), AO, AO2,
- zero_operand);
- break;
-
- /* -------------------------------------------------------------------- */
- /* new_line ----------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case NEW_LINE_CODE:
- INITAOTV(&AO, BYTECONSTANT_OT, 0x0A);
- assembleg_1(streamchar_gc, AO);
- break;
-
- /* -------------------------------------------------------------------- */
- /* objectloop (<initialisation>) <codeblock> -------------------------- */
- /* -------------------------------------------------------------------- */
-
- case OBJECTLOOP_CODE:
-
- match_open_bracket();
- get_next_token();
- if (token_type == LOCAL_VARIABLE_TT) {
- INITAOTV(&AO, LOCALVAR_OT, token_value);
- }
- else if ((token_type == SYMBOL_TT) &&
- (stypes[token_value] == GLOBAL_VARIABLE_T)) {
- INITAOTV(&AO, GLOBALVAR_OT, svals[token_value]);
- }
- else {
- ebf_error("'objectloop' variable", token_text);
- panic_mode_error_recovery();
- break;
- }
- misc_keywords.enabled = TRUE;
- get_next_token(); flag = TRUE;
- misc_keywords.enabled = FALSE;
- if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
- flag = FALSE;
-
- ln = 0;
- if ((token_type == MISC_KEYWORD_TT)
- && (token_value == NEAR_MK)) ln = 1;
- if ((token_type == MISC_KEYWORD_TT)
- && (token_value == FROM_MK)) ln = 2;
- if ((token_type == CND_TT) && (token_value == IN_COND))
- { get_next_token();
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == CLOSEB_SEP))
- ln = 3;
- put_token_back();
- put_token_back();
- }
-
- if (ln != 0) {
- /* Old style (Inform 5) objectloops: note that we
- implement objectloop (a in b) in the old way since
- this runs through objects in a different order from
- the new way, and there may be existing Inform code
- relying on this. */
- assembly_operand AO4, AO5;
- INITAO(&AO5);
-
- sequence_point_follows = TRUE;
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- match_close_bracket();
- if (ln == 1) {
- if (runtime_error_checking_switch)
- AO2 = check_nonzero_at_runtime(AO2, -1,
- OBJECTLOOP_RTE);
- INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_PARENT());
- assembleg_3(aload_gc, AO2, AO4, stack_pointer);
- INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_3(aload_gc, stack_pointer, AO4, stack_pointer);
- AO2 = stack_pointer;
- }
- else if (ln == 3) {
- if (runtime_error_checking_switch) {
- AO5 = AO2;
- AO2 = check_nonzero_at_runtime(AO2, -1,
- CHILD_RTE);
- }
- INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_CHILD());
- assembleg_3(aload_gc, AO2, AO4, stack_pointer);
- AO2 = stack_pointer;
- }
- else {
- /* do nothing */
- }
- assembleg_store(AO, AO2);
- assembleg_1_branch(jz_gc, AO, ln2 = next_label++);
- assemble_label_no(ln4 = next_label++);
- parse_code_block(ln2, ln3 = next_label++, 0);
- sequence_point_follows = FALSE;
- assemble_label_no(ln3);
- if (runtime_error_checking_switch) {
- AO2 = check_nonzero_at_runtime(AO, ln2,
- OBJECTLOOP2_RTE);
- if ((ln == 3)
- && ((AO5.type != LOCALVAR_OT)||(AO5.value != 0))
- && ((AO5.type != LOCALVAR_OT)||(AO5.value != AO.value)))
- { assembly_operand en_ao;
- INITAO(&en_ao);
- en_ao.value = OBJECTLOOP_BROKEN_RTE;
- set_constant_ot(&en_ao);
- INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_PARENT());
- assembleg_3(aload_gc, AO, AO4, stack_pointer);
- assembleg_2_branch(jeq_gc, stack_pointer, AO5,
- next_label);
- assembleg_call_2(veneer_routine(RT__Err_VR),
- en_ao, AO, zero_operand);
- assembleg_jump(ln2);
- assemble_label_no(next_label++);
- }
- }
- else {
- AO2 = AO;
- }
- INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_SIBLING());
- assembleg_3(aload_gc, AO2, AO4, AO);
- assembleg_1_branch(jnz_gc, AO, ln4);
- assemble_label_no(ln2);
- return;
- }
-
- sequence_point_follows = TRUE;
- ln = symbol_index("Class", -1);
- INITAOT(&AO2, CONSTANT_OT);
- AO2.value = svals[ln];
- AO2.marker = OBJECT_MV;
- assembleg_store(AO, AO2);
-
- assemble_label_no(ln = next_label++);
- ln2 = next_label++;
- ln3 = next_label++;
- if (flag)
- { put_token_back();
- put_token_back();
- sequence_point_follows = TRUE;
- code_generate(parse_expression(CONDITION_CONTEXT),
- CONDITION_CONTEXT, ln3);
- match_close_bracket();
- }
- parse_code_block(ln2, ln3, 0);
-
- sequence_point_follows = FALSE;
- assemble_label_no(ln3);
- INITAOTV(&AO4, BYTECONSTANT_OT, GOBJFIELD_CHAIN());
- assembleg_3(aload_gc, AO, AO4, AO);
- assembleg_1_branch(jnz_gc, AO, ln);
- assemble_label_no(ln2);
- return;
-
- /* -------------------------------------------------------------------- */
- /* (see routine above) ------------------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case PRINT_CODE:
- get_next_token();
- parse_print_g(FALSE); return;
- case PRINT_RET_CODE:
- get_next_token();
- parse_print_g(TRUE); return;
-
- /* -------------------------------------------------------------------- */
- /* quit --------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case QUIT_CODE:
- assembleg_0(quit_gc); break;
-
- /* -------------------------------------------------------------------- */
- /* remove <expression> ------------------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case REMOVE_CODE:
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- if ((runtime_error_checking_switch) && (veneer_mode == FALSE))
- assembleg_call_1(veneer_routine(RT__ChR_VR), AO,
- zero_operand);
- else
- assembleg_call_1(veneer_routine(OB__Remove_VR), AO,
- zero_operand);
- break;
-
- /* -------------------------------------------------------------------- */
- /* return [<expression>] ---------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case RETURN_CODE:
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)) {
- assembleg_1(return_gc, one_operand);
- return;
- }
- put_token_back();
- AO = code_generate(parse_expression(RETURN_Q_CONTEXT),
- QUANTITY_CONTEXT, -1);
- assembleg_1(return_gc, AO);
- break;
-
- /* -------------------------------------------------------------------- */
- /* rfalse ------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case RFALSE_CODE:
- assembleg_1(return_gc, zero_operand);
- break;
-
- /* -------------------------------------------------------------------- */
- /* rtrue -------------------------------------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case RTRUE_CODE:
- assembleg_1(return_gc, one_operand);
- break;
-
- /* -------------------------------------------------------------------- */
- /* spaces <expression> ------------------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case SPACES_CODE:
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
-
- assembleg_store(temp_var1, AO);
-
- INITAO(&AO);
- AO.value = 32; set_constant_ot(&AO);
-
- assembleg_2_branch(jlt_gc, temp_var1, one_operand,
- ln = next_label++);
- assemble_label_no(ln2 = next_label++);
- assembleg_1(streamchar_gc, AO);
- assembleg_dec(temp_var1);
- assembleg_1_branch(jnz_gc, temp_var1, ln2);
- assemble_label_no(ln);
- break;
-
- /* -------------------------------------------------------------------- */
- /* string <expression> <literal-string> ------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case STRING_CODE:
- AO2 = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- get_next_token();
- if (token_type == DQ_TT)
- { INITAOT(&AO4, CONSTANT_OT);
- AO4.value = compile_string(token_text, TRUE, TRUE);
- AO4.marker = STRING_MV;
- }
- else
- { put_token_back();
- AO4 = parse_expression(CONSTANT_CONTEXT);
- }
- assembleg_call_2(veneer_routine(Dynam__String_VR),
- AO2, AO4, zero_operand);
- break;
-
- /* -------------------------------------------------------------------- */
- /* style roman/reverse/bold/underline/fixed --------------------------- */
- /* -------------------------------------------------------------------- */
-
- case STYLE_CODE:
- misc_keywords.enabled = TRUE;
- get_next_token();
- misc_keywords.enabled = FALSE;
- if ((token_type != MISC_KEYWORD_TT)
- || ((token_value != ROMAN_MK)
- && (token_value != REVERSE_MK)
- && (token_value != BOLD_MK)
- && (token_value != UNDERLINE_MK)
- && (token_value != FIXED_MK)))
- { ebf_error(
-"'roman', 'bold', 'underline', 'reverse' or 'fixed'",
- token_text);
- panic_mode_error_recovery();
- break;
- }
-
- /* Call glk_set_style() */
-
- INITAO(&AO);
- AO.value = 0x0086;
- set_constant_ot(&AO);
- switch(token_value)
- { case ROMAN_MK:
- default:
- AO2 = zero_operand; /* normal */
- break;
- case REVERSE_MK:
- INITAO(&AO2);
- AO2.value = 5; /* alert */
- set_constant_ot(&AO2);
- break;
- case BOLD_MK:
- INITAO(&AO2);
- AO2.value = 4; /* subheader */
- set_constant_ot(&AO2);
- break;
- case UNDERLINE_MK:
- AO2 = one_operand; /* emphasized */
- break;
- case FIXED_MK:
- AO2 = two_operand; /* preformatted */
- break;
- }
- assembleg_call_2(veneer_routine(Glk__Wrap_VR),
- AO, AO2, zero_operand);
- break;
-
- /* -------------------------------------------------------------------- */
- /* switch (<expression>) <codeblock> ---------------------------------- */
- /* -------------------------------------------------------------------- */
-
- case SWITCH_CODE:
- match_open_bracket();
- AO = code_generate(parse_expression(QUANTITY_CONTEXT),
- QUANTITY_CONTEXT, -1);
- match_close_bracket();
-
- assembleg_store(temp_var1, AO);
-
- parse_code_block(ln = next_label++, continue_label, 1);
- assemble_label_no(ln);
- return;
-
- /* -------------------------------------------------------------------- */
- /* while (<condition>) <codeblock> ------------------------------------ */
- /* -------------------------------------------------------------------- */
-
- case WHILE_CODE:
- assemble_label_no(ln = next_label++);
- match_open_bracket();
-
- code_generate(parse_expression(CONDITION_CONTEXT),
- CONDITION_CONTEXT, ln2 = next_label++);
- match_close_bracket();
-
- parse_code_block(ln2, ln, 0);
- sequence_point_follows = FALSE;
- assembleg_jump(ln);
- assemble_label_no(ln2);
- return;
-
- /* -------------------------------------------------------------------- */
-
- case SDEFAULT_CODE:
- error("'default' without matching 'switch'"); break;
- case ELSE_CODE:
- error("'else' without matching 'if'"); break;
- case UNTIL_CODE:
- error("'until' without matching 'do'");
- panic_mode_error_recovery(); return;
-
- /* -------------------------------------------------------------------- */
-
- /* And a useful default, which will never be triggered in a complete
- Inform compiler, but which is important in development. */
-
- default:
- error("*** Statement code gen: Can't generate yet ***\n");
- panic_mode_error_recovery(); return;
- }
-
- StatementTerminator:
-
- get_next_token();
- if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';'", token_text);
- put_token_back();
- }
-}
-
-extern void parse_statement(int break_label, int continue_label)
-{
- if (!glulx_mode)
- parse_statement_z(break_label, continue_label);
- else
- parse_statement_g(break_label, continue_label);
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_states_vars(void)
-{
-}
-
-extern void states_begin_pass(void)
-{
-}
-
-extern void states_allocate_arrays(void)
-{
-}
-
-extern void states_free_arrays(void)
-{
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "symbols" : The symbols table; creating stock of reserved words */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-/* ------------------------------------------------------------------------- */
-/* This section of Inform is a service detached from the rest. */
-/* Only two variables are accessible from the outside: */
-/* ------------------------------------------------------------------------- */
-
-int no_symbols; /* Total number of symbols defined */
-int no_named_constants; /* Copied into story file */
-
-/* ------------------------------------------------------------------------- */
-/* Plus six arrays. Each symbol has its own index n (an int32) and */
-/* */
-/* svals[n] is its value (must be 32 bits wide, i.e. an int32, tho' */
-/* it is used to hold an unsigned 16 bit Z-machine value) */
-/* sflags[n] holds flags (see "header.h" for a list) */
-/* stypes[n] is the "type", distinguishing between the data type of */
-/* different kinds of constants/variables. */
-/* (See the "typename()" below.) */
-/* symbs[n] (needs to be cast to (char *) to be used) is the name */
-/* of the symbol, in the same case form as when created. */
-/* slines[n] is the source line on which the symbol value was first */
-/* assigned */
-/* symbol_debug_backpatch_positions[n] */
-/* is a file position in the debug information file where */
-/* the symbol's value should be written after backpatching, */
-/* or else the null position if the value was known and */
-/* written beforehand */
-/* replacement_debug_backpatch_positions[n] */
-/* is a file position in the debug information file where */
-/* the symbol's name can be erased if it is replaced, or */
-/* else null if the name will never need to be replaced */
-/* */
-/* Comparison is case insensitive. */
-/* Note that local variable names are not entered into the symbols table, */
-/* as their numbers and scope are too limited for this to be efficient. */
-/* ------------------------------------------------------------------------- */
-/* Caveat editor: some array types are set up to work even on machines */
-/* where sizeof(int32 *) differs from, e.g., sizeof(char *): so do not */
-/* alter the types unless you understand what is going on! */
-/* ------------------------------------------------------------------------- */
-
- int32 **symbs;
- int32 *svals;
- int *smarks; /* Glulx-only */
- brief_location *slines;
- int *sflags;
-#ifdef VAX
- char *stypes; /* In VAX C, insanely, "signed char" is illegal */
-#else
- signed char *stypes;
-#endif
- maybe_file_position *symbol_debug_backpatch_positions;
- maybe_file_position *replacement_debug_backpatch_positions;
-
-/* ------------------------------------------------------------------------- */
-/* Memory to hold the text of symbol names: note that this memory is */
-/* allocated as needed in chunks of size SYMBOLS_CHUNK_SIZE. */
-/* ------------------------------------------------------------------------- */
-
-#define MAX_SYMBOL_CHUNKS (100)
-
-static uchar *symbols_free_space, /* Next byte free to hold new names */
- *symbols_ceiling; /* Pointer to the end of the current
- allocation of memory for names */
-
-static char** symbol_name_space_chunks; /* For chunks of memory used to hold
- the name strings of symbols */
-static int no_symbol_name_space_chunks;
-
-typedef struct value_pair_struct {
- int original_symbol;
- int renamed_symbol;
-} value_pair_t;
-static value_pair_t *symbol_replacements;
-static int symbol_replacements_count;
-static int symbol_replacements_size; /* calloced size */
-
-/* ------------------------------------------------------------------------- */
-/* The symbols table is "hash-coded" into a disjoint union of linked */
-/* lists, so that for any symbol i, next_entry[i] is either -1 (meaning */
-/* that it's the last in its list) or the next in the list. */
-/* */
-/* Each list contains, in alphabetical order, all the symbols which share */
-/* the same "hash code" (a numerical function of the text of the symbol */
-/* name, designed with the aim that roughly equal numbers of symbols are */
-/* given each possible hash code). The hash codes are 0 to HASH_TAB_SIZE */
-/* (which is a memory setting) minus 1: start_of_list[h] gives the first */
-/* symbol with hash code h, or -1 if no symbol exists with hash code h. */
-/* */
-/* Note that the running time of the symbol search algorithm is about */
-/* */
-/* O ( n^2 / HASH_TAB_SIZE ) */
-/* */
-/* (where n is the number of symbols in the program) so that it is a good */
-/* idea to choose HASH_TAB_SIZE as large as conveniently possible. */
-/* ------------------------------------------------------------------------- */
-
-static int *next_entry;
-static int32 *start_of_list;
-
-/* ------------------------------------------------------------------------- */
-/* Initialisation. */
-/* ------------------------------------------------------------------------- */
-
-static void init_symbol_banks(void)
-{ int i;
- for (i=0; i<HASH_TAB_SIZE; i++) start_of_list[i] = -1;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The hash coding we use is quite standard; the variable hashcode is */
-/* expected to overflow a good deal. (The aim is to produce a number */
-/* so that similar names do not produce the same number.) Note that */
-/* 30011 is prime. It doesn't matter if the unsigned int to int cast */
-/* behaves differently on different ports. */
-/* ------------------------------------------------------------------------- */
-
-int case_conversion_grid[128];
-
-static void make_case_conversion_grid(void)
-{
- /* Assumes that A to Z are contiguous in the host OS character set:
- true for ASCII but not for EBCDIC, for instance. */
-
- int i;
- for (i=0; i<128; i++) case_conversion_grid[i] = i;
- for (i=0; i<26; i++) case_conversion_grid['A'+i]='a'+i;
-}
-
-extern int hash_code_from_string(char *p)
-{ uint32 hashcode=0;
- for (; *p; p++) hashcode=hashcode*30011 + case_conversion_grid[(uchar)*p];
- return (int) (hashcode % HASH_TAB_SIZE);
-}
-
-extern int strcmpcis(char *p, char *q)
-{
- /* Case insensitive strcmp */
-
- int i, j, pc, qc;
- for (i=0;p[i] != 0;i++)
- { pc = p[i]; if (isupper(pc)) pc = tolower(pc);
- qc = q[i]; if (isupper(qc)) qc = tolower(qc);
- j = pc - qc;
- if (j!=0) return j;
- }
- qc = q[i]; if (isupper(qc)) qc = tolower(qc);
- return -qc;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Symbol finding, creating, and removing. */
-/* ------------------------------------------------------------------------- */
-
-extern int symbol_index(char *p, int hashcode)
-{
- /* Return the index in the symbs/svals/sflags/stypes/... arrays of symbol
- "p", creating a new symbol with that name if it isn't already there.
-
- New symbols are created with flag UNKNOWN_SFLAG, value 0x100
- (a 2-byte quantity in Z-machine terms) and type CONSTANT_T.
-
- The string "p" is undamaged. */
-
- int32 new_entry, this, last; char *r;
-
- if (hashcode == -1) hashcode = hash_code_from_string(p);
-
- this = start_of_list[hashcode]; last = -1;
-
- do
- { if (this == -1) break;
-
- r = (char *)symbs[this];
- new_entry = strcmpcis(r, p);
- if (new_entry == 0)
- {
- if (track_unused_routines)
- df_note_function_symbol(this);
- return this;
- }
- if (new_entry > 0) break;
-
- last = this;
- this = next_entry[this];
- } while (this != -1);
-
- if (no_symbols >= MAX_SYMBOLS)
- memoryerror("MAX_SYMBOLS", MAX_SYMBOLS);
-
- if (last == -1)
- { next_entry[no_symbols]=start_of_list[hashcode];
- start_of_list[hashcode]=no_symbols;
- }
- else
- { next_entry[no_symbols]=this;
- next_entry[last]=no_symbols;
- }
-
- if (symbols_free_space+strlen(p)+1 >= symbols_ceiling)
- { symbols_free_space
- = my_malloc(SYMBOLS_CHUNK_SIZE, "symbol names chunk");
- symbols_ceiling = symbols_free_space + SYMBOLS_CHUNK_SIZE;
- /* If we've passed MAX_SYMBOL_CHUNKS chunks, we print an error
- message telling the user to increase SYMBOLS_CHUNK_SIZE.
- That is the correct cure, even though the error comes out
- worded inaccurately. */
- if (no_symbol_name_space_chunks >= MAX_SYMBOL_CHUNKS)
- memoryerror("SYMBOLS_CHUNK_SIZE", SYMBOLS_CHUNK_SIZE);
- symbol_name_space_chunks[no_symbol_name_space_chunks++]
- = (char *) symbols_free_space;
- if (symbols_free_space+strlen(p)+1 >= symbols_ceiling)
- memoryerror("SYMBOLS_CHUNK_SIZE", SYMBOLS_CHUNK_SIZE);
- }
-
- strcpy((char *) symbols_free_space, p);
- symbs[no_symbols] = (int32 *) symbols_free_space;
- symbols_free_space += strlen((char *)symbols_free_space) + 1;
-
- svals[no_symbols] = 0x100; /* ###-wrong? Would this fix the
- unbound-symbol-causes-asm-error? */
- sflags[no_symbols] = UNKNOWN_SFLAG;
- stypes[no_symbols] = CONSTANT_T;
- slines[no_symbols] = get_brief_location(&ErrorReport);
- if (debugfile_switch)
- { nullify_debug_file_position
- (&symbol_debug_backpatch_positions[no_symbols]);
- nullify_debug_file_position
- (&replacement_debug_backpatch_positions[no_symbols]);
- }
-
- if (track_unused_routines)
- df_note_function_symbol(no_symbols);
- return(no_symbols++);
-}
-
-extern void end_symbol_scope(int k)
-{
- /* 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.
- */
-
- int j;
- j = hash_code_from_string((char *) symbs[k]);
- if (start_of_list[j] == k)
- { start_of_list[j] = next_entry[k];
- return;
- }
- j = start_of_list[j];
- while (j != -1)
- {
- if (next_entry[j] == k)
- { next_entry[j] = next_entry[k];
- return;
- }
- j = next_entry[j];
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Printing diagnostics */
-/* ------------------------------------------------------------------------- */
-
-extern char *typename(int type)
-{ switch(type)
- {
- /* These are the possible symbol types. Note that local variables
- do not reside in the symbol table (for scope and efficiency
- reasons) and actions have their own name-space (via routine
- names with "Sub" appended). */
-
- case ROUTINE_T: return("Routine");
- case LABEL_T: return("Label");
- case GLOBAL_VARIABLE_T: return("Global variable");
- case ARRAY_T: return("Array");
- case CONSTANT_T: return("Defined constant");
- case ATTRIBUTE_T: return("Attribute");
- case PROPERTY_T: return("Property");
- case INDIVIDUAL_PROPERTY_T: return("Individual property");
- case OBJECT_T: return("Object");
- case CLASS_T: return("Class");
- case FAKE_ACTION_T: return("Fake action");
-
- default: return("(Unknown type)");
- }
-}
-
-static void describe_flags(int flags)
-{ if (flags & UNKNOWN_SFLAG) printf("(?) ");
- if (flags & USED_SFLAG) printf("(used) ");
- if (flags & REPLACE_SFLAG) printf("(Replaced) ");
- if (flags & DEFCON_SFLAG) printf("(Defaulted) ");
- if (flags & STUB_SFLAG) printf("(Stubbed) ");
- if (flags & CHANGE_SFLAG) printf("(value will change) ");
- if (flags & IMPORT_SFLAG) printf("(Imported) ");
- if (flags & EXPORT_SFLAG) printf("(Exported) ");
- if (flags & SYSTEM_SFLAG) printf("(System) ");
- if (flags & INSF_SFLAG) printf("(created in sys file) ");
- if (flags & UERROR_SFLAG) printf("('Unknown' error issued) ");
- if (flags & ALIASED_SFLAG) printf("(aliased) ");
- if (flags & ACTION_SFLAG) printf("(Action name) ");
- if (flags & REDEFINABLE_SFLAG) printf("(Redefinable) ");
-}
-
-extern void describe_symbol(int k)
-{ printf("%4d %-16s %2d:%04d %04x %s ",
- k, (char *) (symbs[k]),
- (int)(slines[k].file_index),
- (int)(slines[k].line_number),
- svals[k], typename(stypes[k]));
- describe_flags(sflags[k]);
-}
-
-extern void list_symbols(int level)
-{ int k;
- for (k=0; k<no_symbols; k++)
- { if ((level==2) ||
- ((sflags[k] & (SYSTEM_SFLAG + UNKNOWN_SFLAG + INSF_SFLAG)) == 0))
- { describe_symbol(k); printf("\n");
- }
- }
-}
-
-extern void issue_unused_warnings(void)
-{ int32 i;
-
- if (module_switch) return;
-
- /* Update any ad-hoc variables that might help the library */
- if (glulx_mode)
- { global_initial_value[10]=statusline_flag;
- }
- /* Now back to mark anything necessary as used */
-
- i = symbol_index("Main", -1);
- if (!(sflags[i] & UNKNOWN_SFLAG)) sflags[i] |= USED_SFLAG;
-
- for (i=0;i<no_symbols;i++)
- { if (((sflags[i]
- & (SYSTEM_SFLAG + UNKNOWN_SFLAG + EXPORT_SFLAG
- + INSF_SFLAG + USED_SFLAG + REPLACE_SFLAG)) == 0)
- && (stypes[i] != OBJECT_T))
- dbnu_warning(typename(stypes[i]), (char *) symbs[i], slines[i]);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* These are arrays used only during story file (never module) creation, */
-/* and not allocated until then. */
-
- int32 *individual_name_strings; /* Packed addresses of Z-encoded
- strings of the names of the
- properties: this is an array
- indexed by the property ID */
- int32 *action_name_strings; /* Ditto for actions */
- int32 *attribute_name_strings; /* Ditto for attributes */
- 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];
- static char unknown_attribute[20] = "<unknown attribute>";
-
- for (i=0; i<no_individual_properties; i++)
- individual_name_strings[i] = 0;
-
- if (module_switch) return;
-
- veneer_mode = TRUE;
-
- null_value = compile_string(unknown_attribute, FALSE, FALSE);
- for (i=0; i<NUM_ATTR_BYTES*8; i++) attribute_name_strings[i] = null_value;
-
- for (i=0; i<no_symbols; i++)
- { t=stypes[i];
- if ((t == INDIVIDUAL_PROPERTY_T) || (t == PROPERTY_T))
- { if (sflags[i] & ALIASED_SFLAG)
- { if (individual_name_strings[svals[i]] == 0)
- { sprintf(idname_string, "%s", (char *) symbs[i]);
-
- for (j=i+1, k=0; (j<no_symbols && k<3); j++)
- { if ((stypes[j] == stypes[i])
- && (svals[j] == svals[i]))
- { sprintf(idname_string+strlen(idname_string),
- "/%s", (char *) symbs[j]);
- k++;
- }
- }
-
- individual_name_strings[svals[i]]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
- else
- { sprintf(idname_string, "%s", (char *) symbs[i]);
-
- individual_name_strings[svals[i]]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
- if (t == ATTRIBUTE_T)
- { if (sflags[i] & ALIASED_SFLAG)
- { if (attribute_name_strings[svals[i]] == null_value)
- { sprintf(idname_string, "%s", (char *) symbs[i]);
-
- for (j=i+1, k=0; (j<no_symbols && k<3); j++)
- { if ((stypes[j] == stypes[i])
- && (svals[j] == svals[i]))
- { sprintf(idname_string+strlen(idname_string),
- "/%s", (char *) symbs[j]);
- k++;
- }
- }
-
- attribute_name_strings[svals[i]]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
- else
- { sprintf(idname_string, "%s", (char *) symbs[i]);
-
- attribute_name_strings[svals[i]]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
- if (sflags[i] & ACTION_SFLAG)
- { sprintf(idname_string, "%s", (char *) symbs[i]);
- idname_string[strlen(idname_string)-3] = 0;
-
- if (debugfile_switch)
- { debug_file_printf("<action>");
- debug_file_printf
- ("<identifier>##%s</identifier>", idname_string);
- debug_file_printf("<value>%d</value>", svals[i]);
- debug_file_printf("</action>");
- }
-
- action_name_strings[svals[i]]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
-
- for (i=0; i<no_symbols; i++)
- { if (stypes[i] == FAKE_ACTION_T)
- { sprintf(idname_string, "%s", (char *) symbs[i]);
- idname_string[strlen(idname_string)-3] = 0;
-
- action_name_strings[svals[i]
- - ((grammar_version_number==1)?256:4096) + no_actions]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
-
- for (j=0; j<no_arrays; j++)
- { i = array_symbols[j];
- sprintf(idname_string, "%s", (char *) symbs[i]);
-
- array_name_strings[j]
- = compile_string(idname_string, FALSE, FALSE);
- }
- if (define_INFIX_switch)
- { for (i=0; i<no_symbols; i++)
- { if (stypes[i] == GLOBAL_VARIABLE_T)
- { sprintf(idname_string, "%s", (char *) symbs[i]);
- array_name_strings[no_arrays + svals[i] -16]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
-
- for (i=0; i<no_named_routines; i++)
- { sprintf(idname_string, "%s", (char *) symbs[named_routine_symbols[i]]);
- array_name_strings[no_arrays + no_globals + i]
- = compile_string(idname_string, FALSE, FALSE);
- }
-
- for (i=0, no_named_constants=0; i<no_symbols; i++)
- { if (((stypes[i] == OBJECT_T) || (stypes[i] == CLASS_T)
- || (stypes[i] == CONSTANT_T))
- && ((sflags[i] & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
- { sprintf(idname_string, "%s", (char *) symbs[i]);
- array_name_strings[no_arrays + no_globals + no_named_routines
- + no_named_constants++]
- = compile_string(idname_string, FALSE, FALSE);
- }
- }
- }
-
- veneer_mode = FALSE;
-}
-/* ------------------------------------------------------------------------- */
-/* Creating symbols */
-/* ------------------------------------------------------------------------- */
-
-static void assign_symbol_base(int index, int32 value, int type)
-{ svals[index] = value;
- stypes[index] = type;
- if (sflags[index] & UNKNOWN_SFLAG)
- { sflags[index] &= (~UNKNOWN_SFLAG);
- if (is_systemfile()) sflags[index] |= INSF_SFLAG;
- slines[index] = get_brief_location(&ErrorReport);
- }
-}
-
-extern void assign_symbol(int index, int32 value, int type)
-{
- if (!glulx_mode) {
- assign_symbol_base(index, value, type);
- }
- else {
- smarks[index] = 0;
- assign_symbol_base(index, value, type);
- }
-}
-
-extern void assign_marked_symbol(int index, int marker, int32 value, int type)
-{
- if (!glulx_mode) {
- assign_symbol_base(index, (int32)marker*0x10000 + (value % 0x10000),
- type);
- }
- else {
- smarks[index] = marker;
- assign_symbol_base(index, value, type);
- }
-}
-
-static void emit_debug_information_for_predefined_symbol
- (char *name, int32 symbol, int32 value, int type)
-{ if (debugfile_switch)
- { switch (type)
- { case CONSTANT_T:
- debug_file_printf("<constant>");
- debug_file_printf("<identifier>%s</identifier>", name);
- write_debug_symbol_optional_backpatch(symbol);
- debug_file_printf("</constant>");
- break;
- case GLOBAL_VARIABLE_T:
- debug_file_printf("<global-variable>");
- debug_file_printf("<identifier>%s</identifier>", name);
- debug_file_printf("<address>");
- write_debug_global_backpatch(value);
- debug_file_printf("</address>");
- debug_file_printf("</global-variable>");
- break;
- case OBJECT_T:
- if (value)
- { compiler_error("Non-nothing object predefined");
- }
- debug_file_printf("<object>");
- debug_file_printf("<identifier>%s</identifier>", name);
- debug_file_printf("<value>0</value>");
- debug_file_printf("</object>");
- break;
- case ATTRIBUTE_T:
- debug_file_printf("<attribute>");
- debug_file_printf("<identifier>%s</identifier>", name);
- debug_file_printf("<value>%d</value>", value);
- debug_file_printf("</attribute>");
- break;
- case PROPERTY_T:
- case INDIVIDUAL_PROPERTY_T:
- debug_file_printf("<property>");
- debug_file_printf("<identifier>%s</identifier>", name);
- debug_file_printf("<value>%d</value>", value);
- debug_file_printf("</property>");
- break;
- default:
- compiler_error
- ("Unable to emit debug information for predefined symbol");
- break;
- }
- }
-}
-
-static void create_symbol(char *p, int32 value, int type)
-{ int i = symbol_index(p, -1);
- svals[i] = value; stypes[i] = type; slines[i] = blank_brief_location;
- sflags[i] = USED_SFLAG + SYSTEM_SFLAG;
- emit_debug_information_for_predefined_symbol(p, i, value, type);
-}
-
-static void create_rsymbol(char *p, int value, int type)
-{ int i = symbol_index(p, -1);
- svals[i] = value; stypes[i] = type; slines[i] = blank_brief_location;
- sflags[i] = USED_SFLAG + SYSTEM_SFLAG + REDEFINABLE_SFLAG;
- emit_debug_information_for_predefined_symbol(p, i, value, type);
-}
-
-static void stockup_symbols(void)
-{
- if (!glulx_mode)
- create_symbol("TARGET_ZCODE", 0, CONSTANT_T);
- else
- create_symbol("TARGET_GLULX", 0, CONSTANT_T);
-
- create_symbol("nothing", 0, OBJECT_T);
- create_symbol("name", 1, PROPERTY_T);
-
- create_symbol("true", 1, CONSTANT_T);
- create_symbol("false", 0, CONSTANT_T);
-
- /* Glulx defaults to GV2; Z-code to GV1 */
- if (!glulx_mode)
- create_rsymbol("Grammar__Version", 1, CONSTANT_T);
- else
- create_rsymbol("Grammar__Version", 2, CONSTANT_T);
- grammar_version_symbol = symbol_index("Grammar__Version", -1);
-
- if (module_switch)
- create_rsymbol("MODULE_MODE",0, CONSTANT_T);
-
- if (runtime_error_checking_switch)
- create_rsymbol("STRICT_MODE",0, CONSTANT_T);
-
- if (define_DEBUG_switch)
- create_rsymbol("DEBUG", 0, CONSTANT_T);
-
- if (define_USE_MODULES_switch)
- create_rsymbol("USE_MODULES",0, CONSTANT_T);
-
- if (define_INFIX_switch)
- { create_rsymbol("INFIX", 0, CONSTANT_T);
- create_symbol("infix__watching", 0, ATTRIBUTE_T);
- }
-
- create_symbol("WORDSIZE", WORDSIZE, CONSTANT_T);
- create_symbol("DICT_ENTRY_BYTES", DICT_ENTRY_BYTE_LENGTH, CONSTANT_T);
- if (!glulx_mode) {
- create_symbol("DICT_WORD_SIZE", ((version_number==3)?4:6), CONSTANT_T);
- create_symbol("NUM_ATTR_BYTES", ((version_number==3)?4:6), CONSTANT_T);
- }
- else {
- create_symbol("DICT_WORD_SIZE", DICT_WORD_SIZE, CONSTANT_T);
- create_symbol("DICT_CHAR_SIZE", DICT_CHAR_SIZE, CONSTANT_T);
- if (DICT_CHAR_SIZE != 1)
- create_symbol("DICT_IS_UNICODE", 1, CONSTANT_T);
- create_symbol("NUM_ATTR_BYTES", NUM_ATTR_BYTES, CONSTANT_T);
- create_symbol("GOBJFIELD_CHAIN", GOBJFIELD_CHAIN(), CONSTANT_T);
- create_symbol("GOBJFIELD_NAME", GOBJFIELD_NAME(), CONSTANT_T);
- create_symbol("GOBJFIELD_PROPTAB", GOBJFIELD_PROPTAB(), CONSTANT_T);
- create_symbol("GOBJFIELD_PARENT", GOBJFIELD_PARENT(), CONSTANT_T);
- create_symbol("GOBJFIELD_SIBLING", GOBJFIELD_SIBLING(), CONSTANT_T);
- create_symbol("GOBJFIELD_CHILD", GOBJFIELD_CHILD(), CONSTANT_T);
- create_symbol("GOBJ_EXT_START", 1+NUM_ATTR_BYTES+6*WORDSIZE, CONSTANT_T);
- create_symbol("GOBJ_TOTAL_LENGTH", 1+NUM_ATTR_BYTES+6*WORDSIZE+GLULX_OBJECT_EXT_BYTES, CONSTANT_T);
- create_symbol("INDIV_PROP_START", INDIV_PROP_START, CONSTANT_T);
- }
-
- if (!glulx_mode) {
- create_symbol("temp_global", 255, GLOBAL_VARIABLE_T);
- create_symbol("temp__global2", 254, GLOBAL_VARIABLE_T);
- create_symbol("temp__global3", 253, GLOBAL_VARIABLE_T);
- create_symbol("temp__global4", 252, GLOBAL_VARIABLE_T);
- create_symbol("self", 251, GLOBAL_VARIABLE_T);
- create_symbol("sender", 250, GLOBAL_VARIABLE_T);
- create_symbol("sw__var", 249, GLOBAL_VARIABLE_T);
-
- create_symbol("sys__glob0", 16, GLOBAL_VARIABLE_T);
- create_symbol("sys__glob1", 17, GLOBAL_VARIABLE_T);
- create_symbol("sys__glob2", 18, GLOBAL_VARIABLE_T);
-
- create_symbol("create", 64, INDIVIDUAL_PROPERTY_T);
- create_symbol("recreate", 65, INDIVIDUAL_PROPERTY_T);
- create_symbol("destroy", 66, INDIVIDUAL_PROPERTY_T);
- create_symbol("remaining", 67, INDIVIDUAL_PROPERTY_T);
- create_symbol("copy", 68, INDIVIDUAL_PROPERTY_T);
- create_symbol("call", 69, INDIVIDUAL_PROPERTY_T);
- create_symbol("print", 70, INDIVIDUAL_PROPERTY_T);
- create_symbol("print_to_array",71, INDIVIDUAL_PROPERTY_T);
- }
- else {
- /* In Glulx, these system globals are entered in order, not down
- from 255. */
- create_symbol("temp_global", MAX_LOCAL_VARIABLES+0,
- GLOBAL_VARIABLE_T);
- create_symbol("temp__global2", MAX_LOCAL_VARIABLES+1,
- GLOBAL_VARIABLE_T);
- create_symbol("temp__global3", MAX_LOCAL_VARIABLES+2,
- GLOBAL_VARIABLE_T);
- create_symbol("temp__global4", MAX_LOCAL_VARIABLES+3,
- GLOBAL_VARIABLE_T);
- create_symbol("self", MAX_LOCAL_VARIABLES+4,
- GLOBAL_VARIABLE_T);
- create_symbol("sender", MAX_LOCAL_VARIABLES+5,
- GLOBAL_VARIABLE_T);
- create_symbol("sw__var", MAX_LOCAL_VARIABLES+6,
- GLOBAL_VARIABLE_T);
-
- /* These are almost certainly meaningless, and can be removed. */
- create_symbol("sys__glob0", MAX_LOCAL_VARIABLES+7,
- GLOBAL_VARIABLE_T);
- create_symbol("sys__glob1", MAX_LOCAL_VARIABLES+8,
- GLOBAL_VARIABLE_T);
- create_symbol("sys__glob2", MAX_LOCAL_VARIABLES+9,
- GLOBAL_VARIABLE_T);
-
- /* value of statusline_flag to be written later */
- create_symbol("sys_statusline_flag", MAX_LOCAL_VARIABLES+10,
- GLOBAL_VARIABLE_T);
-
- /* These are created in order, but not necessarily at a fixed
- value. */
- create_symbol("create", INDIV_PROP_START+0,
- INDIVIDUAL_PROPERTY_T);
- create_symbol("recreate", INDIV_PROP_START+1,
- INDIVIDUAL_PROPERTY_T);
- create_symbol("destroy", INDIV_PROP_START+2,
- INDIVIDUAL_PROPERTY_T);
- create_symbol("remaining", INDIV_PROP_START+3,
- INDIVIDUAL_PROPERTY_T);
- create_symbol("copy", INDIV_PROP_START+4,
- INDIVIDUAL_PROPERTY_T);
- create_symbol("call", INDIV_PROP_START+5,
- INDIVIDUAL_PROPERTY_T);
- create_symbol("print", INDIV_PROP_START+6,
- INDIVIDUAL_PROPERTY_T);
- create_symbol("print_to_array",INDIV_PROP_START+7,
- INDIVIDUAL_PROPERTY_T);
-
- /* Floating-point constants. Note that FLOAT_NINFINITY is not
- -FLOAT_INFINITY, because float negation doesn't work that
- way. Also note that FLOAT_NAN is just one of many possible
- "not-a-number" values. */
- create_symbol("FLOAT_INFINITY", 0x7F800000, CONSTANT_T);
- create_symbol("FLOAT_NINFINITY", 0xFF800000, CONSTANT_T);
- create_symbol("FLOAT_NAN", 0x7FC00000, CONSTANT_T);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* The symbol replacement table. This is needed only for the */
-/* "Replace X Y" directive. */
-/* ------------------------------------------------------------------------- */
-
-extern void add_symbol_replacement_mapping(int original, int renamed)
-{
- int ix;
-
- if (original == renamed) {
- error_named("A routine cannot be 'Replace'd to itself:", (char *)symbs[original]);
- return;
- }
-
- if (symbol_replacements_count == symbol_replacements_size) {
- int oldsize = symbol_replacements_size;
- if (symbol_replacements_size == 0)
- symbol_replacements_size = 4;
- else
- symbol_replacements_size *= 2;
- my_recalloc(&symbol_replacements, sizeof(value_pair_t), oldsize,
- symbol_replacements_size, "symbol replacement table");
- }
-
- /* If the original form is already in our table, report an error.
- Same goes if the replaced form is already in the table as an
- original. (Other collision cases have already been
- detected.) */
-
- for (ix=0; ix<symbol_replacements_count; ix++) {
- if (original == symbol_replacements[ix].original_symbol) {
- error_named("A routine cannot be 'Replace'd to more than one new name:", (char *)symbs[original]);
- }
- if (renamed == symbol_replacements[ix].original_symbol) {
- error_named("A routine cannot be 'Replace'd to a 'Replace'd name:", (char *)symbs[original]);
- }
- }
-
- symbol_replacements[symbol_replacements_count].original_symbol = original;
- symbol_replacements[symbol_replacements_count].renamed_symbol = renamed;
- symbol_replacements_count++;
-}
-
-extern int find_symbol_replacement(int *value)
-{
- int changed = FALSE;
- int ix;
-
- if (!symbol_replacements)
- return FALSE;
-
- for (ix=0; ix<symbol_replacements_count; ix++) {
- if (*value == symbol_replacements[ix].original_symbol) {
- *value = symbol_replacements[ix].renamed_symbol;
- changed = TRUE;
- }
- }
-
- return changed;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The dead-function removal optimization. */
-/* ------------------------------------------------------------------------- */
-
-int track_unused_routines; /* set if either WARN_UNUSED_ROUTINES or
- OMIT_UNUSED_ROUTINES is nonzero */
-int df_dont_note_global_symbols; /* temporarily set at times in parsing */
-static int df_tables_closed; /* set at end of compiler pass */
-
-typedef struct df_function_struct df_function_t;
-typedef struct df_reference_struct df_reference_t;
-
-struct df_function_struct {
- char *name; /* borrowed reference, generally to the symbs[] table */
- brief_location source_line; /* copied from routine_starts_line */
- int sysfile; /* does this occur in a system file? */
- uint32 address; /* function offset in zcode_area (not the final address) */
- uint32 newaddress; /* function offset after stripping */
- uint32 length;
- int usage;
- df_reference_t *refs; /* chain of references made *from* this function */
- int processed;
-
- df_function_t *funcnext; /* in forward functions order */
- df_function_t *todonext; /* in the todo chain */
- df_function_t *next; /* in the hash table */
-};
-
-struct df_reference_struct {
- uint32 address; /* function offset in zcode_area (not the final address) */
- int symbol; /* index in symbols array */
-
- df_reference_t *refsnext; /* in the function's refs chain */
- df_reference_t *next; /* in the hash table */
-};
-
-/* Bitmask flags for how functions are used: */
-#define DF_USAGE_GLOBAL (1<<0) /* In a global variable, array, etc */
-#define DF_USAGE_EMBEDDED (1<<1) /* An anonymous function in a property */
-#define DF_USAGE_MAIN (1<<2) /* Main() or Main__() */
-#define DF_USAGE_FUNCTION (1<<3) /* Used from another used function */
-
-#define DF_FUNCTION_HASH_BUCKETS (1023)
-
-/* Table of all compiled functions. (Only created if track_unused_routines
- is set.) This is a hash table. */
-static df_function_t **df_functions;
-/* List of all compiled functions, in address order. The first entry
- has address DF_NOT_IN_FUNCTION, and stands in for the global namespace. */
-static df_function_t *df_functions_head;
-static df_function_t *df_functions_tail;
-/* Used during output_file(), to track how far the code-area output has
- gotten. */
-static df_function_t *df_iterator;
-
-/* Array of all compiled functions in address order. (Does not include
- the global namespace entry.) This is generated only if needed. */
-static df_function_t **df_functions_sorted;
-static int df_functions_sorted_count;
-
-#define DF_NOT_IN_FUNCTION ((uint32)0xFFFFFFFF)
-#define DF_SYMBOL_HASH_BUCKETS (4095)
-
-/* Map of what functions reference what other functions. (Only created if
- track_unused_routines is set.) */
-static df_reference_t **df_symbol_map;
-
-/* Globals used while a function is being compiled. When a function
- *isn't* being compiled, df_current_function_addr will be DF_NOT_IN_FUNCTION
- and df_current_function will refer to the global namespace record. */
-static df_function_t *df_current_function;
-static char *df_current_function_name;
-static uint32 df_current_function_addr;
-
-/* Size totals for compiled code. These are only meaningful if
- track_unused_routines is true. (If we're only doing WARN_UNUSED_ROUTINES,
- these values will be set, but the "after" value will not affect the
- final game file.) */
-uint32 df_total_size_before_stripping;
-uint32 df_total_size_after_stripping;
-
-/* When we begin compiling a function, call this to note that fact.
- Any symbol referenced from now on will be associated with the function.
-*/
-extern void df_note_function_start(char *name, uint32 address,
- int embedded_flag, brief_location source_line)
-{
- df_function_t *func;
- int bucket;
-
- if (df_tables_closed)
- error("Internal error in stripping: Tried to start a new function after tables were closed.");
-
- /* We retain the name only for debugging output. Note that embedded
- functions all show up as "<embedded>" -- their "obj.prop" name
- never gets stored in permanent memory. */
- df_current_function_name = name;
- df_current_function_addr = address;
-
- func = my_malloc(sizeof(df_function_t), "df function entry");
- memset(func, 0, sizeof(df_function_t));
- func->name = name;
- func->address = address;
- func->source_line = source_line;
- func->sysfile = (address == DF_NOT_IN_FUNCTION || is_systemfile());
- /* An embedded function is stored in an object property, so we
- consider it to be used a priori. */
- if (embedded_flag)
- func->usage |= DF_USAGE_EMBEDDED;
-
- if (!df_functions_head) {
- df_functions_head = func;
- df_functions_tail = func;
- }
- else {
- df_functions_tail->funcnext = func;
- df_functions_tail = func;
- }
-
- bucket = address % DF_FUNCTION_HASH_BUCKETS;
- func->next = df_functions[bucket];
- df_functions[bucket] = func;
-
- df_current_function = func;
-}
-
-/* When we're done compiling a function, call this. Any symbol referenced
- from now on will be associated with the global namespace.
-*/
-extern void df_note_function_end(uint32 endaddress)
-{
- df_current_function->length = endaddress - df_current_function->address;
-
- df_current_function_name = NULL;
- df_current_function_addr = DF_NOT_IN_FUNCTION;
- df_current_function = df_functions_head; /* the global namespace */
-}
-
-/* Find the function record for a given address. (Addresses are offsets
- in zcode_area.)
-*/
-static df_function_t *df_function_for_address(uint32 address)
-{
- int bucket = address % DF_FUNCTION_HASH_BUCKETS;
- df_function_t *func;
- for (func = df_functions[bucket]; func; func = func->next) {
- if (func->address == address)
- return func;
- }
- return NULL;
-}
-
-/* Whenever a function is referenced, we call this to note who called it.
-*/
-extern void df_note_function_symbol(int symbol)
-{
- int bucket, symtype;
- df_reference_t *ent;
-
- /* If the compiler pass is over, looking up symbols does not create
- a global reference. */
- if (df_tables_closed)
- return;
- /* In certain cases during parsing, looking up symbols does not
- create a global reference. (For example, when reading the name
- of a function being defined.) */
- if (df_dont_note_global_symbols)
- return;
-
- /* We are only interested in functions, or forward-declared symbols
- that might turn out to be functions. */
- symtype = stypes[symbol];
- if (symtype != ROUTINE_T && symtype != CONSTANT_T)
- return;
- if (symtype == CONSTANT_T && !(sflags[symbol] & UNKNOWN_SFLAG))
- return;
-
- bucket = (df_current_function_addr ^ (uint32)symbol) % DF_SYMBOL_HASH_BUCKETS;
- for (ent = df_symbol_map[bucket]; ent; ent = ent->next) {
- if (ent->address == df_current_function_addr && ent->symbol == symbol)
- return;
- }
-
- /* Create a new reference entry in df_symbol_map. */
- ent = my_malloc(sizeof(df_reference_t), "df symbol map entry");
- ent->address = df_current_function_addr;
- ent->symbol = symbol;
- ent->next = df_symbol_map[bucket];
- df_symbol_map[bucket] = ent;
-
- /* Add the reference to the function's entry as well. */
- /* The current function is the most recently added, so it will be
- at the top of its bucket. That makes this call fast. Unless
- we're in global scope, in which case it might be slower.
- (I suppose we could cache the df_function_t pointer of the
- current function, to speed things up.) */
- if (!df_current_function || df_current_function_addr != df_current_function->address)
- compiler_error("DF: df_current_function does not match current address.");
- ent->refsnext = df_current_function->refs;
- df_current_function->refs = ent;
-}
-
-/* This does the hard work of figuring out what functions are truly dead.
- It's called near the end of run_pass() in inform.c.
-*/
-extern void locate_dead_functions(void)
-{
- df_function_t *func, *tofunc;
- df_reference_t *ent;
- int ix;
-
- if (!track_unused_routines)
- compiler_error("DF: locate_dead_functions called, but function references have not been mapped");
-
- df_tables_closed = TRUE;
- df_current_function = NULL;
-
- /* Note that Main__ was tagged as global implicitly during
- compile_initial_routine(). Main was tagged during
- issue_unused_warnings(). But for the sake of thoroughness,
- we'll mark them specially. */
-
- ix = symbol_index("Main__", -1);
- if (stypes[ix] == ROUTINE_T) {
- uint32 addr = svals[ix] * (glulx_mode ? 1 : scale_factor);
- tofunc = df_function_for_address(addr);
- if (tofunc)
- tofunc->usage |= DF_USAGE_MAIN;
- }
- ix = symbol_index("Main", -1);
- if (stypes[ix] == ROUTINE_T) {
- uint32 addr = svals[ix] * (glulx_mode ? 1 : scale_factor);
- tofunc = df_function_for_address(addr);
- if (tofunc)
- tofunc->usage |= DF_USAGE_MAIN;
- }
-
- /* Go through all the functions referenced at the global level;
- mark them as used. */
-
- func = df_functions_head;
- if (!func || func->address != DF_NOT_IN_FUNCTION)
- compiler_error("DF: Global namespace entry is not at the head of the chain.");
-
- for (ent = func->refs; ent; ent=ent->refsnext) {
- uint32 addr;
- int symbol = ent->symbol;
- if (stypes[symbol] != ROUTINE_T)
- continue;
- addr = svals[symbol] * (glulx_mode ? 1 : scale_factor);
- tofunc = df_function_for_address(addr);
- if (!tofunc) {
- error_named("Internal error in stripping: global ROUTINE_T symbol is not found in df_function map:", (char *)symbs[symbol]);
- continue;
- }
- /* A function may be marked here more than once. That's fine. */
- tofunc->usage |= DF_USAGE_GLOBAL;
- }
-
- /* Perform a breadth-first search through functions, starting with
- the ones that are known to be used at the top level. */
- {
- df_function_t *todo, *todotail;
- df_function_t *func;
- todo = NULL;
- todotail = NULL;
-
- for (func = df_functions_head; func; func = func->funcnext) {
- if (func->address == DF_NOT_IN_FUNCTION)
- continue;
- if (func->usage == 0)
- continue;
- if (!todo) {
- todo = func;
- todotail = func;
- }
- else {
- todotail->todonext = func;
- todotail = func;
- }
- }
-
- /* todo is a linked list of functions which are known to be
- used. If a function's usage field is nonzero, it must be
- either be on the todo list or have come off already (in
- which case processed will be set). */
-
- while (todo) {
- /* Pop the next function. */
- func = todo;
- todo = todo->todonext;
- if (!todo)
- todotail = NULL;
-
- if (func->processed)
- error_named("Internal error in stripping: function has been processed twice:", func->name);
-
- /* Go through the function's symbol references. Any
- reference to a routine, push it into the todo list (if
- it isn't there already). */
-
- for (ent = func->refs; ent; ent=ent->refsnext) {
- uint32 addr;
- int symbol = ent->symbol;
- if (stypes[symbol] != ROUTINE_T)
- continue;
- addr = svals[symbol] * (glulx_mode ? 1 : scale_factor);
- tofunc = df_function_for_address(addr);
- if (!tofunc) {
- error_named("Internal error in stripping: function ROUTINE_T symbol is not found in df_function map:", (char *)symbs[symbol]);
- continue;
- }
- if (tofunc->usage)
- continue;
-
- /* Not yet known to be used. Add it to the todo list. */
- tofunc->usage |= DF_USAGE_FUNCTION;
- if (!todo) {
- todo = tofunc;
- todotail = tofunc;
- }
- else {
- todotail->todonext = tofunc;
- todotail = tofunc;
- }
- }
-
- func->processed = TRUE;
- }
- }
-
- /* Go through all functions; figure out how much space is consumed,
- with and without useless functions. */
-
- {
- df_function_t *func;
-
- df_total_size_before_stripping = 0;
- df_total_size_after_stripping = 0;
-
- for (func = df_functions_head; func; func = func->funcnext) {
- if (func->address == DF_NOT_IN_FUNCTION)
- continue;
-
- if (func->address != df_total_size_before_stripping)
- compiler_error("DF: Address gap in function list");
-
- df_total_size_before_stripping += func->length;
- if (func->usage) {
- func->newaddress = df_total_size_after_stripping;
- df_total_size_after_stripping += func->length;
- }
-
- if (!glulx_mode && (df_total_size_after_stripping % scale_factor != 0))
- compiler_error("DF: New function address is not aligned");
-
- if (WARN_UNUSED_ROUTINES && !func->usage) {
- if (!func->sysfile || WARN_UNUSED_ROUTINES >= 2)
- uncalled_routine_warning("Routine", func->name, func->source_line);
- }
- }
- }
-
- /* df_measure_hash_table_usage(); */
-}
-
-/* Given an original function address, return where it winds up after
- unused-function stripping. The function must not itself be unused.
-
- Both the input and output are offsets, and already scaled by
- scale_factor.
-
- This is used by the backpatching system.
-*/
-extern uint32 df_stripped_address_for_address(uint32 addr)
-{
- df_function_t *func;
-
- if (!track_unused_routines)
- compiler_error("DF: df_stripped_address_for_address called, but function references have not been mapped");
-
- if (!glulx_mode)
- func = df_function_for_address(addr*scale_factor);
- else
- func = df_function_for_address(addr);
-
- if (!func) {
- compiler_error("DF: Unable to find function while backpatching");
- return 0;
- }
- if (!func->usage)
- compiler_error("DF: Tried to backpatch a function address which should be stripped");
-
- if (!glulx_mode)
- return func->newaddress / scale_factor;
- else
- return func->newaddress;
-}
-
-/* Given an address in the function area, return where it winds up after
- unused-function stripping. The address can be a function or anywhere
- within the function. If the address turns out to be in a stripped
- function, returns 0 (and sets *stripped).
-
- The input and output are offsets, but *not* scaled.
-
- This is only used by the debug-file system.
-*/
-uint32 df_stripped_offset_for_code_offset(uint32 offset, int *stripped)
-{
- df_function_t *func;
- int count;
-
- if (!track_unused_routines)
- compiler_error("DF: df_stripped_offset_for_code_offset called, but function references have not been mapped");
-
- if (!df_functions_sorted) {
- /* To do this efficiently, we need a binary-searchable table. Fine,
- we'll make one. Include both used and unused functions. */
-
- for (func = df_functions_head, count = 0; func; func = func->funcnext) {
- if (func->address == DF_NOT_IN_FUNCTION)
- continue;
- count++;
- }
- df_functions_sorted_count = count;
-
- df_functions_sorted = my_calloc(sizeof(df_function_t *), df_functions_sorted_count, "df function sorted table");
-
- for (func = df_functions_head, count = 0; func; func = func->funcnext) {
- if (func->address == DF_NOT_IN_FUNCTION)
- continue;
- df_functions_sorted[count] = func;
- count++;
- }
- }
-
- /* Do a binary search. Maintain beg <= res < end, where res is the
- function containing the desired address. */
- int beg = 0;
- int end = df_functions_sorted_count;
-
- /* Set stripped flag until we decide on a non-stripped function. */
- *stripped = TRUE;
-
- while (1) {
- if (beg >= end) {
- error("DF: offset_for_code_offset: Could not locate address.");
- return 0;
- }
- if (beg+1 == end) {
- func = df_functions_sorted[beg];
- if (func->usage == 0)
- return 0;
- *stripped = FALSE;
- return func->newaddress + (offset - func->address);
- }
- int new = (beg + end) / 2;
- if (new <= beg || new >= end)
- compiler_error("DF: binary search went off the rails");
-
- func = df_functions_sorted[new];
- if (offset >= func->address) {
- if (offset < func->address+func->length) {
- /* We don't need to loop further; decide here. */
- if (func->usage == 0)
- return 0;
- *stripped = FALSE;
- return func->newaddress + (offset - func->address);
- }
- beg = new;
- }
- else {
- end = new;
- }
- }
-}
-
-/* The output_file() routines in files.c have to run down the list of
- functions, deciding who is in and who is out. But I don't want to
- export the df_function_t list structure. Instead, I provide this
- silly iterator pair. Set it up with df_prepare_function_iterate();
- then repeatedly call df_next_function_iterate().
-*/
-
-extern void df_prepare_function_iterate(void)
-{
- df_iterator = df_functions_head;
- if (!df_iterator || df_iterator->address != DF_NOT_IN_FUNCTION)
- compiler_error("DF: Global namespace entry is not at the head of the chain.");
- if (!df_iterator->funcnext || df_iterator->funcnext->address != 0)
- compiler_error("DF: First function entry is not second in the chain.");
-}
-
-/* This returns the end of the next function, and whether the next function
- is used (live).
-*/
-extern uint32 df_next_function_iterate(int *funcused)
-{
- if (df_iterator)
- df_iterator = df_iterator->funcnext;
- if (!df_iterator) {
- *funcused = TRUE;
- return df_total_size_before_stripping+1;
- }
- *funcused = (df_iterator->usage != 0);
- return df_iterator->address + df_iterator->length;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_symbols_vars(void)
-{
- symbs = NULL;
- svals = NULL;
- smarks = NULL;
- stypes = NULL;
- sflags = NULL;
- next_entry = NULL;
- start_of_list = NULL;
-
- symbol_name_space_chunks = NULL;
- no_symbol_name_space_chunks = 0;
- symbols_free_space=NULL;
- symbols_ceiling=symbols_free_space;
-
- no_symbols = 0;
-
- symbol_replacements = NULL;
- symbol_replacements_count = 0;
- symbol_replacements_size = 0;
-
- make_case_conversion_grid();
-
- track_unused_routines = (WARN_UNUSED_ROUTINES || OMIT_UNUSED_ROUTINES);
- df_tables_closed = FALSE;
- df_symbol_map = NULL;
- df_functions = NULL;
- df_functions_head = NULL;
- df_functions_tail = NULL;
- df_current_function = NULL;
- df_functions_sorted = NULL;
- df_functions_sorted_count = 0;
-}
-
-extern void symbols_begin_pass(void)
-{
- df_total_size_before_stripping = 0;
- df_total_size_after_stripping = 0;
- df_dont_note_global_symbols = FALSE;
- df_iterator = NULL;
-}
-
-extern void symbols_allocate_arrays(void)
-{
- symbs = my_calloc(sizeof(char *), MAX_SYMBOLS, "symbols");
- svals = my_calloc(sizeof(int32), MAX_SYMBOLS, "symbol values");
- if (glulx_mode)
- smarks = my_calloc(sizeof(int), MAX_SYMBOLS, "symbol markers");
- slines = my_calloc(sizeof(brief_location), MAX_SYMBOLS, "symbol lines");
- stypes = my_calloc(sizeof(char), MAX_SYMBOLS, "symbol types");
- sflags = my_calloc(sizeof(int), MAX_SYMBOLS, "symbol flags");
- if (debugfile_switch)
- { symbol_debug_backpatch_positions =
- my_calloc(sizeof(maybe_file_position), MAX_SYMBOLS,
- "symbol debug information backpatch positions");
- replacement_debug_backpatch_positions =
- my_calloc(sizeof(maybe_file_position), MAX_SYMBOLS,
- "replacement debug information backpatch positions");
- }
- next_entry = my_calloc(sizeof(int), MAX_SYMBOLS,
- "symbol linked-list forward links");
- start_of_list = my_calloc(sizeof(int32), HASH_TAB_SIZE,
- "hash code list beginnings");
-
- symbol_name_space_chunks
- = my_calloc(sizeof(char *), MAX_SYMBOL_CHUNKS, "symbol names chunk addresses");
-
- if (track_unused_routines) {
- df_tables_closed = FALSE;
-
- df_symbol_map = my_calloc(sizeof(df_reference_t *), DF_SYMBOL_HASH_BUCKETS, "df symbol-map hash table");
- memset(df_symbol_map, 0, sizeof(df_reference_t *) * DF_SYMBOL_HASH_BUCKETS);
-
- df_functions = my_calloc(sizeof(df_function_t *), DF_FUNCTION_HASH_BUCKETS, "df function hash table");
- memset(df_functions, 0, sizeof(df_function_t *) * DF_FUNCTION_HASH_BUCKETS);
- df_functions_head = NULL;
- df_functions_tail = NULL;
-
- df_functions_sorted = NULL;
- df_functions_sorted_count = 0;
-
- df_note_function_start("<global namespace>", DF_NOT_IN_FUNCTION, FALSE, blank_brief_location);
- df_note_function_end(DF_NOT_IN_FUNCTION);
- /* Now df_current_function is df_functions_head. */
- }
-
- init_symbol_banks();
- stockup_symbols();
-
- /* Allocated as needed */
- symbol_replacements = NULL;
-
- /* Allocated during story file construction, not now */
- individual_name_strings = NULL;
- attribute_name_strings = NULL;
- action_name_strings = NULL;
- array_name_strings = NULL;
-}
-
-extern void symbols_free_arrays(void)
-{ int i;
-
- for (i=0; i<no_symbol_name_space_chunks; i++)
- my_free(&(symbol_name_space_chunks[i]),
- "symbol names chunk");
-
- my_free(&symbol_name_space_chunks, "symbol names chunk addresses");
-
- my_free(&symbs, "symbols");
- my_free(&svals, "symbol values");
- my_free(&smarks, "symbol markers");
- my_free(&slines, "symbol lines");
- my_free(&stypes, "symbol types");
- my_free(&sflags, "symbol flags");
- if (debugfile_switch)
- { my_free
- (&symbol_debug_backpatch_positions,
- "symbol debug information backpatch positions");
- my_free
- (&replacement_debug_backpatch_positions,
- "replacement debug information backpatch positions");
- }
- my_free(&next_entry, "symbol linked-list forward links");
- my_free(&start_of_list, "hash code list beginnings");
-
- if (symbol_replacements)
- my_free(&symbol_replacements, "symbol replacement table");
-
- if (df_symbol_map) {
- for (i=0; i<DF_SYMBOL_HASH_BUCKETS; i++) {
- df_reference_t *ent = df_symbol_map[i];
- while (ent) {
- df_reference_t *next = ent->next;
- my_free(&ent, "df symbol map entry");
- ent = next;
- }
- }
- my_free(&df_symbol_map, "df symbol-map hash table");
- }
- if (df_functions_sorted) {
- my_free(&df_functions, "df function sorted table");
- }
- if (df_functions) {
- for (i=0; i<DF_FUNCTION_HASH_BUCKETS; i++) {
- df_function_t *func = df_functions[i];
- while (func) {
- df_function_t *next = func->next;
- my_free(&func, "df function entry");
- func = next;
- }
- }
- my_free(&df_functions, "df function hash table");
- }
- df_functions_head = NULL;
- df_functions_tail = NULL;
-
- if (individual_name_strings != NULL)
- my_free(&individual_name_strings, "property name strings");
- if (action_name_strings != NULL)
- my_free(&action_name_strings, "action name strings");
- if (attribute_name_strings != NULL)
- my_free(&attribute_name_strings, "attribute name strings");
- if (array_name_strings != NULL)
- my_free(&array_name_strings, "array name strings");
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "syntax" : Syntax analyser and compiler */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-static char *lexical_source;
-
-int no_syntax_lines; /* Syntax line count */
-
-static void begin_syntax_line(int statement_mode)
-{ no_syntax_lines++;
- next_token_begins_syntax_line = TRUE;
-
- clear_expression_space();
- if (statement_mode)
- { statements.enabled = TRUE;
- conditions.enabled = TRUE;
- local_variables.enabled = TRUE;
- system_functions.enabled = TRUE;
-
- misc_keywords.enabled = FALSE;
- directive_keywords.enabled = FALSE;
- directives.enabled = FALSE;
- segment_markers.enabled = FALSE;
- opcode_names.enabled = FALSE;
- }
- else
- { directives.enabled = TRUE;
- segment_markers.enabled = TRUE;
-
- statements.enabled = FALSE;
- misc_keywords.enabled = FALSE;
- directive_keywords.enabled = FALSE;
- local_variables.enabled = FALSE;
- system_functions.enabled = FALSE;
- conditions.enabled = FALSE;
- opcode_names.enabled = FALSE;
- }
-
- sequence_point_follows = TRUE;
-
- if (debugfile_switch)
- { get_next_token();
- statement_debug_location = get_token_location();
- put_token_back();
- }
-}
-
-extern void panic_mode_error_recovery(void)
-{
- /* Consume tokens until the next semicolon (or end of file).
- This is typically called after a syntax error, in hopes of
- getting parsing back on track. */
-
- while ((token_type != EOF_TT)
- && ((token_type != SEP_TT)||(token_value != SEMICOLON_SEP)))
-
- get_next_token();
-}
-
-extern void get_next_token_with_directives(void)
-{
- /* A higher-level version of get_next_token(), which detects and
- obeys directives such as #ifdef/#ifnot/#endif. (The # sign is
- required in this case.)
-
- This is called while parsing a long construct, such as Class or
- Object, where we want to support internal #ifdefs. (Although
- function-parsing predates this and doesn't make use of it.)
-
- (Technically this permits *any* #-directive, which means you
- can define global variables or properties or what-have-you in
- the middle of an object. You can do that in the middle of an
- object, too. Don't. It's about as well-supported as Wile E.
- Coyote one beat before the plummet-lines kick in.) */
-
- int directives_save, segment_markers_save, statements_save;
-
- while (TRUE)
- {
- get_next_token();
-
- /* If the first token is not a '#', return it directly. */
- if ((token_type != SEP_TT) || (token_value != HASH_SEP))
- return;
-
- /* Save the lexer flags, and set up for directive parsing. */
- directives_save = directives.enabled;
- segment_markers_save = segment_markers.enabled;
- statements_save = statements.enabled;
-
- directives.enabled = TRUE;
- segment_markers.enabled = FALSE;
- statements.enabled = FALSE;
- conditions.enabled = FALSE;
- local_variables.enabled = FALSE;
- misc_keywords.enabled = FALSE;
- system_functions.enabled = FALSE;
-
- get_next_token();
-
- if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
- { error("It is illegal to nest a routine inside an object using '#['");
- return;
- }
-
- if (token_type == DIRECTIVE_TT)
- parse_given_directive(TRUE);
- else
- { ebf_error("directive", token_text);
- 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.)
- */
- 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;
- }
-}
-
-extern void parse_program(char *source)
-{
- lexical_source = source;
- while (parse_directive(FALSE)) ;
-}
-
-extern int parse_directive(int internal_flag)
-{
- /* Internal_flag is FALSE if the directive is encountered normally,
- TRUE if encountered with a # prefix inside a routine or object
- definition.
-
- Returns: TRUE if program continues, FALSE if end of file reached. */
-
- int routine_symbol, rep_symbol;
- int is_renamed;
-
- begin_syntax_line(FALSE);
- get_next_token();
-
- if (token_type == EOF_TT) return(FALSE);
-
- if ((token_type == SEP_TT) && (token_value == HASH_SEP))
- get_next_token();
-
- if ((token_type == SEP_TT) && (token_value == OPEN_SQUARE_SEP))
- { if (internal_flag)
- { error("It is illegal to nest routines using '#['");
- return(TRUE);
- }
-
- directives.enabled = FALSE;
- directive_keywords.enabled = FALSE;
- segment_markers.enabled = FALSE;
-
- /* The upcoming symbol is a definition; don't count it as a
- top-level reference *to* the function. */
- df_dont_note_global_symbols = TRUE;
- get_next_token();
- df_dont_note_global_symbols = FALSE;
- if ((token_type != SYMBOL_TT)
- || ((!(sflags[token_value] & UNKNOWN_SFLAG))
- && (!(sflags[token_value] & REPLACE_SFLAG))))
- { ebf_error("routine name", token_text);
- return(FALSE);
- }
-
- routine_symbol = token_value;
-
- rep_symbol = routine_symbol;
- is_renamed = find_symbol_replacement(&rep_symbol);
-
- if ((sflags[routine_symbol] & REPLACE_SFLAG)
- && !is_renamed && (is_systemfile()))
- { /* The function is definitely being replaced (system_file
- always loses priority in a replacement) but is not
- being renamed to something else. Skip its definition
- entirely. */
- dont_enter_into_symbol_table = TRUE;
- do
- { get_next_token();
- } while (!((token_type == EOF_TT)
- || ((token_type==SEP_TT)
- && (token_value==CLOSE_SQUARE_SEP))));
- dont_enter_into_symbol_table = FALSE;
- if (token_type == EOF_TT) return FALSE;
- }
- else
- { /* Parse the function definition and assign its symbol. */
- assign_symbol(routine_symbol,
- parse_routine(lexical_source, FALSE,
- (char *) symbs[routine_symbol], FALSE, routine_symbol),
- ROUTINE_T);
- slines[routine_symbol] = routine_starts_line;
- }
-
- if (is_renamed) {
- /* This function was subject to a "Replace X Y" directive.
- The first time we see a definition for symbol X, we
- copy it to Y -- that's the "original" form of the
- function. */
- if (svals[rep_symbol] == 0) {
- assign_symbol(rep_symbol, svals[routine_symbol], ROUTINE_T);
- }
- }
-
- get_next_token();
- if ((token_type != SEP_TT) || (token_value != SEMICOLON_SEP))
- { ebf_error("';' after ']'", token_text);
- put_token_back();
- }
- return TRUE;
- }
-
- if ((token_type == SYMBOL_TT) && (stypes[token_value] == CLASS_T))
- { if (internal_flag)
- { error("It is illegal to nest an object in a routine using '#classname'");
- return(TRUE);
- }
- sflags[token_value] |= USED_SFLAG;
- make_object(FALSE, NULL, -1, -1, svals[token_value]);
- return TRUE;
- }
-
- if (token_type != DIRECTIVE_TT)
- { /* 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);
- else
- ebf_error("directive, '[' or class name", token_text);
- panic_mode_error_recovery();
- return TRUE;
- }
-
- return !(parse_given_directive(internal_flag));
-}
-
-static int switch_sign(void)
-{
- if ((token_type == SEP_TT)&&(token_value == COLON_SEP)) return 1;
- if ((token_type == SEP_TT)&&(token_value == COMMA_SEP)) return 2;
- if ((token_type==MISC_KEYWORD_TT)&&(token_value==TO_MK)) return 3;
- return 0;
-}
-
-static assembly_operand spec_stack[32];
-static int spec_type[32];
-
-static void compile_alternatives_z(assembly_operand switch_value, int n,
- int stack_level, int label, int flag)
-{ switch(n)
- { case 1:
- assemblez_2_branch(je_zc, switch_value,
- spec_stack[stack_level],
- label, flag); return;
- case 2:
- assemblez_3_branch(je_zc, switch_value,
- spec_stack[stack_level], spec_stack[stack_level+1],
- label, flag); return;
- case 3:
- assemblez_4_branch(je_zc, switch_value,
- spec_stack[stack_level], spec_stack[stack_level+1],
- spec_stack[stack_level+2],
- label, flag); return;
- }
-}
-
-static void compile_alternatives_g(assembly_operand switch_value, int n,
- int stack_level, int label, int flag)
-{
- int the_zc = (flag) ? jeq_gc : jne_gc;
-
- if (n == 1) {
- assembleg_2_branch(the_zc, switch_value,
- spec_stack[stack_level],
- label);
- }
- else {
- error("*** Cannot generate multi-equality tests in Glulx ***");
- }
-}
-
-static void compile_alternatives(assembly_operand switch_value, int n,
- int stack_level, int label, int flag)
-{
- if (!glulx_mode)
- compile_alternatives_z(switch_value, n, stack_level, label, flag);
- else
- compile_alternatives_g(switch_value, n, stack_level, label, flag);
-}
-
-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);
-
- sequence_point_follows = FALSE;
-
- do
- { if (spec_sp == 32)
- { error("At most 32 values can be given in a single 'switch' case");
- panic_mode_error_recovery();
- return;
- }
-
- if (action_switch)
- { get_next_token();
- if (token_type == SQ_TT || token_type == DQ_TT) {
- ebf_error("action (or fake action) name", token_text);
- 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);
- }
- }
- else
- spec_stack[spec_sp] =
- code_generate(parse_expression(CONSTANT_CONTEXT), CONSTANT_CONTEXT, -1);
-
- misc_keywords.enabled = TRUE;
- get_next_token();
- misc_keywords.enabled = FALSE;
-
- spec_type[spec_sp++] = switch_sign();
- switch(spec_type[spec_sp-1])
- { case 0:
- if (action_switch)
- ebf_error("',' or ':'", token_text);
- else ebf_error("',', ':' or 'to'", token_text);
- panic_mode_error_recovery();
- return;
- case 1: goto GenSpecCode;
- case 3: if (label_after == -1) label_after = next_label++;
- }
- } while(TRUE);
-
- GenSpecCode:
-
- if ((spec_sp > max_equality_args) && (label_after == -1))
- label_after = next_label++;
-
- if (label_after == -1)
- { compile_alternatives(switch_value, spec_sp, 0, label, FALSE); return;
- }
-
- for (i=0; i<spec_sp;)
- {
- j=i; while ((j<spec_sp) && (spec_type[j] != 3)) j++;
-
- if (j > i)
- { if (j-i > max_equality_args) j=i+max_equality_args;
-
- if (j == spec_sp)
- compile_alternatives(switch_value, j-i, i, label, FALSE);
- else
- compile_alternatives(switch_value, j-i, i, label_after, TRUE);
-
- i=j;
- }
- else
- {
- if (!glulx_mode) {
- if (i == spec_sp - 2)
- { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
- label, TRUE);
- assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
- label, TRUE);
- }
- else
- { assemblez_2_branch(jl_zc, switch_value, spec_stack[i],
- next_label, TRUE);
- assemblez_2_branch(jg_zc, switch_value, spec_stack[i+1],
- label_after, FALSE);
- assemble_label_no(next_label++);
- }
- }
- else {
- if (i == spec_sp - 2)
- { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
- label);
- assembleg_2_branch(jgt_gc, switch_value, spec_stack[i+1],
- label);
- }
- else
- { assembleg_2_branch(jlt_gc, switch_value, spec_stack[i],
- next_label);
- assembleg_2_branch(jle_gc, switch_value, spec_stack[i+1],
- label_after);
- assemble_label_no(next_label++);
- }
- }
- i = i+2;
- }
- }
-
- assemble_label_no(label_after);
-}
-
-extern int32 parse_routine(char *source, int embedded_flag, char *name,
- int veneer_flag, int r_symbol)
-{ int32 packed_address; int i; int debug_flag = FALSE;
- int switch_clause_made = FALSE, default_clause_made = FALSE,
- switch_label = 0;
- debug_location_beginning beginning_debug_location =
- get_token_location_beginning();
-
- /* (switch_label needs no initialisation here, but it prevents some
- compilers from issuing warnings) */
-
- if ((source != lexical_source) || (veneer_flag))
- { lexical_source = source;
- restart_lexer(lexical_source, name);
- }
-
- no_locals = 0;
-
- for (i=0;i<MAX_LOCAL_VARIABLES-1;i++) local_variables.keywords[i] = "";
-
- do
- { statements.enabled = TRUE;
- dont_enter_into_symbol_table = TRUE;
- get_next_token();
- dont_enter_into_symbol_table = FALSE;
- if ((token_type == SEP_TT) && (token_value == TIMES_SEP)
- && (no_locals == 0) && (!debug_flag))
- { debug_flag = TRUE; continue;
- }
-
- if (token_type != DQ_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);
- panic_mode_error_recovery();
- break;
- }
-
- if (no_locals == MAX_LOCAL_VARIABLES-1)
- { error_numbered("Too many local variables for a routine; max is",
- MAX_LOCAL_VARIABLES-1);
- panic_mode_error_recovery();
- break;
- }
-
- for (i=0;i<no_locals;i++)
- if (strcmpcis(token_text, local_variables.keywords[i])==0)
- error_named("Local variable defined twice:", token_text);
- local_variables.keywords[no_locals++] = token_text;
- } while(TRUE);
-
- construct_local_variable_tables();
-
- if ((trace_fns_setting==3)
- || ((trace_fns_setting==2) && (veneer_mode==FALSE))
- || ((trace_fns_setting==1) && (is_systemfile()==FALSE)))
- debug_flag = TRUE;
- if ((embedded_flag == FALSE) && (veneer_mode == FALSE) && debug_flag)
- sflags[r_symbol] |= STAR_SFLAG;
-
- packed_address = assemble_routine_header(no_locals, debug_flag,
- name, embedded_flag, r_symbol);
-
- do
- { begin_syntax_line(TRUE);
-
- get_next_token();
-
- if (token_type == EOF_TT)
- { ebf_error("']'", token_text);
- assemble_routine_end
- (embedded_flag,
- get_token_location_end(beginning_debug_location));
- put_token_back();
- break;
- }
-
- if ((token_type == SEP_TT)
- && (token_value == CLOSE_SQUARE_SEP))
- { if (switch_clause_made && (!default_clause_made))
- assemble_label_no(switch_label);
- directives.enabled = TRUE;
- sequence_point_follows = TRUE;
- get_next_token();
- assemble_routine_end
- (embedded_flag,
- get_token_location_end(beginning_debug_location));
- put_token_back();
- break;
- }
-
- if ((token_type == STATEMENT_TT) && (token_value == SDEFAULT_CODE))
- { if (default_clause_made)
- error("Multiple 'default' clauses defined in same 'switch'");
- default_clause_made = TRUE;
-
- if (switch_clause_made)
- { if (!execution_never_reaches_here)
- { sequence_point_follows = FALSE;
- if (!glulx_mode)
- assemblez_0((embedded_flag)?rfalse_zc:rtrue_zc);
- else
- assembleg_1(return_gc,
- ((embedded_flag)?zero_operand:one_operand));
- }
- assemble_label_no(switch_label);
- }
- switch_clause_made = TRUE;
-
- get_next_token();
- if ((token_type == SEP_TT) &&
- (token_value == COLON_SEP)) continue;
- ebf_error("':' after 'default'", token_text);
- panic_mode_error_recovery();
- continue;
- }
-
- /* Only check for the form of a case switch if the initial token
- isn't double-quoted text, as that would mean it was a print_ret
- statement: this is a mild ambiguity in the grammar.
- Action statements also cannot be cases. */
-
- if ((token_type != DQ_TT) && (token_type != SEP_TT))
- { get_next_token();
- if (switch_sign() > 0)
- { assembly_operand AO;
- 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;
- if (!glulx_mode)
- assemblez_0((embedded_flag)?rfalse_zc:rtrue_zc);
- else
- assembleg_1(return_gc,
- ((embedded_flag)?zero_operand:one_operand));
- }
- assemble_label_no(switch_label);
- }
-
- switch_label = next_label++;
- switch_clause_made = TRUE;
- put_token_back(); put_token_back();
-
- if (!glulx_mode) {
- INITAOTV(&AO, VARIABLE_OT, 249);
- }
- else {
- INITAOTV(&AO, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+6); /* sw__var */
- }
- parse_switch_spec(AO, switch_label, TRUE);
-
- continue;
- }
- else
- { put_token_back(); put_token_back(); get_next_token();
- sequence_point_follows = TRUE;
- }
- }
-
- parse_statement(-1, -1);
-
- } while (TRUE);
-
- return packed_address;
-}
-
-extern void parse_code_block(int break_label, int continue_label,
- int switch_rule)
-{ int switch_clause_made = FALSE, default_clause_made = FALSE, switch_label = 0,
- unary_minus_flag;
-
- begin_syntax_line(TRUE);
- get_next_token();
-
- if (token_type == SEP_TT && token_value == OPEN_BRACE_SEP)
- { do
- { begin_syntax_line(TRUE);
- get_next_token();
- if (token_type == SEP_TT && token_value == CLOSE_BRACE_SEP)
- { if (switch_clause_made && (!default_clause_made))
- assemble_label_no(switch_label);
- return;
- }
- if (token_type == EOF_TT)
- { ebf_error("'}'", token_text); return; }
-
- if (switch_rule != 0)
- {
- /* Within a 'switch' block */
-
- if ((token_type==STATEMENT_TT)&&(token_value==SDEFAULT_CODE))
- { if (default_clause_made)
- error("Multiple 'default' clauses defined in same 'switch'");
- default_clause_made = TRUE;
-
- if (switch_clause_made)
- { if (!execution_never_reaches_here)
- { sequence_point_follows = FALSE;
- assemble_jump(break_label);
- }
- assemble_label_no(switch_label);
- }
- switch_clause_made = TRUE;
-
- get_next_token();
- if ((token_type == SEP_TT) &&
- (token_value == COLON_SEP)) continue;
- ebf_error("':' after 'default'", token_text);
- panic_mode_error_recovery();
- continue;
- }
-
- /* Decide: is this an ordinary statement, or the start
- of a new case? */
-
- if (token_type == DQ_TT) goto NotASwitchCase;
-
- unary_minus_flag
- = ((token_type == SEP_TT)&&(token_value == MINUS_SEP));
- if (unary_minus_flag) get_next_token();
-
- /* Now read the token _after_ any possible constant:
- if that's a 'to', ',' or ':' then we have a case */
-
- misc_keywords.enabled = TRUE;
- get_next_token();
- misc_keywords.enabled = FALSE;
-
- if (switch_sign() > 0)
- { assembly_operand AO;
-
- 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;
- put_token_back(); put_token_back();
- if (unary_minus_flag) put_token_back();
-
- AO = temp_var1;
- parse_switch_spec(AO, switch_label, FALSE);
- continue;
- }
- else
- { put_token_back(); put_token_back();
- if (unary_minus_flag) put_token_back();
- get_next_token();
- }
- }
-
- if ((switch_rule != 0) && (!switch_clause_made))
- ebf_error("switch value", token_text);
-
- NotASwitchCase:
- sequence_point_follows = TRUE;
- parse_statement(break_label, continue_label);
- }
- while(TRUE);
- }
-
- if (switch_rule != 0)
- ebf_error("braced code block after 'switch'", token_text);
-
- parse_statement(break_label, continue_label);
- return;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_syntax_vars(void)
-{
-}
-
-extern void syntax_begin_pass(void)
-{ no_syntax_lines = 0;
-}
-
-extern void syntax_allocate_arrays(void)
-{
-}
-
-extern void syntax_free_arrays(void)
-{
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "tables" : Constructs the story file or module (the output) up to the */
-/* end of dynamic memory, gluing together all the required */
-/* tables. */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-uchar *zmachine_paged_memory; /* Where we shall store the story file
- constructed (contains all of paged
- memory, i.e. all but code and the
- static strings: allocated only when
- we know how large it needs to be,
- at the end of the compilation pass */
-
-/* In Glulx, zmachine_paged_memory contains all of RAM -- i.e. all but
- the header, the code, and the static strings. */
-
-/* ------------------------------------------------------------------------- */
-/* Offsets of various areas in the Z-machine: these are set to nominal */
-/* values before the compilation pass, and to their calculated final */
-/* values only when construct_storyfile() happens. These are then used to */
-/* backpatch the incorrect values now existing in the Z-machine which */
-/* used these nominal values. */
-/* Most of the nominal values are 0x800 because this is guaranteed to */
-/* be assembled as a long constant if it's needed in code, since the */
-/* largest possible value of scale_factor is 8 and 0x800/8 = 256. */
-/* */
-/* In Glulx, I use 0x12345 instead of 0x800. This will always be a long */
-/* (32-bit) constant, since there's no scale_factor. */
-/* ------------------------------------------------------------------------- */
-
-int32 code_offset,
- actions_offset,
- preactions_offset,
- dictionary_offset,
- adjectives_offset,
- variables_offset,
- strings_offset,
- class_numbers_offset,
- individuals_offset,
- identifier_names_offset,
- array_names_offset,
- prop_defaults_offset,
- prop_values_offset,
- static_memory_offset,
- attribute_names_offset,
- action_names_offset,
- fake_action_names_offset,
- routine_names_offset,
- constant_names_offset,
- routines_array_offset,
- constants_array_offset,
- routine_flags_array_offset,
- global_names_offset,
- global_flags_array_offset,
- array_flags_array_offset;
-int32 arrays_offset,
- object_tree_offset,
- grammar_table_offset,
- abbreviations_offset; /* Glulx */
-
-int32 Out_Size, Write_Code_At, Write_Strings_At;
-int32 RAM_Size, Write_RAM_At; /* Glulx */
-
-/* ------------------------------------------------------------------------- */
-/* Story file header settings. (Written to in "directs.c" and "asm.c".) */
-/* ------------------------------------------------------------------------- */
-
-int release_number, /* Release number game is to have */
- statusline_flag; /* Either TIME_STYLE or SCORE_STYLE */
-
-int serial_code_given_in_program /* If TRUE, a Serial directive has */
- = FALSE; /* specified this 6-digit serial code */
-char serial_code_buffer[7]; /* (overriding the usual date-stamp) */
-int flags2_requirements[16]; /* An array of which bits in Flags 2 of
- the header will need to be set:
- e.g. if the save_undo / restore_undo
- opcodes are ever assembled, we have
- to set the "games want UNDO" bit.
- Values are 0 or 1. */
-
-/* ------------------------------------------------------------------------- */
-/* Construct story/module file (up to code area start). */
-/* */
-/* (To understand what follows, you really need to look at the run-time */
-/* system's specification, the Z-Machine Standards document.) */
-/* ------------------------------------------------------------------------- */
-
-extern void write_serial_number(char *buffer)
-{
- /* Note that this function may require modification for "ANSI" compilers
- which do not provide the standard time functions: what is needed is
- the ability to work out today's date */
-
- time_t tt; tt=time(0);
- if (serial_code_given_in_program)
- strcpy(buffer, serial_code_buffer);
- else
-#ifdef TIME_UNAVAILABLE
- sprintf(buffer,"970000");
-#else
- strftime(buffer,10,"%y%m%d",localtime(&tt));
-#endif
-}
-
-static void percentage(char *name, int32 x, int32 total)
-{ printf(" %-20s %2d.%d%%\n",name,x*100/total,(x*1000/total)%10);
-}
-
-static char *version_name(int v)
-{
- if (!glulx_mode) {
- switch(v)
- { case 3: return "Standard";
- case 4: return "Plus";
- case 5: return "Advanced";
- case 6: return "Graphical";
- case 8: return "Extended";
- }
- return "experimental format";
- }
- else {
- return "Glulx";
- }
-}
-
-static int32 rough_size_of_paged_memory_z(void)
-{
- /* This function calculates a modest over-estimate of the amount of
- memory required to store the Z-machine's paged memory area
- (that is, everything up to the start of the code area). */
-
- int32 total, i;
-
- ASSERT_ZCODE();
-
- total = 64 /* header */
- + 2 + subtract_pointers(low_strings_top, low_strings)
- /* low strings pool */
- + 6*32; /* abbreviations table */
-
- total += 8; /* header extension table */
- if (ZCODE_HEADER_EXT_WORDS>3) total += (ZCODE_HEADER_EXT_WORDS-3)*2;
-
- if (alphabet_modified) total += 78; /* character set table */
-
- if (zscii_defn_modified) /* Unicode translation table */
- total += 2 + 2*zscii_high_water_mark;
-
- total += 2*((version_number==3)?31:63) /* property default values */
- + no_objects*((version_number==3)?9:14) /* object tree table */
- + properties_table_size /* property values of objects */
- + (no_classes+1)*(module_switch?4:2)
- /* class object numbers table */
- + no_symbols*2 /* names of numerous things */
- + individuals_length /* tables of prop variables */
- + dynamic_array_area_size; /* variables and arrays */
-
- for (i=0; i<no_Inform_verbs; i++)
- total += 2 + 1 + /* address of grammar table, */
- /* number of grammar lines */
- ((grammar_version_number == 1)?
- (8*Inform_verbs[i].lines):0); /* grammar lines */
-
- if (grammar_version_number != 1)
- total += grammar_lines_top; /* size of grammar lines area */
-
- total += 2 + 4*no_adjectives /* adjectives table */
- + 2*no_actions /* action routines */
- + 2*no_grammar_token_routines; /* general parsing routines */
-
- total += (subtract_pointers(dictionary_top, dictionary)) /* dictionary */
- + ((module_switch)?30:0); /* module map */
-
- total += scale_factor*0x100 /* maximum null bytes before code */
- + 1000; /* fudge factor (in case the above is wrong) */
-
- return(total);
-}
-
-static int32 rough_size_of_paged_memory_g(void)
-{
- /* This function calculates a modest over-estimate of the amount of
- memory required to store the machine's paged memory area
- (that is, everything up to the start of the code area). */
-
- int32 total;
-
- ASSERT_GLULX();
-
- /* No header for us! */
- total = 1000; /* bit of a fudge factor */
-
- total += dynamic_array_area_size; /* arrays and global variables */
-
- total += no_objects * OBJECT_BYTE_LENGTH; /* object tables */
- total += properties_table_size; /* property tables */
- total += no_properties * 4; /* property defaults table */
-
- total += 4 + no_classes * 4; /* class prototype object numbers */
-
- total += 32; /* address/length of the identifier tables */
- total += no_properties * 4;
- total += (no_individual_properties-INDIV_PROP_START) * 4;
- total += (NUM_ATTR_BYTES*8) * 4;
- total += (no_actions + no_fake_actions) * 4;
- total += 4 + no_arrays * 4;
-
- total += 4 + no_Inform_verbs * 4; /* index of grammar tables */
- total += grammar_lines_top; /* grammar tables */
-
- total += 4 + no_actions * 4; /* actions functions table */
-
- total += 4;
- total += subtract_pointers(dictionary_top, dictionary);
-
- while (total % GPAGESIZE)
- total++;
-
- return(total);
-}
-
-static void construct_storyfile_z(void)
-{ uchar *p;
- int32 i, j, k, l, mark, objs, strings_length, code_length,
- limit=0, excess=0, extend_offset=0, headerext_length=0;
- int32 globals_at=0, link_table_at=0, dictionary_at=0, actions_at=0, preactions_at=0,
- abbrevs_at=0, prop_defaults_at=0, object_tree_at=0, object_props_at=0,
- map_of_module=0, grammar_table_at=0, charset_at=0, headerext_at=0,
- terminating_chars_at=0, unicode_at=0, id_names_length=0;
- int skip_backpatching = FALSE;
- char *output_called = (module_switch)?"module":"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");
-
- 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");
-
- /* Foolish code to make this routine compile on all ANSI compilers */
-
- p = (uchar *) zmachine_paged_memory;
-
- /* In what follows, the "mark" will move upwards in memory: at various
- points its value will be recorded for milestones like
- "dictionary table start". It begins at 0x40, just after the header */
-
- mark = 0x40;
-
- /* ----------------- Low Strings and Abbreviations -------------------- */
-
- p[mark]=0x80; p[mark+1]=0; mark+=2; /* Start the low strings pool
- with a useful default string, " " */
-
- for (i=0; i+low_strings<low_strings_top; mark++, i++) /* Low strings pool */
- p[0x42+i]=low_strings[i];
-
- abbrevs_at = mark;
- for (i=0; i<3*32; i++) /* Initially all 96 entries */
- { p[mark++]=0; p[mark++]=0x20; /* are set to " " */
- }
- for (i=0; i<no_abbreviations; i++) /* Write any abbreviations */
- { j=abbrev_values[i]; /* into banks 2 and 3 */
- p[abbrevs_at+64+2*i]=j/256; /* (bank 1 is reserved for */
- p[abbrevs_at+65+2*i]=j%256; /* "variable strings") */
- }
-
- /* ------------------- Header extension table ------------------------- */
-
- headerext_at = mark;
- headerext_length = ZCODE_HEADER_EXT_WORDS;
- if (zscii_defn_modified) {
- /* Need at least 3 words for unicode table address */
- if (headerext_length < 3)
- headerext_length = 3;
- }
- if (ZCODE_HEADER_FLAGS_3) {
- /* Need at least 4 words for the flags-3 field (ZSpec 1.1) */
- if (headerext_length < 4)
- headerext_length = 4;
- }
- p[mark++] = 0; p[mark++] = headerext_length;
- for (i=0; i<headerext_length; i++)
- { p[mark++] = 0; p[mark++] = 0;
- }
-
- /* -------------------- Z-character set table ------------------------- */
-
- if (alphabet_modified)
- { charset_at = mark;
- for (i=0;i<3;i++) for (j=0;j<26;j++)
- { if (alphabet[i][j] == '~') p[mark++] = '\"';
- else p[mark++] = alphabet[i][j];
- }
- }
-
- /* ------------------ Unicode translation table ----------------------- */
-
- unicode_at = 0;
- if (zscii_defn_modified)
- { unicode_at = mark;
- p[mark++] = zscii_high_water_mark;
- for (i=0;i<zscii_high_water_mark;i++)
- { j = zscii_to_unicode(155 + i);
- if (j < 0 || j > 0xFFFF) {
- error("Z-machine Unicode translation table cannot contain characters beyond $FFFF.");
- }
- p[mark++] = j/256; p[mark++] = j%256;
- }
- }
-
- /* -------------------- Objects and Properties ------------------------ */
-
- /* The object table must be word-aligned. The Z-machine spec does not
- require this, but the RA__Pr() veneer routine does. See
- http://inform7.com/mantis/view.php?id=1712.
- */
- while ((mark%2) != 0) p[mark++]=0;
-
- prop_defaults_at = mark;
-
- p[mark++]=0; p[mark++]=0;
-
- for (i=2; i< ((version_number==3)?32:64); i++)
- { p[mark++]=prop_default_value[i]/256;
- p[mark++]=prop_default_value[i]%256;
- }
-
- object_tree_at = mark;
-
- mark += ((version_number==3)?9:14)*no_objects;
-
- object_props_at = mark;
-
- for (i=0; i<properties_table_size; i++)
- p[mark+i]=properties_table[i];
-
- for (i=0, objs=object_tree_at; i<no_objects; i++)
- {
- if (version_number == 3)
- { p[objs]=objectsz[i].atts[0];
- p[objs+1]=objectsz[i].atts[1];
- p[objs+2]=objectsz[i].atts[2];
- p[objs+3]=objectsz[i].atts[3];
- p[objs+4]=objectsz[i].parent;
- p[objs+5]=objectsz[i].next;
- p[objs+6]=objectsz[i].child;
- p[objs+7]=mark/256;
- p[objs+8]=mark%256;
- objs+=9;
- }
- else
- { p[objs]=objectsz[i].atts[0];
- p[objs+1]=objectsz[i].atts[1];
- p[objs+2]=objectsz[i].atts[2];
- p[objs+3]=objectsz[i].atts[3];
- p[objs+4]=objectsz[i].atts[4];
- p[objs+5]=objectsz[i].atts[5];
- p[objs+6]=(objectsz[i].parent)/256;
- p[objs+7]=(objectsz[i].parent)%256;
- p[objs+8]=(objectsz[i].next)/256;
- p[objs+9]=(objectsz[i].next)%256;
- p[objs+10]=(objectsz[i].child)/256;
- p[objs+11]=(objectsz[i].child)%256;
- if (!module_switch)
- { p[objs+12]=mark/256;
- p[objs+13]=mark%256;
- }
- else
- { p[objs+12]=objectsz[i].propsize/256;
- p[objs+13]=objectsz[i].propsize%256;
- }
- objs+=14;
- }
- mark+=objectsz[i].propsize;
- }
-
- /* ----------- Table of Class Prototype Object Numbers ---------------- */
-
- class_numbers_offset = mark;
- for (i=0; i<no_classes; i++)
- { p[mark++] = class_object_numbers[i]/256;
- p[mark++] = class_object_numbers[i]%256;
- if (module_switch)
- { p[mark++] = class_begins_at[i]/256;
- p[mark++] = class_begins_at[i]%256;
- }
- }
- p[mark++] = 0;
- p[mark++] = 0;
-
- /* ------------------- Table of Identifier Names ---------------------- */
-
- identifier_names_offset = mark;
-
- if (!module_switch)
- { p[mark++] = no_individual_properties/256;
- p[mark++] = no_individual_properties%256;
- for (i=1; i<no_individual_properties; i++)
- { p[mark++] = individual_name_strings[i]/256;
- p[mark++] = individual_name_strings[i]%256;
- }
-
- attribute_names_offset = mark;
- for (i=0; i<48; i++)
- { p[mark++] = attribute_name_strings[i]/256;
- p[mark++] = attribute_name_strings[i]%256;
- }
-
- action_names_offset = mark;
- fake_action_names_offset = mark + 2*no_actions;
- for (i=0; i<no_actions + no_fake_actions; i++)
- { p[mark++] = action_name_strings[i]/256;
- p[mark++] = action_name_strings[i]%256;
- }
-
- array_names_offset = mark;
- global_names_offset = mark + 2*no_arrays;
- routine_names_offset = global_names_offset + 2*no_globals;
- constant_names_offset = routine_names_offset + 2*no_named_routines;
- for (i=0; i<no_arrays + no_globals
- + no_named_routines + no_named_constants; i++)
- { if ((i == no_arrays) && (define_INFIX_switch == FALSE)) break;
- p[mark++] = array_name_strings[i]/256;
- p[mark++] = array_name_strings[i]%256;
- }
-
- id_names_length = (mark - identifier_names_offset)/2;
- }
- routine_flags_array_offset = mark;
-
- if (define_INFIX_switch)
- { for (i=0, k=1, l=0; i<no_named_routines; i++)
- { if (sflags[named_routine_symbols[i]] & STAR_SFLAG) l=l+k;
- k=k*2;
- if (k==256) { p[mark++] = l; k=1; l=0; }
- }
- if (k!=1) p[mark++]=l;
- }
-
- /* ---------------- Table of Indiv Property Values -------------------- */
-
- individuals_offset = mark;
- for (i=0; i<individuals_length; i++)
- p[mark++] = individuals_table[i];
-
- /* ----------------- Variables and Dynamic Arrays --------------------- */
-
- globals_at = mark;
-
- for (i=0; i<dynamic_array_area_size; i++)
- p[mark++] = dynamic_array_area[i];
-
- for (i=0; i<240; i++)
- { j=global_initial_value[i];
- p[globals_at+i*2] = j/256; p[globals_at+i*2+1] = j%256;
- }
-
- /* ------------------ Terminating Characters Table -------------------- */
-
- if (version_number >= 5)
- { terminating_chars_at = mark;
- for (i=0; i<no_termcs; i++) p[mark++] = terminating_characters[i];
- p[mark++] = 0;
- }
-
- /* ------------------------ Grammar Table ----------------------------- */
-
- if (grammar_version_number > 2)
- { warning("This version of Inform is unable to produce the grammar \
-table format requested (producing number 2 format instead)");
- grammar_version_number = 2;
- }
-
- grammar_table_at = mark;
-
- mark = mark + no_Inform_verbs*2;
-
- 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);
- p[mark++] = Inform_verbs[i].lines;
- for (j=0; j<Inform_verbs[i].lines; j++)
- { k = Inform_verbs[i].l[j];
- if (grammar_version_number == 1)
- { int m, n;
- p[mark+7] = grammar_lines[k+1];
- for (m=1;m<=6;m++) p[mark + m] = 0;
- k = k + 2; m = 1; n = 0;
- while ((grammar_lines[k] != 15) && (m<=6))
- { p[mark + m] = grammar_lines[k];
- if (grammar_lines[k] < 180) n++;
- m++; k = k + 3;
- }
- p[mark] = n;
- mark = mark + 8;
- }
- else
- { int tok;
- p[mark++] = grammar_lines[k++];
- p[mark++] = grammar_lines[k++];
- for (;;)
- { tok = grammar_lines[k++];
- p[mark++] = tok;
- if (tok == 15) break;
- p[mark++] = grammar_lines[k++];
- p[mark++] = grammar_lines[k++];
- }
- }
- }
- }
-
- /* ------------------- Actions and Preactions ------------------------- */
- /* (The term "preactions" is traditional: Inform uses the preactions */
- /* table for a different purpose than Infocom used to.) */
- /* The values are written later, when the Z-code offset is known. */
- /* -------------------------------------------------------------------- */
-
- actions_at = mark;
- mark += no_actions*2;
-
- preactions_at = mark;
- if (grammar_version_number == 1)
- mark += no_grammar_token_routines*2;
-
- /* ----------------------- Adjectives Table --------------------------- */
-
- if (grammar_version_number == 1)
- { p[mark]=0; p[mark+1]=no_adjectives; mark+=2; /* To assist "infodump" */
- adjectives_offset = mark;
- dictionary_offset = mark + 4*no_adjectives;
-
- for (i=0; i<no_adjectives; i++)
- { j = final_dict_order[adjectives[no_adjectives-i-1]]
- *((version_number==3)?7:9)
- + dictionary_offset + 7;
- p[mark++]=j/256; p[mark++]=j%256; p[mark++]=0;
- p[mark++]=(256-no_adjectives+i);
- }
- }
- else
- { p[mark]=0; p[mark+1]=0; mark+=2;
- adjectives_offset = mark;
- dictionary_offset = mark;
- }
-
- /* ------------------------- Dictionary ------------------------------- */
-
- dictionary_at=mark;
-
- dictionary[0]=3; dictionary[1]='.'; /* Non-space characters which */
- dictionary[2]=','; /* force words apart */
- dictionary[3]='"';
-
- dictionary[4]=(version_number==3)?7:9; /* Length of each entry */
- dictionary[5]=(dict_entries/256); /* Number of entries */
- dictionary[6]=(dict_entries%256);
-
- for (i=0; i<7; i++) p[mark++] = dictionary[i];
-
- for (i=0; i<dict_entries; i++)
- { k = 7 + i*((version_number==3)?7:9);
- j = mark + final_dict_order[i]*((version_number==3)?7:9);
- for (l = 0; l<((version_number==3)?7:9); l++)
- p[j++] = dictionary[k++];
- }
- mark += dict_entries * ((version_number==3)?7:9);
-
- /* ------------------------- Module Map ------------------------------- */
-
- if (module_switch)
- { map_of_module = mark; /* Filled in below */
- mark += 30;
- }
-
- /* ----------------- A gap before the code area ----------------------- */
- /* (so that it will start at an exact packed address and so that all */
- /* routine packed addresses are >= 256, hence long constants) */
- /* -------------------------------------------------------------------- */
-
- while ((mark%length_scale_factor) != 0) p[mark++]=0;
- while (mark < (scale_factor*0x100)) p[mark++]=0;
- if (oddeven_packing_switch)
- while ((mark%(scale_factor*2)) != 0) p[mark++]=0;
-
- if (mark > 0x0FFFE)
- { error("This program has overflowed the maximum readable-memory \
-size of the Z-machine format. See the memory map below: the start \
-of the area marked \"above readable memory\" must be brought down to $FFFE \
-or less.");
- memory_map_switch = TRUE;
- /* Backpatching the grammar tables requires us to trust some of the */
- /* addresses we've written into Z-machine memory, but they may have */
- /* been truncated to 16 bits, so we can't do it. */
- skip_backpatching = TRUE;
- }
-
- /* -------------------------- Code Area ------------------------------- */
- /* (From this point on we don't write any more into the "p" buffer.) */
- /* -------------------------------------------------------------------- */
-
- Write_Code_At = mark;
- if (!OMIT_UNUSED_ROUTINES) {
- code_length = zmachine_pc;
- }
- else {
- if (zmachine_pc != df_total_size_before_stripping)
- compiler_error("Code size does not match (zmachine_pc and df_total_size).");
- code_length = df_total_size_after_stripping;
- }
- mark += code_length;
-
- /* ------------------ Another synchronising gap ----------------------- */
-
- if (oddeven_packing_switch)
- { if (module_switch)
- while ((mark%(scale_factor*2)) != 0) mark++;
- else
- while ((mark%(scale_factor*2)) != scale_factor) mark++;
- }
- else
- while ((mark%scale_factor) != 0) mark++;
-
- /* ------------------------- Strings Area ----------------------------- */
-
- Write_Strings_At = mark;
- strings_length = static_strings_extent;
- mark += strings_length;
-
- /* --------------------- Module Linking Data -------------------------- */
-
- if (module_switch)
- { link_table_at = mark; mark += link_data_size;
- mark += zcode_backpatch_size;
- mark += zmachine_backpatch_size;
- }
-
- /* --------------------- Is the file too big? ------------------------- */
-
- Out_Size = mark;
-
- switch(version_number)
- { case 3: excess = Out_Size-((int32) 0x20000L); limit = 128; break;
- case 4:
- case 5: excess = Out_Size-((int32) 0x40000L); limit = 256; break;
- case 6:
- case 7:
- case 8: excess = Out_Size-((int32) 0x80000L); limit = 512; break;
- }
-
- if (module_switch)
- { excess = Out_Size-((int32) 0x10000L); limit=64;
- }
-
- if (excess > 0)
- { char memory_full_error[80];
- sprintf(memory_full_error,
- "The %s exceeds version-%d limit (%dK) by %d bytes",
- output_called, version_number, limit, excess);
- fatalerror(memory_full_error);
- }
-
- /* --------------------------- Offsets -------------------------------- */
-
- dictionary_offset = dictionary_at;
- variables_offset = globals_at;
- actions_offset = actions_at;
- preactions_offset = preactions_at;
- prop_defaults_offset = prop_defaults_at;
- prop_values_offset = object_props_at;
- static_memory_offset = grammar_table_at;
- grammar_table_offset = grammar_table_at;
-
- if (extend_memory_map)
- { extend_offset=256;
- if (no_objects+9 > extend_offset) extend_offset=no_objects+9;
- while ((extend_offset%length_scale_factor) != 0) extend_offset++;
- /* Not sure why above line is necessary, but oddeven_packing
- * will need extend_offset to be even */
- code_offset = extend_offset*scale_factor;
- if (oddeven_packing_switch)
- strings_offset = code_offset + scale_factor;
- else
- strings_offset = code_offset + (Write_Strings_At-Write_Code_At);
-
- /* With the extended memory model, need to specifically check that we
- * haven't overflowed the packed address range for routines or strings.
- * With the standard memory model, we only need the earlier total size
- * check.
- */
- excess = code_length + code_offset - (scale_factor*((int32) 0x10000L));
- if (excess > 0)
- { char code_full_error[80];
- sprintf(code_full_error,
- "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,
- "The strings area limit has been exceeded by %d bytes",
- excess);
- else
- sprintf(strings_full_error,
- "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
- { code_offset = Write_Code_At;
- strings_offset = Write_Strings_At;
- }
-
- /* --------------------------- The Header ----------------------------- */
-
- for (i=0; i<=0x3f; i++) p[i]=0; /* Begin with 64 blank bytes */
-
- p[0] = version_number; /* Version number */
- p[1] = statusline_flag*2; /* Bit 1 of Flags 1: statusline style */
- p[2] = (release_number/256);
- p[3] = (release_number%256); /* Release */
- p[4] = (Write_Code_At/256);
- p[5] = (Write_Code_At%256); /* End of paged memory */
- if (version_number==6)
- { j=code_offset/scale_factor; /* Packed address of "Main__" */
- p[6]=(j/256); p[7]=(j%256);
- }
- else
- { j=Write_Code_At+1; /* Initial PC value (bytes) */
- p[6]=(j/256); p[7]=(j%256); /* (first opcode in "Main__") */
- }
- p[8] = (dictionary_at/256); p[9]=(dictionary_at%256); /* Dictionary */
- p[10]=prop_defaults_at/256; p[11]=prop_defaults_at%256; /* Objects */
- p[12]=(globals_at/256); p[13]=(globals_at%256); /* Dynamic area */
- p[14]=(grammar_table_at/256);
- p[15]=(grammar_table_at%256); /* Grammar */
- for (i=0, j=0, k=1;i<16;i++, k=k*2) /* Flags 2 as needed for any */
- j+=k*flags2_requirements[i]; /* unusual opcodes assembled */
- p[16]=j/256; p[17]=j%256;
- write_serial_number((char *) (p+18)); /* Serial number: 6 chars of ASCII */
- p[24]=abbrevs_at/256;
- p[25]=abbrevs_at%256; /* Abbreviations table */
- p[26]=0; p[27]=0; /* Length of file to be filled in "files.c" */
- p[28]=0; p[29]=0; /* Checksum to be filled in "files.c" */
-
- if (extend_memory_map)
- { j=(Write_Code_At - extend_offset*scale_factor)/length_scale_factor;
- p[40]=j/256; p[41]=j%256; /* Routines offset */
- if (oddeven_packing_switch)
- j=(Write_Strings_At - extend_offset*scale_factor)/length_scale_factor;
- p[42]=j/256; p[43]=j%256; /* = Strings offset */
- }
-
- if (version_number >= 5)
- { p[46] = terminating_chars_at/256; /* Terminating characters table */
- p[47] = terminating_chars_at%256;
- }
-
- if (alphabet_modified)
- { j = charset_at;
- p[52]=j/256; p[53]=j%256; } /* Character set table address */
-
- j = headerext_at;
- p[54] = j/256; p[55] = j%256; /* Header extension table address */
-
- p[60] = '0' + ((RELEASE_NUMBER/100)%10);
- p[61] = '.';
- p[62] = '0' + ((RELEASE_NUMBER/10)%10);
- p[63] = '0' + RELEASE_NUMBER%10;
-
- /* ------------------------ Header Extension -------------------------- */
-
- /* The numbering in the spec is a little weird -- it's headerext_length
- words *after* the initial length word. We follow the spec numbering
- in this switch statement, so the count is 1-based. */
- for (i=1; i<=headerext_length; i++) {
- switch (i) {
- case 3:
- j = unicode_at; /* Unicode translation table address */
- break;
- case 4:
- j = ZCODE_HEADER_FLAGS_3; /* Flags 3 word */
- break;
- default:
- j = 0;
- break;
- }
- p[headerext_at+2*i+0] = j / 256;
- p[headerext_at+2*i+1] = j % 256;
- }
-
- /* ----------------- The Header: Extras for modules ------------------- */
-
- if (module_switch)
- { p[0]=p[0]+64;
- p[1]=MODULE_VERSION_NUMBER;
- p[6]=map_of_module/256;
- p[7]=map_of_module%256;
-
- mark = map_of_module; /* Module map format: */
-
- p[mark++]=object_tree_at/256; /* 0: Object tree addr */
- p[mark++]=object_tree_at%256;
- p[mark++]=object_props_at/256; /* 2: Prop values addr */
- p[mark++]=object_props_at%256;
- p[mark++]=(Write_Strings_At/scale_factor)/256; /* 4: Static strs */
- p[mark++]=(Write_Strings_At/scale_factor)%256;
- p[mark++]=class_numbers_offset/256; /* 6: Class nos addr */
- p[mark++]=class_numbers_offset%256;
- p[mark++]=individuals_offset/256; /* 8: Indiv prop values */
- p[mark++]=individuals_offset%256;
- p[mark++]=individuals_length/256; /* 10: Length of table */
- p[mark++]=individuals_length%256;
- p[mark++]=no_symbols/256; /* 12: No of symbols */
- p[mark++]=no_symbols%256;
- p[mark++]=no_individual_properties/256; /* 14: Max property no */
- p[mark++]=no_individual_properties%256;
- p[mark++]=no_objects/256; /* 16: No of objects */
- p[mark++]=no_objects%256;
- i = link_table_at;
- p[mark++]=i/256; /* 18: Import/exports */
- p[mark++]=i%256;
- p[mark++]=link_data_size/256; /* 20: Size of */
- p[mark++]=link_data_size%256;
- i += link_data_size;
- p[mark++]=i/256; /* 22: Code backpatch */
- p[mark++]=i%256;
- p[mark++]=zcode_backpatch_size/256; /* 24: Size of */
- p[mark++]=zcode_backpatch_size%256;
- i += zcode_backpatch_size;
- p[mark++]=i/256; /* 26: Image backpatch */
- p[mark++]=i%256;
- p[mark++]=zmachine_backpatch_size/256; /* 28: Size of */
- p[mark++]=zmachine_backpatch_size%256;
-
- /* Further space in this table is reserved for future use */
- }
-
- /* ---- Backpatch the Z-machine, now that all information is in ------- */
-
- if (!module_switch && !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;
- }
-
- mark = actions_at;
- for (i=0; i<no_actions; i++)
- { j=action_byte_offset[i];
- if (OMIT_UNUSED_ROUTINES)
- j = df_stripped_address_for_address(j);
- j += code_offset/scale_factor;
- p[mark++]=j/256; p[mark++]=j%256;
- }
-
- if (grammar_version_number == 1)
- { mark = preactions_at;
- for (i=0; i<no_grammar_token_routines; i++)
- { j=grammar_token_routine[i];
- if (OMIT_UNUSED_ROUTINES)
- j = df_stripped_address_for_address(j);
- j += code_offset/scale_factor;
- p[mark++]=j/256; p[mark++]=j%256;
- }
- }
- else
- { for (l = 0; l<no_Inform_verbs; l++)
- { k = grammar_table_at + 2*l;
- i = p[k]*256 + p[k+1];
- for (j = p[i++]; j>0; j--)
- { int topbits; int32 value;
- i = i + 2;
- while (p[i] != 15)
- { topbits = (p[i]/0x40) & 3;
- value = p[i+1]*256 + p[i+2];
- switch(topbits)
- { case 1:
- value = final_dict_order[value]
- *((version_number==3)?7:9)
- + dictionary_offset + 7;
- break;
- case 2:
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset/scale_factor;
- break;
- }
- p[i+1] = value/256; p[i+2] = value%256;
- i = i + 3;
- }
- i++;
- }
- }
- }
- }
-
- /* ---- From here on, it's all reportage: construction is finished ---- */
-
- if (statistics_switch)
- { int32 k_long, rate; char *k_str="";
- k_long=(Out_Size/1024);
- if ((Out_Size-1024*k_long) >= 512) { k_long++; k_str=""; }
- else if ((Out_Size-1024*k_long) > 0) { k_str=".5"; }
- if (total_bytes_trans == 0) rate = 0;
- else rate=total_bytes_trans*1000/total_chars_trans;
-
- { printf("In:\
-%3d source code files %6d syntactic lines\n\
-%6d textual lines %8ld characters ",
- total_input_files, no_syntax_lines,
- total_source_line_count, (long int) total_chars_read);
- if (character_set_unicode) printf("(UTF-8)\n");
- else if (character_set_setting == 0) printf("(plain ASCII)\n");
- else
- { printf("(ISO 8859-%d %s)\n", character_set_setting,
- name_of_iso_set(character_set_setting));
- }
-
- printf("Allocated:\n\
-%6d symbols (maximum %4d) %8ld bytes of memory\n\
-Out: Version %d \"%s\" %s %d.%c%c%c%c%c%c (%ld%sK long):\n",
- no_symbols, MAX_SYMBOLS,
- (long int) malloced_bytes,
- version_number,
- version_name(version_number),
- output_called,
- release_number, p[18], p[19], p[20], p[21], p[22], p[23],
- (long int) k_long, k_str);
-
- printf("\
-%6d classes (maximum %3d) %6d objects (maximum %3d)\n\
-%6d global vars (maximum 233) %6d variable/array space (maximum %d)\n",
- no_classes, MAX_CLASSES,
- no_objects, ((version_number==3)?255:(MAX_OBJECTS-1)),
- no_globals,
- dynamic_array_area_size, MAX_STATIC_DATA);
-
- printf(
-"%6d verbs (maximum %3d) %6d dictionary entries (maximum %d)\n\
-%6d grammar lines (version %d) %6d grammar tokens (unlimited)\n\
-%6d actions (maximum %3d) %6d attributes (maximum %2d)\n\
-%6d common props (maximum %2d) %6d individual props (unlimited)\n",
- no_Inform_verbs, MAX_VERBS,
- dict_entries, MAX_DICT_ENTRIES,
- no_grammar_lines, grammar_version_number,
- no_grammar_tokens,
- no_actions, MAX_ACTIONS,
- no_attributes, ((version_number==3)?32:48),
- no_properties-2, ((version_number==3)?30:62),
- no_individual_properties - 64);
-
- if (track_unused_routines)
- {
- uint32 diff = df_total_size_before_stripping - df_total_size_after_stripping;
- printf(
-"%6ld bytes of Z-code %6ld unused bytes %s (%.1f%%)\n",
- (long int) df_total_size_before_stripping, (long int) diff,
- (OMIT_UNUSED_ROUTINES ? "stripped out" : "detected"),
- 100 * (float)diff / (float)df_total_size_before_stripping);
- }
-
- printf(
-"%6ld characters used in text %6ld bytes compressed (rate %d.%3ld)\n\
-%6d abbreviations (maximum %d) %6d routines (unlimited)\n\
-%6ld instructions of Z-code %6d sequence points\n\
-%6ld bytes readable memory used (maximum 65536)\n\
-%6ld bytes used in Z-machine %6ld bytes free in Z-machine\n",
- (long int) total_chars_trans,
- (long int) total_bytes_trans,
- (total_chars_trans>total_bytes_trans)?0:1,
- (long int) rate,
- no_abbreviations, MAX_ABBREVS,
- no_routines,
- (long int) no_instructions, no_sequence_points,
- (long int) Write_Code_At,
- (long int) Out_Size,
- (long int)
- (((long int) (limit*1024L)) - ((long int) Out_Size)));
-
- }
- }
-
- if (offsets_switch)
- {
- { printf(
-"\nOffsets in %s:\n\
-%05lx Synonyms %05lx Defaults %05lx Objects %05lx Properties\n\
-%05lx Variables %05lx Parse table %05lx Actions %05lx Preactions\n\
-%05lx Adjectives %05lx Dictionary %05lx Code %05lx Strings\n",
- output_called,
- (long int) abbrevs_at,
- (long int) prop_defaults_at,
- (long int) object_tree_at,
- (long int) object_props_at,
- (long int) globals_at,
- (long int) grammar_table_at,
- (long int) actions_at,
- (long int) preactions_at,
- (long int) adjectives_offset,
- (long int) dictionary_at,
- (long int) Write_Code_At,
- (long int) Write_Strings_At);
- if (module_switch)
- printf("%05lx Linking data\n",(long int) link_table_at);
- }
- }
-
- if (debugfile_switch)
- { begin_writing_debug_sections();
- write_debug_section("abbreviations", 64);
- write_debug_section("abbreviations table", abbrevs_at);
- write_debug_section("header extension", headerext_at);
- if (alphabet_modified)
- { write_debug_section("alphabets table", charset_at);
- }
- if (zscii_defn_modified)
- { write_debug_section("Unicode table", unicode_at);
- }
- write_debug_section("property defaults", prop_defaults_at);
- write_debug_section("object tree", object_tree_at);
- write_debug_section("common properties", object_props_at);
- write_debug_section("class numbers", class_numbers_offset);
- write_debug_section("identifier names", identifier_names_offset);
- write_debug_section("individual properties", individuals_offset);
- write_debug_section("global variables", globals_at);
- write_debug_section("array space", globals_at+480);
- write_debug_section("grammar table", grammar_table_at);
- write_debug_section("actions table", actions_at);
- write_debug_section("parsing routines", preactions_at);
- write_debug_section("adjectives table", adjectives_offset);
- write_debug_section("dictionary", dictionary_at);
- write_debug_section("code area", Write_Code_At);
- write_debug_section("strings area", Write_Strings_At);
- end_writing_debug_sections(Out_Size);
- }
-
- if (memory_map_switch)
- {
- {
-printf("Dynamic +---------------------+ 00000\n");
-printf("memory | header |\n");
-printf(" +---------------------+ 00040\n");
-printf(" | abbreviations |\n");
-printf(" + - - - - - - - - - - + %05lx\n", (long int) abbrevs_at);
-printf(" | abbreviations table |\n");
-printf(" +---------------------+ %05lx\n", (long int) headerext_at);
-printf(" | header extension |\n");
- if (alphabet_modified)
- {
-printf(" + - - - - - - - - - - + %05lx\n", (long int) charset_at);
-printf(" | alphabets table |\n");
- }
- if (zscii_defn_modified)
- {
-printf(" + - - - - - - - - - - + %05lx\n", (long int) unicode_at);
-printf(" | Unicode table |\n");
- }
-printf(" +---------------------+ %05lx\n",
- (long int) prop_defaults_at);
-printf(" | property defaults |\n");
-printf(" + - - - - - - - - - - + %05lx\n", (long int) object_tree_at);
-printf(" | objects |\n");
-printf(" + - - - - - - - - - - + %05lx\n",
- (long int) object_props_at);
-printf(" | object short names, |\n");
-printf(" | common prop values |\n");
-printf(" + - - - - - - - - - - + %05lx\n",
- (long int) class_numbers_offset);
-printf(" | class numbers table |\n");
-printf(" + - - - - - - - - - - + %05lx\n",
- (long int) identifier_names_offset);
-printf(" | symbol names table |\n");
-printf(" + - - - - - - - - - - + %05lx\n",
- (long int) individuals_offset);
-printf(" | indiv prop values |\n");
-printf(" +---------------------+ %05lx\n", (long int) globals_at);
-printf(" | global variables |\n");
-printf(" + - - - - - - - - - - + %05lx\n",
- ((long int) globals_at)+480L);
-printf(" | arrays |\n");
-printf(" +=====================+ %05lx\n",
- (long int) grammar_table_at);
-printf("Readable| grammar table |\n");
-printf("memory + - - - - - - - - - - + %05lx\n", (long int) actions_at);
-printf(" | actions |\n");
-printf(" + - - - - - - - - - - + %05lx\n", (long int) preactions_at);
-printf(" | parsing routines |\n");
-printf(" + - - - - - - - - - - + %05lx\n",
- (long int) adjectives_offset);
-printf(" | adjectives |\n");
-printf(" +---------------------+ %05lx\n", (long int) dictionary_at);
-printf(" | dictionary |\n");
-if (module_switch)
-{
-printf(" + - - - - - - - - - - + %05lx\n",
- (long int) map_of_module);
-printf(" | map of module addrs |\n");
-}
-printf(" +=====================+ %05lx\n", (long int) Write_Code_At);
-printf("Above | Z-code |\n");
-printf("readable+---------------------+ %05lx\n",
- (long int) Write_Strings_At);
-printf("memory | strings |\n");
-if (module_switch)
-{
-printf(" +=====================+ %05lx\n", (long int) link_table_at);
-printf(" | module linking data |\n");
-}
-printf(" +---------------------+ %05lx\n", (long int) Out_Size);
- }
- }
- if (percentages_switch)
- { printf("Approximate percentage breakdown of %s:\n",
- output_called);
- percentage("Z-code", code_length,Out_Size);
- if (module_switch)
- percentage("Linking data", link_data_size,Out_Size);
- percentage("Static strings", strings_length,Out_Size);
- percentage("Dictionary", Write_Code_At-dictionary_at,Out_Size);
- percentage("Objects", globals_at-prop_defaults_at,Out_Size);
- percentage("Globals", grammar_table_at-globals_at,Out_Size);
- percentage("Parsing tables", dictionary_at-grammar_table_at,Out_Size);
- percentage("Header and synonyms", prop_defaults_at,Out_Size);
- percentage("Total of save area", grammar_table_at,Out_Size);
- percentage("Total of text", total_bytes_trans,Out_Size);
- }
- if (frequencies_switch)
- {
- { printf("How frequently abbreviations were used, and roughly\n");
- printf("how many bytes they saved: ('_' denotes spaces)\n");
- for (i=0; i<no_abbreviations; i++)
- { 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,abbrev_freqs[i],
- 2*((abbrev_freqs[i]-1)*abbrev_quality[i])/3);
- if ((i%3)==2) printf("\n");
- }
- if ((i%3)!=0) printf("\n");
- if (no_abbreviations==0) printf("None were declared.\n");
- }
- }
-}
-
-static void construct_storyfile_g(void)
-{ uchar *p;
- int32 i, j, k, l, mark, strings_length, limit;
- int32 globals_at, dictionary_at, actions_at, preactions_at,
- abbrevs_at, prop_defaults_at, object_tree_at, object_props_at,
- grammar_table_at, charset_at, headerext_at,
- unicode_at, arrays_at;
- int32 threespaces, code_length;
- char *output_called = (module_switch)?"module":"story file";
-
- ASSERT_GLULX();
-
- 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), NUM_ATTR_BYTES*8,
- "attribute name strings");
- array_name_strings =
- my_calloc(sizeof(int32),
- no_symbols,
- "array name strings");
-
- write_the_identifier_names();
- threespaces = compile_string(" ", FALSE, FALSE);
-
- compress_game_text();
-
- /* 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");
-
- /* Foolish code to make this routine compile on all ANSI compilers */
-
- p = (uchar *) zmachine_paged_memory;
-
- /* In what follows, the "mark" will move upwards in memory: at various
- points its value will be recorded for milestones like
- "dictionary table start". It begins at 0x40, just after the header */
-
- /* Ok, our policy here will be to set the *_at values all relative
- to RAM. That's so we can write into zmachine_paged_memory[mark]
- and actually hit what we're aiming at.
- All the *_offset values will be set to true Glulx machine
- addresses. */
-
- /* To get our bearings, figure out where the strings and code are. */
- /* We start with two words, which conventionally identify the
- memory layout. This is why the code starts eight bytes after
- the header. */
- Write_Code_At = GLULX_HEADER_SIZE + GLULX_STATIC_ROM_SIZE;
- if (!OMIT_UNUSED_ROUTINES) {
- code_length = zmachine_pc;
- }
- else {
- if (zmachine_pc != df_total_size_before_stripping)
- compiler_error("Code size does not match (zmachine_pc and df_total_size).");
- code_length = df_total_size_after_stripping;
- }
- Write_Strings_At = Write_Code_At + code_length;
- strings_length = compression_table_size + compression_string_size;
-
- /* Now figure out where RAM starts. */
- Write_RAM_At = Write_Strings_At + strings_length;
- /* The Write_RAM_At boundary must be a multiple of GPAGESIZE. */
- while (Write_RAM_At % GPAGESIZE)
- Write_RAM_At++;
-
- /* Now work out all those RAM positions. */
- mark = 0;
-
- /* ----------------- Variables and Dynamic Arrays --------------------- */
-
- globals_at = mark;
- for (i=0; i<no_globals; i++) {
- j = global_initial_value[i];
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
- arrays_at = mark;
- for (i=MAX_GLOBAL_VARIABLES*4; i<dynamic_array_area_size; i++)
- p[mark++] = dynamic_array_area[i];
-
- /* -------------------------- Dynamic Strings -------------------------- */
-
- abbrevs_at = mark;
- WriteInt32(p+mark, no_dynamic_strings);
- mark += 4;
- for (i=0; i<no_dynamic_strings; i++) {
- j = Write_Strings_At + compressed_offsets[threespaces-1];
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
- /* ---------------- Various Things I'm Not Sure About ------------------ */
- /* Actually, none of these are relevant to Glulx. */
- headerext_at = mark;
- charset_at = 0;
- if (alphabet_modified)
- charset_at = mark;
- unicode_at = 0;
- if (zscii_defn_modified)
- unicode_at = mark;
-
- /* -------------------- Objects and Properties ------------------------ */
-
- object_tree_at = mark;
-
- object_props_at = mark + no_objects*OBJECT_BYTE_LENGTH;
-
- for (i=0; i<no_objects; i++) {
- int32 objmark = mark;
- p[mark++] = 0x70; /* type byte -- object */
- for (j=0; j<NUM_ATTR_BYTES; j++) {
- p[mark++] = objectatts[i*NUM_ATTR_BYTES+j];
- }
- for (j=0; j<6; j++) {
- int32 val = 0;
- switch (j) {
- case 0: /* next object in the linked list. */
- if (i == no_objects-1)
- val = 0;
- else
- val = Write_RAM_At + objmark + OBJECT_BYTE_LENGTH;
- break;
- case 1: /* hardware name address */
- val = Write_Strings_At + compressed_offsets[objectsg[i].shortname-1];
- break;
- case 2: /* property table address */
- val = Write_RAM_At + object_props_at + objectsg[i].propaddr;
- break;
- case 3: /* parent */
- if (objectsg[i].parent == 0)
- val = 0;
- else
- val = Write_RAM_At + object_tree_at +
- (OBJECT_BYTE_LENGTH*(objectsg[i].parent-1));
- break;
- case 4: /* sibling */
- if (objectsg[i].next == 0)
- val = 0;
- else
- val = Write_RAM_At + object_tree_at +
- (OBJECT_BYTE_LENGTH*(objectsg[i].next-1));
- break;
- case 5: /* child */
- if (objectsg[i].child == 0)
- val = 0;
- else
- val = Write_RAM_At + object_tree_at +
- (OBJECT_BYTE_LENGTH*(objectsg[i].child-1));
- break;
- }
- p[mark++] = (val >> 24) & 0xFF;
- p[mark++] = (val >> 16) & 0xFF;
- p[mark++] = (val >> 8) & 0xFF;
- p[mark++] = (val) & 0xFF;
- }
-
- for (j=0; j<GLULX_OBJECT_EXT_BYTES; j++) {
- p[mark++] = 0;
- }
- }
-
- if (object_props_at != mark)
- error("*** Object table was impossible length ***");
-
- for (i=0; i<properties_table_size; i++)
- p[mark+i]=properties_table[i];
-
- for (i=0; i<no_objects; i++) {
- int32 tableaddr = object_props_at + objectsg[i].propaddr;
- int32 tablelen = ReadInt32(p+tableaddr);
- tableaddr += 4;
- for (j=0; j<tablelen; j++) {
- k = ReadInt32(p+tableaddr+4);
- k += (Write_RAM_At + object_props_at);
- WriteInt32(p+tableaddr+4, k);
- tableaddr += 10;
- }
- }
-
- mark += properties_table_size;
-
- prop_defaults_at = mark;
- for (i=0; i<no_properties; i++) {
- k = prop_default_value[i];
- WriteInt32(p+mark, k);
- mark += 4;
- }
-
- /* ----------- Table of Class Prototype Object Numbers ---------------- */
-
- class_numbers_offset = mark;
- for (i=0; i<no_classes; i++) {
- j = Write_RAM_At + object_tree_at +
- (OBJECT_BYTE_LENGTH*(class_object_numbers[i]-1));
- WriteInt32(p+mark, j);
- mark += 4;
- }
- WriteInt32(p+mark, 0);
- mark += 4;
-
- /* -------------------- Table of Property Names ------------------------ */
-
- /* We try to format this bit with some regularity...
- address of common properties
- number of common properties
- address of indiv properties
- number of indiv properties (counted from INDIV_PROP_START)
- address of attributes
- number of attributes (always NUM_ATTR_BYTES*8)
- address of actions
- number of actions
- */
-
- identifier_names_offset = mark;
- mark += 32; /* eight pairs of values, to be filled in. */
-
- WriteInt32(p+identifier_names_offset+0, Write_RAM_At + mark);
- WriteInt32(p+identifier_names_offset+4, no_properties);
- for (i=0; i<no_properties; i++) {
- j = individual_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
- WriteInt32(p+identifier_names_offset+8, Write_RAM_At + mark);
- WriteInt32(p+identifier_names_offset+12,
- no_individual_properties-INDIV_PROP_START);
- for (i=INDIV_PROP_START; i<no_individual_properties; i++) {
- j = individual_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
- WriteInt32(p+identifier_names_offset+16, Write_RAM_At + mark);
- WriteInt32(p+identifier_names_offset+20, NUM_ATTR_BYTES*8);
- for (i=0; i<NUM_ATTR_BYTES*8; i++) {
- j = attribute_name_strings[i];
- if (j)
- j = Write_Strings_At + compressed_offsets[j-1];
- WriteInt32(p+mark, j);
- 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 ----------------------------- */
-
- if (grammar_version_number != 2)
- { warning("This version of Inform is unable to produce the grammar \
-table format requested (producing number 2 format instead)");
- grammar_version_number = 2;
- }
-
- grammar_table_at = mark;
-
- WriteInt32(p+mark, no_Inform_verbs);
- mark += 4;
-
- mark += no_Inform_verbs*4;
-
- for (i=0; i<no_Inform_verbs; i++) {
- j = mark + Write_RAM_At;
- WriteInt32(p+(grammar_table_at+4+i*4), j);
- p[mark++] = Inform_verbs[i].lines;
- for (j=0; j<Inform_verbs[i].lines; j++) {
- int tok;
- k = Inform_verbs[i].l[j];
- p[mark++] = grammar_lines[k++];
- p[mark++] = grammar_lines[k++];
- p[mark++] = grammar_lines[k++];
- for (;;) {
- tok = grammar_lines[k++];
- p[mark++] = tok;
- if (tok == 15) break;
- p[mark++] = grammar_lines[k++];
- p[mark++] = grammar_lines[k++];
- p[mark++] = grammar_lines[k++];
- p[mark++] = grammar_lines[k++];
- }
- }
- }
-
- /* ------------------- Actions and Preactions ------------------------- */
-
- actions_at = mark;
- WriteInt32(p+mark, no_actions);
- mark += 4;
- mark += no_actions*4;
- /* Values to be written in later. */
-
- if (DICT_CHAR_SIZE != 1) {
- /* If the dictionary is Unicode, we'd like it to be word-aligned. */
- while (mark % 4)
- p[mark++]=0;
- }
-
- preactions_at = mark;
- adjectives_offset = mark;
- dictionary_offset = mark;
-
- /* ------------------------- Dictionary ------------------------------- */
-
- dictionary_at = mark;
-
- WriteInt32(dictionary+0, dict_entries);
- for (i=0; i<4; i++)
- p[mark+i] = dictionary[i];
-
- for (i=0; i<dict_entries; i++) {
- k = 4 + i*DICT_ENTRY_BYTE_LENGTH;
- j = mark + 4 + final_dict_order[i]*DICT_ENTRY_BYTE_LENGTH;
- for (l=0; l<DICT_ENTRY_BYTE_LENGTH; l++)
- p[j++] = dictionary[k++];
- }
- mark += 4 + dict_entries * DICT_ENTRY_BYTE_LENGTH;
-
- /* -------------------------- All Data -------------------------------- */
-
- /* The end-of-RAM boundary must be a multiple of GPAGESIZE. */
- while (mark % GPAGESIZE)
- p[mark++]=0;
-
- RAM_Size = mark;
-
- Out_Size = Write_RAM_At + RAM_Size;
- limit=1024*1024;
-
- /* --------------------------- Offsets -------------------------------- */
-
- dictionary_offset = Write_RAM_At + dictionary_at;
- variables_offset = Write_RAM_At + globals_at;
- arrays_offset = Write_RAM_At + arrays_at;
- actions_offset = Write_RAM_At + actions_at;
- preactions_offset = Write_RAM_At + preactions_at;
- prop_defaults_offset = Write_RAM_At + prop_defaults_at;
- object_tree_offset = Write_RAM_At + object_tree_at;
- prop_values_offset = Write_RAM_At + object_props_at;
- static_memory_offset = Write_RAM_At + grammar_table_at;
- grammar_table_offset = Write_RAM_At + grammar_table_at;
- abbreviations_offset = Write_RAM_At + abbrevs_at;
-
- code_offset = Write_Code_At;
- strings_offset = Write_Strings_At;
-
- /* --------------------------- The Header ----------------------------- */
-
- /* ------ Backpatch the machine, now that all information is in ------- */
-
- if (!module_switch)
- { backpatch_zmachine_image_g();
-
- mark = actions_at + 4;
- for (i=0; i<no_actions; i++) {
- j = action_byte_offset[i];
- if (OMIT_UNUSED_ROUTINES)
- j = df_stripped_address_for_address(j);
- j += code_offset;
- WriteInt32(p+mark, j);
- mark += 4;
- }
-
- for (l = 0; l<no_Inform_verbs; l++) {
- k = grammar_table_at + 4 + 4*l;
- i = ((p[k] << 24) | (p[k+1] << 16) | (p[k+2] << 8) | (p[k+3]));
- i -= Write_RAM_At;
- for (j = p[i++]; j>0; j--) {
- int topbits;
- int32 value;
- i = i + 3;
- while (p[i] != 15) {
- topbits = (p[i]/0x40) & 3;
- value = ((p[i+1] << 24) | (p[i+2] << 16)
- | (p[i+3] << 8) | (p[i+4]));
- switch(topbits) {
- case 1:
- value = dictionary_offset + 4
- + final_dict_order[value]*DICT_ENTRY_BYTE_LENGTH;
- break;
- case 2:
- if (OMIT_UNUSED_ROUTINES)
- value = df_stripped_address_for_address(value);
- value += code_offset;
- break;
- }
- WriteInt32(p+(i+1), value);
- i = i + 5;
- }
- i++;
- }
- }
-
- }
-
- /* ---- From here on, it's all reportage: construction is finished ---- */
-
- if (statistics_switch)
- { int32 k_long, rate; char *k_str="";
- k_long=(Out_Size/1024);
- if ((Out_Size-1024*k_long) >= 512) { k_long++; k_str=""; }
- else if ((Out_Size-1024*k_long) > 0) { k_str=".5"; }
- if (strings_length == 0) rate = 0;
- else rate=strings_length*1000/total_chars_trans;
-
- { printf("In:\
-%3d source code files %6d syntactic lines\n\
-%6d textual lines %8ld characters ",
- total_input_files, no_syntax_lines,
- total_source_line_count, (long int) total_chars_read);
- if (character_set_unicode) printf("(UTF-8)\n");
- else if (character_set_setting == 0) printf("(plain ASCII)\n");
- else
- { printf("(ISO 8859-%d %s)\n", character_set_setting,
- name_of_iso_set(character_set_setting));
- }
-
- {char serialnum[8];
- write_serial_number(serialnum);
- printf("Allocated:\n\
-%6d symbols (maximum %4d) %8ld bytes of memory\n\
-Out: %s %s %d.%c%c%c%c%c%c (%ld%sK long):\n",
- no_symbols, MAX_SYMBOLS,
- (long int) malloced_bytes,
- version_name(version_number),
- output_called,
- release_number,
- serialnum[0], serialnum[1], serialnum[2],
- serialnum[3], serialnum[4], serialnum[5],
- (long int) k_long, k_str);
- }
-
- printf("\
-%6d classes (maximum %3d) %6d objects (maximum %3d)\n\
-%6d global vars (maximum %3d) %6d variable/array space (maximum %d)\n",
- no_classes, MAX_CLASSES,
- no_objects, MAX_OBJECTS,
- no_globals, MAX_GLOBAL_VARIABLES,
- dynamic_array_area_size, MAX_STATIC_DATA);
-
- printf(
-"%6d verbs (maximum %3d) %6d dictionary entries (maximum %d)\n\
-%6d grammar lines (version %d) %6d grammar tokens (unlimited)\n\
-%6d actions (maximum %3d) %6d attributes (maximum %2d)\n\
-%6d common props (maximum %3d) %6d individual props (unlimited)\n",
- no_Inform_verbs, MAX_VERBS,
- dict_entries, MAX_DICT_ENTRIES,
- no_grammar_lines, grammar_version_number,
- no_grammar_tokens,
- no_actions, MAX_ACTIONS,
- no_attributes, NUM_ATTR_BYTES*8,
- no_properties, INDIV_PROP_START,
- no_individual_properties - INDIV_PROP_START);
-
- if (track_unused_routines)
- {
- uint32 diff = df_total_size_before_stripping - df_total_size_after_stripping;
- printf(
-"%6ld bytes of code %6ld unused bytes %s (%.1f%%)\n",
- (long int) df_total_size_before_stripping, (long int) diff,
- (OMIT_UNUSED_ROUTINES ? "stripped out" : "detected"),
- 100 * (float)diff / (float)df_total_size_before_stripping);
- }
-
- printf(
-"%6ld characters used in text %6ld bytes compressed (rate %d.%3ld)\n\
-%6d abbreviations (maximum %d) %6d routines (unlimited)\n\
-%6ld instructions of code %6d sequence points\n\
-%6ld bytes writable memory used %6ld bytes read-only memory used\n\
-%6ld bytes used in machine %10ld bytes free in machine\n",
- (long int) total_chars_trans,
- (long int) strings_length,
- (total_chars_trans>strings_length)?0:1,
- (long int) rate,
- no_abbreviations, MAX_ABBREVS,
- no_routines,
- (long int) no_instructions, no_sequence_points,
- (long int) (Out_Size - Write_RAM_At),
- (long int) Write_RAM_At,
- (long int) Out_Size,
- (long int)
- (((long int) (limit*1024L)) - ((long int) Out_Size)));
-
- }
- }
-
- if (offsets_switch)
- {
- { printf(
-"\nOffsets in %s:\n\
-%05lx Synonyms %05lx Defaults %05lx Objects %05lx Properties\n\
-%05lx Variables %05lx Parse table %05lx Actions %05lx Preactions\n\
-%05lx Adjectives %05lx Dictionary %05lx Code %05lx Strings\n",
- output_called,
- (long int) abbrevs_at,
- (long int) prop_defaults_at,
- (long int) object_tree_at,
- (long int) object_props_at,
- (long int) globals_at,
- (long int) grammar_table_at,
- (long int) actions_at,
- (long int) preactions_at,
- (long int) adjectives_offset,
- (long int) dictionary_at,
- (long int) Write_Code_At,
- (long int) Write_Strings_At);
- }
- }
-
- if (debugfile_switch)
- { begin_writing_debug_sections();
- write_debug_section("memory layout id", GLULX_HEADER_SIZE);
- write_debug_section("code area", Write_Code_At);
- write_debug_section("string decoding table", Write_Strings_At);
- write_debug_section("strings area",
- Write_Strings_At + compression_table_size);
- if (Write_Strings_At + strings_length < Write_RAM_At)
- { write_debug_section
- ("zero padding", Write_Strings_At + strings_length);
- }
- if (globals_at)
- { compiler_error("Failed assumption that globals are at start of "
- "Glulx RAM");
- }
- write_debug_section("global variables", Write_RAM_At + globals_at);
- write_debug_section("array space", Write_RAM_At + arrays_at);
- write_debug_section("abbreviations table", Write_RAM_At + abbrevs_at);
- write_debug_section("object tree", Write_RAM_At + object_tree_at);
- write_debug_section("common properties",
- Write_RAM_At + object_props_at);
- write_debug_section("property defaults",
- Write_RAM_At + prop_defaults_at);
- write_debug_section("class numbers",
- Write_RAM_At + class_numbers_offset);
- write_debug_section("identifier names",
- Write_RAM_At + identifier_names_offset);
- write_debug_section("grammar table", Write_RAM_At + grammar_table_at);
- write_debug_section("actions table", Write_RAM_At + actions_at);
- write_debug_section("dictionary", Write_RAM_At + dictionary_at);
- if (MEMORY_MAP_EXTENSION)
- { write_debug_section("zero padding", Out_Size);
- }
- end_writing_debug_sections(Out_Size + MEMORY_MAP_EXTENSION);
- }
-
- if (memory_map_switch)
- {
-
- {
-printf(" +---------------------+ 000000\n");
-printf("Read- | header |\n");
-printf(" only +=====================+ %06lx\n", (long int) GLULX_HEADER_SIZE);
-printf("memory | memory layout id |\n");
-printf(" +---------------------+ %06lx\n", (long int) Write_Code_At);
-printf(" | code |\n");
-printf(" +---------------------+ %06lx\n",
- (long int) Write_Strings_At);
-printf(" | string decode table |\n");
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) Write_Strings_At + compression_table_size);
-printf(" | strings |\n");
-printf(" +=====================+ %06lx\n",
- (long int) (Write_RAM_At+globals_at));
-printf("Dynamic | global variables |\n");
-printf("memory + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+arrays_at));
-printf(" | arrays |\n");
-printf(" +---------------------+ %06lx\n",
- (long int) (Write_RAM_At+abbrevs_at));
-printf(" | printing variables |\n");
- if (alphabet_modified)
- {
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+charset_at));
-printf(" | alphabets table |\n");
- }
- if (zscii_defn_modified)
- {
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+unicode_at));
-printf(" | Unicode table |\n");
- }
-printf(" +---------------------+ %06lx\n",
- (long int) (Write_RAM_At+object_tree_at));
-printf(" | objects |\n");
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+object_props_at));
-printf(" | property values |\n");
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+prop_defaults_at));
-printf(" | property defaults |\n");
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+class_numbers_offset));
-printf(" | class numbers table |\n");
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+identifier_names_offset));
-printf(" | id names table |\n");
-printf(" +---------------------+ %06lx\n",
- (long int) (Write_RAM_At+grammar_table_at));
-printf(" | grammar table |\n");
-printf(" + - - - - - - - - - - + %06lx\n",
- (long int) (Write_RAM_At+actions_at));
-printf(" | actions |\n");
-printf(" +---------------------+ %06lx\n",
- (long int) dictionary_offset);
-printf(" | dictionary |\n");
- if (MEMORY_MAP_EXTENSION == 0)
- {
-printf(" +---------------------+ %06lx\n", (long int) Out_Size);
- }
- else
- {
-printf(" +=====================+ %06lx\n", (long int) Out_Size);
-printf("Runtime | (empty) |\n");
-printf(" extn +---------------------+ %06lx\n", (long int) Out_Size+MEMORY_MAP_EXTENSION);
- }
-
- }
-
- }
-
-
- if (percentages_switch)
- { printf("Approximate percentage breakdown of %s:\n",
- output_called);
- percentage("Code", code_length,Out_Size);
- if (module_switch)
- percentage("Linking data", link_data_size,Out_Size);
- percentage("Static strings", strings_length,Out_Size);
- percentage("Dictionary", Write_Code_At-dictionary_at,Out_Size);
- percentage("Objects", globals_at-prop_defaults_at,Out_Size);
- percentage("Globals", grammar_table_at-globals_at,Out_Size);
- percentage("Parsing tables", dictionary_at-grammar_table_at,Out_Size);
- percentage("Header and synonyms", prop_defaults_at,Out_Size);
- percentage("Total of save area", grammar_table_at,Out_Size);
- percentage("Total of text", strings_length,Out_Size);
- }
- if (frequencies_switch)
- {
- { printf("How frequently abbreviations were used, and roughly\n");
- printf("how many bytes they saved: ('_' denotes spaces)\n");
- for (i=0; i<no_abbreviations; i++)
- { 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,abbrev_freqs[i],
- 2*((abbrev_freqs[i]-1)*abbrev_quality[i])/3);
- if ((i%3)==2) printf("\n");
- }
- if ((i%3)!=0) printf("\n");
- if (no_abbreviations==0) printf("None were declared.\n");
- }
- }
-}
-
-extern void construct_storyfile(void)
-{
- if (!glulx_mode)
- construct_storyfile_z();
- else
- construct_storyfile_g();
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_tables_vars(void)
-{
- release_number = 1;
- statusline_flag = SCORE_STYLE;
-
- zmachine_paged_memory = NULL;
-
- if (!glulx_mode) {
- code_offset = 0x800;
- actions_offset = 0x800;
- preactions_offset = 0x800;
- dictionary_offset = 0x800;
- adjectives_offset = 0x800;
- variables_offset = 0;
- strings_offset = 0xc00;
- individuals_offset=0x800;
- identifier_names_offset=0x800;
- class_numbers_offset = 0x800;
- arrays_offset = 0x0800; /* only used in Glulx, but might as well set */
- }
- else {
- code_offset = 0x12345;
- actions_offset = 0x12345;
- preactions_offset = 0x12345;
- dictionary_offset = 0x12345;
- adjectives_offset = 0x12345;
- variables_offset = 0x12345;
- arrays_offset = 0x12345;
- strings_offset = 0x12345;
- individuals_offset=0x12345;
- identifier_names_offset=0x12345;
- class_numbers_offset = 0x12345;
- }
-}
-
-extern void tables_begin_pass(void)
-{
-}
-
-extern void tables_allocate_arrays(void)
-{
-}
-
-extern void tables_free_arrays(void)
-{
- /* Allocation for this array happens in construct_storyfile() above */
-
- my_free(&zmachine_paged_memory,"output buffer");
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "text" : Text translation, the abbreviations optimiser, the dictionary */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-uchar *low_strings, *low_strings_top; /* Start and next free byte in the low
- strings pool */
-
-int32 static_strings_extent; /* Number of bytes of static strings
- made so far */
-memory_block static_strings_area; /* Used if (!temporary_files_switch) to
- hold the static strings area so far */
-
-static uchar *strings_holding_area; /* Area holding translated strings
- until they are moved into either
- a temporary file, or the
- static_strings_area below */
-
-char *all_text, *all_text_top; /* Start and next byte free in (large)
- text buffer holding the entire text
- of the game, when it is being
- recorded */
-int put_strings_in_low_memory, /* When TRUE, put static strings in
- the low strings pool at 0x100 rather
- than in the static strings area */
- is_abbreviation, /* When TRUE, the string being trans
- is itself an abbreviation string
- so can't make use of abbreviations */
- abbrevs_lookup_table_made, /* The abbreviations lookup table is
- constructed when the first non-
- abbreviation string is translated:
- this flag is TRUE after that */
- abbrevs_lookup[256]; /* Once this has been constructed,
- abbrevs_lookup[n] = the smallest
- number of any abbreviation beginning
- with ASCII character n, or -1
- if none of the abbreviations do */
-int no_abbreviations; /* No of abbreviations defined so far */
-uchar *abbreviations_at; /* Memory to hold the text of any
- abbreviation strings declared */
-/* ------------------------------------------------------------------------- */
-/* Glulx string compression storage */
-/* ------------------------------------------------------------------------- */
-
-int no_strings; /* No of strings in static strings
- area. */
-int no_dynamic_strings; /* No. of @.. string escapes used
- (actually, the highest value used
- plus one) */
-int no_unicode_chars; /* Number of distinct Unicode chars
- used. (Beyond 0xFF.) */
-
-static int MAX_CHARACTER_SET; /* Number of possible entities */
-huffentity_t *huff_entities; /* The list of entities (characters,
- abbreviations, @.. escapes, and
- the terminator) */
-static huffentity_t **hufflist; /* Copy of the list, for sorting */
-
-int no_huff_entities; /* The number of entities in the list */
-int huff_unicode_start; /* Position in the list where Unicode
- chars begin. */
-int huff_abbrev_start; /* Position in the list where string
- abbreviations begin. */
-int huff_dynam_start; /* Position in the list where @..
- entities begin. */
-int huff_entity_root; /* The position in the list of the root
- entry (when considering the table
- as a tree). */
-
-int done_compression; /* Has the game text been compressed? */
-int32 compression_table_size; /* Length of the Huffman table, in
- bytes */
-int32 compression_string_size; /* Length of the compressed string
- data, in bytes */
-int32 *compressed_offsets; /* The beginning of every string in
- the game, relative to the beginning
- of the Huffman table. (So entry 0
- is equal to compression_table_size)*/
-
-#define UNICODE_HASH_BUCKETS (64)
-unicode_usage_t *unicode_usage_entries;
-static unicode_usage_t *unicode_usage_hash[UNICODE_HASH_BUCKETS];
-
-static int unicode_entity_index(int32 unicode);
-
-/* ------------------------------------------------------------------------- */
-/* Abbreviation arrays */
-/* ------------------------------------------------------------------------- */
-
-int *abbrev_values;
-int *abbrev_quality;
-int *abbrev_freqs;
-
-/* ------------------------------------------------------------------------- */
-
-int32 total_chars_trans, /* Number of ASCII chars of text in */
- total_bytes_trans, /* Number of bytes of Z-code text out */
- zchars_trans_in_last_string; /* Number of Z-chars in last string:
- needed only for abbrev efficiency
- calculation in "directs.c" */
-static int32 total_zchars_trans, /* Number of Z-chars of text out
- (only used to calculate the above) */
- no_chars_transcribed; /* Number of ASCII chars written to
- the text transcription area (used
- for the -r and -u switches) */
-
-static int zchars_out_buffer[3], /* During text translation, a buffer of
- 3 Z-chars at a time: when it's full
- these are written as a 2-byte word */
- zob_index; /* Index (0 to 2) into it */
-
-static unsigned char *text_out_pc; /* The "program counter" during text
- translation: the next address to
- write Z-coded text output to */
-
-static unsigned char *text_out_limit; /* The upper limit of text_out_pc
- during text translation */
-
-static int text_out_overflow; /* During text translation, becomes
- true if text_out_pc tries to pass
- text_out_limit */
-
-/* ------------------------------------------------------------------------- */
-/* For variables/arrays used by the dictionary manager, see below */
-/* ------------------------------------------------------------------------- */
-
-/* ------------------------------------------------------------------------- */
-/* Prepare the abbreviations lookup table (used to speed up abbreviation */
-/* detection in text translation). We first bubble-sort the abbrevs into */
-/* alphabetical order (this is necessary for the detection algorithm to */
-/* to work). Since the table is only prepared once, and for a table */
-/* of size at most 96, there's no point using an efficient sort algorithm. */
-/* ------------------------------------------------------------------------- */
-
-static void make_abbrevs_lookup(void)
-{ int bubble_sort, j, k, l; char p[MAX_ABBREV_LENGTH]; 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;
- if (strcmp(p1,p2)<0)
- { strcpy(p,p1); strcpy(p1,p2); strcpy(p2,p);
- l=abbrev_values[j]; abbrev_values[j]=abbrev_values[k];
- abbrev_values[k]=l;
- l=abbrev_quality[j]; abbrev_quality[j]=abbrev_quality[k];
- abbrev_quality[k]=l;
- bubble_sort = TRUE;
- }
- }
- } while (bubble_sort);
-
- for (j=no_abbreviations-1; j>=0; j--)
- { p1=(char *)abbreviations_at+j*MAX_ABBREV_LENGTH;
- abbrevs_lookup[(uchar)p1[0]]=j;
- abbrev_freqs[j]=0;
- }
- abbrevs_lookup_table_made = TRUE;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Search the abbreviations lookup table (a routine which must be fast). */
-/* The source text to compare is text[i], text[i+1], ... and this routine */
-/* is only called if text[i] is indeed the first character of at least one */
-/* abbreviation, "from" begin the least index into the abbreviations table */
-/* of an abbreviation for which text[i] is the first character. Recall */
-/* that the abbrevs table is in alphabetical order. */
-/* */
-/* The return value is -1 if there is no match. If there is a match, the */
-/* text to be abbreviated out is over-written by a string of null chars */
-/* with "ASCII" value 1, and the abbreviation number is returned. */
-/* */
-/* In Glulx, we *do not* do this overwriting with 1's. */
-/* ------------------------------------------------------------------------- */
-
-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 (k=2; p[k]!=0; k++)
- if (text[i+k]!=p[k]) goto NotMatched;
- if (!glulx_mode) {
- for (k=0; p[k]!=0; k++) text[i+k]=1;
- }
- abbrev_freqs[j]++;
- return(j);
- NotMatched: ;
- }
- }
- return(-1);
-}
-
-extern void make_abbreviation(char *text)
-{
- strcpy((char *)abbreviations_at
- + no_abbreviations*MAX_ABBREV_LENGTH, text);
-
- is_abbreviation = TRUE;
- abbrev_values[no_abbreviations] = compile_string(text, TRUE, TRUE);
- is_abbreviation = FALSE;
-
- /* The quality is the number of Z-chars saved by using this */
- /* abbreviation: note that it takes 2 Z-chars to print it. */
-
- abbrev_quality[no_abbreviations++] = zchars_trans_in_last_string - 2;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The front end routine for text translation */
-/* ------------------------------------------------------------------------- */
-
-extern int32 compile_string(char *b, int in_low_memory, int is_abbrev)
-{ int i, j; uchar *c;
-
- is_abbreviation = is_abbrev;
-
- /* Put into the low memory pool (at 0x100 in the Z-machine) of strings */
- /* which may be wanted as possible entries in the abbreviations table */
-
- if (!glulx_mode && in_low_memory)
- { j=subtract_pointers(low_strings_top,low_strings);
- low_strings_top=translate_text(low_strings_top, low_strings+MAX_LOW_STRINGS, b);
- if (!low_strings_top)
- memoryerror("MAX_LOW_STRINGS", MAX_LOW_STRINGS);
- is_abbreviation = FALSE;
- return(0x21+(j/2));
- }
-
- if (glulx_mode && done_compression)
- compiler_error("Tried to add a string after compression was done.");
-
- c = translate_text(strings_holding_area, strings_holding_area+MAX_STATIC_STRINGS, b);
- if (!c)
- memoryerror("MAX_STATIC_STRINGS",MAX_STATIC_STRINGS);
-
- i = subtract_pointers(c, strings_holding_area);
-
- /* Insert null bytes as needed to ensure that the next static string */
- /* also occurs at an address expressible as a packed address */
-
- if (!glulx_mode) {
- int textalign;
- if (oddeven_packing_switch)
- textalign = scale_factor*2;
- else
- textalign = scale_factor;
- while ((i%textalign)!=0)
- {
- if (i+2 > MAX_STATIC_STRINGS)
- memoryerror("MAX_STATIC_STRINGS",MAX_STATIC_STRINGS);
- i+=2; *c++ = 0; *c++ = 0;
- }
- }
-
- j = static_strings_extent;
-
- if (temporary_files_switch)
- for (c=strings_holding_area; c<strings_holding_area+i;
- c++, static_strings_extent++)
- fputc(*c,Temp1_fp);
- else
- for (c=strings_holding_area; c<strings_holding_area+i;
- c++, static_strings_extent++)
- write_byte_to_memory_block(&static_strings_area,
- static_strings_extent, *c);
-
- is_abbreviation = FALSE;
-
- if (!glulx_mode) {
- return(j/scale_factor);
- }
- else {
- /* The marker value is a one-based string number. (We reserve zero
- to mean "not a string at all". */
- return (++no_strings);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Output a single Z-character into the buffer, and flush it if full */
-/* ------------------------------------------------------------------------- */
-
-static void write_z_char_z(int i)
-{ uint32 j;
- ASSERT_ZCODE();
- total_zchars_trans++;
- zchars_out_buffer[zob_index++]=(i%32);
- if (zob_index!=3) return;
- zob_index=0;
- j= zchars_out_buffer[0]*0x0400 + zchars_out_buffer[1]*0x0020
- + zchars_out_buffer[2];
- if (text_out_pc+2 > text_out_limit) {
- text_out_overflow = TRUE;
- return;
- }
- text_out_pc[0] = j/256; text_out_pc[1] = j%256; text_out_pc+=2;
- total_bytes_trans+=2;
-}
-
-static void write_zscii(int zsc)
-{
- int lookup_value, in_alphabet;
-
- if (zsc==' ')
- { write_z_char_z(0);
- return;
- }
-
- if (zsc < 0x100) lookup_value = zscii_to_alphabet_grid[zsc];
-
- else lookup_value = -1;
-
- if (lookup_value >= 0)
- { alphabet_used[lookup_value] = 'Y';
- in_alphabet = lookup_value/26;
- if (in_alphabet==1) write_z_char_z(4); /* SHIFT to A1 */
- if (in_alphabet==2) write_z_char_z(5); /* SHIFT to A2 */
- write_z_char_z(lookup_value%26 + 6);
- }
- else
- { write_z_char_z(5); write_z_char_z(6);
- write_z_char_z(zsc/32); write_z_char_z(zsc%32);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Finish a Z-coded string, padding out with Z-char 5s if necessary and */
-/* setting the "end" bit on the final 2-byte word */
-/* ------------------------------------------------------------------------- */
-
-static void end_z_chars(void)
-{ unsigned char *p;
- zchars_trans_in_last_string=total_zchars_trans-zchars_trans_in_last_string;
- while (zob_index!=0) write_z_char_z(5);
- p=(unsigned char *) text_out_pc;
- *(p-2)= *(p-2)+128;
-}
-
-/* Glulx handles this much more simply -- compression is done elsewhere. */
-static void write_z_char_g(int i)
-{
- ASSERT_GLULX();
- if (text_out_pc+1 > text_out_limit) {
- text_out_overflow = TRUE;
- return;
- }
- total_zchars_trans++;
- text_out_pc[0] = i;
- text_out_pc++;
- total_bytes_trans++;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The main routine "text.c" provides to the rest of Inform: the text */
-/* translator. p is the address to write output to, s_text the source text */
-/* and the return value is the next free address to write output to. */
-/* The return value will not exceed p_limit. If the translation tries to */
-/* overflow this boundary, the return value will be NULL (and you should */
-/* display an error). */
-/* Note that the source text may be corrupted by this routine. */
-/* ------------------------------------------------------------------------- */
-
-extern uchar *translate_text(uchar *p, uchar *p_limit, char *s_text)
-{ int i, j, k, in_alphabet, lookup_value;
- int32 unicode; int zscii;
- unsigned char *text_in;
-
- /* Cast the input and output streams to unsigned char: text_out_pc will
- advance as bytes of Z-coded text are written, but text_in doesn't */
-
- text_in = (unsigned char *) s_text;
- text_out_pc = (unsigned char *) p;
- text_out_limit = (unsigned char *) p_limit;
- text_out_overflow = FALSE;
-
- /* Remember the Z-chars total so that later we can subtract to find the
- number of Z-chars translated on this string */
-
- zchars_trans_in_last_string = total_zchars_trans;
-
- /* Start with the Z-characters output buffer empty */
-
- zob_index=0;
-
- /* If this is the first text translated since the abbreviations were
- declared, and if some were declared, then it's time to make the
- lookup table for abbreviations
-
- (Except: we don't if the text being translated is itself
- the text of an abbreviation currently being defined) */
-
- if ((!abbrevs_lookup_table_made) && (no_abbreviations > 0)
- && (!is_abbreviation))
- make_abbrevs_lookup();
-
- /* If we're storing the whole game text to memory, then add this text */
-
- if ((!is_abbreviation) && (store_the_text))
- { no_chars_transcribed += strlen(s_text)+2;
- if (no_chars_transcribed >= MAX_TRANSCRIPT_SIZE)
- memoryerror("MAX_TRANSCRIPT_SIZE", MAX_TRANSCRIPT_SIZE);
- sprintf(all_text_top, "%s\n\n", s_text);
- all_text_top += strlen(all_text_top);
- }
-
- if (transcript_switch && (!veneer_mode))
- write_to_transcript_file(s_text);
-
- if (!glulx_mode) {
-
- /* The empty string of Z-text is illegal, since it can't carry an end
- bit: so we translate an empty string of ASCII text to just the
- pad character 5. Printing this causes nothing to appear on screen. */
-
- if (text_in[0]==0) write_z_char_z(5);
-
- /* Loop through the characters of the null-terminated input text: note
- that if 1 is written over a character in the input text, it is
- afterwards ignored */
-
- for (i=0; text_in[i]!=0; i++)
- { total_chars_trans++;
-
- /* Contract ". " into ". " if double-space-removing switch set:
- likewise "? " and "! " if the setting is high enough */
-
- if ((double_space_setting >= 1)
- && (text_in[i+1]==' ') && (text_in[i+2]==' '))
- { if (text_in[i]=='.') text_in[i+2]=1;
- if (double_space_setting >= 2)
- { if (text_in[i]=='?') text_in[i+2]=1;
- if (text_in[i]=='!') text_in[i+2]=1;
- }
- }
-
- /* Try abbreviations if the economy switch set */
-
- if ((economy_switch) && (!is_abbreviation)
- && ((k=abbrevs_lookup[text_in[i]])!=-1))
- { if ((j=try_abbreviations_from(text_in, i, k))!=-1)
- { if (j<32) { write_z_char_z(2); write_z_char_z(j); }
- else { write_z_char_z(3); write_z_char_z(j-32); }
- }
- }
-
- /* If Unicode switch set, use text_to_unicode to perform UTF-8
- decoding */
- if (character_set_unicode && (text_in[i] & 0x80))
- { unicode = text_to_unicode((char *) (text_in+i));
- zscii = unicode_to_zscii(unicode);
- if (zscii != 5) write_zscii(zscii);
- else
- { unicode_char_error(
- "Character can only be used if declared in \
-advance as part of 'Zcharacter table':", unicode);
- }
- i += textual_form_length - 1;
- continue;
- }
-
- /* '@' is the escape character in Inform string notation: the various
- possibilities are:
-
- (printing only)
- @@decimalnumber : write this ZSCII char (0 to 1023)
- @twodigits : write the abbreviation string with this
- decimal number
-
- (any string context)
- @accentcode : this accented character: e.g.,
- for @'e write an E-acute
- @{...} : this Unicode char (in hex) */
-
- if (text_in[i]=='@')
- { if (text_in[i+1]=='@')
- {
- /* @@... */
-
- i+=2; j=atoi((char *) (text_in+i));
- switch(j)
- { /* Prevent ~ and ^ from being translated to double-quote
- and new-line, as they ordinarily would be */
-
- case 94: write_z_char_z(5); write_z_char_z(6);
- write_z_char_z(94/32); write_z_char_z(94%32);
- break;
- case 126: write_z_char_z(5); write_z_char_z(6);
- write_z_char_z(126/32); write_z_char_z(126%32);
- break;
-
- default: write_zscii(j); break;
- }
- while (isdigit(text_in[i])) i++; i--;
- }
- else if (isdigit(text_in[i+1])!=0)
- { int d1, d2;
-
- /* @.. */
-
- d1 = character_digit_value[text_in[i+1]];
- d2 = character_digit_value[text_in[i+2]];
- if ((d1 == 127) || (d1 >= 10) || (d2 == 127) || (d2 >= 10))
- error("'@..' must have two decimal digits");
- else
- { i+=2;
- write_z_char_z(1); write_z_char_z(d1*10 + d2);
- }
- }
- else
- {
- /* A string escape specifying an unusual character */
-
- unicode = text_to_unicode((char *) (text_in+i));
- zscii = unicode_to_zscii(unicode);
- if (zscii != 5) write_zscii(zscii);
- else
- { unicode_char_error(
- "Character can only be used if declared in \
-advance as part of 'Zcharacter table':", unicode);
- }
- i += textual_form_length - 1;
- }
- }
- else
- { /* Skip a character which has been over-written with the null
- value 1 earlier on */
-
- if (text_in[i]!=1)
- { if (text_in[i]==' ') write_z_char_z(0);
- else
- { j = (int) text_in[i];
- lookup_value = iso_to_alphabet_grid[j];
- if (lookup_value < 0)
- { /* The character isn't in the standard alphabets, so
- we have to use the ZSCII 4-Z-char sequence */
-
- if (lookup_value == -5)
- { /* Character isn't in the ZSCII set at all */
-
- unicode = iso_to_unicode(j);
- unicode_char_error(
- "Character can only be used if declared in \
-advance as part of 'Zcharacter table':", unicode);
- write_zscii(0x200 + unicode/0x100);
- write_zscii(0x300 + unicode%0x100);
- }
- else write_zscii(-lookup_value);
- }
- else
- { /* The character is in one of the standard alphabets:
- write a SHIFT to temporarily change alphabet if
- it isn't in alphabet 0, then write the Z-char */
-
- alphabet_used[lookup_value] = 'Y';
- in_alphabet = lookup_value/26;
- if (in_alphabet==1) write_z_char_z(4); /* SHIFT to A1 */
- if (in_alphabet==2) write_z_char_z(5); /* SHIFT to A2 */
- write_z_char_z(lookup_value%26 + 6);
- }
- }
- }
- }
- }
-
- /* Flush the Z-characters output buffer and set the "end" bit */
-
- end_z_chars();
-
- }
- else {
-
- /* The text storage here is, of course, temporary. Compression
- will occur when we're finished compiling, so that all the
- clever Huffman stuff will work.
- In the stored text, we use "@@" to indicate @,
- "@0" to indicate a zero byte,
- "@ANNNN" to indicate an abbreviation,
- "@DNNNN" to indicate a dynamic string thing.
- "@UNNNN" to indicate a four-byte Unicode value (0x100 or higher).
- (NNNN is a four-digit hex number using the letters A-P... an
- ugly representation but a convenient one.)
- */
-
- for (i=0; text_in[i]!=0; i++) {
-
- /* Contract ". " into ". " if double-space-removing switch set:
- likewise "? " and "! " if the setting is high enough. */
- if ((double_space_setting >= 1)
- && (text_in[i+1]==' ') && (text_in[i+2]==' ')) {
- if (text_in[i]=='.'
- || (double_space_setting >= 2
- && (text_in[i]=='?' || text_in[i]=='!'))) {
- text_in[i+1] = text_in[i];
- i++;
- }
- }
-
- total_chars_trans++;
-
- /* Try abbreviations if the economy switch set. We have to be in
- compression mode too, since the abbreviation mechanism is part
- of string decompression. */
-
- 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;
- i += (strlen(cx)-1);
- write_z_char_g('@');
- write_z_char_g('A');
- write_z_char_g('A' + ((j >>12) & 0x0F));
- write_z_char_g('A' + ((j >> 8) & 0x0F));
- write_z_char_g('A' + ((j >> 4) & 0x0F));
- write_z_char_g('A' + ((j ) & 0x0F));
- }
- else if (text_in[i] == '@') {
- if (text_in[i+1]=='@') {
- /* An ASCII code */
- i+=2; j=atoi((char *) (text_in+i));
- if (j == '@' || j == '\0') {
- write_z_char_g('@');
- if (j == 0) {
- j = '0';
- if (!compression_switch)
- warning("Ascii @@0 will prematurely terminate non-compressed \
-string.");
- }
- }
- write_z_char_g(j);
- while (isdigit(text_in[i])) i++; i--;
- }
- else if (isdigit(text_in[i+1])) {
- int d1, d2;
- d1 = character_digit_value[text_in[i+1]];
- d2 = character_digit_value[text_in[i+2]];
- if ((d1 == 127) || (d1 >= 10) || (d2 == 127) || (d2 >= 10)) {
- error("'@..' must have two decimal digits");
- }
- else {
- if (!compression_switch)
- warning("'@..' print variable will not work in non-compressed \
-string; substituting ' '.");
- i += 2;
- j = d1*10 + d2;
- if (j >= MAX_DYNAMIC_STRINGS) {
- memoryerror("MAX_DYNAMIC_STRINGS", MAX_DYNAMIC_STRINGS);
- j = 0;
- }
- if (j+1 >= no_dynamic_strings)
- no_dynamic_strings = j+1;
- write_z_char_g('@');
- write_z_char_g('D');
- write_z_char_g('A' + ((j >>12) & 0x0F));
- write_z_char_g('A' + ((j >> 8) & 0x0F));
- write_z_char_g('A' + ((j >> 4) & 0x0F));
- write_z_char_g('A' + ((j ) & 0x0F));
- }
- }
- else {
- unicode = text_to_unicode((char *) (text_in+i));
- i += textual_form_length - 1;
- if (unicode == '@' || unicode == '\0') {
- write_z_char_g('@');
- write_z_char_g(unicode ? '@' : '0');
- }
- else if (unicode >= 0 && unicode < 256) {
- write_z_char_g(unicode);
- }
- else {
- if (!compression_switch) {
- warning("Unicode characters will not work in non-compressed \
-string; substituting '?'.");
- write_z_char_g('?');
- }
- else {
- j = unicode_entity_index(unicode);
- write_z_char_g('@');
- write_z_char_g('U');
- write_z_char_g('A' + ((j >>12) & 0x0F));
- write_z_char_g('A' + ((j >> 8) & 0x0F));
- write_z_char_g('A' + ((j >> 4) & 0x0F));
- write_z_char_g('A' + ((j ) & 0x0F));
- }
- }
- }
- }
- else if (text_in[i] == '^')
- write_z_char_g(0x0A);
- else if (text_in[i] == '~')
- write_z_char_g('"');
- else if (character_set_unicode) {
- if (text_in[i] & 0x80) {
- unicode = text_to_unicode((char *) (text_in+i));
- i += textual_form_length - 1;
- if (unicode >= 0 && unicode < 256) {
- write_z_char_g(unicode);
- }
- else {
- if (!compression_switch) {
- warning("Unicode characters will not work in non-compressed \
-string; substituting '?'.");
- write_z_char_g('?');
- }
- else {
- j = unicode_entity_index(unicode);
- write_z_char_g('@');
- write_z_char_g('U');
- write_z_char_g('A' + ((j >>12) & 0x0F));
- write_z_char_g('A' + ((j >> 8) & 0x0F));
- write_z_char_g('A' + ((j >> 4) & 0x0F));
- write_z_char_g('A' + ((j ) & 0x0F));
- }
- }
- }
- else {
- write_z_char_g(text_in[i]);
- }
- }
- else {
- unicode = iso_to_unicode_grid[text_in[i]];
- if (unicode >= 0 && unicode < 256) {
- write_z_char_g(unicode);
- }
- else {
- if (!compression_switch) {
- warning("Unicode characters will not work in non-compressed \
-string; substituting '?'.");
- write_z_char_g('?');
- }
- else {
- j = unicode_entity_index(unicode);
- write_z_char_g('@');
- write_z_char_g('U');
- write_z_char_g('A' + ((j >>12) & 0x0F));
- write_z_char_g('A' + ((j >> 8) & 0x0F));
- write_z_char_g('A' + ((j >> 4) & 0x0F));
- write_z_char_g('A' + ((j ) & 0x0F));
- }
- }
- }
- }
- write_z_char_g(0);
-
- }
-
- if (text_out_overflow)
- return NULL;
- else
- return((uchar *) text_out_pc);
-}
-
-static int unicode_entity_index(int32 unicode)
-{
- unicode_usage_t *uptr;
- int j;
- int buck = unicode % UNICODE_HASH_BUCKETS;
-
- for (uptr = unicode_usage_hash[buck]; uptr; uptr=uptr->next) {
- if (uptr->ch == unicode)
- break;
- }
- if (uptr) {
- j = (uptr - unicode_usage_entries);
- }
- else {
- if (no_unicode_chars >= MAX_UNICODE_CHARS) {
- memoryerror("MAX_UNICODE_CHARS", MAX_UNICODE_CHARS);
- j = 0;
- }
- else {
- j = no_unicode_chars;
- no_unicode_chars++;
- uptr = unicode_usage_entries + j;
- uptr->ch = unicode;
- uptr->next = unicode_usage_hash[buck];
- unicode_usage_hash[buck] = uptr;
- }
- }
-
- return j;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Glulx compression code */
-/* ------------------------------------------------------------------------- */
-
-
-static void compress_makebits(int entnum, int depth, int prevbit,
- huffbitlist_t *bits);
-
-/* The compressor. This uses the usual Huffman compression algorithm. */
-void compress_game_text()
-{
- int entities=0, branchstart, branches;
- int numlive;
- int32 lx;
- int jx;
- int ch;
- int32 ix;
- huffbitlist_t bits;
-
- if (compression_switch) {
-
- /* How many entities have we currently got? Well, 256 plus the
- string-terminator plus Unicode chars plus abbrevations plus
- dynamic strings. */
- entities = 256+1;
- huff_unicode_start = entities;
- entities += no_unicode_chars;
- huff_abbrev_start = entities;
- if (economy_switch)
- entities += no_abbreviations;
- huff_dynam_start = entities;
- entities += no_dynamic_strings;
-
- if (entities > MAX_CHARACTER_SET)
- memoryerror("MAX_CHARACTER_SET",MAX_CHARACTER_SET);
-
- /* Characters */
- for (jx=0; jx<256; jx++) {
- huff_entities[jx].type = 2;
- huff_entities[jx].count = 0;
- huff_entities[jx].u.ch = jx;
- }
- /* Terminator */
- huff_entities[256].type = 1;
- huff_entities[256].count = 0;
- for (jx=0; jx<no_unicode_chars; jx++) {
- huff_entities[huff_unicode_start+jx].type = 4;
- huff_entities[huff_unicode_start+jx].count = 0;
- huff_entities[huff_unicode_start+jx].u.val = jx;
- }
- if (economy_switch) {
- for (jx=0; jx<no_abbreviations; jx++) {
- huff_entities[huff_abbrev_start+jx].type = 3;
- huff_entities[huff_abbrev_start+jx].count = 0;
- huff_entities[huff_abbrev_start+jx].u.val = jx;
- }
- }
- for (jx=0; jx<no_dynamic_strings; jx++) {
- huff_entities[huff_dynam_start+jx].type = 9;
- huff_entities[huff_dynam_start+jx].count = 0;
- huff_entities[huff_dynam_start+jx].u.val = jx;
- }
- }
- else {
- /* No compression; use defaults that will make it easy to check
- for errors. */
- no_huff_entities = 257;
- huff_unicode_start = 257;
- huff_abbrev_start = 257;
- huff_dynam_start = 257+MAX_ABBREVS;
- compression_table_size = 0;
- }
-
- if (temporary_files_switch) {
- fclose(Temp1_fp);
- Temp1_fp=fopen(Temp1_Name,"rb");
- if (Temp1_fp==NULL)
- fatalerror("I/O failure: couldn't reopen temporary file 1");
- }
-
- if (compression_switch) {
-
- for (lx=0, ix=0; lx<no_strings; lx++) {
- int escapelen=0, escapetype=0;
- int done=FALSE;
- int32 escapeval=0;
- while (!done) {
- if (temporary_files_switch)
- ch = fgetc(Temp1_fp);
- else
- ch = read_byte_from_memory_block(&static_strings_area, ix);
- ix++;
- if (ix > static_strings_extent || ch < 0)
- compiler_error("Read too much not-yet-compressed text.");
- if (escapelen == -1) {
- escapelen = 0;
- if (ch == '@') {
- ch = '@';
- }
- else if (ch == '0') {
- ch = '\0';
- }
- else if (ch == 'A' || ch == 'D' || ch == 'U') {
- escapelen = 4;
- escapetype = ch;
- escapeval = 0;
- continue;
- }
- else {
- compiler_error("Strange @ escape in processed text.");
- }
- }
- else if (escapelen) {
- escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
- escapelen--;
- if (escapelen == 0) {
- if (escapetype == 'A') {
- ch = huff_abbrev_start+escapeval;
- }
- else if (escapetype == 'D') {
- ch = huff_dynam_start+escapeval;
- }
- else if (escapetype == 'U') {
- ch = huff_unicode_start+escapeval;
- }
- else {
- compiler_error("Strange @ escape in processed text.");
- }
- }
- else
- continue;
- }
- else {
- if (ch == '@') {
- escapelen = -1;
- continue;
- }
- if (ch == 0) {
- ch = 256;
- done = TRUE;
- }
- }
- huff_entities[ch].count++;
- }
- }
-
- numlive = 0;
- for (jx=0; jx<entities; jx++) {
- if (huff_entities[jx].count) {
- hufflist[numlive] = &(huff_entities[jx]);
- numlive++;
- }
- }
-
- branchstart = entities;
- branches = 0;
-
- while (numlive > 1) {
- int best1, best2;
- int best1num, best2num;
- huffentity_t *bran;
-
- if (hufflist[0]->count < hufflist[1]->count) {
- best1 = 0;
- best2 = 1;
- }
- else {
- best2 = 0;
- best1 = 1;
- }
-
- best1num = hufflist[best1]->count;
- best2num = hufflist[best2]->count;
-
- for (jx=2; jx<numlive; jx++) {
- if (hufflist[jx]->count < best1num) {
- best2 = best1;
- best2num = best1num;
- best1 = jx;
- best1num = hufflist[best1]->count;
- }
- else if (hufflist[jx]->count < best2num) {
- best2 = jx;
- best2num = hufflist[best2]->count;
- }
- }
-
- bran = &(huff_entities[branchstart+branches]);
- branches++;
- bran->type = 0;
- bran->count = hufflist[best1]->count + hufflist[best2]->count;
- bran->u.branch[0] = (hufflist[best1] - huff_entities);
- bran->u.branch[1] = (hufflist[best2] - huff_entities);
- hufflist[best1] = bran;
- if (best2 < numlive-1) {
- memmove(&(hufflist[best2]), &(hufflist[best2+1]),
- ((numlive-1) - best2) * sizeof(huffentity_t *));
- }
- numlive--;
- }
-
- huff_entity_root = (hufflist[0] - huff_entities);
-
- for (ix=0; ix<MAXHUFFBYTES; ix++)
- bits.b[ix] = 0;
- compression_table_size = 12;
-
- no_huff_entities = 0; /* compress_makebits will total this up */
- compress_makebits(huff_entity_root, 0, -1, &bits);
- }
-
- /* Now, sadly, we have to compute the size of the string section,
- without actually doing the compression. */
- compression_string_size = 0;
-
- if (temporary_files_switch) {
- fseek(Temp1_fp, 0, SEEK_SET);
- }
-
- if (no_strings >= MAX_NUM_STATIC_STRINGS)
- memoryerror("MAX_NUM_STATIC_STRINGS", MAX_NUM_STATIC_STRINGS);
-
- for (lx=0, ix=0; lx<no_strings; lx++) {
- int escapelen=0, escapetype=0;
- int done=FALSE;
- int32 escapeval=0;
- jx = 0;
- compressed_offsets[lx] = compression_table_size + compression_string_size;
- compression_string_size++; /* for the type byte */
- while (!done) {
- if (temporary_files_switch)
- ch = fgetc(Temp1_fp);
- else
- ch = read_byte_from_memory_block(&static_strings_area, ix);
- ix++;
- if (ix > static_strings_extent || ch < 0)
- compiler_error("Read too much not-yet-compressed text.");
- if (escapelen == -1) {
- escapelen = 0;
- if (ch == '@') {
- ch = '@';
- }
- else if (ch == '0') {
- ch = '\0';
- }
- else if (ch == 'A' || ch == 'D' || ch == 'U') {
- escapelen = 4;
- escapetype = ch;
- escapeval = 0;
- continue;
- }
- else {
- compiler_error("Strange @ escape in processed text.");
- }
- }
- else if (escapelen) {
- escapeval = (escapeval << 4) | ((ch-'A') & 0x0F);
- escapelen--;
- if (escapelen == 0) {
- if (escapetype == 'A') {
- ch = huff_abbrev_start+escapeval;
- }
- else if (escapetype == 'D') {
- ch = huff_dynam_start+escapeval;
- }
- else if (escapetype == 'U') {
- ch = huff_unicode_start+escapeval;
- }
- else {
- compiler_error("Strange @ escape in processed text.");
- }
- }
- else
- continue;
- }
- else {
- if (ch == '@') {
- escapelen = -1;
- continue;
- }
- if (ch == 0) {
- ch = 256;
- done = TRUE;
- }
- }
-
- if (compression_switch) {
- jx += huff_entities[ch].depth;
- compression_string_size += (jx/8);
- jx = (jx % 8);
- }
- else {
- if (ch >= huff_dynam_start) {
- compression_string_size += 3;
- }
- else if (ch >= huff_unicode_start) {
- compiler_error("Abbreviation/Unicode in non-compressed string \
-should be impossible.");
- }
- else
- compression_string_size += 1;
- }
- }
- if (compression_switch && jx)
- compression_string_size++;
- }
-
- done_compression = TRUE;
-}
-
-static void compress_makebits(int entnum, int depth, int prevbit,
- huffbitlist_t *bits)
-{
- huffentity_t *ent = &(huff_entities[entnum]);
- char *cx;
-
- no_huff_entities++;
- ent->addr = compression_table_size;
- ent->depth = depth;
- ent->bits = *bits;
- if (depth > 0) {
- if (prevbit)
- ent->bits.b[(depth-1) / 8] |= (1 << ((depth-1) % 8));
- }
-
- switch (ent->type) {
- case 0:
- compression_table_size += 9;
- compress_makebits(ent->u.branch[0], depth+1, 0, &ent->bits);
- compress_makebits(ent->u.branch[1], depth+1, 1, &ent->bits);
- break;
- case 1:
- compression_table_size += 1;
- break;
- case 2:
- compression_table_size += 2;
- break;
- case 3:
- cx = (char *)abbreviations_at + ent->u.val*MAX_ABBREV_LENGTH;
- compression_table_size += (1 + 1 + strlen(cx));
- break;
- case 4:
- case 9:
- compression_table_size += 5;
- break;
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* The abbreviations optimiser */
-/* */
-/* This is a very complex, memory and time expensive algorithm to */
-/* approximately solve the problem of which abbreviation strings would */
-/* minimise the total number of Z-chars to which the game text translates. */
-/* It is in some ways a quite separate program but remains inside Inform */
-/* for compatibility with previous releases. */
-/* ------------------------------------------------------------------------- */
-
-typedef struct tlb_s
-{ char text[4];
- int32 intab, occurrences;
-} tlb;
-static tlb *tlbtab;
-static int32 no_occs;
-
-static int32 *grandtable;
-static int32 *grandflags;
-typedef struct optab_s
-{ int32 length;
- int32 popularity;
- int32 score;
- int32 location;
- char text[MAX_ABBREV_LENGTH];
-} optab;
-static optab *bestyet, *bestyet2;
-
-static int pass_no;
-
-static char *sub_buffer;
-
-static void optimise_pass(void)
-{ int32 i; int t1, t2;
- int32 j, j2, k, nl, matches, noflags, score, min, minat=0, x, scrabble, c;
- for (i=0; i<256; i++) bestyet[i].length=0;
- for (i=0; i<no_occs; i++)
- { if ((*(tlbtab[i].text)!=(int) '\n')&&(tlbtab[i].occurrences!=0))
- {
-#ifdef MAC_FACE
- if (i%((**g_pm_hndl).linespercheck) == 0)
- { ProcessEvents (&g_proc);
- if (g_proc != true)
- { free_arrays();
- if (store_the_text)
- my_free(&all_text,"transcription text");
- longjmp (g_fallback, 1);
- }
- }
-#endif
- printf("Pass %d, %4ld/%ld '%s' (%ld occurrences) ",
- pass_no, (long int) i, (long int) no_occs, tlbtab[i].text,
- (long int) tlbtab[i].occurrences);
- t1=(int) (time(0));
- 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<=62))
- { nl++;
- for (j2=0; j2<nl; j2++)
- if (all_text[grandtable[tlbtab[i].intab+j]+j2]=='\n')
- goto FinishEarly;
- matches=0;
- for (j2=j; j2<tlbtab[i].occurrences; j2++)
- { if (grandflags[j2]==1)
- { x=grandtable[tlbtab[i].intab+j2]
- - grandtable[tlbtab[i].intab+j];
- if (((x>-nl)&&(x<nl))
- || (memcmp(all_text+grandtable[tlbtab[i].intab+j],
- all_text+grandtable[tlbtab[i].intab+j2],
- nl)!=0))
- { grandflags[j2]=0; noflags--; }
- else matches++;
- }
- }
- scrabble=0;
- for (k=0; k<nl; k++)
- { scrabble++;
- c=all_text[grandtable[tlbtab[i].intab+j+k]];
- if (c!=(int) ' ')
- { if (iso_to_alphabet_grid[c]<0)
- scrabble+=2;
- else
- if (iso_to_alphabet_grid[c]>=26)
- scrabble++;
- }
- }
- score=(matches-1)*(scrabble-2);
- min=score;
- for (j2=0; j2<256; j2++)
- { if ((nl==bestyet[j2].length)
- && (memcmp(all_text+bestyet[j2].location,
- all_text+grandtable[tlbtab[i].intab+j],
- nl)==0))
- { j2=256; min=score; }
- else
- { if (bestyet[j2].score<min)
- { min=bestyet[j2].score; minat=j2;
- }
- }
- }
- if (min!=score)
- { bestyet[minat].score=score;
- bestyet[minat].length=nl;
- bestyet[minat].location=grandtable[tlbtab[i].intab+j];
- bestyet[minat].popularity=matches;
- for (j2=0; j2<nl; j2++) sub_buffer[j2]=
- all_text[bestyet[minat].location+j2];
- sub_buffer[nl]=0;
- }
- }
- FinishEarly: ;
- }
- t2=((int) time(0)) - t1;
- printf(" (%d seconds)\n",t2);
- }
- }
-}
-
-static int any_overlap(char *s1, char *s2)
-{ int a, b, i, j, flag;
- a=strlen(s1); b=strlen(s2);
- for (i=1-b; i<a; i++)
- { flag=0;
- for (j=0; j<b; j++)
- if ((0<=i+j)&&(i+j<=a-1))
- if (s1[i+j]!=s2[j]) flag=1;
- if (flag==0) return(1);
- }
- return(0);
-}
-
-#define MAX_TLBS 8000
-
-extern void optimise_abbreviations(void)
-{ int32 i, j, t, max=0, MAX_GTABLE;
- int32 j2, selected, available, maxat=0, nl;
- tlb test;
-
- printf("Beginning calculation of optimal abbreviations...\n");
-
- pass_no = 0;
- tlbtab=my_calloc(sizeof(tlb), MAX_TLBS, "tlb table"); no_occs=0;
- sub_buffer=my_calloc(sizeof(char), 4000, "sub_buffer");
- for (i=0; i<MAX_TLBS; i++) tlbtab[i].occurrences=0;
-
- bestyet=my_calloc(sizeof(optab), 256, "bestyet");
- bestyet2=my_calloc(sizeof(optab), 64, "bestyet2");
-
- bestyet2[0].text[0]='.';
- bestyet2[0].text[1]=' ';
- bestyet2[0].text[2]=0;
-
- bestyet2[1].text[0]=',';
- bestyet2[1].text[1]=' ';
- bestyet2[1].text[2]=0;
-
- for (i=0; all_text+i<all_text_top; i++)
- {
- if ((all_text[i]=='.') && (all_text[i+1]==' ') && (all_text[i+2]==' '))
- { all_text[i]='\n'; all_text[i+1]='\n'; all_text[i+2]='\n';
- bestyet2[0].popularity++;
- }
-
- if ((all_text[i]=='.') && (all_text[i+1]==' '))
- { all_text[i]='\n'; all_text[i+1]='\n';
- bestyet2[0].popularity++;
- }
-
- if ((all_text[i]==',') && (all_text[i+1]==' '))
- { all_text[i]='\n'; all_text[i+1]='\n';
- bestyet2[1].popularity++;
- }
- }
-
- MAX_GTABLE=subtract_pointers(all_text_top,all_text)+1;
- grandtable=my_calloc(4*sizeof(int32), MAX_GTABLE/4, "grandtable");
-
- for (i=0, t=0; all_text+i<all_text_top; i++)
- { test.text[0]=all_text[i];
- test.text[1]=all_text[i+1];
- test.text[2]=all_text[i+2];
- test.text[3]=0;
- if ((test.text[0]=='\n')||(test.text[1]=='\n')||(test.text[2]=='\n'))
- goto DontKeep;
- for (j=0; j<no_occs; j++)
- if (strcmp(test.text,tlbtab[j].text)==0)
- goto DontKeep;
- test.occurrences=0;
- for (j=i+3; all_text+j<all_text_top; j++)
- {
-#ifdef MAC_FACE
- if (j%((**g_pm_hndl).linespercheck) == 0)
- { ProcessEvents (&g_proc);
- if (g_proc != true)
- { free_arrays();
- if (store_the_text)
- my_free(&all_text,"transcription text");
- longjmp (g_fallback, 1);
- }
- }
-#endif
- if ((all_text[i]==all_text[j])
- && (all_text[i+1]==all_text[j+1])
- && (all_text[i+2]==all_text[j+2]))
- { grandtable[t+test.occurrences]=j;
- test.occurrences++;
- if (t+test.occurrences==MAX_GTABLE)
- { printf("All %ld cross-references used\n",
- (long int) MAX_GTABLE);
- goto Built;
- }
- }
- }
- if (test.occurrences>=2)
- { tlbtab[no_occs]=test;
- tlbtab[no_occs].intab=t; t+=tlbtab[no_occs].occurrences;
- if (max<tlbtab[no_occs].occurrences)
- max=tlbtab[no_occs].occurrences;
- no_occs++;
- if (no_occs==MAX_TLBS)
- { printf("All %d three-letter-blocks used\n",
- MAX_TLBS);
- goto Built;
- }
- }
- DontKeep: ;
- }
-
- Built:
- grandflags=my_calloc(sizeof(int), max, "grandflags");
-
-
- printf("Cross-reference table (%ld entries) built...\n",
- (long int) no_occs);
- /* for (i=0; i<no_occs; i++)
- printf("%4d %4d '%s' %d\n",i,tlbtab[i].intab,tlbtab[i].text,
- tlbtab[i].occurrences);
- */
-
- for (i=0; i<64; i++) bestyet2[i].length=0; selected=2;
- available=256;
- while ((available>0)&&(selected<64))
- { printf("Pass %d\n", ++pass_no);
-
- optimise_pass();
- available=0;
- for (i=0; i<256; i++)
- if (bestyet[i].score!=0)
- { available++;
- nl=bestyet[i].length;
- for (j2=0; j2<nl; j2++) bestyet[i].text[j2]=
- all_text[bestyet[i].location+j2];
- bestyet[i].text[nl]=0;
- }
-
- /* printf("End of pass results:\n");
- printf("\nno score freq string\n");
- for (i=0; i<256; i++)
- if (bestyet[i].score>0)
- printf("%02d: %4d %4d '%s'\n", i, bestyet[i].score,
- bestyet[i].popularity, bestyet[i].text);
- */
-
- do
- { max=0;
- for (i=0; i<256; i++)
- if (max<bestyet[i].score)
- { max=bestyet[i].score;
- maxat=i;
- }
-
- if (max>0)
- { bestyet2[selected++]=bestyet[maxat];
-
- printf(
- "Selection %2ld: '%s' (repeated %ld times, scoring %ld)\n",
- (long int) selected,bestyet[maxat].text,
- (long int) bestyet[maxat].popularity,
- (long int) bestyet[maxat].score);
-
- test.text[0]=bestyet[maxat].text[0];
- test.text[1]=bestyet[maxat].text[1];
- test.text[2]=bestyet[maxat].text[2];
- test.text[3]=0;
-
- for (i=0; i<no_occs; i++)
- if (strcmp(test.text,tlbtab[i].text)==0)
- break;
-
- for (j=0; j<tlbtab[i].occurrences; j++)
- { if (memcmp(bestyet[maxat].text,
- all_text+grandtable[tlbtab[i].intab+j],
- bestyet[maxat].length)==0)
- { for (j2=0; j2<bestyet[maxat].length; j2++)
- all_text[grandtable[tlbtab[i].intab+j]+j2]='\n';
- }
- }
-
- for (i=0; i<256; i++)
- if ((bestyet[i].score>0)&&
- (any_overlap(bestyet[maxat].text,bestyet[i].text)==1))
- { bestyet[i].score=0;
- /* printf("Discarding '%s' as overlapping\n",
- bestyet[i].text); */
- }
- }
- } while ((max>0)&&(available>0)&&(selected<64));
- }
-
- printf("\nChosen abbreviations (in Inform syntax):\n\n");
- for (i=0; i<selected; i++)
- printf("Abbreviate \"%s\";\n", bestyet2[i].text);
-
- text_free_arrays();
-}
-
-/* ------------------------------------------------------------------------- */
-/* The dictionary manager begins here. */
-/* */
-/* Speed is extremely important in these algorithms. If a linear-time */
-/* routine were used to search the dictionary words so far built up, then */
-/* Inform would crawl. */
-/* */
-/* Instead, the dictionary is stored as a binary tree, which is kept */
-/* balanced with the red-black algorithm. */
-/* ------------------------------------------------------------------------- */
-/* A dictionary table similar to the Z-machine format is kept: there is a */
-/* 7-byte header (left blank here to be filled in at the */
-/* construct_storyfile() stage in "tables.c") and then a sequence of */
-/* records, one per word, in the form */
-/* */
-/* <Z-coded text> <flags> <verbnumber> <adjectivenumber> */
-/* 4 or 6 bytes byte byte byte */
-/* */
-/* For Glulx, the form is instead: (But see below about Unicode-valued */
-/* dictionaries and my heinie.) */
-/* */
-/* <plain text> <flags> <verbnumber> <adjectivenumber> */
-/* DICT_WORD_SIZE short short short */
-/* */
-/* These records are stored in "accession order" (i.e. in order of their */
-/* first being received by these routines) and only alphabetically sorted */
-/* by construct_storyfile() (using the array below). */
-/* ------------------------------------------------------------------------- */
-/* */
-/* Further notes about the data fields... */
-/* The flags are currently: */
-/* bit 0: word is used as a verb (in verb grammar) */
-/* bit 1: word is used as a meta verb */
-/* bit 2: word is plural (set by '//p') */
-/* bit 3: word is used as a preposition (in verb grammar) */
-/* bit 6: set for all verbs, but not used by the parser? */
-/* bit 7: word is used as a noun (set for every word that appears in */
-/* code or in an object property) */
-/* */
-/* In grammar version 2, the third field (adjectivenumber) is unused (and */
-/* zero). */
-/* */
-/* The compiler generates special constants #dict_par1, #dict_par2, */
-/* #dict_par3 to refer to the byte offsets of the three fields. In */
-/* Z-code v3, these are 4/5/6; in v4+, they are 6/7/8. In Glulx, they */
-/* are $DICT_WORD_SIZE+2/4/6, referring to the *low* bytes of the three */
-/* fields. (The high bytes are $DICT_WORD_SIZE+1/3/5.) */
-/* ------------------------------------------------------------------------- */
-
-uchar *dictionary, /* (These two pointers are externally
- used only in "tables.c" when
- building the story-file) */
- *dictionary_top; /* Pointer to next free record */
-
-int dict_entries; /* Total number of records entered */
-
-/* ------------------------------------------------------------------------- */
-/* dict_word is a typedef for a struct of 6 unsigned chars (defined in */
-/* "header.h"): it holds the (4 or) 6 bytes of Z-coded text of a word. */
-/* Usefully, because the PAD character 5 is < all alphabetic characters, */
-/* alphabetic order corresponds to numeric order. For this reason, the */
-/* dict_word is called the "sort code" of the original text word. */
-/* */
-/* ###- In modifying the compiler, I've 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.) */
-/* */
-/* ###- 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).*/
-/* Then we store the 32-bit character value big-endian. This lets us */
-/* continue to compare arrays bytewise, which is a nice simplification. */
-/* ------------------------------------------------------------------------- */
-
-extern int compare_sorts(uchar *d1, uchar *d2)
-{ int i;
- for (i=0; i<DICT_WORD_BYTES; i++)
- if (d1[i]!=d2[i]) return((int)(d1[i]) - (int)(d2[i]));
- /* (since memcmp(d1, d2, DICT_WORD_BYTES); runs into a bug on some Unix
- libraries) */
- return(0);
-}
-
-extern void copy_sorts(uchar *d1, uchar *d2)
-{ int i;
- for (i=0; i<DICT_WORD_BYTES; i++)
- d1[i] = d2[i];
-}
-
-static uchar prepared_sort[MAX_DICT_WORD_BYTES]; /* Holds the sort code
- of current word */
-
-static int number_and_case;
-
-/* Also used by verbs.c */
-static void dictionary_prepare_z(char *dword, uchar *optresult)
-{ int i, j, k, k2, wd[13]; int32 tot;
-
- /* A rapid text translation algorithm using only the simplified rules
- applying to the text of dictionary entries: first produce a sequence
- of 6 (v3) or 9 (v4+) Z-characters */
-
- number_and_case = 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;
- default:
- error_named("Expected 'p' after '//' \
-to give number of dictionary word", dword);
- break;
- }
- }
- break;
- }
- if (i>=9) break;
-
- k=(int) dword[j];
- if (k==(int) '\'')
- warning_named("Obsolete usage: use the ^ character for the \
-apostrophe in", dword);
- if (k==(int) '^') k=(int) '\'';
- if (k=='\"') k='~';
-
- if (k==(int) '@' || (character_set_unicode && (k & 0x80)))
- { int unicode = text_to_unicode(dword+j);
- if ((unicode < 128) && isupper(unicode)) unicode = tolower(unicode);
- k = unicode_to_zscii(unicode);
- j += textual_form_length - 1;
- if ((k == 5) || (k >= 0x100))
- { unicode_char_error(
- "Character can be printed but not input:", unicode);
- k = '?';
- }
- k2 = zscii_to_alphabet_grid[(uchar) k];
- }
- else
- { if (isupper(k)) k = tolower(k);
- k2 = iso_to_alphabet_grid[(uchar) k];
- }
-
- if (k2 < 0)
- { if ((k2 == -5) || (k2 <= -0x100))
- 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;
- k2 = -k2;
- wd[i++] = k2/32; wd[i] = k2%32;
- }
- }
- else
- { alphabet_used[k2] = 'Y';
- if ((k2/26)!=0)
- wd[i++]=3+(k2/26); /* Change alphabet for symbols */
- wd[i]=6+(k2%26); /* Write the Z character */
- }
- }
-
- /* Fill up to the end of the dictionary block with PAD characters */
-
- for (; i<9; i++) wd[i]=5;
-
- /* The array of Z-chars is converted to three 2-byte blocks */
-
- tot = wd[2] + wd[1]*(1<<5) + wd[0]*(1<<10);
- prepared_sort[1]=tot%0x100;
- prepared_sort[0]=(tot/0x100)%0x100;
- tot = wd[5] + wd[4]*(1<<5) + wd[3]*(1<<10);
- prepared_sort[3]=tot%0x100;
- prepared_sort[2]=(tot/0x100)%0x100;
- tot = wd[8] + wd[7]*(1<<5) + wd[6]*(1<<10);
- prepared_sort[5]=tot%0x100;
- prepared_sort[4]=(tot/0x100)%0x100;
-
- /* Set the "end bit" on the 2nd (in v3) or the 3rd (v4+) 2-byte block */
-
- if (version_number==3) prepared_sort[2]+=0x80;
- else prepared_sort[4]+=0x80;
-
- if (optresult) copy_sorts(optresult, prepared_sort);
-}
-
-/* Also used by verbs.c */
-static void dictionary_prepare_g(char *dword, uchar *optresult)
-{
- int i, j, k;
- int32 unicode;
-
- number_and_case = 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;
- default:
- error_named("Expected 'p' after '//' \
-to give gender or number of dictionary word", dword);
- break;
- }
- }
- break;
- }
- if (i>=DICT_WORD_SIZE) break;
-
- k= ((unsigned char *)dword)[j];
- if (k=='\'')
- warning_named("Obsolete usage: use the ^ character for the \
-apostrophe in", dword);
- if (k=='^')
- k='\'';
- if (k=='~') /* as in iso_to_alphabet_grid */
- k='\"';
-
- if (k=='@' || (character_set_unicode && (k & 0x80))) {
- unicode = text_to_unicode(dword+j);
- j += textual_form_length - 1;
- }
- else {
- unicode = iso_to_unicode_grid[k];
- }
-
- if (DICT_CHAR_SIZE != 1 || (unicode >= 0 && unicode < 256)) {
- k = unicode;
- }
- else {
- error("The dictionary cannot contain Unicode characters beyond Latin-1. \
-Define DICT_CHAR_SIZE=4 for a Unicode-compatible dictionary.");
- k = '?';
- }
-
- if (k >= (unsigned)'A' && k <= (unsigned)'Z')
- k += ('a' - 'A');
-
- if (DICT_CHAR_SIZE == 1) {
- 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 (DICT_CHAR_SIZE == 1) {
- for (; i<DICT_WORD_SIZE; i++)
- prepared_sort[i] = 0;
- }
- else {
- for (; i<DICT_WORD_SIZE; i++) {
- prepared_sort[4*i] = 0;
- prepared_sort[4*i+1] = 0;
- prepared_sort[4*i+2] = 0;
- prepared_sort[4*i+3] = 0;
- }
- }
-
- if (optresult) copy_sorts(optresult, prepared_sort);
-}
-
-extern void dictionary_prepare(char *dword, uchar *optresult)
-{
- if (!glulx_mode)
- dictionary_prepare_z(dword, optresult);
- else
- dictionary_prepare_g(dword, optresult);
-}
-
-/* ------------------------------------------------------------------------- */
-/* The arrays below are all concerned with the problem of alphabetically */
-/* sorting the dictionary during the compilation pass. */
-/* Note that it is not enough simply to apply qsort to the dictionary at */
-/* the end of the pass: we need to ensure that no duplicates are ever */
-/* created. */
-/* */
-/* dict_sort_codes[n] the sort code of record n: i.e., of the nth */
-/* word to be entered into the dictionary, where */
-/* n counts upward from 0 */
-/* (n is also called the "accession number") */
-/* */
-/* The tree structure encodes an ordering. The special value VACANT means */
-/* "no node here": otherwise, node numbers are the same as accession */
-/* numbers. At all times, "root" holds the node number of the top of the */
-/* tree; each node has up to two branches, such that the subtree of the */
-/* left branch is always alphabetically before what's at the node, and */
-/* the subtree to the right is always after; and all branches are coloured */
-/* either "black" or "red". These colours are used to detect points where */
-/* the tree is growing asymmetrically (and therefore becoming inefficient */
-/* to search). */
-/* ------------------------------------------------------------------------- */
-
-#define RED 'r'
-#define BLACK 'b'
-#define VACANT -1
-
-static int root;
-typedef struct dict_tree_node_s
-{ int branch[2]; /* Branch 0 is "left", 1 is "right" */
- char colour; /* The colour of the branch to the parent */
-} dict_tree_node;
-
-static dict_tree_node *dtree;
-
-int *final_dict_order;
-static uchar *dict_sort_codes;
-
-static void dictionary_begin_pass(void)
-{
- /* Leave room for the 7-byte header (added in "tables.c" much later) */
- /* Glulx has a 4-byte header instead. */
-
- if (!glulx_mode)
- dictionary_top=dictionary+7;
- else
- dictionary_top=dictionary+4;
-
- root = VACANT;
- dict_entries = 0;
-}
-
-static int fdo_count;
-static void recursively_sort(int node)
-{ if (dtree[node].branch[0] != VACANT)
- recursively_sort(dtree[node].branch[0]);
- final_dict_order[node] = fdo_count++;
- if (dtree[node].branch[1] != VACANT)
- recursively_sort(dtree[node].branch[1]);
-}
-
-extern void sort_dictionary(void)
-{ int i;
- if (module_switch)
- { for (i=0; i<dict_entries; i++)
- final_dict_order[i] = i;
- return;
- }
-
- if (root != VACANT)
- { fdo_count = 0; recursively_sort(root);
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* If "dword" is in the dictionary, return its accession number plus 1; */
-/* If not, return 0. */
-/* ------------------------------------------------------------------------- */
-
-static int dictionary_find(char *dword)
-{ int at = root, n;
-
- dictionary_prepare(dword, NULL);
-
- while (at != VACANT)
- { n = compare_sorts(prepared_sort, dict_sort_codes+at*DICT_WORD_BYTES);
- if (n==0) return at + 1;
- if (n>0) at = dtree[at].branch[1]; else at = dtree[at].branch[0];
- }
- return 0;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Add "dword" to the dictionary with (x,y,z) as its data fields; unless */
-/* it already exists, in which case OR the data with (x,y,z) */
-/* */
-/* 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)
-{ 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);
-
- dictionary_prepare(dword, NULL);
-
- if (root == VACANT)
- { root = 0; goto CreateEntry;
- }
- while (TRUE)
- {
- n = compare_sorts(prepared_sort, dict_sort_codes+at*DICT_WORD_BYTES);
- if (n==0)
- {
- if (!glulx_mode) {
- p = dictionary+7 + at*(3+res) + res;
- p[0]=(p[0])|x; p[1]=(p[1])|y; p[2]=(p[2])|z;
- if (x & 128) p[0] = (p[0])|number_and_case;
- }
- 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;
- }
- return at;
- }
- if (n>0) r=1; else r=0;
-
- a = dtree[at].branch[0]; b = dtree[at].branch[1];
- if ((a != VACANT) && (dtree[a].colour == RED) &&
- (b != VACANT) && (dtree[b].colour == RED))
- { dtree[a].colour = BLACK;
- dtree[b].colour = BLACK;
-
- dtree[at].colour = RED;
-
- /* A tree rotation may be needed to avoid two red links in a row:
- e.g.
- ggf (or else gf is root) ggf (or f is root)
- | |
- gf f
- / \(red) / \ (both red)
- f becomes gf at
- / \(red) / \ / \
- at
- / \
-
- In effect we rehang the "gf" subtree from "f".
- See the Technical Manual for further details.
- */
-
- if ((f != VACANT) && (gf != VACANT) && (dtree[f].colour == RED))
- {
- if (fr == gfr)
- { if (ggf == VACANT) root = f; else dtree[ggf].branch[ggfr] = f;
- dtree[gf].branch[gfr] = dtree[f].branch[1-fr];
- dtree[f].branch[1-fr] = gf;
- dtree[f].colour = BLACK;
- dtree[gf].colour = RED;
- gf = ggf; gfr = ggfr;
- }
- else
- { if (ggf == VACANT) root = at; else dtree[ggf].branch[ggfr] = at;
- dtree[at].colour = BLACK;
- dtree[gf].colour = RED;
- dtree[f].branch[fr] = dtree[at].branch[gfr];
- dtree[gf].branch[gfr] = dtree[at].branch[fr];
- dtree[at].branch[gfr] = f;
- dtree[at].branch[fr] = gf;
-
- r = 1-r; n = at; if (r==fr) at = f; else at = gf;
- f = n; gf = ggf; fr = 1-r; gfr = ggfr;
- }
- }
- }
-
- if (dtree[at].branch[r] == VACANT)
- { dtree[at].colour = RED;
-
- if ((f != VACANT) && (gf != VACANT) && (dtree[f].colour == RED))
- { if (fr == gfr)
- { if (ggf == VACANT) root = f; else dtree[ggf].branch[ggfr] = f;
- dtree[gf].branch[gfr] = dtree[f].branch[1-fr];
- dtree[f].branch[1-fr] = gf;
- dtree[f].colour = BLACK;
- dtree[gf].colour = RED;
- }
- else
- { if (ggf == VACANT) root = at; else dtree[ggf].branch[ggfr] = at;
- dtree[at].colour = BLACK;
- dtree[gf].colour = RED;
- dtree[f].branch[fr] = dtree[at].branch[gfr];
- dtree[gf].branch[gfr] = dtree[at].branch[fr];
- dtree[at].branch[gfr] = f;
- dtree[at].branch[fr] = gf;
-
- r = 1-r; n = at; if (r==fr) at = f; else at = gf;
- f = n; gf = ggf;
- }
- }
- dtree[at].branch[r] = dict_entries;
- goto CreateEntry;
- }
- ggf = gf; gf = f; f = at; at = dtree[at].branch[r];
- ggfr = gfr; gfr = fr; fr = r;
- }
-
- CreateEntry:
-
- if (dict_entries==MAX_DICT_ENTRIES)
- memoryerror("MAX_DICT_ENTRIES",MAX_DICT_ENTRIES);
-
- dtree[dict_entries].branch[0] = VACANT;
- dtree[dict_entries].branch[1] = VACANT;
- dtree[dict_entries].colour = BLACK;
-
- /* Address in Inform's own dictionary table to write the record to */
-
- if (!glulx_mode) {
-
- p = dictionary + (3+res)*dict_entries + 7;
-
- /* So copy in the 4 (or 6) bytes of Z-coded text and the 3 data
- bytes */
-
- p[0]=prepared_sort[0]; p[1]=prepared_sort[1];
- 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; p[res+2]=z;
- if (x & 128) p[res] = (p[res])|number_and_case;
-
- dictionary_top += res+3;
-
- }
- else {
- int i;
- p = dictionary + 4 + DICT_ENTRY_BYTE_LENGTH*dict_entries;
- p[0] = 0x60; /* type byte -- dict word */
-
- p += DICT_CHAR_SIZE;
- for (i=0; i<DICT_WORD_BYTES; i++)
- 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;
-
- dictionary_top += DICT_ENTRY_BYTE_LENGTH;
-
- }
-
- copy_sorts(dict_sort_codes+dict_entries*DICT_WORD_BYTES, prepared_sort);
-
- return dict_entries++;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Used in "tables.c" for "Extend ... only", to renumber a verb-word to a */
-/* new verb syntax of its own. (Otherwise existing verb-words never */
-/* change their verb-numbers.) */
-/* ------------------------------------------------------------------------- */
-
-extern void dictionary_set_verb_number(char *dword, int to)
-{ int i; uchar *p;
- int res=((version_number==3)?4:6);
- i=dictionary_find(dword);
- if (i!=0)
- {
- if (!glulx_mode) {
- p=dictionary+7+(i-1)*(3+res)+res;
- p[1]=to;
- }
- else {
- p=dictionary+4 + (i-1)*DICT_ENTRY_BYTE_LENGTH + DICT_ENTRY_FLAG_POS;
- p[2]=to/256; p[3]=to%256;
- }
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Tracing code for the dictionary: used not only by "trace" and text */
-/* transcription, but also (in the case of "word_to_ascii") in a vital */
-/* by the linker. */
-/* ------------------------------------------------------------------------- */
-
-static char *d_show_to;
-static int d_show_total;
-
-static void show_char(char c)
-{ if (d_show_to == NULL) printf("%c", c);
- else
- { int i = strlen(d_show_to);
- d_show_to[i] = c; d_show_to[i+1] = 0;
- }
-}
-
-extern void word_to_ascii(uchar *p, char *results)
-{ int i, shift, cc, zchar; uchar encoded_word[9];
- encoded_word[0] = (((int) p[0])&0x7c)/4;
- encoded_word[1] = 8*(((int) p[0])&0x3) + (((int) p[1])&0xe0)/32;
- encoded_word[2] = ((int) p[1])&0x1f;
- encoded_word[3] = (((int) p[2])&0x7c)/4;
- encoded_word[4] = 8*(((int) p[2])&0x3) + (((int) p[3])&0xe0)/32;
- encoded_word[5] = ((int) p[3])&0x1f;
- if (version_number > 3)
- { encoded_word[6] = (((int) p[4])&0x7c)/4;
- encoded_word[7] = 8*(((int) p[4])&0x3) + (((int) p[5])&0xe0)/32;
- encoded_word[8] = ((int) p[5])&0x1f;
- }
-
- shift = 0; cc = 0;
- for (i=0; i< ((version_number==3)?6:9); i++)
- { zchar = encoded_word[i];
-
- if (zchar == 4) shift = 1;
- else
- if (zchar == 5) shift = 2;
- else
- { if ((shift == 2) && (zchar == 6))
- { zchar = 32*encoded_word[i+1] + encoded_word[i+2];
- i += 2;
- if ((zchar>=32) && (zchar<=126))
- results[cc++] = zchar;
- else
- { zscii_to_text(results+cc, zchar);
- cc = strlen(results);
- }
- }
- else
- { zscii_to_text(results+cc, (alphabet[shift])[zchar-6]);
- cc = strlen(results);
- }
- shift = 0;
- }
- }
- results[cc] = 0;
-}
-
-static void recursively_show_z(int node)
-{ int i, cprinted, flags; uchar *p;
- char textual_form[32];
- int res = (version_number == 3)?4:6;
-
- if (dtree[node].branch[0] != VACANT)
- recursively_show_z(dtree[node].branch[0]);
-
- p = (uchar *)dictionary + 7 + (3+res)*node;
-
- word_to_ascii(p, textual_form);
-
- for (cprinted = 0; textual_form[cprinted]!=0; cprinted++)
- show_char(textual_form[cprinted]);
- for (; cprinted < 4 + ((version_number==3)?6:9); cprinted++)
- show_char(' ');
-
- if (d_show_to == NULL)
- { for (i=0; i<3+res; i++) printf("%02x ",p[i]);
-
- flags = (int) p[res];
- if (flags & 128)
- { printf("noun ");
- if (flags & 4) printf("p"); else printf(" ");
- printf(" ");
- }
- else printf(" ");
- if (flags & 8)
- { if (grammar_version_number == 1)
- printf("preposition:%d ", (int) p[res+2]);
- else
- printf("preposition ");
- }
- if ((flags & 3) == 3) printf("metaverb:%d ", (int) p[res+1]);
- else if ((flags & 3) == 1) printf("verb:%d ", (int) p[res+1]);
- printf("\n");
- }
-
- if (d_show_total++ == 5)
- { d_show_total = 0;
- if (d_show_to != NULL)
- { write_to_transcript_file(d_show_to);
- d_show_to[0] = 0;
- }
- }
-
- if (dtree[node].branch[1] != VACANT)
- recursively_show_z(dtree[node].branch[1]);
-}
-
-static void recursively_show_g(int node)
-{
- warning("### Glulx dictionary-show not yet implemented.\n");
-}
-
-static void show_alphabet(int i)
-{ int j, c; char chartext[8];
-
- for (j=0; j<26; j++)
- { c = alphabet[i][j];
-
- if (alphabet_used[26*i+j] == 'N') printf("("); else printf(" ");
-
- zscii_to_text(chartext, c);
- printf("%s", chartext);
-
- if (alphabet_used[26*i+j] == 'N') printf(")"); else printf(" ");
- }
- printf("\n");
-}
-
-extern void show_dictionary(void)
-{ printf("Dictionary contains %d entries:\n",dict_entries);
- if (dict_entries != 0)
- { d_show_total = 0; d_show_to = NULL;
- if (!glulx_mode)
- recursively_show_z(root);
- else
- recursively_show_g(root);
- }
- printf("\nZ-machine alphabet entries:\n");
- show_alphabet(0);
- show_alphabet(1);
- show_alphabet(2);
-}
-
-extern void write_dictionary_to_transcript(void)
-{ char d_buffer[81];
-
- sprintf(d_buffer, "\n[Dictionary contains %d entries:]\n", dict_entries);
-
- d_buffer[0] = 0; write_to_transcript_file(d_buffer);
-
- if (dict_entries != 0)
- { d_show_total = 0; d_show_to = d_buffer;
- if (!glulx_mode)
- recursively_show_z(root);
- else
- recursively_show_g(root);
- }
- if (d_show_total != 0) write_to_transcript_file(d_buffer);
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_text_vars(void)
-{ int j;
- bestyet = NULL;
- bestyet2 = NULL;
- tlbtab = NULL;
- grandtable = NULL;
- grandflags = NULL;
- no_chars_transcribed = 0;
- is_abbreviation = FALSE;
- put_strings_in_low_memory = FALSE;
-
- for (j=0; j<256; j++) abbrevs_lookup[j] = -1;
-
- total_zchars_trans = 0;
-
- dtree = NULL;
- final_dict_order = NULL;
- dict_sort_codes = NULL;
- dict_entries=0;
-
- initialise_memory_block(&static_strings_area);
-}
-
-extern void text_begin_pass(void)
-{ abbrevs_lookup_table_made = FALSE;
- no_abbreviations=0;
- total_chars_trans=0; total_bytes_trans=0;
- if (store_the_text) all_text_top=all_text;
- dictionary_begin_pass();
- low_strings_top = low_strings;
-
- static_strings_extent = 0;
- no_strings = 0;
- no_dynamic_strings = 0;
- no_unicode_chars = 0;
-}
-
-/* Note: for allocation and deallocation of all_the_text, see inform.c */
-
-extern void text_allocate_arrays(void)
-{ abbreviations_at = my_malloc(MAX_ABBREVS*MAX_ABBREV_LENGTH,
- "abbreviations");
- abbrev_values = my_calloc(sizeof(int), MAX_ABBREVS, "abbrev values");
- abbrev_quality = my_calloc(sizeof(int), MAX_ABBREVS, "abbrev quality");
- abbrev_freqs = my_calloc(sizeof(int), MAX_ABBREVS, "abbrev freqs");
-
- dtree = my_calloc(sizeof(dict_tree_node), MAX_DICT_ENTRIES,
- "red-black tree for dictionary");
- final_dict_order = my_calloc(sizeof(int), MAX_DICT_ENTRIES,
- "final dictionary ordering table");
- dict_sort_codes = my_calloc(DICT_WORD_BYTES, MAX_DICT_ENTRIES,
- "dictionary sort codes");
-
- if (!glulx_mode)
- dictionary = my_malloc(9*MAX_DICT_ENTRIES+7,
- "dictionary");
- else
- dictionary = my_malloc(DICT_ENTRY_BYTE_LENGTH*MAX_DICT_ENTRIES+4,
- "dictionary");
-
- strings_holding_area
- = my_malloc(MAX_STATIC_STRINGS,"static strings holding area");
- low_strings = my_malloc(MAX_LOW_STRINGS,"low (abbreviation) strings");
-
- huff_entities = NULL;
- hufflist = NULL;
- unicode_usage_entries = NULL;
- done_compression = FALSE;
- compression_table_size = 0;
- compressed_offsets = NULL;
-
- MAX_CHARACTER_SET = 0;
-
- if (glulx_mode) {
- if (compression_switch) {
- int ix;
- MAX_CHARACTER_SET = 257 + MAX_ABBREVS + MAX_DYNAMIC_STRINGS
- + MAX_UNICODE_CHARS;
- huff_entities = my_calloc(sizeof(huffentity_t), MAX_CHARACTER_SET*2+1,
- "huffman entities");
- hufflist = my_calloc(sizeof(huffentity_t *), MAX_CHARACTER_SET,
- "huffman node list");
- unicode_usage_entries = my_calloc(sizeof(unicode_usage_t),
- MAX_UNICODE_CHARS, "unicode entity entries");
- for (ix=0; ix<UNICODE_HASH_BUCKETS; ix++)
- unicode_usage_hash[ix] = NULL;
- }
- compressed_offsets = my_calloc(sizeof(int32), MAX_NUM_STATIC_STRINGS,
- "static strings index table");
- }
-}
-
-extern void text_free_arrays(void)
-{
- my_free(&strings_holding_area, "static strings holding area");
- my_free(&low_strings, "low (abbreviation) strings");
- my_free(&abbreviations_at, "abbreviations");
- my_free(&abbrev_values, "abbrev values");
- my_free(&abbrev_quality, "abbrev quality");
- my_free(&abbrev_freqs, "abbrev freqs");
-
- my_free(&dtree, "red-black tree for dictionary");
- my_free(&final_dict_order, "final dictionary ordering table");
- my_free(&dict_sort_codes, "dictionary sort codes");
-
- my_free(&dictionary,"dictionary");
-
- my_free(&compressed_offsets, "static strings index table");
- my_free(&hufflist, "huffman node list");
- my_free(&huff_entities, "huffman entities");
- my_free(&unicode_usage_entries, "unicode entity entities");
-
- deallocate_memory_block(&static_strings_area);
-}
-
-extern void ao_free_arrays(void)
-{ my_free (&tlbtab,"tlb table");
- my_free (&sub_buffer,"sub_buffer");
- my_free (&bestyet,"bestyet");
- my_free (&bestyet2,"bestyet2");
- my_free (&grandtable,"grandtable");
- my_free (&grandflags,"grandflags");
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "veneer" : Compiling the run-time "veneer" of any routines invoked */
-/* by the compiler (e.g. DefArt) which the program doesn't */
-/* provide */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int veneer_mode; /* Is the code currently being
- compiled from the veneer? */
-
-static debug_locations null_debug_locations =
- { { 0, 0, 0, 0, 0, 0, 0 }, NULL, 0 };
-
-extern void compile_initial_routine(void)
-{
- /* The first routine present in memory in any Inform game, beginning
- at the code area start position, always has 0 local variables
- (since the interpreter begins execution with an empty stack frame):
- and it must "quit" rather than "return".
-
- In order not to impose these restrictions on "Main", we compile a
- trivial routine consisting of a call to "Main" followed by "quit". */
-
- int32 j;
- assembly_operand AO;
-
- j = symbol_index("Main__", -1);
- assign_symbol(j,
- assemble_routine_header(0, FALSE, "Main__", FALSE, j),
- ROUTINE_T);
- sflags[j] |= SYSTEM_SFLAG + USED_SFLAG;
- if (trace_fns_setting==3) sflags[j] |= STAR_SFLAG;
-
- if (!glulx_mode) {
-
- INITAOTV(&AO, LONG_CONSTANT_OT, 0);
- AO.marker = MAIN_MV;
-
- sequence_point_follows = FALSE;
-
- if (version_number > 3)
- assemblez_1_to(call_vs_zc, AO, temp_var1);
- else
- assemblez_1_to(call_zc, AO, temp_var1);
-
- assemblez_0(quit_zc);
-
- }
- else {
-
- INITAOTV(&AO, CONSTANT_OT, 0);
- AO.marker = MAIN_MV;
-
- sequence_point_follows = FALSE;
-
- assembleg_3(call_gc, AO, zero_operand, zero_operand);
- assembleg_1(return_gc, zero_operand);
-
- }
-
- assemble_routine_end(FALSE, null_debug_locations);
-}
-
-/* ------------------------------------------------------------------------- */
-/* The rest of the veneer is applied at the end of the pass, as required. */
-/* ------------------------------------------------------------------------- */
-
-static int veneer_routine_needs_compilation[VENEER_ROUTINES];
-int32 veneer_routine_address[VENEER_ROUTINES];
-static int veneer_symbols_base;
-
-#define VR_UNUSED 0
-#define VR_CALLED 1
-#define VR_COMPILED 2
-
-typedef struct VeneerRoutine_s
-{ char *name;
- char *source1;
- char *source2;
- char *source3;
- char *source4;
- char *source5;
- char *source6;
-} VeneerRoutine;
-
-static char *veneer_source_area;
-
-static VeneerRoutine VRs_z[VENEER_ROUTINES] =
-{
- /* Box__Routine: the only veneer routine used in the implementation of
- an actual statement ("box", of course), written in a
- hybrid of Inform and assembly language. Note the
- transcription of the box text to the transcript
- output stream (-1, or $ffff). */
-
- { "Box__Routine",
- "maxw table n w w2 line lc t;\
- n = table --> 0;\
- @add n 6 -> sp;\
- @split_window sp;\
- @set_window 1;\
- w = 0 -> 33;\
- if (w == 0) w=80;\
- w2 = (w - maxw)/2;\
- style reverse;\
- @sub w2 2 -> w;\
- line = 5;\
- lc = 1;\
- @set_cursor 4 w;\
- spaces maxw + 4;",
- "do\
- { @set_cursor line w;\
- spaces maxw + 4;\
- @set_cursor line w2;\
- t = table --> lc;\
- if (t~=0) print (string) t;\
- line++; lc++;\
- } until (lc > n);\
- @set_cursor line w;\
- spaces maxw + 4;\
- @buffer_mode 1;\
- style roman;\
- @set_window 0;\
- @split_window 1;\
- @output_stream $ffff;\
- print \"[ \";\
- lc = 1;",
- "do\
- { w = table --> lc;\
- if (w ~= 0) print (string) w;\
- lc++;\
- if (lc > n)\
- { print \"]^^\";\
- break;\
- }\
- print \"^ \";\
- } until (false);\
- @output_stream 1;\
- ]", "", "", ""
- },
-
- /* This batch of routines is expected to be defined (rather better) by
- the Inform library: these minimal forms here are provided to prevent
- tiny non-library-using programs from failing to compile when certain
- legal syntaxes (such as <<Action a b>>;) are used. */
-
- { "R_Process",
- "a b c d; print \"Action <\", a, \" \", b, \" \", c;\
- if (d) print \", \", d; print \">^\";\
- ]", "", "", "", "", ""
- },
- { "DefArt",
- "obj; print \"the \", obj; ]", "", "", "", "", ""
- },
- { "InDefArt",
- "obj; print \"a \", obj; ]", "", "", "", "", ""
- },
- { "CDefArt",
- "obj; print \"The \", obj; ]", "", "", "", "", ""
- },
- { "CInDefArt",
- "obj; print \"A \", obj; ]", "", "", "", "", ""
- },
- { "PrintShortName",
- "obj; switch(metaclass(obj))\
- { 0: print \"nothing\";\
- Object: @print_obj obj;\
- Class: print \"class \"; @print_obj obj;\
- Routine: print \"(routine at \", obj, \")\";\
- String: print \"(string at \", obj, \")\";\
- } ]", "", "", "", "", ""
- },
- { "EnglishNumber",
- "obj; print obj; ]", "", "", "", "", ""
- },
- { "Print__PName",
- "prop p size cla i;\
- if (prop & $c000)\
- { cla = #classes_table-->(prop & $ff);\
- print (name) cla, \"::\";\
- if ((prop & $8000) == 0) prop = (prop & $3f00)/$100;\
- else\
- { prop = (prop & $7f00)/$100;\
- i = cla.3;\
- while ((i-->0 ~= 0) && (prop>0))\
- { i = i + i->2 + 3;\
- prop--;\
- }\
- prop = (i-->0) & $7fff;\
- }\
- }",
- "p = #identifiers_table;\
- size = p-->0;\
- if (prop<=0 || prop>=size || p-->prop==0)\
- print \"<number \", prop, \">\";\
- else print (string) p-->prop;\
- ]", "", "", "", ""
- },
-
- /* The remaining routines make up the run-time half of the object
- orientation system, and need never be present for Inform 5 programs. */
-
- {
- /* WV__Pr: write a value to the property for the given
- object having the given identifier */
-
- "WV__Pr",
- "obj identifier value x;\
- x = obj..&identifier;\
- if (x==0) { RT__Err(\"write to\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,value);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,value);\
- #endif; #endif;\
- x-->0 = value;\
- ]", "", "", "", "", ""
- },
- {
- /* RV__Pr: read a value from the property for the given
- object having the given identifier */
-
- "RV__Pr",
- "obj identifier x;\
- x = obj..&identifier;\
- if (x==0)\
- { if (identifier >= 1 && identifier < 64 && obj.#identifier <= 2)\
- return obj.identifier;\
- RT__Err(\"read\", obj, identifier); return; }\
- if (obj..#identifier > 2) RT__Err(\"read\", obj, identifier, 2);\
- return x-->0;\
- ]", "", "", "", "", ""
- },
- { /* CA__Pr: call, that is, print-or-run-or-read, a property:
- this exactly implements obj..prop(...). Note that
- classes (members of Class) have 5 built-in properties
- inherited from Class: create, recreate, destroy,
- remaining and copy. Implementing these here prevents
- the need for a full metaclass inheritance scheme. */
-
- "CA__Pr",
- "obj id a b c d e f x y z s s2 n m;\
- if (obj < 1 || obj > #largest_object-255)\
- { switch(Z__Region(obj))\
- { 2: if (id == call)\
- { s = sender; sender = self; self = obj;\
- #ifdef action;sw__var=action;#endif;\
- x = indirect(obj, a, b, c, d, e, f);\
- self = sender; sender = s; return x; }\
- jump Call__Error;",
- "3: if (id == print) { @print_paddr obj; rtrue; }\
- if (id == print_to_array)\
- { @output_stream 3 a; @print_paddr obj; @output_stream -3;\
- return a-->0; }\
- jump Call__Error;\
- }\
- jump Call__Error;\
- }\
- @check_arg_count 3 ?~A__x;y++;@check_arg_count 4 ?~A__x;y++;\
- @check_arg_count 5 ?~A__x;y++;@check_arg_count 6 ?~A__x;y++;\
- @check_arg_count 7 ?~A__x;y++;@check_arg_count 8 ?~A__x;y++;.A__x;",
- "#ifdef INFIX;if (obj has infix__watching) n=1;#endif;\
- #ifdef DEBUG;if (debug_flag & 1 ~= 0) n=1;#endif;\
- if (n==1) {\
- #ifdef DEBUG;n=debug_flag & 1; debug_flag=debug_flag-n;#endif;\
- print \"[ ~\", (name) obj, \"~.\", (property) id, \"(\";\
- switch(y) { 1: print a; 2: print a,\",\",b; 3: print a,\",\",b,\",\",c;\
- 4: print a,\",\",b,\",\",c,\",\",d;\
- 5: print a,\",\",b,\",\",c,\",\",d,\",\",e;\
- 6: print a,\",\",b,\",\",c,\",\",d,\",\",e,\",\",f; }\
- print \") ]^\";\
- #ifdef DEBUG;debug_flag = debug_flag + n;#endif;\
- }",
- "if (id > 0 && id < 64)\
- { x = obj.&id; if (x==0) { x=$000a-->0 + 2*(id-1); n=2; }\
- else n = obj.#id; }\
- else\
- { if (id>=64 && id<69 && obj in Class)\
- return Cl__Ms(obj,id,y,a,b,c,d);\
- x = obj..&id;\
- if (x == 0) { .Call__Error;\
- RT__Err(\"send message\", obj, id); return; }\
- n = 0->(x-1);\
- if (id&$C000==$4000)\
- switch (n&$C0) { 0: n=1; $40: n=2; $80: n=n&$3F; }\
- }",
- "for (:2*m<n:m++)\
- { if (x-->m==$ffff) rfalse;\
- switch(Z__Region(x-->m))\
- { 2: s = sender; sender = self; self = obj; s2 = sw__var;\
- #ifdef LibSerial;\
- if (id==life) sw__var=reason_code; else sw__var=action;\
- #endif;\
- switch(y) { 0: z = indirect(x-->m); 1: z = indirect(x-->m, a);\
- 2: z = indirect(x-->m, a, b); 3: z = indirect(x-->m, a, b, c);",
- "4: z = indirect(x-->m, a, b, c, d); 5:z = indirect(x-->m, a, b, c, d, e);\
- 6: z = indirect(x-->m, a, b, c, d, e, f); }\
- self = sender; sender = s; sw__var = s2;\
- if (z ~= 0) return z;\
- 3: print_ret (string) x-->m;\
- default: return x-->m;\
- }\
- }\
- rfalse;\
- ]"
- },
- {
- /* IB__Pr: ++(individual property) */
-
- "IB__Pr",
- "obj identifier x;\
- x = obj..&identifier;\
- if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)+1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
- #endif; #endif;\
- return ++(x-->0);\
- ]", "", "", "", "", ""
- },
- {
- /* IA__Pr: (individual property)++ */
-
- "IA__Pr",
- "obj identifier x;\
- x = obj..&identifier;\
- if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15))\
- RT__TrPS(obj,identifier,(x-->0)+1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
- #endif; #endif;\
- return (x-->0)++;\
- ]", "", "", "", "", ""
- },
- {
- /* DB__Pr: --(individual property) */
-
- "DB__Pr",
- "obj identifier x;\
- x = obj..&identifier;\
- if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
- #endif; #endif;\
- return --(x-->0);\
- ]", "", "", "", "", ""
- },
- {
- /* DA__Pr: (individual property)-- */
-
- "DA__Pr",
- "obj identifier x;\
- x = obj..&identifier;\
- if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
- #endif; #endif;\
- return (x-->0)--;\
- ]", "", "", "", "", ""
- },
- {
- /* RA__Pr: read the address of a property value for a given object,
- returning 0 if it doesn't provide this individual
- property */
-
- "RA__Pr",
- "obj identifier i otherid cla;\
- if (obj==0) rfalse;\
- if (identifier<64 && identifier>0) return obj.&identifier;\
- if (identifier & $8000 ~= 0)\
- { cla = #classes_table-->(identifier & $ff);\
- if (cla.&3 == 0) rfalse;\
- if (~~(obj ofclass cla)) rfalse;\
- identifier = (identifier & $7f00) / $100;\
- i = cla.3;\
- while (identifier>0)\
- { identifier--;\
- i = i + i->2 + 3;\
- }\
- return i+3;\
- }",
- "if (identifier & $4000 ~= 0)\
- { cla = #classes_table-->(identifier & $ff);\
- identifier = (identifier & $3f00) / $100;\
- if (~~(obj ofclass cla)) rfalse; i=0-->5;\
- if (cla == 2) return i+2*identifier-2;\
- i = 0-->((i+124+cla*14)/2);\
- i = CP__Tab(i + 2*(0->i) + 1, -1)+6;\
- return CP__Tab(i, identifier);\
- }\
- if (obj.&3 == 0) rfalse;\
- if (obj in 1)\
- { if (identifier<64 || identifier>=72) rfalse;\
- }",
- "if (self == obj)\
- otherid = identifier | $8000;\
- i = obj.3;\
- while (i-->0 ~= 0)\
- { if (i-->0 == identifier or otherid)\
- return i+3;\
- i = i + i->2 + 3;\
- }\
- rfalse;\
- ]", "", "", ""
- },
- {
- /* RL__Pr: read the property length of an individual property value,
- returning 0 if it isn't provided by the given object */
-
- "RL__Pr",
- "obj identifier x;\
- if (identifier<64 && identifier>0) return obj.#identifier;\
- x = obj..&identifier;\
- if (x==0) rfalse;\
- if (identifier&$C000==$4000)\
- switch (((x-1)->0)&$C0)\
- { 0: return 1; $40: return 2; $80: return ((x-1)->0)&$3F; }\
- return (x-1)->0;\
- ]", "", "", "", "", ""
- },
- {
- /* RA__Sc: implement the "superclass" (::) operator,
- returning an identifier */
-
- "RA__Sc",
- "cla identifier otherid i j k;\
- if (cla notin 1 && cla > 4)\
- { RT__Err(\"be a '::' superclass\", cla, -1); rfalse; }\
- if (self ofclass cla) otherid = identifier | $8000;\
- for (j=0: #classes_table-->j ~= 0: j++)\
- { if (cla==#classes_table-->j)\
- { if (identifier < 64) return $4000 + identifier*$100 + j;\
- if (cla.&3 == 0) break;\
- i = cla.3;",
- "while (i-->0 ~= 0)\
- { if (i-->0 == identifier or otherid)\
- return $8000 + k*$100 + j;\
- i = i + i->2 + 3;\
- k++;\
- }\
- break;\
- }\
- }\
- RT__Err(\"make use of\", cla, identifier);\
- rfalse;\
- ]", "", "", "", ""
- },
- {
- /* OP__Pr: test whether or not given object provides individual
- property with the given identifier code */
-
- "OP__Pr",
- "obj identifier;\
- if (obj<1 || obj > (#largest_object-255))\
- { if (identifier ~= print or print_to_array or call) rfalse;\
- switch(Z__Region(obj))\
- { 2: if (identifier == call) rtrue;\
- 3: if (identifier == print or print_to_array) rtrue;\
- }\
- rfalse;\
- }",
- "if (identifier<64)\
- { if (obj.&identifier ~= 0) rtrue;\
- rfalse;\
- }\
- if (obj..&identifier ~= 0) rtrue;\
- if (identifier<72 && obj in 1) rtrue;\
- rfalse;\
- ]", "", "", "", ""
- },
- {
- /* OC__Cl: test whether or not given object is of the given class */
-
- "OC__Cl",
- "obj cla j a n;\
- if (obj<1 || obj > (#largest_object-255))\
- { if (cla ~= 3 or 4) rfalse;\
- if (Z__Region(obj) == cla-1) rtrue;\
- rfalse;\
- }\
- if (cla == 1) {\
- if (obj<=4) rtrue;\
- if (obj in 1) rtrue;\
- rfalse;\
- } else if (cla == 2) {\
- if (obj<=4) rfalse;\
- if (obj in 1) rfalse;\
- rtrue;\
- } else if (cla == 3 or 4) {\
- rfalse;\
- }",
- "if (cla notin 1) { RT__Err(\"apply 'ofclass' for\", cla, -1);rfalse;}\
- @get_prop_addr obj 2 -> a;\
- if (a==0) rfalse;\
- @get_prop_len a -> n;\
- for (j=0: j<n/2: j++)\
- { if (a-->j == cla) rtrue;\
- }\
- rfalse;\
- ]", "", "", "", ""
- },
- { /* Copy__Primitive: routine to "deep copy" objects */
-
- "Copy__Primitive",
- "o1 o2 a1 a2 n m l size identifier;\
- for (n=0:n<48:n++)\
- { if (o2 has n) give o1 n;\
- else give o1 ~n;\
- }\
- for (n=1:n<64:n++) if (n~=2 or 3)\
- { a1 = o1.&n; a2 = o2.&n; size = o1.#n;\
- if (a1~=0 && a2~=0 && size==o2.#n)\
- { for (m=0:m<size:m++) a1->m=a2->m;\
- }\
- }",
- "if (o1.&3 == 0 || o2.&3 == 0) return;\
- for (n=o2.3: n-->0 ~= 0: n = n + size + 3)\
- { identifier = n-->0;\
- size = n->2;\
- for (m=o1.3: m-->0 ~= 0: m = m + m->2 + 3)\
- if ((identifier & $7fff == (m-->0) & $7fff) && size==m->2)\
- for (l=3: l<size+3: l++) m->l = n->l;\
- }\
- ]", "", "", "", ""
- },
- { /* RT__Err: for run-time errors occurring in the above: e.g.,
- an attempt to write to a non-existent individual
- property */
-
- "RT__Err",
- "crime obj id size p q;\
- print \"^[** Programming error: \";\
- if (crime<0) jump RErr;\
- if (crime==1) { print \"class \"; @print_obj obj;\
- \": 'create' can have 0 to 3 parameters only **]\";}\
- if (crime == 32) \"objectloop broken because the object \",\
- (name) obj, \" was moved while the loop passed through it **]\";\
- if (crime == 33) \"tried to print (char) \", obj,\
- \", which is not a valid ZSCII character code for output **]\";\
- if (crime == 34) \"tried to print (address) on something not the \",\
- \"byte address of a string **]\";\
- if (crime == 35) \"tried to print (string) on something not a \",\
- \"string **]\";\
- if (crime == 36) \"tried to print (object) on something not an \",\
- \"object or class **]\";",
- "if (crime < 32) { print \"tried to \";\
- if (crime >= 28) { if (crime==28 or 29) print \"read from \";\
- else print \"write to \";\
- if (crime==29 or 31) print \"-\"; print \"->\", obj,\
- \" 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\" (-->)\";\
- \" array ~\", (string) #array_names_offset-->p,\
- \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
- if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
- else print \"write\"; print \" outside memory using \";\
- switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
- if (crime < 4) print \"test \"; else\
- if (crime < 12 || crime > 20) print \"find the \"; else\
- if (crime < 14) print \"use \";\
- if (crime==20) \"divide by zero **]\"; print \"~\";\
- switch(crime) {\
- 2: print \"in~ or ~notin\"; 3: print \"has~ or ~hasnt\";\
- 4: print \"parent\"; 5: print \"eldest\"; 6: print \"child\";\
- 7: print \"younger\"; 8: print \"sibling\"; 9: print \"children\";\
- 10: print \"youngest\"; 11: print \"elder\";\
- 12: print \"objectloop\"; 13: print \"}~ at end of ~objectloop\";\
- 14: \"give~ an attribute to \", (name) obj, \" **]\";\
- 15: \"remove~ \", (name) obj, \" **]\";",
- "16,17,18: print \"move~ \", (name) obj, \" to \", (name) id;\
- if (crime==18) { print \", which would make a loop: \",(name) obj;\
- p=id; if (p==obj) p=obj;\
- else do { print \" in \", (name) p; p=parent(p);} until (p==obj);\
- \" in \", (name) p, \" **]\"; }\
- \" **]\"; 19: \"give~ or test ~has~ or ~hasnt~ with a non-attribute"\
- " on the object \",(name) obj,\" **]\";\
- 21: print \".&\"; 22: print \".#\"; 23: print \".\"; }\
- \"~ of \", (name) obj, \" **]\"; }",
- ".RErr; if (obj>=0 && obj<=(#largest_object-255)) {\
- if (obj && obj in Class) print \"class \";\
- if (obj) @print_obj obj;else print \"nothing\";print\" \";}\
- print \"(object number \", obj, \") \";\
- if (id<0) print \"is not of class \", (name) -id;",
- "else if (size) print \"has a property \", (property) id,\
- \", but it is longer than 2 bytes so you cannot use ~.~\";\
- else\
- { print \" has no property \", (property) id;\
- p = #identifiers_table;\
- size = p-->0;\
- if (id<0 || id>=size)\
- print \" (and nor has any other object)\";\
- }\
- print \" to \", (string) crime, \" **]^\";\
- ]", ""
- },
- { /* Z__Region: Determines whether a value is:
- 1 an object number
- 2 a code address
- 3 a string address
- 0 none of the above */
-
- "Z__Region",
- "addr top;\
- if (addr==0 or -1) rfalse;\
- top = addr;\
- #IfV5; #iftrue (#version_number == 6) || (#version_number == 7);\
- @log_shift addr $FFFF -> top; #Endif; #Endif;\
- if (Unsigned__Compare(top, $001A-->0) >= 0) rfalse;\
- if (addr>=1 && addr<=(#largest_object-255)) rtrue;\
- #iftrue #oddeven_packing;\
- @test addr 1 ?~NotString;\
- if (Unsigned__Compare(addr, #strings_offset)<0) rfalse;\
- return 3;\
- .NotString;\
- if (Unsigned__Compare(addr, #code_offset)<0) rfalse;\
- return 2;\
- #ifnot;\
- if (Unsigned__Compare(addr, #strings_offset)>=0) return 3;\
- if (Unsigned__Compare(addr, #code_offset)>=0) return 2;\
- rfalse;\
- #endif;\
- ]", "", "", "", "", ""
- },
- { /* Unsigned__Compare: returns 1 if x>y, 0 if x=y, -1 if x<y */
-
- "Unsigned__Compare",
- "x y u v;\
- if (x==y) return 0;\
- if (x<0 && y>=0) return 1;\
- if (x>=0 && y<0) return -1;\
- u = x&$7fff; v= y&$7fff;\
- if (u>v) return 1;\
- return -1;\
- ]", "", "", "", "", ""
- },
- { /* Meta__class: returns the metaclass of an object */
-
- "Meta__class",
- "obj;\
- switch(Z__Region(obj))\
- { 2: return Routine;\
- 3: return String;\
- 1: if (obj in 1 || obj <= 4) return Class;\
- return Object;\
- }\
- rfalse;\
- ]", "", "", "", "", ""
- },
- { /* CP__Tab: searches a common property table for the given
- identifier, thus imitating the get_prop_addr opcode.
- Returns 0 if not provided, except:
- if the identifier supplied is -1, then returns
- the address of the first byte after the table. */
-
- "CP__Tab",
- "x id n l;\
- while ((n=0->x) ~= 0)\
- { if (n & $80) { x++; l = (0->x) & $3f; }\
- else { if (n & $40) l=2; else l=1; }\
- x++;\
- if ((n & $3f) == id) return x;\
- x = x + l;\
- }\
- 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;\
- switch(id)\
- { create:\
- if (children(obj)<=1) rfalse; x=child(obj);\
- remove x; if (x provides create) { if (y==0) x..create();\
- if (y==1) x..create(a); if (y==2) x..create(a,b);\
- if (y>3) RT__Err(1,obj); if (y>=3) x..create(a,b,c);}\
- return x;\
- recreate:\
- if (~~(a ofclass obj))\
- { RT__Err(\"recreate\", a, -obj); rfalse; }\
- Copy__Primitive(a, child(obj));\
- if (a provides create) { if (y==1) a..create();\
- if (y==2) a..create(b); if (y==3) a..create(b,c);\
- if (y>4) RT__Err(1,obj); if (y>=4) a..create(b,c,d);\
- } rfalse;",
- "destroy:\
- if (~~(a ofclass obj))\
- { RT__Err(\"destroy\", a, -obj); rfalse; }\
- if (a provides destroy) a..destroy();\
- Copy__Primitive(a, child(obj));\
- move a to obj; rfalse;\
- remaining:\
- return children(obj)-1;",
- "copy:\
- if (~~(a ofclass obj))\
- { RT__Err(\"copy\", a, -obj); rfalse; }\
- if (~~(b ofclass obj))\
- { RT__Err(\"copy\", b, -obj); rfalse; }\
- Copy__Primitive(a, b); rfalse;\
- }\
- ]", "", "", ""
- },
- { /* RT__ChT: check at run-time that a proposed object move is legal
- cause error and do nothing if not; otherwise move */
-
- "RT__ChT",
- "obj1 obj2 x;\
- if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
- return RT__Err(16,obj1,obj2);\
- if (obj2<5 || obj2>(#largest_object-255) || obj2 in 1)\
- return RT__Err(17,obj1,obj2);",
- "x=obj2; while (x~=0) { if (x==obj1) return RT__Err(18,obj1,obj2); \
- x=parent(x); }\
- #ifdef INFIX;\
- if (obj1 has infix__watching\
- || obj2 has infix__watching || (debug_flag & 15))\
- print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15)\
- print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
- #endif; #endif;\
- @insert_obj obj1 obj2; ]", "", "", "", ""
- },
- { /* RT__ChR: check at run-time that a proposed object remove is legal
- cause error and do nothing if not; otherwise remove */
-
- "RT__ChR",
- "obj1;\
- if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
- return RT__Err(15,obj1);",
- "#ifdef INFIX;\
- if (obj1 has infix__watching || (debug_flag & 15))\
- print \"[Removing \", (name) obj1, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15)\
- print \"[Removing \", (name) obj1, \"]^\";\
- #endif; #endif;\
- @remove_obj obj1; ]", "", "", "", ""
- },
- { /* RT__ChG: check at run-time that a proposed attr give is legal
- cause error and do nothing if not; otherwise give */
-
- "RT__ChG",
- "obj1 a;\
- if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
- return RT__Err(14,obj1); if (a<0 || a>=48) return RT__Err(19,obj1);\
- if (obj1 has a) return;",
- "#ifdef INFIX;\
- if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
- print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (a ~= workflag && debug_flag & 15)\
- print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
- #endif; #endif;\
- @set_attr obj1 a; ]", "", "", "", ""
- },
- { /* RT__ChGt: check at run-time that a proposed attr give ~ is legal
- cause error and do nothing if not; otherwise give */
-
- "RT__ChGt",
- "obj1 a;\
- if (obj1<5 || obj1>(#largest_object-255) || obj1 in 1)\
- return RT__Err(14,obj1); if (a<0 || a>=48) return RT__Err(19,obj1);\
- if (obj1 hasnt a) return;",
- "#ifdef INFIX;\
- if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
- print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (a ~= workflag && debug_flag & 15)\
- print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
- #endif; #endif;\
- @clear_attr obj1 a; ]", "", "", "", ""
- },
- { /* RT__ChPS: check at run-time that a proposed property set is legal
- cause error and do nothing if not; otherwise make it */
-
- "RT__ChPS",
- "obj prop val size;\
- if (obj<5 || obj>(#largest_object-255) || obj in 1 || obj.&prop==0 || (size=obj.#prop)>2 )\
- return RT__Err(\"set\", obj, prop, size);\
- @put_prop obj prop val;",
- "#ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,prop,val);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,prop,val);\
- #endif; #endif;\
- return val; ]", "", "", "", ""
- },
- { /* RT__ChPR: check at run-time that a proposed property read is legal
- cause error and return 0 if not; otherwise read it */
-
- "RT__ChPR",
- "obj prop val size;\
- if (obj<5 || obj>(#largest_object-255) || (size=obj.#prop)>2)\
- {RT__Err(\"read\", obj, prop, size); obj=2;}\
- @get_prop obj prop -> val;",
- "return val; ]", "", "", "", ""
- },
- { /* RT__TrPS: trace property settings */
-
- "RT__TrPS",
- "obj prop val;\
- print \"[Setting \",(name) obj,\".\",(property) prop,\
- \" to \",val,\"]^\"; ]",
- "", "", "", "", ""
- },
- { /* RT__ChLDB: check at run-time that it's safe to load a byte
- and return the byte */
-
- "RT__ChLDB",
- "base offset a val;\
- a=base+offset;if (Unsigned__Compare(a,#readable_memory_offset)>=0)\
- return RT__Err(24);",
- "@loadb base offset -> val;return val; ]", "", "", "", ""
- },
- { /* RT__ChLDW: check at run-time that it's safe to load a word
- and return the word */
-
- "RT__ChLDW",
- "base offset a val;\
- a=base+2*offset;if (Unsigned__Compare(a,#readable_memory_offset)>=0)\
- return RT__Err(25);",
- "@loadw base offset -> val;return val; ]", "", "", "", ""
- },
- { /* RT__ChSTB: check at run-time that it's safe to store a byte
- and store it */
-
- "RT__ChSTB",
- "base offset val a f;\
- a=base+offset;\
- if (Unsigned__Compare(a,#array__start)>=0\
- && Unsigned__Compare(a,#array__end)<0) f=1; else\
- if (Unsigned__Compare(a,#cpv__start)>=0\
- && Unsigned__Compare(a,#cpv__end)<0) f=1; else\
- if (Unsigned__Compare(a,#ipv__start)>=0\
- && Unsigned__Compare(a,#ipv__end)<0) f=1; else\
- if (a==$0011) f=1;\
- if (f==0) return RT__Err(26);",
- "@storeb base offset val; ]", "", "", "", ""
- },
- { /* RT__ChSTW: check at run-time that it's safe to store a word
- and store it */
-
- "RT__ChSTW",
- "base offset val a f;\
- a=base+2*offset;\
- if (Unsigned__Compare(a,#array__start)>=0\
- && Unsigned__Compare(a,#array__end)<0) f=1; else\
- if (Unsigned__Compare(a,#cpv__start)>=0\
- && Unsigned__Compare(a,#cpv__end)<0) f=1; else\
- if (Unsigned__Compare(a,#ipv__start)>=0\
- && Unsigned__Compare(a,#ipv__end)<0) f=1; else\
- if (a==$0010) f=1;\
- if (f==0) return RT__Err(27);",
- "@storew base offset val; ]", "", "", "", ""
- },
- { /* RT__ChPrintC: check at run-time that it's safe to print (char)
- and do so */
-
- "RT__ChPrintC",
- "c fl;\
- if (c==0 or 9 or 11 or 13) fl=1;\
- if (c>=32 && c<=126) fl=1; if (c>=155 && c<=251) fl=1;\
- if (fl==0) return RT__Err(33,c);",
- "@print_char c; ]", "", "", "", ""
- },
- { /* RT__ChPrintA: check at run-time that it's safe to print (address)
- and do so */
-
- "RT__ChPrintA",
- "a;\
- if (Unsigned__Compare(a, #readable_memory_offset)>=0)\
- return RT__Err(34);",
- "@print_addr a; ]", "", "", "", ""
- },
- { /* RT__ChPrintS: check at run-time that it's safe to print (string)
- and do so */
-
- "RT__ChPrintS",
- "a;\
- if (Z__Region(a)~=3) return RT__Err(35);",
- "@print_paddr a; ]", "", "", "", ""
- },
- { /* RT__ChPrintO: check at run-time that it's safe to print (object)
- and do so */
-
- "RT__ChPrintO",
- "a;\
- if (Z__Region(a)~=1) return RT__Err(36);",
- "@print_obj a; ]", "", "", "", ""
- }
-};
-
-static VeneerRoutine VRs_g[VENEER_ROUTINES] =
-{
- {
- /* Box__Routine: Display the given array of text as a box quote.
- This is a very simple implementation; the library should provide
- a fancier version.
- */
- "Box__Routine",
- "maxwid arr ix;\
- maxwid = 0;\
- glk($0086, 7);\
- for (ix=0 : ix<arr-->0 : ix++) {\
- print (string) arr-->(ix+1);\
- new_line;\
- }\
- glk($0086, 0);\
- ]", "", "", "", "", ""
- },
-
- /* This batch of routines is expected to be defined (rather better) by
- the Inform library: these minimal forms here are provided to prevent
- tiny non-library-using programs from failing to compile when certain
- legal syntaxes (such as <<Action a b>>;) are used. */
-
- { "R_Process",
- "a b c d; print \"Action <\", a, \" \", b, \" \", c;\
- if (d) print \", \", d; print \">^\";\
- ]", "", "", "", "", ""
- },
- { "DefArt",
- "obj; print \"the \", obj; ]", "", "", "", "", ""
- },
- { "InDefArt",
- "obj; print \"a \", obj; ]", "", "", "", "", ""
- },
- { "CDefArt",
- "obj; print \"The \", obj; ]", "", "", "", "", ""
- },
- { "CInDefArt",
- "obj; print \"A \", obj; ]", "", "", "", "", ""
- },
- { "PrintShortName",
- "obj q; switch(metaclass(obj))\
- { 0: print \"nothing\";\
- Object: q = obj-->GOBJFIELD_NAME; @streamstr q;\
- Class: print \"class \"; q = obj-->GOBJFIELD_NAME; @streamstr q;\
- Routine: print \"(routine at \", obj, \")\";\
- String: print \"(string at \", obj, \")\";\
- } ]", "", "", "", "", ""
- },
- { "EnglishNumber",
- "obj; print obj; ]", "", "", "", "", ""
- },
- {
- /* Print__PName: Print the name of a property.
- */
- "Print__PName",
- "prop ptab cla maxcom minind maxind str;\
- if (prop & $FFFF0000) {\
- cla = #classes_table-->(prop & $FFFF);\
- print (name) cla, \"::\";\
- @ushiftr prop 16 prop;\
- }\
- ptab = #identifiers_table;\
- maxcom = ptab-->1;\
- minind = INDIV_PROP_START;\
- maxind = minind + ptab-->3;\
- str = 0;\
- if (prop >= 0 && prop < maxcom) {\
- str = (ptab-->0)-->prop;\
- }\
- else if (prop >= minind && prop < maxind) {\
- str = (ptab-->2)-->(prop-minind);\
- }\
- if (str)\
- print (string) str;\
- else\
- print \"<number \", prop, \">\";\
- ]", "", "", "", "", ""
- },
-
- /* The remaining routines make up the run-time half of the object
- orientation system, and need never be present for Inform 5 programs. */
-
- {
- /* WV__Pr: Write a value to the property for the given object.
- */
- "WV__Pr",
- "obj id val addr;\
- addr = obj.&id;\
- if (addr == 0) {\
- RT__Err(\"write\", obj, id);\
- return 0;\
- }\
- addr-->0 = val;\
- return 0;\
- ]", "", "", "", "", ""
- },
-
- {
- /* RV__Pr: Read a value to the property for the given object.
- */
- "RV__Pr",
- "obj id addr;\
- addr = obj.&id;\
- if (addr == 0) {\
- if (id > 0 && id < INDIV_PROP_START) {\
- return #cpv__start-->id;\
- }\
- RT__Err(\"read\", obj, id);\
- return 0;\
- }\
- return addr-->0;\
- ]", "", "", "", "", ""
- },
- {
- /* CA__Pr: Call, that is, print-or-run-or-read, a property:
- this exactly implements obj..prop(...). Note that
- classes (members of Class) have 5 built-in properties
- inherited from Class: create, recreate, destroy,
- remaining and copy. Implementing these here prevents
- the need for a full metaclass inheritance scheme.
- */
- "CA__Pr",
- "_vararg_count obj id zr s s2 z addr len m val;\
- @copy sp obj;\
- @copy sp id;\
- _vararg_count = _vararg_count - 2;\
- zr = Z__Region(obj);\
- if (zr == 2) {\
- if (id == call) {\
- s = sender; sender = self; self = obj;\
- #ifdef action; sw__var=action; #endif;\
- @call obj _vararg_count z;\
- self = sender; sender = s;\
- return z;\
- }\
- jump Call__Error;\
- }",
- " if (zr == 3) {\
- if (id == print) {\
- @streamstr obj; rtrue;\
- }\
- if (id == print_to_array) {\
- if (_vararg_count >= 2) {\
- @copy sp m;\
- @copy sp len;\
- }\
- else {\
- RT__Err(37); rfalse;\
- }\
- s2 = glk($0048);\
- s = glk($0043, m+4, len-4, 1, 0);",
- " if (s) {\
- glk($0047, s);\
- @streamstr obj;\
- glk($0047, s2);\
- @copy $ffffffff sp;\
- @copy s sp;\
- @glk $0044 2 0;\
- @copy sp len;\
- @copy sp 0;\
- m-->0 = len;\
- return len;\
- }\
- rfalse;\
- }\
- jump Call__Error;\
- }",
- " if (zr ~= 1)\
- jump Call__Error;\
- #ifdef DEBUG;#ifdef InformLibrary;\
- if (debug_flag & 1 ~= 0) {\
- debug_flag--;\
- print \"[ ~\", (name) obj, \"~.\", (property) id, \"(\";\
- @stkcopy _vararg_count;\
- for (val=0 : val < _vararg_count : val++) {\
- if (val) print \", \";\
- @streamnum sp;\
- }\
- print \") ]^\";\
- debug_flag++;\
- }\
- #endif;#endif;\
- if (obj in Class) {\
- switch (id) {\
- remaining:\
- return Cl__Ms(obj, id);\
- copy:\
- @copy sp m;\
- @copy sp val;\
- return Cl__Ms(obj, id, m, val);\
- create, destroy, recreate:\
- m = _vararg_count+2;\
- @copy id sp;\
- @copy obj sp;\
- @call Cl__Ms m val;\
- return val;\
- }\
- }",
- " addr = obj.&id;\
- if (addr == 0) {\
- if (id > 0 && id < INDIV_PROP_START) {\
- addr = #cpv__start + 4*id;\
- len = 4;\
- }\
- else {\
- jump Call__Error;\
- }\
- }\
- else {\
- len = obj.#id;\
- }\
- for (m=0 : 4*m<len : m++) {\
- val = addr-->m;\
- if (val == -1) rfalse;\
- switch (Z__Region(val)) {\
- 2:\
- s = sender; sender = self; self = obj; s2 = sw__var;\
- #ifdef LibSerial;\
- if (id==life) sw__var=reason_code; else sw__var=action;\
- #endif;",
- " @stkcopy _vararg_count;\
- @call val _vararg_count z;\
- self = sender; sender = s; sw__var = s2;\
- if (z ~= 0) return z;\
- 3:\
- @streamstr val;\
- new_line;\
- rtrue;\
- default:\
- return val;\
- }\
- }\
- rfalse;\
- .Call__Error;\
- RT__Err(\"send message\", obj, id);\
- rfalse;\
- ]"
- },
- {
- /* IB__Pr: ++(individual property) */
-
- "IB__Pr",
- "obj identifier x;\
- x = obj.&identifier;\
- if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)+1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
- #endif; #endif;\
- return ++(x-->0);\
- ]", "", "", "", "", ""
- },
- {
- /* IA__Pr: (individual property)++ */
-
- "IA__Pr",
- "obj identifier x;\
- x = obj.&identifier;\
- if (x==0) { RT__Err(\"increment\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15))\
- RT__TrPS(obj,identifier,(x-->0)+1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)+1);\
- #endif; #endif;\
- return (x-->0)++;\
- ]", "", "", "", "", ""
- },
- {
- /* DB__Pr: --(individual property) */
-
- "DB__Pr",
- "obj identifier x;\
- x = obj.&identifier;\
- if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
- #endif; #endif;\
- return --(x-->0);\
- ]", "", "", "", "", ""
- },
- {
- /* DA__Pr: (individual property)-- */
-
- "DA__Pr",
- "obj identifier x;\
- x = obj.&identifier;\
- if (x==0) { RT__Err(\"decrement\", obj, identifier); return; }\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,identifier,(x-->0)-1);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,identifier,(x-->0)-1);\
- #endif; #endif;\
- return (x-->0)--;\
- ]", "", "", "", "", ""
- },
- {
- /* RA__Pr: Read the property address of a given property value.
- Returns zero if it isn't provided by the object. This
- understands all the same concerns as RL__Pr().
- */
- "RA__Pr",
- "obj id cla prop ix;\
- if (id & $FFFF0000) {\
- cla = #classes_table-->(id & $FFFF);\
- if (~~(obj ofclass cla)) return 0;\
- @ushiftr id 16 id;\
- obj = cla;\
- }\
- prop = CP__Tab(obj, id);\
- if (prop==0) return 0;\
- if (obj in Class && cla == 0) {\
- if (id < INDIV_PROP_START || id >= INDIV_PROP_START+8)\
- return 0;\
- }\
- if (self ~= obj) {\
- @aloadbit prop 72 ix;\
- if (ix) return 0;\
- }\
- return prop-->1;\
- ]", "", "", "", "", ""
- },
-
- {
- /* RL__Pr: Read the property length of a given property value.
- Returns zero if it isn't provided by the object. This understands
- inherited values (of the form class::prop) as well as simple
- property ids and the special metaclass methods. It also knows
- that private properties can only be read if (self == obj).
- */
- "RL__Pr",
- "obj id cla prop ix;\
- if (id & $FFFF0000) {\
- cla = #classes_table-->(id & $FFFF);\
- if (~~(obj ofclass cla)) return 0;\
- @ushiftr id 16 id;\
- obj = cla;\
- }\
- prop = CP__Tab(obj, id);\
- if (prop==0) return 0;\
- if (obj in Class && cla == 0) {\
- if (id < INDIV_PROP_START || id >= INDIV_PROP_START+8)\
- return 0;\
- }\
- if (self ~= obj) {\
- @aloadbit prop 72 ix;\
- if (ix) return 0;\
- }\
- @aloads prop 1 ix;\
- return WORDSIZE * ix;\
- ]", "", "", "", "", ""
- },
- {
- /* RA__Sc: Implement the \"superclass\" (::) operator. This
- returns an compound property identifier, which is a
- 32-bit value.
- */
- "RA__Sc",
- "cla id j;\
- if ((cla notin Class) && (cla ~= Class or String or Routine or Object)) {\
- RT__Err(\"be a '::' superclass\", cla, -1);\
- rfalse;\
- }\
- for (j=0 : #classes_table-->j ~= 0 : j++) {\
- if (cla == #classes_table-->j) {\
- return (id * $10000 + j);\
- }\
- }\
- RT__Err(\"make use of\", cla, id);\
- rfalse;\
- ]", "", "", "", "", ""
- },
-
- {
- /* OP__Pr: Test whether the given object provides the given property.
- This winds up calling RA__Pr().
- */
- "OP__Pr",
- "obj id zr;\
- zr = Z__Region(obj);\
- if (zr == 3) {\
- if (id == print or print_to_array) rtrue;\
- rfalse;\
- }\
- if (zr == 2) {\
- if (id == call) rtrue;\
- rfalse;\
- }\
- if (zr ~= 1) rfalse;\
- if (id >= INDIV_PROP_START && id < INDIV_PROP_START+8) {\
- if (obj in Class) rtrue;\
- }\
- if (obj.&id ~= 0)\
- rtrue;\
- rfalse;\
- ]", "", "", "", "", ""
- },
- {
- /* OC__Cl: Test whether the given object is of the given class.
- (implements the OfClass operator.)
- */
- "OC__Cl",
- "obj cla zr jx inlist inlistlen;\
- zr = Z__Region(obj);\
- if (zr == 3) {\
- if (cla == String) rtrue;\
- rfalse;\
- }\
- if (zr == 2) {\
- if (cla == Routine) rtrue;\
- rfalse;\
- }\
- if (zr ~= 1) rfalse;\
- if (cla == Class) {\
- if (obj in Class\
- || obj == Class or String or Routine or Object)\
- rtrue;\
- rfalse;\
- }\
- if (cla == Object) {\
- if (obj in Class\
- || obj == Class or String or Routine or Object)\
- rfalse;\
- rtrue;\
- }\
- if (cla == String or Routine) rfalse;\
- if (cla notin Class) {\
- RT__Err(\"apply 'ofclass' for\", cla, -1);\
- rfalse;\
- }\
- inlist = obj.&2;\
- if (inlist == 0) rfalse;\
- inlistlen = (obj.#2) / WORDSIZE;\
- for (jx=0 : jx<inlistlen : jx++) {\
- if (inlist-->jx == cla) rtrue;\
- }\
- rfalse;\
- ]", "", "", "", "", ""
- },
-
- {
- /* Copy__Primitive: Routine to \"deep copy\" objects.
- */
- "Copy__Primitive",
- "o1 o2 p1 p2 pcount i j propid proplen val pa1 pa2;\
- for (i=1 : i<=NUM_ATTR_BYTES : i++) {\
- o1->i = o2->i;\
- }\
- p2 = o2-->GOBJFIELD_PROPTAB;\
- pcount = p2-->0;\
- p2 = p2+4;\
- for (i=0 : i<pcount : i++) {\
- @aloads p2 0 propid;\
- @aloads p2 1 proplen;\
- p1 = CP__Tab(o1, propid);\
- if (p1) {\
- @aloads p1 1 val;\
- if (proplen == val) {\
- @aloads p2 4 val;\
- @astores p1 4 val;\
- pa1 = p1-->1;\
- pa2 = p2-->1;\
- for (j=0 : j<proplen : j++)\
- pa1-->j = pa2-->j;\
- }\
- }\
- p2 = p2+10;\
- }\
- ]", "", "", "", "", ""
- },
- { /* RT__Err: for run-time errors occurring in the above: e.g.,
- an attempt to write to a non-existent individual
- property */
-
- "RT__Err",
- "crime obj id size p q;\
- print \"^[** Programming error: \";\
- if (crime<0) jump RErr;\
- if (crime==1) { print \"class \"; q = obj-->GOBJFIELD_NAME; @streamstr q;\
- \": 'create' can have 0 to 3 parameters only **]\";}\
- if (crime == 40) \"tried to change printing variable \",\
- obj, \"; must be 0 to \", #dynam_string_table-->0-1, \" **]\";\
- if (crime == 32) \"objectloop broken because the object \",\
- (name) obj, \" was moved while the loop passed through it **]\";\
- if (crime == 33) \"tried to print (char) \", obj,\
- \", which is not a valid Glk character code for output **]\";\
- if (crime == 34) \"tried to print (address) on something not the \",\
- \"address of a dict word **]\";\
- if (crime == 35) \"tried to print (string) on something not a \",\
- \"string **]\";\
- if (crime == 36) \"tried to print (object) on something not an \",\
- \"object or class **]\";\
- if (crime == 37) \"tried to call Glulx print_to_array with only \",\
- \"one argument **]\";",
- "if (crime < 32) { print \"tried to \";\
- if (crime >= 28) { if (crime==28 or 29) print \"read from \";\
- else print \"write to \";\
- if (crime==29 or 31) print \"-\"; print \"->\", obj,\
- \" 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\" (-->)\";\
- \" array ~\", (string) #array_names_offset-->(p+1),\
- \"~, which has entries \", q, \" up to \",id,\" **]\"; }\
- if (crime >= 24 && crime <=27) { if (crime<=25) print \"read\";\
- else print \"write\"; print \" outside memory using \";\
- switch(crime) { 24,26:\"-> **]\"; 25,27:\"--> **]\"; } }\
- if (crime < 4) print \"test \"; else\
- if (crime < 12 || crime > 20) print \"find the \"; else\
- if (crime < 14) print \"use \";\
- if (crime==20) \"divide by zero **]\"; print \"~\";\
- switch(crime) {\
- 2: print \"in~ or ~notin\"; 3: print \"has~ or ~hasnt\";\
- 4: print \"parent\"; 5: print \"eldest\"; 6: print \"child\";\
- 7: print \"younger\"; 8: print \"sibling\"; 9: print \"children\";\
- 10: print \"youngest\"; 11: print \"elder\";\
- 12: print \"objectloop\"; 13: print \"}~ at end of ~objectloop\";\
- 14: \"give~ an attribute to \", (name) obj, \" **]\";\
- 15: \"remove~ \", (name) obj, \" **]\";",
- "16,17,18: print \"move~ \", (name) obj, \" to \", (name) id;\
- if (crime==18) { print \", which would make a loop: \",(name) obj;\
- p=id; if (p==obj) p=obj;\
- else do { print \" in \", (name) p; p=parent(p);} until (p==obj);\
- \" in \", (name) p, \" **]\"; }\
- \" **]\"; 19: \"give~ or test ~has~ or ~hasnt~ with a non-attribute"\
- " on the object \",(name) obj,\" **]\";\
- 21: print \".&\"; 22: print \".#\"; 23: print \".\"; }\
- \"~ of \", (name) obj, \" **]\"; }",
- ".RErr; if (obj==0 || obj->0>=$70 && obj->0<=$7F) {\
- if (obj && obj in Class) print \"class \";\
- if (obj) print (object) obj;else print \"nothing\";print\" \";}\
- print \"(object number \", obj, \") \";\
- if (id<0) print \"is not of class \", (name) -id;",
- "else\
- { print \" has no property \", (property) id;\
- p = #identifiers_table;\
- size = INDIV_PROP_START + p-->3;\
- if (id<0 || id>=size)\
- print \" (and nor has any other object)\";\
- }\
- print \" to \", (string) crime, \" **]^\";\
- ]", ""
- },
- {
- /* Z__Region: Determines whether a value is:
- 1 an object number
- 2 a code address
- 3 a string address
- 0 none of the above
- */
- "Z__Region",
- "addr tb endmem;\
- if (addr<36) rfalse;\
- @getmemsize endmem;\
- @jgeu addr endmem?outrange;\
- tb=addr->0;\
- if (tb >= $E0) return 3;\
- if (tb >= $C0) return 2;\
- if (tb >= $70 && tb <= $7F && addr >= (0-->2)) return 1;\
- .outrange;\
- rfalse;\
- ]", "", "", "", "", ""
- },
- { /* Unsigned__Compare: returns 1 if x>y, 0 if x=y, -1 if x<y */
-
- "Unsigned__Compare",
- "x y;\
- @jleu x y ?lesseq;\
- return 1;\
- .lesseq;\
- @jeq x y ?equal;\
- return -1;\
- .equal;\
- return 0;\
- ]", "", "", "", "", ""
- },
- { /* Meta__class: returns the metaclass of an object */
-
- "Meta__class",
- "obj;\
- switch(Z__Region(obj))\
- { 2: return Routine;\
- 3: return String;\
- 1: if (obj in Class\
- || obj == Class or String or Routine or Object)\
- return Class;\
- return Object;\
- }\
- rfalse;\
- ]", "", "", "", "", ""
- },
-
- {
- /* CP__Tab: Search a property table for the given identifier.
- The definition here is a bit different from the Z-code veneer.
- This just searches the property table of obj for an entry with
- the given identifier. It return the address of the property
- entry, or 0 if nothing found. (Remember that the value returned
- is not the address of the property *data*; it's the structure
- which contains the address/length/flags.)
- */
- "CP__Tab",
- "obj id otab max res;\
- if (Z__Region(obj)~=1) {RT__Err(23, obj); rfalse;}\
- otab = obj-->GOBJFIELD_PROPTAB;\
- if (otab == 0) return 0;\
- max = otab-->0;\
- otab = otab+4;\
- @binarysearch id 2 otab 10 max 0 0 res;\
- return res;\
- ]", "", "", "", "", ""
- },
-
- {
- /* Cl__Ms: Implements the five message-receiving properties of
- Classes.
- */
- "Cl__Ms",
- "_vararg_count obj id a b x y;\
- @copy sp obj;\
- @copy sp id;\
- _vararg_count = _vararg_count - 2;\
- switch (id) {\
- create:\
- if (children(obj) <= 1) rfalse;\
- x = child(obj);\
- remove x;\
- if (x provides create) {\
- @copy create sp;\
- @copy x sp;\
- y = _vararg_count + 2;\
- @call CA__Pr y 0;\
- }\
- return x;\
- recreate:\
- @copy sp a;\
- _vararg_count--;\
- if (~~(a ofclass obj)) {\
- RT__Err(\"recreate\", a, -obj);\
- rfalse;\
- }\
- if (a provides destroy)\
- a.destroy();\
- Copy__Primitive(a, child(obj));\
- if (a provides create) {\
- @copy create sp;\
- @copy a sp;\
- y = _vararg_count + 2;\
- @call CA__Pr y 0;\
- }\
- rfalse;\
- destroy:\
- @copy sp a;\
- _vararg_count--;\
- if (~~(a ofclass obj)) {\
- RT__Err(\"destroy\", a, -obj);\
- rfalse;\
- }\
- if (a provides destroy)\
- a.destroy();\
- Copy__Primitive(a, child(obj));\
- move a to obj;\
- rfalse;\
- remaining:\
- return children(obj)-1;\
- copy:\
- @copy sp a;\
- @copy sp b;\
- _vararg_count = _vararg_count - 2;\
- if (~~(a ofclass obj)) {\
- RT__Err(\"copy\", a, -obj);\
- rfalse;\
- }\
- if (~~(b ofclass obj)) {\
- RT__Err(\"copy\", b, -obj);\
- rfalse;\
- }\
- Copy__Primitive(a, b);\
- rfalse;\
- }\
- ]", "", "", "", "", ""
- },
- {
- /* RT__ChT: Check at run-time that a proposed object move is legal.
- Cause error and do nothing if not; otherwise move
- */
- "RT__ChT",
- "obj1 obj2 ix;\
- if (obj1==0 || Z__Region(obj1)~=1\
- || (obj1 == Class or String or Routine or Object) || obj1 in Class)\
- return RT__Err(16, obj1, obj2);\
- if (obj2==0 || Z__Region(obj2)~=1\
- || (obj2 == Class or String or Routine or Object) || obj2 in Class)\
- return RT__Err(17, obj1, obj2);\
- ix = obj2;\
- while (ix ~= 0) {\
- if (ix==obj1) return RT__Err(18, obj1, obj2);\
- ix = parent(ix);\
- }\
- #ifdef INFIX;\
- if (obj1 has infix__watching\
- || obj2 has infix__watching || (debug_flag & 15))\
- print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15)\
- print \"[Moving \", (name) obj1, \" to \", (name) obj2, \"]^\";\
- #endif; #endif;\
- OB__Move(obj1, obj2);\
- ]", "", "", "", "", ""
- },
- {
- /* RT__ChR: Check at run-time that a proposed object remove is legal.
- Cause error and do nothing if not; otherwise remove
- */
- "RT__ChR",
- "obj1;\
- if (obj1==0 || Z__Region(obj1)~=1\
- || (obj1 == Class or String or Routine or Object) || obj1 in Class)\
- return RT__Err(15, obj1);\
- #ifdef INFIX;\
- if (obj1 has infix__watching || (debug_flag & 15))\
- print \"[Removing \", (name) obj1, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15)\
- print \"[Removing \", (name) obj1, \"]^\";\
- #endif; #endif;\
- OB__Remove(obj1);\
- ]", "", "", "", "", ""
- },
- { /* RT__ChG: check at run-time that a proposed attr give is legal
- cause error and do nothing if not; otherwise give */
-
- "RT__ChG",
- "obj1 a;\
- if (Z__Region(obj1) ~= 1) return RT__Err(14,obj1);\
- if (obj1 in Class || obj1 == Class or String or Routine or Object)\
- return RT__Err(14,obj1);\
- if (a<0 || a>=NUM_ATTR_BYTES*8) return RT__Err(19,obj1);\
- if (obj1 has a) return;",
- "#ifdef INFIX;\
- if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
- print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (a ~= workflag && debug_flag & 15)\
- print \"[Giving \", (name) obj1, \" \", (DebugAttribute) a, \"]^\";\
- #endif; #endif;\
- give obj1 a; ]", "", "", "", ""
- },
- { /* RT__ChGt: check at run-time that a proposed attr give ~ is legal
- cause error and do nothing if not; otherwise give */
-
- "RT__ChGt",
- "obj1 a;\
- if (Z__Region(obj1) ~= 1) return RT__Err(14,obj1);\
- if (obj1 in Class || obj1 == Class or String or Routine or Object)\
- return RT__Err(14,obj1);\
- if (a<0 || a>=NUM_ATTR_BYTES*8) return RT__Err(19,obj1);\
- if (obj1 hasnt a) return;",
- "#ifdef INFIX;\
- if (a ~= workflag && (obj1 has infix__watching || (debug_flag & 15)))\
- print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
- #ifnot; #ifdef DEBUG;\
- if (a ~= workflag && debug_flag & 15)\
- print \"[Giving \",(name) obj1,\" @@126\", (DebugAttribute) a, \"]^\";\
- #endif; #endif;\
- give obj1 ~a; ]", "", "", "", ""
- },
- {
- /* RT__ChPS: Check at run-time that a proposed property set is legal.
- Cause error and do nothing if not; otherwise make it.
- */
- "RT__ChPS",
- "obj prop val res;\
- if (obj==0 || Z__Region(obj)~=1\
- || (obj == Class or String or Routine or Object) || obj in Class)\
- return RT__Err(\"set\", obj, prop);\
- res = WV__Pr(obj, prop, val);\
- #ifdef INFIX;\
- if (obj has infix__watching || (debug_flag & 15)) RT__TrPS(obj,prop,val);\
- #ifnot; #ifdef DEBUG;\
- if (debug_flag & 15) RT__TrPS(obj,prop,val);\
- #endif; #endif;\
- return res;\
- ]", "", "", "", "", ""
- },
- { /* RT__ChPR: check at run-time that a proposed property read is legal.
- cause error and return 0 if not; otherwise read it */
- "RT__ChPR",
- "obj prop val;\
- if (obj==0 or Class or String or Routine or Object || Z_Region(obj)~=1 )\
- {RT__Err(\"read\", obj, prop); obj=2;}\
- val = RV__Pr(obj, prop);",
- "return val; ]", "", "", "", ""
- },
- { /* RT__TrPS: trace property settings */
-
- "RT__TrPS",
- "obj prop val;\
- print \"[Setting \",(name) obj,\".\",(property) prop,\
- \" to \",val,\"]^\"; ]",
- "", "", "", "", ""
- },
- {
- /* RT__ChLDB: Check at run-time that it's safe to load a byte
- and return the byte.
- */
- "RT__ChLDB",
- "base offset a b val;\
- a=base+offset;\
- @getmemsize b;\
- if (Unsigned__Compare(a, b) >= 0)\
- return RT__Err(24);\
- @aloadb base offset val;\
- return val;\
- ]", "", "", "", "", ""
- },
-
- {
- /* RT__ChLDW: Check at run-time that it's safe to load a word
- and return the word
- */
- "RT__ChLDW",
- "base offset a b val;\
- a=base+WORDSIZE*offset;\
- @getmemsize b;\
- if (Unsigned__Compare(a, b) >= 0)\
- return RT__Err(25);\
- @aload base offset val;\
- return val;\
- ]", "", "", "", "", ""
- },
-
- {
- /* RT__ChSTB: Check at run-time that it's safe to store a byte
- and store it
- */
- "RT__ChSTB",
- "base offset val a b;\
- a=base+offset;\
- @getmemsize b;\
- if (Unsigned__Compare(a, b) >= 0) jump ChSTB_Fail;\
- @aload 0 2 b;\
- if (Unsigned__Compare(a, b) < 0) jump ChSTB_Fail;\
- @astoreb base offset val;\
- return;\
- .ChSTB_Fail;\
- return RT__Err(26);\
- ]", "", "", "", "", ""
- },
-
- {
- /* RT__ChSTW: Check at run-time that it's safe to store a word
- and store it
- */
- "RT__ChSTW",
- "base offset val a b;\
- a=base+WORDSIZE*offset;\
- @getmemsize b;\
- if (Unsigned__Compare(a, b) >= 0) jump ChSTW_Fail;\
- @aload 0 2 b;\
- if (Unsigned__Compare(a, b) < 0) jump ChSTW_Fail;\
- @astore base offset val;\
- return;\
- .ChSTW_Fail;\
- return RT__Err(27);\
- ]", "", "", "", "", ""
- },
-
- {
- /* RT__ChPrintC: Check at run-time that it's safe to print (char)
- and do so.
- */
- "RT__ChPrintC",
- "c;\
- if (c<10 || (c>10 && c<32) || (c>126 && c<160))\
- return RT__Err(33,c);\
- if (c>=0 && c<256)\
- @streamchar c;\
- else\
- @streamunichar c;\
- ]", "", "", "", "", ""
- },
- {
- /* RT__ChPrintA: Check at run-time that it's safe to print (address)
- and do so.
- */
- "RT__ChPrintA",
- "addr endmem;\
- if (addr<36)\
- return RT__Err(34);\
- @getmemsize endmem;\
- if (Unsigned__Compare(addr, endmem) >= 0)\
- return RT__Err(34);\
- if (addr->0 ~= $60)\
- return RT__Err(34);\
- Print__Addr(addr);\
- ]", "", "", "", "", ""
- },
- {
- /* Check at run-time that it's safe to print (string) and do so.
- */
- "RT__ChPrintS",
- "str;\
- if (Z__Region(str) ~= 3)\
- return RT__Err(35);\
- @streamstr str;\
- ]", "", "", "", "", ""
- },
- {
- /* Check at run-time that it's safe to print (object) and do so.
- */
- "RT__ChPrintO",
- "obj;\
- if (Z__Region(obj) ~= 1)\
- return RT__Err(36);\
- @aload obj GOBJFIELD_NAME sp; @streamstr sp;\
- ]", "", "", "", "", ""
- },
- {
- /* OB__Move: Move an object within the object tree. This does no
- more error checking than the Z-code \"move\" opcode.
- */
- "OB__Move",
- "obj dest par chi sib;\
- par = obj-->GOBJFIELD_PARENT;\
- if (par ~= 0) {\
- chi = par-->GOBJFIELD_CHILD;\
- if (chi == obj) {\
- par-->GOBJFIELD_CHILD = obj-->GOBJFIELD_SIBLING;\
- }\
- else {\
- while (1) {\
- sib = chi-->GOBJFIELD_SIBLING;\
- if (sib == obj)\
- break;\
- chi = sib;\
- }\
- chi-->GOBJFIELD_SIBLING = obj-->GOBJFIELD_SIBLING;\
- }\
- }\
- obj-->GOBJFIELD_SIBLING = dest-->GOBJFIELD_CHILD;\
- obj-->GOBJFIELD_PARENT = dest;\
- dest-->GOBJFIELD_CHILD = obj;\
- rfalse;\
- ]", "", "", "", "", ""
- },
-
- {
- /* OB__Remove: Remove an object from the tree. This does no
- more error checking than the Z-code \"remove\" opcode.
- */
- "OB__Remove",
- "obj par chi sib;\
- par = obj-->GOBJFIELD_PARENT;\
- if (par == 0)\
- rfalse;\
- chi = par-->GOBJFIELD_CHILD;\
- if (chi == obj) {\
- par-->GOBJFIELD_CHILD = obj-->GOBJFIELD_SIBLING;\
- }\
- else {\
- while (1) {\
- sib = chi-->GOBJFIELD_SIBLING;\
- if (sib == obj)\
- break;\
- chi = sib;\
- }\
- chi-->GOBJFIELD_SIBLING = obj-->GOBJFIELD_SIBLING;\
- }\
- obj-->GOBJFIELD_SIBLING = 0;\
- obj-->GOBJFIELD_PARENT = 0;\
- rfalse;\
- ]", "", "", "", "", ""
- },
-
- {
- /* Print__Addr: Handle the print (address) statement. In Glulx,
- this behaves differently than on the Z-machine; it can *only*
- print dictionary words.
- */
- "Print__Addr",
- "addr ix ch;\
- if (addr->0 ~= $60) {\
- print \"(\", addr, \": not dict word)\";\
- return;\
- }\
- for (ix=1 : ix <= DICT_WORD_SIZE : ix++) {\
- #ifndef DICT_IS_UNICODE;\
- ch = addr->ix;\
- #ifnot;\
- ch = addr-->ix;\
- #endif;\
- if (ch == 0) return;\
- print (char) ch;\
- }\
- ]", "", "", "", "", ""
- },
-
- {
- /* Glk__Wrap: This is a wrapper for the @glk opcode. It just passes
- all its arguments into the Glk dispatcher, and returns the Glk
- call result.
- */
- "Glk__Wrap",
- "_vararg_count callid retval;\
- @copy sp callid;\
- _vararg_count = _vararg_count - 1;\
- @glk callid _vararg_count retval;\
- return retval;\
- ]", "", "", "", "", ""
- },
-
- {
- /* Dynam__String: Set dynamic string (printing variable) num to the
- given val, which can be any string or function.
- */
- "Dynam__String",
- "num val;\
- if (num < 0 || num >= #dynam_string_table-->0)\
- return RT__Err(40, num);\
- (#dynam_string_table)-->(num+1) = val;\
- ]", "", "", "", "", ""
- }
-
-};
-
-
-static void mark_as_needed_z(int code)
-{
- ASSERT_ZCODE();
- if (veneer_routine_needs_compilation[code] == VR_UNUSED)
- { veneer_routine_needs_compilation[code] = VR_CALLED;
- /* Here each routine must mark every veneer routine it explicitly
- calls as needed */
- switch(code)
- { case WV__Pr_VR:
- mark_as_needed_z(RT__TrPS_VR);
- mark_as_needed_z(RT__Err_VR);
- return;
- case RV__Pr_VR:
- mark_as_needed_z(RT__Err_VR);
- return;
- case CA__Pr_VR:
- mark_as_needed_z(Z__Region_VR);
- mark_as_needed_z(Cl__Ms_VR);
- mark_as_needed_z(RT__Err_VR);
- return;
- case IB__Pr_VR:
- case IA__Pr_VR:
- case DB__Pr_VR:
- case DA__Pr_VR:
- mark_as_needed_z(RT__Err_VR);
- mark_as_needed_z(RT__TrPS_VR);
- return;
- case RA__Pr_VR:
- mark_as_needed_z(CP__Tab_VR);
- return;
- case RA__Sc_VR:
- mark_as_needed_z(RT__Err_VR);
- return;
- case OP__Pr_VR:
- mark_as_needed_z(Z__Region_VR);
- return;
- case OC__Cl_VR:
- mark_as_needed_z(Z__Region_VR);
- mark_as_needed_z(RT__Err_VR);
- return;
- case Z__Region_VR:
- mark_as_needed_z(Unsigned__Compare_VR);
- return;
- case Metaclass_VR:
- mark_as_needed_z(Z__Region_VR);
- return;
- case Cl__Ms_VR:
- mark_as_needed_z(RT__Err_VR);
- mark_as_needed_z(Copy__Primitive_VR);
- return;
- case RT__ChR_VR:
- case RT__ChT_VR:
- case RT__ChG_VR:
- case RT__ChGt_VR:
- case RT__ChPR_VR:
- mark_as_needed_z(RT__Err_VR);
- return;
- case RT__ChPS_VR:
- mark_as_needed_z(RT__Err_VR);
- mark_as_needed_z(RT__TrPS_VR);
- return;
- case RT__ChLDB_VR:
- case RT__ChLDW_VR:
- case RT__ChSTB_VR:
- case RT__ChSTW_VR:
- mark_as_needed_z(Unsigned__Compare_VR);
- mark_as_needed_z(RT__Err_VR);
- return;
- case RT__ChPrintC_VR:
- mark_as_needed_z(RT__Err_VR);
- return;
- case RT__ChPrintA_VR:
- mark_as_needed_z(Unsigned__Compare_VR);
- mark_as_needed_z(RT__Err_VR);
- return;
- case RT__ChPrintS_VR:
- case RT__ChPrintO_VR:
- mark_as_needed_z(RT__Err_VR);
- mark_as_needed_z(Z__Region_VR);
- return;
- }
- }
-}
-
-static void mark_as_needed_g(int code)
-{
- ASSERT_GLULX();
- if (veneer_routine_needs_compilation[code] == VR_UNUSED)
- { veneer_routine_needs_compilation[code] = VR_CALLED;
- /* Here each routine must mark every veneer routine it explicitly
- calls as needed */
- switch(code)
- {
- case PrintShortName_VR:
- mark_as_needed_g(Metaclass_VR);
- return;
- case Print__Pname_VR:
- mark_as_needed_g(PrintShortName_VR);
- return;
- case WV__Pr_VR:
- mark_as_needed_g(RA__Pr_VR);
- mark_as_needed_g(RT__TrPS_VR);
- mark_as_needed_g(RT__Err_VR);
- return;
- case RV__Pr_VR:
- mark_as_needed_g(RA__Pr_VR);
- mark_as_needed_g(RT__Err_VR);
- return;
- case CA__Pr_VR:
- mark_as_needed_g(RA__Pr_VR);
- mark_as_needed_g(RL__Pr_VR);
- mark_as_needed_g(PrintShortName_VR);
- mark_as_needed_g(Print__Pname_VR);
- mark_as_needed_g(Z__Region_VR);
- mark_as_needed_g(Cl__Ms_VR);
- mark_as_needed_g(Glk__Wrap_VR);
- mark_as_needed_g(RT__Err_VR);
- return;
- case IB__Pr_VR:
- case IA__Pr_VR:
- case DB__Pr_VR:
- case DA__Pr_VR:
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(RT__TrPS_VR);
- return;
- case RA__Pr_VR:
- mark_as_needed_g(OC__Cl_VR);
- mark_as_needed_g(CP__Tab_VR);
- return;
- case RL__Pr_VR:
- mark_as_needed_g(OC__Cl_VR);
- mark_as_needed_g(CP__Tab_VR);
- return;
- case RA__Sc_VR:
- mark_as_needed_g(OC__Cl_VR);
- mark_as_needed_g(RT__Err_VR);
- return;
- case OP__Pr_VR:
- mark_as_needed_g(RA__Pr_VR);
- mark_as_needed_g(Z__Region_VR);
- return;
- case OC__Cl_VR:
- mark_as_needed_g(RA__Pr_VR);
- mark_as_needed_g(RL__Pr_VR);
- mark_as_needed_g(Z__Region_VR);
- mark_as_needed_g(RT__Err_VR);
- return;
- case Copy__Primitive_VR:
- mark_as_needed_g(CP__Tab_VR);
- return;
- case Z__Region_VR:
- mark_as_needed_g(Unsigned__Compare_VR);
- return;
- case CP__Tab_VR:
- case Metaclass_VR:
- mark_as_needed_g(Z__Region_VR);
- return;
- case Cl__Ms_VR:
- mark_as_needed_g(OC__Cl_VR);
- mark_as_needed_g(OP__Pr_VR);
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(Copy__Primitive_VR);
- mark_as_needed_g(OB__Remove_VR);
- mark_as_needed_g(OB__Move_VR);
- return;
- case RT__ChG_VR:
- case RT__ChGt_VR:
- mark_as_needed_g(RT__Err_VR);
- return;
- case RT__ChR_VR:
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(Z__Region_VR);
- mark_as_needed_g(OB__Remove_VR);
- return;
- case RT__ChT_VR:
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(Z__Region_VR);
- mark_as_needed_g(OB__Move_VR);
- return;
- case RT__ChPS_VR:
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(RT__TrPS_VR);
- mark_as_needed_g(WV__Pr_VR);
- return;
- case RT__ChPR_VR:
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(RV__Pr_VR); return;
- case RT__ChLDB_VR:
- case RT__ChLDW_VR:
- case RT__ChSTB_VR:
- case RT__ChSTW_VR:
- mark_as_needed_g(Unsigned__Compare_VR);
- mark_as_needed_g(RT__Err_VR);
- return;
- case RT__ChPrintC_VR:
- mark_as_needed_g(RT__Err_VR);
- return;
- case RT__ChPrintA_VR:
- mark_as_needed_g(Unsigned__Compare_VR);
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(Print__Addr_VR);
- return;
- case RT__ChPrintS_VR:
- case RT__ChPrintO_VR:
- mark_as_needed_g(RT__Err_VR);
- mark_as_needed_g(Z__Region_VR);
- return;
- case Print__Addr_VR:
- mark_as_needed_g(RT__Err_VR);
- return;
- case Dynam__String_VR:
- mark_as_needed_g(RT__Err_VR);
- return;
- }
- }
-}
-
-extern assembly_operand veneer_routine(int code)
-{ assembly_operand AO;
- if (!glulx_mode) {
- INITAOTV(&AO, LONG_CONSTANT_OT, code);
- AO.marker = VROUTINE_MV;
- mark_as_needed_z(code);
- }
- else {
- INITAOTV(&AO, CONSTANT_OT, code);
- AO.marker = VROUTINE_MV;
- mark_as_needed_g(code);
- }
- return(AO);
-}
-
-static void compile_symbol_table_routine(void)
-{ int32 j, nl, arrays_l, routines_l, constants_l;
- assembly_operand AO, AO2, AO3;
-
- /* Assign local var names for the benefit of the debugging information
- file. */
- local_variable_texts[0] = "dummy1";
- local_variable_texts[1] = "dummy2";
-
- veneer_mode = TRUE; j = symbol_index("Symb__Tab", -1);
- assign_symbol(j,
- assemble_routine_header(2, FALSE, "Symb__Tab", FALSE, j),
- ROUTINE_T);
- sflags[j] |= SYSTEM_SFLAG + USED_SFLAG;
- if (trace_fns_setting==3) sflags[j] |= STAR_SFLAG;
-
- if (!glulx_mode) {
-
- if (define_INFIX_switch == FALSE)
- { assemblez_0(rfalse_zc);
- variable_usage[1] = TRUE;
- variable_usage[2] = TRUE;
- assemble_routine_end(FALSE, null_debug_locations);
- veneer_mode = FALSE;
- return;
- }
-
- INITAOTV(&AO, VARIABLE_OT, 1);
- INITAOT(&AO2, SHORT_CONSTANT_OT);
- INITAOT(&AO3, LONG_CONSTANT_OT);
-
- arrays_l = next_label++;
- routines_l = next_label++;
- constants_l = next_label++;
-
- sequence_point_follows = FALSE;
- AO2.value = 1;
- assemblez_2_branch(je_zc, AO, AO2, arrays_l, TRUE);
- sequence_point_follows = FALSE;
- AO2.value = 2;
- assemblez_2_branch(je_zc, AO, AO2, routines_l, TRUE);
- sequence_point_follows = FALSE;
- AO2.value = 3;
- assemblez_2_branch(je_zc, AO, AO2, constants_l, TRUE);
- sequence_point_follows = FALSE;
- assemblez_0(rtrue_zc);
-
- assemble_label_no(arrays_l);
- AO.value = 2;
- for (j=0; j<no_arrays; j++)
- { { AO2.value = j;
- if (AO2.value<256) AO2.type = SHORT_CONSTANT_OT;
- else AO2.type = LONG_CONSTANT_OT;
- nl = next_label++;
- sequence_point_follows = FALSE;
- assemblez_2_branch(je_zc, AO, AO2, nl, FALSE);
- AO3.value = array_sizes[j];
- AO3.marker = 0;
- assemblez_store(temp_var2, AO3);
- AO3.value = array_types[j];
- if (sflags[array_symbols[j]] & (INSF_SFLAG+SYSTEM_SFLAG))
- AO3.value = AO3.value + 16;
- AO3.marker = 0;
- assemblez_store(temp_var3, AO3);
- AO3.value = svals[array_symbols[j]];
- AO3.marker = ARRAY_MV;
- assemblez_1(ret_zc, AO3);
- assemble_label_no(nl);
- }
- }
- sequence_point_follows = FALSE;
- assemblez_0(rtrue_zc);
- assemble_label_no(routines_l);
- for (j=0; j<no_named_routines; j++)
- { AO2.value = j;
- if (AO2.value<256) AO2.type = SHORT_CONSTANT_OT;
- else AO2.type = LONG_CONSTANT_OT;
- nl = next_label++;
- sequence_point_follows = FALSE;
- assemblez_2_branch(je_zc, AO, AO2, nl, FALSE);
- AO3.value = 0;
- if (sflags[named_routine_symbols[j]]
- & (INSF_SFLAG+SYSTEM_SFLAG)) AO3.value = 16;
- AO3.marker = 0;
- assemblez_store(temp_var3, AO3);
- AO3.value = svals[named_routine_symbols[j]];
- AO3.marker = IROUTINE_MV;
- assemblez_1(ret_zc, AO3);
- assemble_label_no(nl);
- }
- sequence_point_follows = FALSE;
- assemblez_0(rtrue_zc);
-
- assemble_label_no(constants_l);
- for (j=0, no_named_constants=0; j<no_symbols; j++)
- { if (((stypes[j] == OBJECT_T) || (stypes[j] == CLASS_T)
- || (stypes[j] == CONSTANT_T))
- && ((sflags[j] & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
- { AO2.value = no_named_constants++;
- if (AO2.value<256) AO2.type = SHORT_CONSTANT_OT;
- else AO2.type = LONG_CONSTANT_OT;
- nl = next_label++;
- sequence_point_follows = FALSE;
- assemblez_2_branch(je_zc, AO, AO2, nl, FALSE);
- AO3.value = 0;
- if (stypes[j] == OBJECT_T) AO3.value = 2;
- if (stypes[j] == CLASS_T) AO3.value = 1;
- if (sflags[j] & (INSF_SFLAG+SYSTEM_SFLAG))
- AO3.value = AO3.value + 16;
- AO3.marker = 0;
- assemblez_store(temp_var3, AO3);
- AO3.value = j;
- AO3.marker = SYMBOL_MV;
- assemblez_1(ret_zc, AO3);
- assemble_label_no(nl);
- }
- }
- no_named_constants = 0; AO3.marker = 0;
-
- sequence_point_follows = FALSE;
- assemblez_0(rfalse_zc);
- variable_usage[1] = TRUE;
- variable_usage[2] = TRUE;
- assemble_routine_end(FALSE, null_debug_locations);
- veneer_mode = FALSE;
- }
- else {
-
- if (define_INFIX_switch == FALSE)
- { assembleg_1(return_gc, zero_operand);
- variable_usage[1] = TRUE;
- variable_usage[2] = TRUE;
- assemble_routine_end(FALSE, null_debug_locations);
- veneer_mode = FALSE;
- return;
- }
-
- error("*** Infix symbol-table routine is not yet implemented. ***");
- }
-}
-
-extern void compile_veneer(void)
-{ int i, j, try_veneer_again;
- VeneerRoutine *VRs;
-
- if (module_switch) return;
-
- VRs = (!glulx_mode) ? VRs_z : VRs_g;
-
- /* Called at the end of the pass to insert as much of the veneer as is
- needed and not elsewhere compiled. */
-
- veneer_symbols_base = no_symbols;
-
- /* for (i=0; i<VENEER_ROUTINES; i++)
- printf("%s %d %d %d %d %d %d\n", VRs[i].name,
- strlen(VRs[i].source1), strlen(VRs[i].source2),
- strlen(VRs[i].source3), strlen(VRs[i].source4),
- strlen(VRs[i].source5), strlen(VRs[i].source6)); */
-
- try_veneer_again = TRUE;
- while (try_veneer_again)
- { 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);
- if (sflags[j] & UNKNOWN_SFLAG)
- { veneer_mode = TRUE;
- strcpy(veneer_source_area, VRs[i].source1);
- strcat(veneer_source_area, VRs[i].source2);
- strcat(veneer_source_area, VRs[i].source3);
- strcat(veneer_source_area, VRs[i].source4);
- strcat(veneer_source_area, VRs[i].source5);
- strcat(veneer_source_area, VRs[i].source6);
- assign_symbol(j,
- parse_routine(veneer_source_area, FALSE,
- VRs[i].name, TRUE, j),
- ROUTINE_T);
- veneer_mode = FALSE;
- if (trace_fns_setting==3) sflags[j] |= STAR_SFLAG;
- }
- else
- { if (stypes[j] != ROUTINE_T)
- error_named("The following name is reserved by Inform for its \
-own use as a routine name; you can use it as a routine name yourself (to \
-override the standard definition) but cannot use it for anything else:",
- VRs[i].name);
- else
- sflags[j] |= USED_SFLAG;
- }
- veneer_routine_address[i] = svals[j];
- veneer_routine_needs_compilation[i] = VR_COMPILED;
- try_veneer_again = TRUE;
- }
- }
- }
-
- compile_symbol_table_routine();
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_veneer_vars(void)
-{
-}
-
-extern void veneer_begin_pass(void)
-{ int i;
- veneer_mode = FALSE;
- for (i=0; i<VENEER_ROUTINES; i++)
- { veneer_routine_needs_compilation[i] = VR_UNUSED;
- veneer_routine_address[i] = 0;
- }
-}
-
-extern void veneer_allocate_arrays(void)
-{ veneer_source_area = my_malloc(16384, "veneer source code area");
-}
-
-extern void veneer_free_arrays(void)
-{ my_free(&veneer_source_area, "veneer source code area");
-}
-
-/* ========================================================================= */
+++ /dev/null
-/* ------------------------------------------------------------------------- */
-/* "verbs" : Manages actions and grammar tables; parses the directives */
-/* Verb and Extend. */
-/* */
-/* Copyright (c) Graham Nelson 1993 - 2018 */
-/* */
-/* This file is part of Inform. */
-/* */
-/* Inform is free software: you can redistribute it and/or modify */
-/* it under the terms of the GNU General Public License as published by */
-/* the Free Software Foundation, either version 3 of the License, or */
-/* (at your option) any later version. */
-/* */
-/* Inform is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-/* */
-/* You should have received a copy of the GNU General Public License */
-/* along with Inform. If not, see https://gnu.org/licenses/ */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#include "header.h"
-
-int grammar_version_number; /* 1 for pre-Inform 6.06 table format */
-int32 grammar_version_symbol; /* Index of "Grammar__Version"
- within symbols table */
-
-/* ------------------------------------------------------------------------- */
-/* Actions. */
-/* ------------------------------------------------------------------------- */
-/* Array defined below: */
-/* */
-/* int32 action_byte_offset[n] The (byte) offset in the Z-machine */
-/* code area of the ...Sub routine */
-/* for action n. (NB: This is left */
-/* blank until the end of the */
-/* compilation pass.) */
-/* int32 action_symbol[n] The symbol table index of the n-th */
-/* action's name. */
-/* ------------------------------------------------------------------------- */
-
-int no_actions, /* Number of actions made so far */
- no_fake_actions; /* Number of fake actions made so far */
-
-/* ------------------------------------------------------------------------- */
-/* Adjectives. (The term "adjective" is traditional; they are mainly */
-/* prepositions, such as "onto".) */
-/* ------------------------------------------------------------------------- */
-/* Arrays defined below: */
-/* */
-/* int32 adjectives[n] Byte address of dictionary entry */
-/* for the nth adjective */
-/* dict_word adjective_sort_code[n] Dictionary sort code of nth adj */
-/* ------------------------------------------------------------------------- */
-
-int no_adjectives; /* Number of adjectives made so far */
-
-/* ------------------------------------------------------------------------- */
-/* Verbs. Note that Inform-verbs are not quite the same as English verbs: */
-/* for example the English verbs "take" and "drop" both normally */
-/* correspond in a game's dictionary to the same Inform verb. An */
-/* Inform verb is essentially a list of grammar lines. */
-/* ------------------------------------------------------------------------- */
-/* Arrays defined below: */
-/* */
-/* verbt Inform_verbs[n] The n-th grammar line sequence: */
-/* see "header.h" for the definition */
-/* of the typedef struct verbt */
-/* int32 grammar_token_routine[n] The byte offset from start of code */
-/* area of the n-th one */
-/* ------------------------------------------------------------------------- */
-
-int no_Inform_verbs, /* Number of Inform-verbs made so far */
- no_grammar_token_routines; /* Number of routines given in tokens */
-
-/* ------------------------------------------------------------------------- */
-/* We keep a list of English verb-words known (e.g. "take" or "eat") and */
-/* which Inform-verbs they correspond to. (This list is needed for some */
-/* of the grammar extension operations.) */
-/* The format of this list is a sequence of variable-length records: */
-/* */
-/* Byte offset to start of next record (1 byte) */
-/* Inform verb number this word corresponds to (1 byte) */
-/* The English verb-word (reduced to lower case), null-terminated */
-/* ------------------------------------------------------------------------- */
-
-static char *English_verb_list, /* First byte of first record */
- *English_verb_list_top; /* Next byte free for new record */
-
-static int English_verb_list_size; /* Size of the list in bytes
- (redundant but convenient) */
-
-/* ------------------------------------------------------------------------- */
-/* Arrays used by this file */
-/* ------------------------------------------------------------------------- */
-
- verbt *Inform_verbs;
- uchar *grammar_lines;
- int32 grammar_lines_top;
- int no_grammar_lines, no_grammar_tokens;
-
- int32 *action_byte_offset,
- *action_symbol,
- *grammar_token_routine,
- *adjectives;
- static uchar *adjective_sort_code;
-
-/* ------------------------------------------------------------------------- */
-/* Tracing for compiler maintenance */
-/* ------------------------------------------------------------------------- */
-
-extern void list_verb_table(void)
-{ int i;
- for (i=0; i<no_Inform_verbs; i++)
- printf("Verb %2d has %d lines\n", i, Inform_verbs[i].lines);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Actions. */
-/* ------------------------------------------------------------------------- */
-
-static void new_action(char *b, int c)
-{
- /* Called whenever a new action (or fake action) is created (either
- by using make_action above, or the Fake_Action directive, or by
- the linker). At present just a hook for some tracing code. */
-
- if (printprops_switch)
- printf("Action '%s' is numbered %d\n",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];
- 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);
- panic_mode_error_recovery(); return;
- }
-
- snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", token_text);
- i = symbol_index(action_sub, -1);
-
- if (!(sflags[i] & UNKNOWN_SFLAG))
- { discard_token_location(beginning_debug_location);
- ebf_error("new fake action name", token_text);
- panic_mode_error_recovery(); return;
- }
-
- assign_symbol(i, ((grammar_version_number==1)?256:4096)+no_fake_actions++,
- FAKE_ACTION_T);
-
- new_action(token_text, i);
-
- if (debugfile_switch)
- { debug_file_printf("<fake-action>");
- debug_file_printf("<identifier>##%s</identifier>", token_text);
- debug_file_printf("<value>%d</value>", svals[i]);
- get_next_token();
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- put_token_back();
- debug_file_printf("</fake-action>");
- }
-
- return;
-}
-
-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];
- int j;
- assembly_operand AO;
-
- snprintf(action_sub, MAX_IDENTIFIER_LENGTH+4, "%s__A", name);
- j = symbol_index(action_sub, -1);
-
- if (stypes[j] == FAKE_ACTION_T)
- { INITAO(&AO);
- AO.value = svals[j];
- if (!glulx_mode)
- AO.type = LONG_CONSTANT_OT;
- else
- set_constant_ot(&AO);
- sflags[j] |= USED_SFLAG;
- return AO;
- }
-
- if (sflags[j] & UNKNOWN_SFLAG)
- {
- if (no_actions>=MAX_ACTIONS) memoryerror("MAX_ACTIONS",MAX_ACTIONS);
- new_action(name, no_actions);
- action_symbol[no_actions] = j;
- assign_symbol(j, no_actions++, CONSTANT_T);
- sflags[j] |= ACTION_SFLAG;
- }
- sflags[j] |= USED_SFLAG;
-
- INITAO(&AO);
- AO.value = svals[j];
- AO.marker = ACTION_MV;
- if (!glulx_mode) {
- AO.type = (module_switch)?LONG_CONSTANT_OT:SHORT_CONSTANT_OT;
- if (svals[j] >= 256) AO.type = LONG_CONSTANT_OT;
- }
- else {
- AO.type = CONSTANT_OT;
- }
- return AO;
-}
-
-extern void find_the_actions(void)
-{ int i; int32 j;
- char action_name[MAX_IDENTIFIER_LENGTH+4];
- char action_sub[MAX_IDENTIFIER_LENGTH+4];
-
- if (module_switch)
- for (i=0; i<no_actions; i++) action_byte_offset[i] = 0;
- else
- for (i=0; i<no_actions; i++)
- { strcpy(action_name, (char *) symbs[action_symbol[i]]);
- action_name[strlen(action_name) - 3] = '\0'; /* remove "__A" */
- strcpy(action_sub, action_name);
- strcat(action_sub, "Sub");
- j = symbol_index(action_sub, -1);
- if (sflags[j] & UNKNOWN_SFLAG)
- {
- error_named_at("No ...Sub action routine found for action:", action_name, slines[action_symbol[i]]);
- }
- else
- if (stypes[j] != ROUTINE_T)
- {
- error_named_at("No ...Sub action routine found for action:", action_name, slines[action_symbol[i]]);
- error_named_at("-- ...Sub symbol found, but not a routine:", action_sub, slines[j]);
- }
- else
- { action_byte_offset[i] = svals[j];
- sflags[j] |= USED_SFLAG;
- }
- }
-}
-
-/* ------------------------------------------------------------------------- */
-/* Adjectives. */
-/* ------------------------------------------------------------------------- */
-
-static int make_adjective(char *English_word)
-{
- /* Returns adjective number of the English word supplied, creating
- a new adjective number if need be.
-
- Note that (partly for historical reasons) adjectives are numbered
- from 0xff downwards. (And partly to make them stand out as tokens.)
-
- This routine is used only in grammar version 1: the corresponding
- table is left empty in GV2. */
-
- int i;
- uchar new_sort_code[MAX_DICT_WORD_BYTES];
-
- if (no_adjectives >= MAX_ADJECTIVES)
- memoryerror("MAX_ADJECTIVES", MAX_ADJECTIVES);
-
- dictionary_prepare(English_word, new_sort_code);
- for (i=0; i<no_adjectives; i++)
- if (compare_sorts(new_sort_code,
- adjective_sort_code+i*DICT_WORD_BYTES) == 0)
- 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++);
-}
-
-/* ------------------------------------------------------------------------- */
-/* Parsing routines. */
-/* ------------------------------------------------------------------------- */
-
-static int make_parsing_routine(int32 routine_address)
-{
- /* This routine is used only in grammar version 1: the corresponding
- table is left empty in GV2. */
-
- int l;
- for (l=0; l<no_grammar_token_routines; l++)
- if (grammar_token_routine[l] == routine_address)
- return l;
-
- grammar_token_routine[l] = routine_address;
- return(no_grammar_token_routines++);
-}
-
-/* ------------------------------------------------------------------------- */
-/* The English-verb list. */
-/* ------------------------------------------------------------------------- */
-
-static int find_or_renumber_verb(char *English_verb, int *new_number)
-{
- /* If new_number is null, returns the Inform-verb number which the
- * given English verb causes, or -1 if the given verb is not in the
- * dictionary */
-
- /* If new_number is non-null, renumbers the Inform-verb number which
- * English_verb matches in English_verb_list to account for the case
- * when we are extending a verb. Returns 0 if successful, or -1 if
- * the given verb is not in the dictionary (which shouldn't happen as
- * get_verb has already run) */
-
- char *p;
- p=English_verb_list;
- while (p < English_verb_list_top)
- { if (strcmp(English_verb, p+3) == 0)
- { if (new_number)
- { p[1] = (*new_number)/256;
- p[2] = (*new_number)%256;
- return 0;
- }
- return(256*((uchar)p[1]))+((uchar)p[2]);
- }
- p=p+(uchar)p[0];
- }
- return(-1);
-}
-
-static void register_verb(char *English_verb, int number)
-{
- /* Registers a new English verb as referring to the given Inform-verb
- number. (See comments above for format of the list.) */
- int entrysize;
-
- if (find_or_renumber_verb(English_verb, NULL) != -1)
- { error_named("Two different verb definitions refer to", English_verb);
- return;
- }
-
- /* 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.) */
- 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);
- English_verb_list_size += entrysize;
- if (English_verb_list_size >= MAX_VERBSPACE)
- memoryerror("MAX_VERBSPACE", MAX_VERBSPACE);
-
- English_verb_list_top[0] = entrysize;
- English_verb_list_top[1] = number/256;
- English_verb_list_top[2] = number%256;
- strcpy(English_verb_list_top+3, English_verb);
- English_verb_list_top += entrysize;
-}
-
-static int get_verb(void)
-{
- /* Look at the last-read token: if it's the name of an English verb
- understood by Inform, in double-quotes, then return the Inform-verb
- that word refers to: otherwise give an error and return -1. */
-
- int j;
-
- if ((token_type == DQ_TT) || (token_type == SQ_TT))
- { j = find_or_renumber_verb(token_text, NULL);
- if (j==-1)
- error_named("There is no previous grammar for the verb",
- token_text);
- return j;
- }
-
- ebf_error("an English verb in quotes", token_text);
-
- return -1;
-}
-
-/* ------------------------------------------------------------------------- */
-/* Grammar lines for Verb/Extend directives. */
-/* ------------------------------------------------------------------------- */
-
-static int grammar_line(int verbnum, int line)
-{
- /* Parse a grammar line, to be written into grammar_lines[mark] onward.
-
- Syntax: * <token1> ... <token-n> -> <action>
-
- is compiled to a table in the form:
-
- <action number : word>
- <token 1> ... <token n> <ENDIT>
-
- where <ENDIT> is the byte 15, and each <token> is 3 bytes long.
-
- If grammar_version_number is 1, the token holds
-
- <bytecode> 00 00
-
- and otherwise a GV2 token.
-
- Return TRUE if grammar continues after the line, FALSE if the
- directive comes to an end. */
-
- int j, bytecode, mark; int32 wordcode;
- int grammar_token, slash_mode, last_was_slash;
- int reverse_action, TOKEN_SIZE;
- debug_location_beginning beginning_debug_location =
- get_token_location_beginning();
-
- get_next_token();
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { discard_token_location(beginning_debug_location);
- return FALSE;
- }
- if (!((token_type == SEP_TT) && (token_value == TIMES_SEP)))
- { discard_token_location(beginning_debug_location);
- ebf_error("'*' divider", token_text);
- panic_mode_error_recovery();
- return FALSE;
- }
-
- /* Have we run out of lines or token space? */
-
- if (line >= MAX_LINES_PER_VERB)
- { discard_token_location(beginning_debug_location);
- error("Too many lines of grammar for verb. This maximum is built \
-into Inform, so suggest rewriting grammar using general parsing routines");
- return(FALSE);
- }
-
- /* Internally, a line can be up to 3*32 + 1 + 2 = 99 bytes long */
- /* In Glulx, that's 5*32 + 4 = 164 bytes */
-
- mark = grammar_lines_top;
- if (!glulx_mode) {
- if (mark + 100 >= MAX_LINESPACE)
- { discard_token_location(beginning_debug_location);
- memoryerror("MAX_LINESPACE", MAX_LINESPACE);
- }
- }
- else {
- if (mark + 165 >= MAX_LINESPACE)
- { discard_token_location(beginning_debug_location);
- memoryerror("MAX_LINESPACE", MAX_LINESPACE);
- }
- }
-
- Inform_verbs[verbnum].l[line] = mark;
-
- if (!glulx_mode) {
- mark = mark + 2;
- TOKEN_SIZE = 3;
- }
- else {
- mark = mark + 3;
- TOKEN_SIZE = 5;
- }
-
- grammar_token = 0; last_was_slash = TRUE; slash_mode = FALSE;
- no_grammar_lines++;
-
- do
- { get_next_token();
- bytecode = 0; wordcode = 0;
- if ((token_type == SEP_TT) && (token_value == SEMICOLON_SEP))
- { discard_token_location(beginning_debug_location);
- ebf_error("'->' clause", token_text);
- return FALSE;
- }
- if ((token_type == SEP_TT) && (token_value == ARROW_SEP))
- { if (last_was_slash && (grammar_token>0))
- ebf_error("grammar token", token_text);
- break;
- }
-
- if (!last_was_slash) slash_mode = FALSE;
- if ((token_type == SEP_TT) && (token_value == DIVIDE_SEP))
- { 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);
- else
- { last_was_slash = TRUE;
- slash_mode = TRUE;
- if (((grammar_lines[mark-TOKEN_SIZE]) & 0x0f) != 2)
- error("'/' can only be applied to prepositions");
- grammar_lines[mark-TOKEN_SIZE] |= 0x20;
- continue;
- }
- }
- else last_was_slash = FALSE;
-
- if ((token_type == DQ_TT) || (token_type == SQ_TT))
- { if (grammar_version_number == 1)
- bytecode = make_adjective(token_text);
- else
- { bytecode = 0x42;
- wordcode = dictionary_add(token_text, 8, 0, 0);
- }
- }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==NOUN_DK))
- { get_next_token();
- if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
- {
- /* noun = <routine> */
-
- get_next_token();
- if ((token_type != SYMBOL_TT)
- || (stypes[token_value] != ROUTINE_T))
- { discard_token_location(beginning_debug_location);
- ebf_error("routine name after 'noun='", token_text);
- panic_mode_error_recovery();
- return FALSE;
- }
- if (grammar_version_number == 1)
- bytecode
- = 16 + make_parsing_routine(svals[token_value]);
- else
- { bytecode = 0x83;
- wordcode = svals[token_value];
- }
- sflags[token_value] |= USED_SFLAG;
- }
- else
- { put_token_back();
- if (grammar_version_number == 1) bytecode=0;
- else { bytecode = 1; wordcode = 0; }
- }
- }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==HELD_DK))
- { if (grammar_version_number==1) bytecode=1;
- else { bytecode=1; wordcode=1; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTI_DK))
- { if (grammar_version_number==1) bytecode=2;
- else { bytecode=1; wordcode=2; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTIHELD_DK))
- { if (grammar_version_number==1) bytecode=3;
- else { bytecode=1; wordcode=3; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTIEXCEPT_DK))
- { if (grammar_version_number==1) bytecode=4;
- else { bytecode=1; wordcode=4; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==MULTIINSIDE_DK))
- { if (grammar_version_number==1) bytecode=5;
- else { bytecode=1; wordcode=5; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==CREATURE_DK))
- { if (grammar_version_number==1) bytecode=6;
- else { bytecode=1; wordcode=6; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==SPECIAL_DK))
- { if (grammar_version_number==1) bytecode=7;
- else { bytecode=1; wordcode=7; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==NUMBER_DK))
- { if (grammar_version_number==1) bytecode=8;
- else { bytecode=1; wordcode=8; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==TOPIC_DK))
- { if (grammar_version_number==1)
- error("The 'topic' token is only available if you \
-are using Library 6/3 or later");
- else { bytecode=1; wordcode=9; } }
- else if ((token_type==DIR_KEYWORD_TT)&&(token_value==SCOPE_DK))
- {
- /* scope = <routine> */
-
- get_next_token();
- if (!((token_type==SEP_TT)&&(token_value==SETEQUALS_SEP)))
- { discard_token_location(beginning_debug_location);
- ebf_error("'=' after 'scope'", token_text);
- panic_mode_error_recovery();
- return FALSE;
- }
-
- get_next_token();
- if ((token_type != SYMBOL_TT)
- || (stypes[token_value] != ROUTINE_T))
- { discard_token_location(beginning_debug_location);
- ebf_error("routine name after 'scope='", token_text);
- panic_mode_error_recovery();
- return FALSE;
- }
-
- if (grammar_version_number == 1)
- bytecode = 80 +
- make_parsing_routine(svals[token_value]);
- else { bytecode = 0x85; wordcode = svals[token_value]; }
- sflags[token_value] |= USED_SFLAG;
- }
- else if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
- { discard_token_location(beginning_debug_location);
- error("'=' is only legal here as 'noun=Routine'");
- panic_mode_error_recovery();
- return FALSE;
- }
- else { /* <attribute> or <general-parsing-routine> tokens */
-
- if ((token_type != SYMBOL_TT)
- || ((stypes[token_value] != ATTRIBUTE_T)
- && (stypes[token_value] != ROUTINE_T)))
- { discard_token_location(beginning_debug_location);
- error_named("No such grammar token as", token_text);
- panic_mode_error_recovery();
- return FALSE;
- }
- if (stypes[token_value]==ATTRIBUTE_T)
- { if (grammar_version_number == 1)
- bytecode = 128 + svals[token_value];
- else { bytecode = 4; wordcode = svals[token_value]; }
- }
- else
- { if (grammar_version_number == 1)
- bytecode = 48 +
- make_parsing_routine(svals[token_value]);
- else { bytecode = 0x86; wordcode = svals[token_value]; }
- }
- sflags[token_value] |= USED_SFLAG;
- }
-
- grammar_token++; no_grammar_tokens++;
- if ((grammar_version_number == 1) && (grammar_token > 6))
- { if (grammar_token == 7)
- warning("Grammar line cut short: you can only have up to 6 \
-tokens in any line (unless you're compiling with library 6/3 or later)");
- }
- else
- { if (slash_mode)
- { if (bytecode != 0x42)
- error("'/' can only be applied to prepositions");
- bytecode |= 0x10;
- }
- grammar_lines[mark++] = bytecode;
- if (!glulx_mode) {
- grammar_lines[mark++] = wordcode/256;
- grammar_lines[mark++] = wordcode%256;
- }
- else {
- grammar_lines[mark++] = ((wordcode >> 24) & 0xFF);
- grammar_lines[mark++] = ((wordcode >> 16) & 0xFF);
- grammar_lines[mark++] = ((wordcode >> 8) & 0xFF);
- grammar_lines[mark++] = ((wordcode) & 0xFF);
- }
- }
-
- } while (TRUE);
-
- grammar_lines[mark++] = 15;
- grammar_lines_top = mark;
-
- dont_enter_into_symbol_table = TRUE;
- get_next_token();
- dont_enter_into_symbol_table = FALSE;
-
- if (token_type != DQ_TT)
- { discard_token_location(beginning_debug_location);
- ebf_error("name of new or existing action", token_text);
- panic_mode_error_recovery();
- return FALSE;
- }
-
- { assembly_operand AO = action_of_name(token_text);
- j = AO.value;
- if (j >= ((grammar_version_number==1)?256:4096))
- error_named("This is a fake action, not a real one:", token_text);
- }
-
- reverse_action = FALSE;
- get_next_token();
- if ((token_type == DIR_KEYWORD_TT) && (token_value == REVERSE_DK))
- { if (grammar_version_number == 1)
- error("'reverse' actions can only be used with \
-Library 6/3 or later");
- reverse_action = TRUE;
- }
- else put_token_back();
-
- mark = Inform_verbs[verbnum].l[line];
-
- if (debugfile_switch)
- { debug_file_printf("<table-entry>");
- debug_file_printf("<type>grammar line</type>");
- debug_file_printf("<address>");
- write_debug_grammar_backpatch(mark);
- debug_file_printf("</address>");
- debug_file_printf("<end-address>");
- write_debug_grammar_backpatch(grammar_lines_top);
- debug_file_printf("</end-address>");
- write_debug_locations
- (get_token_location_end(beginning_debug_location));
- debug_file_printf("</table-entry>");
- }
-
- if (!glulx_mode) {
- if (reverse_action)
- j = j + 0x400;
- grammar_lines[mark++] = j/256;
- grammar_lines[mark++] = j%256;
- }
- else {
- grammar_lines[mark++] = ((j >> 8) & 0xFF);
- grammar_lines[mark++] = ((j) & 0xFF);
- grammar_lines[mark++] = (reverse_action ? 1 : 0);
- }
-
- return TRUE;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The Verb directive: */
-/* */
-/* Verb [meta] "word-1" ... "word-n" | = "existing-English-verb" */
-/* | <grammar-line-1> ... <g-line-n> */
-/* */
-/* ------------------------------------------------------------------------- */
-
-extern void make_verb(void)
-{
- /* Parse an entire Verb ... directive. */
-
- int Inform_verb, meta_verb_flag=FALSE, verb_equals_form=FALSE;
-
- char *English_verbs_given[32]; int no_given = 0, i;
-
- directive_keywords.enabled = TRUE;
-
- get_next_token();
-
- if ((token_type == DIR_KEYWORD_TT) && (token_value == META_DK))
- { meta_verb_flag = TRUE;
- get_next_token();
- }
-
- while ((token_type == DQ_TT) || (token_type == SQ_TT))
- { English_verbs_given[no_given++] = token_text;
- get_next_token();
- }
-
- if (no_given == 0)
- { ebf_error("English verb in quotes", token_text);
- panic_mode_error_recovery(); return;
- }
-
- if ((token_type == SEP_TT) && (token_value == SETEQUALS_SEP))
- { verb_equals_form = TRUE;
- get_next_token();
- Inform_verb = get_verb();
- if (Inform_verb == -1) return;
- get_next_token();
- if (!((token_type == SEP_TT) && (token_value == SEMICOLON_SEP)))
- ebf_error("';' after English verb", token_text);
- }
- else
- { Inform_verb = no_Inform_verbs;
- if (no_Inform_verbs == MAX_VERBS)
- memoryerror("MAX_VERBS",MAX_VERBS);
- }
-
- for (i=0; i<no_given; i++)
- { dictionary_add(English_verbs_given[i],
- 0x41 + ((meta_verb_flag)?0x02:0x00),
- (glulx_mode)?(0xffff-Inform_verb):(0xff-Inform_verb), 0);
- register_verb(English_verbs_given[i], Inform_verb);
- }
-
- if (!verb_equals_form)
- { int lines = 0;
- put_token_back();
- while (grammar_line(no_Inform_verbs, lines++)) ;
- Inform_verbs[no_Inform_verbs++].lines = --lines;
- }
-
- directive_keywords.enabled = FALSE;
-}
-
-/* ------------------------------------------------------------------------- */
-/* The Extend directive: */
-/* */
-/* Extend | only "verb-1" ... "verb-n" | <grammar-lines> */
-/* | "verb" | "replace" */
-/* | "first" */
-/* | "last" */
-/* */
-/* ------------------------------------------------------------------------- */
-
-#define EXTEND_REPLACE 1
-#define EXTEND_FIRST 2
-#define EXTEND_LAST 3
-
-extern void extend_verb(void)
-{
- /* Parse an entire Extend ... directive. */
-
- int Inform_verb = -1, k, l, lines, extend_mode;
-
- directive_keywords.enabled = TRUE;
- directives.enabled = FALSE;
-
- get_next_token();
- if ((token_type == DIR_KEYWORD_TT) && (token_value == ONLY_DK))
- { l = -1;
- if (no_Inform_verbs == MAX_VERBS)
- memoryerror("MAX_VERBS", MAX_VERBS);
- while (get_next_token(),
- ((token_type == DQ_TT) || (token_type == SQ_TT)))
- { Inform_verb = get_verb();
- if (Inform_verb == -1) return;
- if ((l!=-1) && (Inform_verb!=l))
- warning_named("Verb disagrees with previous verbs:", token_text);
- l = Inform_verb;
- dictionary_set_verb_number(token_text,
- (glulx_mode)?(0xffff-no_Inform_verbs):(0xff-no_Inform_verbs));
- /* make call to renumber verb in English_verb_list too */
- if (find_or_renumber_verb(token_text, &no_Inform_verbs) == -1)
- warning_named("Verb to extend not found in English_verb_list:",
- token_text);
- }
-
- /* Copy the old Inform-verb into a new one which the list of
- English-verbs given have had their dictionary entries modified
- to point to */
-
- Inform_verbs[no_Inform_verbs] = Inform_verbs[Inform_verb];
- Inform_verb = no_Inform_verbs++;
- }
- else
- { Inform_verb = get_verb();
- if (Inform_verb == -1) return;
- get_next_token();
- }
-
- /* Inform_verb now contains the number of the Inform-verb to extend... */
-
- extend_mode = EXTEND_LAST;
- if ((token_type == SEP_TT) && (token_value == TIMES_SEP))
- put_token_back();
- else
- { extend_mode = 0;
- if ((token_type == DIR_KEYWORD_TT) && (token_value == REPLACE_DK))
- extend_mode = EXTEND_REPLACE;
- if ((token_type == DIR_KEYWORD_TT) && (token_value == FIRST_DK))
- extend_mode = EXTEND_FIRST;
- if ((token_type == DIR_KEYWORD_TT) && (token_value == LAST_DK))
- extend_mode = EXTEND_LAST;
-
- if (extend_mode==0)
- { ebf_error("'replace', 'last', 'first' or '*'", token_text);
- extend_mode = EXTEND_LAST;
- }
- }
-
- l = Inform_verbs[Inform_verb].lines;
- lines = 0;
- if (extend_mode == EXTEND_LAST) lines=l;
- do
- { if (extend_mode == EXTEND_FIRST)
- for (k=l; k>0; k--)
- Inform_verbs[Inform_verb].l[k+lines]
- = Inform_verbs[Inform_verb].l[k-1+lines];
- } while (grammar_line(Inform_verb, lines++));
-
- if (extend_mode == EXTEND_FIRST)
- { Inform_verbs[Inform_verb].lines = l+lines-1;
- for (k=0; k<l; k++)
- Inform_verbs[Inform_verb].l[k+lines-1]
- = Inform_verbs[Inform_verb].l[k+lines];
- }
- else Inform_verbs[Inform_verb].lines = --lines;
-
- directive_keywords.enabled = FALSE;
- directives.enabled = TRUE;
-}
-
-/* ========================================================================= */
-/* Data structure management routines */
-/* ------------------------------------------------------------------------- */
-
-extern void init_verbs_vars(void)
-{
- no_fake_actions = 0;
- no_actions = 0;
- no_grammar_lines = 0;
- no_grammar_tokens = 0;
- English_verb_list_size = 0;
-
- Inform_verbs = NULL;
- action_byte_offset = NULL;
- grammar_token_routine = NULL;
- adjectives = NULL;
- adjective_sort_code = NULL;
- English_verb_list = NULL;
-
- if (!glulx_mode)
- grammar_version_number = 1;
- else
- grammar_version_number = 2;
-}
-
-extern void verbs_begin_pass(void)
-{
- no_Inform_verbs=0; no_adjectives=0;
- no_grammar_token_routines=0;
- no_actions=0;
-
- no_fake_actions=0;
- grammar_lines_top = 0;
-}
-
-extern void verbs_allocate_arrays(void)
-{
- Inform_verbs = my_calloc(sizeof(verbt), MAX_VERBS, "verbs");
- grammar_lines = my_malloc(MAX_LINESPACE, "grammar lines");
- action_byte_offset = my_calloc(sizeof(int32), MAX_ACTIONS, "actions");
- action_symbol = my_calloc(sizeof(int32), MAX_ACTIONS,
- "action symbols");
- grammar_token_routine = my_calloc(sizeof(int32), MAX_ACTIONS,
- "grammar token routines");
- adjectives = my_calloc(sizeof(int32), MAX_ADJECTIVES,
- "adjectives");
- adjective_sort_code = my_calloc(DICT_WORD_BYTES, MAX_ADJECTIVES,
- "adjective sort codes");
-
- English_verb_list = my_malloc(MAX_VERBSPACE, "register of verbs");
- English_verb_list_top = English_verb_list;
-}
-
-extern void verbs_free_arrays(void)
-{
- my_free(&Inform_verbs, "verbs");
- my_free(&grammar_lines, "grammar lines");
- my_free(&action_byte_offset, "actions");
- my_free(&action_symbol, "action symbols");
- my_free(&grammar_token_routine, "grammar token routines");
- my_free(&adjectives, "adjectives");
- my_free(&adjective_sort_code, "adjective sort codes");
- my_free(&English_verb_list, "register of verbs");
-}
-
-/* ========================================================================= */
--- /dev/null
+# This file is part of Inform.
+#
+# Inform is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# theFree Software Foundation, either version 3 of the License, or
+#(at your option) any later version.
+#
+# Inform is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Inform. If not, see https://gnu.org/licenses/
+
+commit_count=$(git rev-list HEAD --count)
+echo "6.$commit_count"
\ No newline at end of file
projects / inform.git / commitdiff