Add Glulxe and Git. They compile but don't work yet.
authorfliep <fliep@ddfedd41-794f-dd11-ae45-00112f111e67>
Wed, 7 Oct 2009 17:43:16 +0000 (17:43 +0000)
committerfliep <fliep@ddfedd41-794f-dd11-ae45-00112f111e67>
Wed, 7 Oct 2009 17:43:16 +0000 (17:43 +0000)
56 files changed:
configure.ac
interpreters/Makefile.am
interpreters/git/.svnignore [new file with mode: 0644]
interpreters/git/Makefile.am [new file with mode: 0644]
interpreters/git/README.txt [new file with mode: 0644]
interpreters/git/accel.c [new file with mode: 0644]
interpreters/git/compiler.c [new file with mode: 0644]
interpreters/git/compiler.h [new file with mode: 0644]
interpreters/git/config.h [new file with mode: 0644]
interpreters/git/gestalt.c [new file with mode: 0644]
interpreters/git/git.c [new file with mode: 0644]
interpreters/git/git.h [new file with mode: 0644]
interpreters/git/git_unix.c [new file with mode: 0644]
interpreters/git/glkop.c [new file with mode: 0644]
interpreters/git/heap.c [new file with mode: 0644]
interpreters/git/labels.inc [new file with mode: 0644]
interpreters/git/memory.c [new file with mode: 0644]
interpreters/git/memory.h [new file with mode: 0644]
interpreters/git/opcodes.c [new file with mode: 0644]
interpreters/git/opcodes.h [new file with mode: 0644]
interpreters/git/operands.c [new file with mode: 0644]
interpreters/git/peephole.c [new file with mode: 0644]
interpreters/git/savefile.c [new file with mode: 0644]
interpreters/git/saveundo.c [new file with mode: 0644]
interpreters/git/search.c [new file with mode: 0644]
interpreters/git/terp.c [new file with mode: 0644]
interpreters/git/test/Alabaster.gblorb [new file with mode: 0644]
interpreters/git/test/Alabaster.golden [new file with mode: 0644]
interpreters/git/test/Alabaster.walk [new file with mode: 0644]
interpreters/git/test/test.sh [new file with mode: 0644]
interpreters/git/version.h [new file with mode: 0644]
interpreters/glulxe/Makefile.am [new file with mode: 0644]
interpreters/glulxe/README [new file with mode: 0644]
interpreters/glulxe/accel.c [new file with mode: 0644]
interpreters/glulxe/exec.c [new file with mode: 0644]
interpreters/glulxe/files.c [new file with mode: 0644]
interpreters/glulxe/funcs.c [new file with mode: 0644]
interpreters/glulxe/gestalt.c [new file with mode: 0644]
interpreters/glulxe/gestalt.h [new file with mode: 0644]
interpreters/glulxe/glkop.c [new file with mode: 0644]
interpreters/glulxe/glulxe.h [new file with mode: 0644]
interpreters/glulxe/heap.c [new file with mode: 0644]
interpreters/glulxe/main.c [new file with mode: 0644]
interpreters/glulxe/opcodes.h [new file with mode: 0644]
interpreters/glulxe/operand.c [new file with mode: 0644]
interpreters/glulxe/osdepend.c [new file with mode: 0644]
interpreters/glulxe/profile-analyze.py [new file with mode: 0644]
interpreters/glulxe/profile.c [new file with mode: 0644]
interpreters/glulxe/search.c [new file with mode: 0644]
interpreters/glulxe/serial.c [new file with mode: 0644]
interpreters/glulxe/string.c [new file with mode: 0644]
interpreters/glulxe/unixstrt.c [new file with mode: 0644]
interpreters/glulxe/vm.c [new file with mode: 0644]
libchimara/Makefile.am
tests/main.c
tests/photo201.blb [new file with mode: 0644]

index 3e39397a816e4847180819186250824e1633cae8..1c1d5e17a4f15a85a4532a85cbc17ad469f3c026 100644 (file)
@@ -100,6 +100,8 @@ libchimara/Makefile
 interpreters/Makefile
 interpreters/frotz/Makefile
 interpreters/nitfol/Makefile
+interpreters/glulxe/Makefile
+interpreters/git/Makefile
 tests/Makefile
 docs/Makefile
 docs/reference/Makefile
index e1407a3e5ece14c7a819d15296384805b0fb2dc7..2e8fc836e286976932fd6d65cfcf89d0f18859f5 100644 (file)
@@ -1 +1 @@
-SUBDIRS=nitfol frotz
+SUBDIRS=nitfol frotz glulxe git
diff --git a/interpreters/git/.svnignore b/interpreters/git/.svnignore
new file mode 100644 (file)
index 0000000..3045c51
--- /dev/null
@@ -0,0 +1,4 @@
+.deps
+.libs
+Makefile.in
+Makefile
diff --git a/interpreters/git/Makefile.am b/interpreters/git/Makefile.am
new file mode 100644 (file)
index 0000000..2257391
--- /dev/null
@@ -0,0 +1,46 @@
+PLUGIN_LIBTOOL_FLAGS=-module -avoid-version -export-symbols-regex "^glk"
+
+# Automatically generate version.h
+MAJOR = 1
+MINOR = 2
+PATCH = 4
+version.h: Makefile
+       echo "// Automatically generated file -- do not edit!" > version.h
+       echo "#define GIT_MAJOR" $(MAJOR) >> version.h
+       echo "#define GIT_MINOR" $(MINOR) >> version.h
+       echo "#define GIT_PATCH" $(PATCH) >> version.h
+
+pkglib_LTLIBRARIES = git.la
+BUILT_SOURCES = version.h
+git_la_SOURCES = version.h git.h config.h compiler.h memory.h opcodes.h \
+    labels.inc compiler.c gestalt.c git.c git_unix.c glkop.c heap.c memory.c \
+    opcodes.c operands.c peephole.c savefile.c saveundo.c search.c terp.c \
+    accel.c
+git_la_CPPFLAGS = -I$(top_srcdir) -I$(top_srcdir)/libchimara
+git_la_CFLAGS = -DUSE_MMAP -DUSE_INLINE $(AM_CFLAGS)
+git_la_LDFLAGS = $(PLUGIN_LIBTOOL_FLAGS)
+
+gitdocdir = $(datadir)/doc/$(PACKAGE)/git
+dist_gitdoc_DATA = README.txt
+
+CLEANFILES = test/*.tmp
+
+#TESTS = test/test.sh \
+#      test/Alabaster.gblorb test/Alabaster.walk test/Alabaster.golden
+#
+#test: git
+#      sh test/test.sh
+       
+# Best settings for GCC 2.95. This generates faster code than
+# GCC 3, so you should use this setup if possible.
+#CC = gcc -Wall -O3
+#OPTIONS = -DUSE_DIRECT_THREADING -DUSE_MMAP -DUSE_INLINE
+#
+# Best settings for GCC 3. The optimiser in this version of GCC
+# is somewhat broken, so we can't use USE_DIRECT_THREADING.
+#CC = gcc -Wall -O3
+#OPTIONS = -DUSE_MMAP -DUSE_INLINE
+#
+# Mac OS X (PowerPC) settings.
+#CC = gcc2 -Wall -O3 -no-cpp-precomp
+#OPTIONS = -DUSE_DIRECT_THREADING -DUSE_BIG_ENDIAN_UNALIGNED -DUSE_MMAP -DUSE_INLINE
\ No newline at end of file
diff --git a/interpreters/git/README.txt b/interpreters/git/README.txt
new file mode 100644 (file)
index 0000000..a297ace
--- /dev/null
@@ -0,0 +1,255 @@
+Git is an interpreter for the Glulx virtual machine. Its homepage is here:
+
+  http://diden.net/if/git
+
+Git's main goal in life is to be fast. It's about five times faster than Glulxe,
+and about twice as fast as Frotz (using the same Inform source compiled for the
+Z-machine). It also tries to be reasonably careful with memory: it's possible to
+trade speed off against memory by changing the sizes of Git's internal buffers.
+
+I wrote Git because I want people to be able to write huge games or try out
+complicated algorithms without worrying about how fast their games are going to
+run. I want to play City of Secrets on a Palm without having to wait ten seconds
+between each prompt.
+
+Have fun, and let me know what you think!
+
+  Iain Merrick
+  iain@diden.net
+
+--------------------------------------------------------------------------------
+
+* Building and installing Git
+
+This is just source code, not a usable application. You'll have to do a bit of
+work before you can start playing games with it. If you're not confident about
+compiling stuff yourself, you probably want to wait until somebody uploads a
+compiled version of Git for your own platform.
+
+Git needs to be linked with a Glk library in order to run. This can be easy or
+hard, depending on what kind of computer you're using and whether you want Git
+to be able to display graphics and play sounds. To find a suitable Glk library,
+look here:
+
+  http://eblong.com/zarf/glk
+
+Exactly how you build and link everything depends on what platform you're on and
+which Glk library you're using. The supplied Makefile should work on any Unix
+machine (including Macs with OS X), but you'll probably want to tweak it to
+account for your particular setup. If you're not using Unix, I'm afraid you'll
+have to play it by ear. If the Glk library you chose comes with instructions,
+that's probably a good place to start.
+
+On Unix, git_unix.c contains the startup code required by the Glk library.
+git_mac.c and git_windows.c contain startup code for MacGlk and WinGlk
+respectively, but I can't guarantee that they're fully up-to-date.
+
+It should be possible to build Git with any C compiler, but it works best with
+GCC, because that has a non-standard extension that Git can use for a big speed
+boost. GCC 2.95 actually generates faster code than GCC 3, so if you have a
+choice, use the former. (On OS X, this means compiling with 'gcc2'.)
+
+--------------------------------------------------------------------------------
+
+* Configuring Git
+
+There are several configuration options you can use when compiling Git. Have a
+look at config.h and see which ones look applicable to your platform. The
+Makefile includes settings to configure Git for maximum speed on Mac OS X; the
+best settings for other Unix platforms should be similar.
+
+The most important setting is USE_DIRECT_THREADING, which makes the interpreter
+engine use GCC's labels-as-values extension, but this only works with GCC 2.95.
+
+--------------------------------------------------------------------------------
+
+* Porting to a new platform
+
+To do a new port, you first need to find a suitable Glk library, or write a new
+one. Then you need to write the startup code. Start with a copy of git_unix.c,
+git_mac.c or git_windows.c and modify it appropriately.
+
+The startup code needs to implement the following functions:
+
+  void glk_main()                 // Standard Glk entrypoint
+  void fatalError(const char* s)  // Display error message and quit
+
+In glk_main(), you need to locate the game file somehow. Then you have two
+options. You can open the game as a Glk stream and pass it to this function:
+
+  extern void gitWithStream (strid_t stream,
+                             git_uint32 cacheSize,
+                             git_uint32 undoSize);
+
+Or you can load the game yourself, and just pass Git a pointer to your buffer:
+
+  extern void git (const git_uint8 * game,
+                   git_uint32 gameSize,
+                   git_uint32 cacheSize,
+                   git_uint32 undoSize);
+
+If the operating system provides some way of memory-mapping files (such as
+Unix's mmap() system call), you should do that and call git(), because it will
+allow the game to start up much more quickly. If you can't do memory-mapping,
+you should just open the game as a file stream and call gitWithStream(). Note
+that some Glk libraries, such as xglk, aren't compatible with memory-mapped
+files.
+
+"cacheSize" and "undoSize" tell Git what size to use for its two main internal
+buffers. Both sizes are in bytes. You may want to make these values
+user-configurable, or you may just want to pick values that make sense for your
+platform and use those. (My Unix version currently uses fixed values, but I'm
+going to add some optional command-line parameters to override these defaults.)
+
+"cacheSize" is the size of the buffer used to store Glulx code that Git has
+recompiled into its internal format. Git will run faster with a larger buffer,
+but using a huge buffer is just a waste of memory; 256KB is plenty.
+
+"undoSize" is the maximum amount of memory used to remember previous moves. The
+larger you make it, the more levels of undo will be available. The amount of
+memory required to remember one undo position varies from a few KB up to tens of
+KB. 256KB is usually enough to store dozens of moves.
+
+--------------------------------------------------------------------------------
+
+* Known problems
+
+GCC 3 has bigger problems than I thought. On PowerPC, the direct threading
+option results in much slower code; and on x86, terp.c crashes GCC itself if
+direct threading is used. Therefore, I recommend that you use GCC 2.95 if
+possible. If you only have GCC 3, don't define USE_DIRECT_THREADING, at least
+until the compiler bug is fixed.
+
+Since the previous update, GCC 4 has been released, but I haven't evaluated it
+yet. If you want to give it a try, let me know how you get on!
+
+Some Glk libraries, such as xglk, can't deal with memory-mapped files. You can
+tell that this is happening if Git can open .ulx files, but complains that .blb
+files are invalid. The solution is to use gitWithStream() rather than git() in
+your startup file, and make sure you're giving it a file stream rather than a
+memory stream. If you're using the git_unix.c startup file, just make sure
+USE_MMAP isn't defined.
+
+1-byte and 2-byte local variables are not implemented yet. This means git can't
+currently play games created with the Superglus system. This will be fixed at
+some point.
+
+In the search opcodes, direct keys don't work unless they're exactly 4 bytes
+long.
+
+--------------------------------------------------------------------------------
+
+* Copyright information
+
+Note: previous versions of Git used an informal freeware license, but I've
+decided it's worth formalising. As of version 1.2.3, I've switched to the
+MIT license.
+
+Copyright (c) 2003 Iain Merrick
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+the Software, and to permit persons to whom the Software is furnished to do so,
+subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+--------------------------------------------------------------------------------
+
+* Credits
+
+Andrew Plotkin invented Glulx, so obviously Git wouldn't exist without him. I
+also reused some code from his Glulxe interpreter (glkop.c and search.c), which
+saved me a lot of time and let me concentrate on the more interesting stuff.
+
+Many thanks are due to John Cater, who not only persuaded me to use source
+control, but let me use his own CVS server. John also provided lots of useful
+advice and encouragement, as did Sean Barrett.
+
+Thanks also to Joe Mason, Adam Thornton, Simon Baldwin and Joonas Pihlaja who
+were among the first to try it out and complain that it wasn't working. Joonas
+also gets special brownie points for trying out more bizarre boundary cases than
+I realised existed in the first place.
+
+Tor Andersson was apparently the first person to use setmemsize, since he also
+explained why it didn't work and contributed a fix. Thanks, Tor!
+
+David Kinder has done a stellar job of maintaining the code recently. Thanks
+also to Eliuk Blau for tracking down bugs in the memory management opcodes.
+
+--------------------------------------------------------------------------------
+
+* Version History
+
+1.2.4 2009-04-02  More David Kinder! Accelerated opcode support (VM spec 3.1.1).
+
+1.2.3 2009-02-22  David Kinder and Eliuk Blau fixed some memory management bugs.
+                  Added a regression test (thanks to Emily Short for assistance)
+                  Switched to MIT-style license (see above).
+
+1.2.2 2009-01-21  malloc & mfree contributed by the most excellent David Kinder.
+
+1.2.1 2008-09-14  Support for 64-bit machines, contributed by Alexander Beels.
+                  Fix for crashing bug in RESTORE, contributed by David Kinder.
+                  Non-Unicode display bug fix, contributed by Jeremy Bernstein.
+
+1.2   2008-01-06  Minor version increment for VM spec 3.1.
+                  Implemented mzero and mcopy, but not malloc and mfree (yet).
+
+1.1.3 2006-10-04  Fixed a bug in the cache logic that broke the game Floatpoint.
+                  Added some other caching tweaks and put in a few more asserts.
+
+1.1.2 2006-08-22  streamnum in filter I/O mode no longer prints a garbage char.
+                  Merged in David Kinder's updated Windows startup code.
+                  
+1.1.1 2006-08-17  Wow, over a year since the last update.
+                  Rolled in Tor Andersson's fix for setmemsize.
+
+1.1   2004-12-22  Minor version increment because we now implement VM spec 3.0.
+                  Implemented new Unicode opcodes and string types.
+
+1.0.6 2004-12-10  Random number generator now handles random(0) correctly.
+                  Code cache now tracks the number of function calls properly.
+                  Fixed a bug that could hang the terp when the cache filled up.
+
+1.0.5 2004-05-31  Random number generator is now initialised properly.
+                  Some source files had Mac line-endings, now fixed.
+                  Version number is now set in the Makefile, not in git.h.
+                  Merged David Kinder's Windows Git code into main distribution.
+
+1.0.4 2004-03-13  Fixed a silly bug in direct threading mode that broke stkroll.
+                  Memory access bounds checking has been tightened up slightly.
+                  aload and astore now work correctly with negative offsets.
+                  Rewrote the shift opcodes a bit more defensively.
+                  Implemented the "verify" opcode.
+                  Code in RAM is no longer cached by default.
+                  Adding some special opcodes to control the code cache.
+                  Bad instructions are now caught in the terp, not the compiler.
+                  Now passes all of Joonas' indirect string decoding tests.
+                  
+1.0.3 2004-01-22  No longer hangs when using streamnum in the "filter" I/O mode.
+                  setstringtbl opcode now works correctly.
+
+1.0.2 2003-10-25  Stupid bug in 1.0.1 -- gitWithStream() was broken and wasn't
+                  able to load Blorb files. Now it's *really* fixed.
+
+1.0.1 2003-10-23  Fixed a bug where strings were printed as "[string]"
+                  Fixed a bug in tailcall
+                  Implemented setmemsize
+                  Implemented protect
+                  Moved git_init_dispatch() call out of startup code, into git.c
+                  Added divide-by-zero check
+                  Compiler now stops when it finds a 'quit' or 'restart'
+                  Added gitWithStream() as a workaround for xglk
+
+1.0   2003-10-18  First public release
diff --git a/interpreters/git/accel.c b/interpreters/git/accel.c
new file mode 100644 (file)
index 0000000..2a1fe52
--- /dev/null
@@ -0,0 +1,404 @@
+/* accel.c: Glulxe code for accelerated functions
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "git.h"
+
+#define ARGS_REVERSED
+#define glulx_malloc malloc
+
+/* Git passes along function arguments in reverse order. To make our lives
+   more interesting. */
+#ifdef ARGS_REVERSED
+#define ARG(argv, argc, ix) (argv[(argc-1)-ix])
+#else
+#define ARG(argv, argc, ix) (argv[ix])
+#endif
+
+/* Any function can be called with any number of arguments. This macro
+   lets us snarf a given argument, or zero if it wasn't supplied. */
+#define ARG_IF_GIVEN(argv, argc, ix)  ((argc > ix) ? (ARG(argv, argc, ix)) : 0)
+
+static void accel_error(char *msg);
+static glui32 func_1_z__region(glui32 argc, glui32 *argv);
+static glui32 func_2_cp__tab(glui32 argc, glui32 *argv);
+static glui32 func_3_ra__pr(glui32 argc, glui32 *argv);
+static glui32 func_4_rl__pr(glui32 argc, glui32 *argv);
+static glui32 func_5_oc__cl(glui32 argc, glui32 *argv);
+static glui32 func_6_rv__pr(glui32 argc, glui32 *argv);
+static glui32 func_7_op__pr(glui32 argc, glui32 *argv);
+
+static int obj_in_class(glui32 obj);
+static glui32 get_prop(glui32 obj, glui32 id);
+
+/* Parameters, set by @accelparam. */
+static glui32 classes_table = 0;     /* class object array */
+static glui32 indiv_prop_start = 0;  /* first individual prop ID */
+static glui32 class_metaclass = 0;   /* "Class" class object */
+static glui32 object_metaclass = 0;  /* "Object" class object */
+static glui32 routine_metaclass = 0; /* "Routine" class object */
+static glui32 string_metaclass = 0;  /* "String" class object */
+static glui32 self = 0;              /* address of global "self" */
+static glui32 num_attr_bytes = 0;    /* number of attributes / 8 */
+static glui32 cpv__start = 0;        /* array of common prop defaults */
+
+typedef struct accelentry_struct {
+    glui32 addr;
+    acceleration_func func;
+    struct accelentry_struct *next;
+} accelentry_t;
+
+#define ACCEL_HASH_SIZE (511)
+
+static accelentry_t **accelentries = NULL;
+
+void init_accel()
+{
+    accelentries = NULL;
+}
+
+acceleration_func accel_find_func(glui32 index)
+{
+    switch (index) {
+        case 0: return NULL; /* 0 always means no acceleration */
+        case 1: return func_1_z__region;
+        case 2: return func_2_cp__tab;
+        case 3: return func_3_ra__pr;
+        case 4: return func_4_rl__pr;
+        case 5: return func_5_oc__cl;
+        case 6: return func_6_rv__pr;
+        case 7: return func_7_op__pr;
+    }
+    return NULL;
+}
+
+acceleration_func accel_get_func(glui32 addr)
+{
+    int bucknum;
+    accelentry_t *ptr;
+
+    if (!accelentries)
+        return NULL;
+
+    bucknum = (addr % ACCEL_HASH_SIZE);
+    for (ptr = accelentries[bucknum]; ptr; ptr = ptr->next) {
+        if (ptr->addr == addr)
+            return ptr->func;
+    }
+    return NULL;
+}
+
+void accel_set_func(glui32 index, glui32 addr)
+{
+    int bucknum;
+    accelentry_t *ptr;
+    int functype;
+    acceleration_func new_func = NULL;
+
+    /* Check the Glulx type identifier byte. */
+    functype = memRead8(addr);
+    if (functype != 0xC0 && functype != 0xC1) {
+        fatalError("Attempt to accelerate non-function.");
+    }
+
+    if (!accelentries) {
+        accelentries = (accelentry_t **)glulx_malloc(ACCEL_HASH_SIZE 
+            * sizeof(accelentry_t *));
+        if (!accelentries) 
+            fatalError("Cannot malloc acceleration table.");
+        for (bucknum=0; bucknum<ACCEL_HASH_SIZE; bucknum++)
+            accelentries[bucknum] = NULL;
+    }
+
+    new_func = accel_find_func(index);
+
+    bucknum = (addr % ACCEL_HASH_SIZE);
+    for (ptr = accelentries[bucknum]; ptr; ptr = ptr->next) {
+        if (ptr->addr == addr)
+            break;
+    }
+    if (!ptr) {
+        if (!new_func) {
+            return; /* no need for a new entry */
+        }
+        ptr = (accelentry_t *)glulx_malloc(sizeof(accelentry_t));
+        if (!ptr)
+            fatalError("Cannot malloc acceleration entry.");
+        ptr->addr = addr;
+        ptr->func = NULL;
+        ptr->next = accelentries[bucknum];
+        accelentries[bucknum] = ptr;
+    }
+
+    ptr->func = new_func;
+}
+
+void accel_set_param(glui32 index, glui32 val)
+{
+    switch (index) {
+        case 0: classes_table = val; break;
+        case 1: indiv_prop_start = val; break;
+        case 2: class_metaclass = val; break;
+        case 3: object_metaclass = val; break;
+        case 4: routine_metaclass = val; break;
+        case 5: string_metaclass = val; break;
+        case 6: self = val; break;
+        case 7: num_attr_bytes = val; break;
+        case 8: cpv__start = val; break;
+    }
+}
+
+static void accel_error(char *msg)
+{
+    glk_put_char('\n');
+    glk_put_string(msg);
+    glk_put_char('\n');
+}
+
+static int obj_in_class(glui32 obj)
+{
+    /* This checks whether obj is contained in Class, not whether
+       it is a member of Class. */
+    return (memRead32(obj + 13 + num_attr_bytes) == class_metaclass);
+}
+
+static glui32 get_prop(glui32 obj, glui32 id)
+{
+    glui32 cla = 0;
+    glui32 prop;
+    glui32 call_argv[2];
+
+    if (id & 0xFFFF0000) {
+        cla = memRead32(classes_table+((id & 0xFFFF) * 4));
+        ARG(call_argv, 2, 0) = obj;
+        ARG(call_argv, 2, 1) = cla;
+        if (func_5_oc__cl(2, call_argv) == 0)
+            return 0;
+
+        id >>= 16;
+        obj = cla;
+    }
+
+    ARG(call_argv, 2, 0) = obj;
+    ARG(call_argv, 2, 1) = id;
+    prop = func_2_cp__tab(2, call_argv);
+    if (prop == 0)
+        return 0;
+
+    if (obj_in_class(obj) && (cla == 0)) {
+        if ((id < indiv_prop_start) || (id >= indiv_prop_start+8))
+            return 0;
+    }
+
+    if (memRead32(self) != obj) {
+        if (memRead8(prop + 9) & 1)
+            return 0;
+    }
+    return prop;
+}
+
+static glui32 func_1_z__region(glui32 argc, glui32 *argv)
+{
+    glui32 addr;
+    glui32 tb;
+
+    if (argc < 1)
+        return 0;
+
+    addr = ARG(argv, argc, 0);
+    if (addr < 36)
+        return 0;
+    if (addr >= gEndMem)
+        return 0;
+
+    tb = memRead8(addr);
+    if (tb >= 0xE0) {
+        return 3;
+    }
+    if (tb >= 0xC0) {
+        return 2;
+    }
+    if (tb >= 0x70 && tb <= 0x7F && addr >= gRamStart) {
+        return 1;
+    }
+    return 0;
+}
+
+static glui32 func_2_cp__tab(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 otab, max;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    if (func_1_z__region(1, &obj) != 1) {
+        accel_error("[** Programming error: tried to find the \".\" of (something) **]");
+        return 0;
+    }
+
+    otab = memRead32(obj + 16);
+    if (!otab)
+        return 0;
+
+    max = memRead32(otab);
+    otab += 4;
+    /* @binarysearch id 2 otab 10 max 0 0 res; */
+    return git_binary_search(id, 2, otab, 10, max, 0, 0);
+}
+
+static glui32 func_3_ra__pr(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 prop;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    prop = get_prop(obj, id);
+    if (prop == 0)
+        return 0;
+
+    return memRead32(prop + 4);
+}
+
+static glui32 func_4_rl__pr(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 prop;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    prop = get_prop(obj, id);
+    if (prop == 0)
+        return 0;
+
+    return 4 * memRead16(prop + 2);
+}
+
+static glui32 func_5_oc__cl(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 cla;
+    glui32 zr, prop, inlist, inlistlen, jx;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    cla = ARG_IF_GIVEN(argv, argc, 1);
+
+    zr = func_1_z__region(1, &obj);
+    if (zr == 3)
+        return (cla == string_metaclass) ? 1 : 0;
+    if (zr == 2)
+        return (cla == routine_metaclass) ? 1 : 0;
+    if (zr != 1)
+        return 0;
+
+    if (cla == class_metaclass) {
+        if (obj_in_class(obj))
+            return 1;
+        if (obj == class_metaclass)
+            return 1;
+        if (obj == string_metaclass)
+            return 1;
+        if (obj == routine_metaclass)
+            return 1;
+        if (obj == object_metaclass)
+            return 1;
+        return 0;
+    }
+    if (cla == object_metaclass) {
+        if (obj_in_class(obj))
+            return 0;
+        if (obj == class_metaclass)
+            return 0;
+        if (obj == string_metaclass)
+            return 0;
+        if (obj == routine_metaclass)
+            return 0;
+        if (obj == object_metaclass)
+            return 0;
+        return 1;
+    }
+    if ((cla == string_metaclass) || (cla == routine_metaclass))
+        return 0;
+
+    if (!obj_in_class(cla)) {
+        accel_error("[** Programming error: tried to apply 'ofclass' with non-class **]");
+        return 0;
+    }
+
+    prop = get_prop(obj, 2);
+    if (prop == 0)
+       return 0;
+
+    inlist = memRead32(prop + 4);
+    if (inlist == 0)
+       return 0;
+
+    inlistlen = memRead16(prop + 2);
+    for (jx = 0; jx < inlistlen; jx++) {
+        if (memRead32(inlist + (4 * jx)) == cla)
+            return 1;
+    }
+    return 0;
+}
+
+static glui32 func_6_rv__pr(glui32 argc, glui32 *argv)
+{
+    glui32 id;
+    glui32 addr;
+
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    addr = func_3_ra__pr(argc, argv);
+
+    if (addr == 0) {
+        if ((id > 0) && (id < indiv_prop_start))
+            return memRead32(cpv__start + (4 * id));
+
+        accel_error("[** Programming error: tried to read (something) **]");
+        return 0;
+    }
+
+    return memRead32(addr);
+}
+
+static glui32 func_7_op__pr(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 zr;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    zr = func_1_z__region(1, &obj);
+    if (zr == 3) {
+        /* print is INDIV_PROP_START+6 */
+        if (id == indiv_prop_start+6)
+            return 1;
+        /* print_to_array is INDIV_PROP_START+7 */
+        if (id == indiv_prop_start+7)
+            return 1;
+        return 0;
+    }
+    if (zr == 2) {
+        /* call is INDIV_PROP_START+5 */
+        return ((id == indiv_prop_start+5) ? 1 : 0);
+    }
+    if (zr != 1)
+        return 0;
+
+    if ((id >= indiv_prop_start) && (id < indiv_prop_start+8)) {
+        if (obj_in_class(obj))
+            return 1;
+    }
+
+    return ((func_3_ra__pr(argc, argv)) ? 1 : 0);
+}
diff --git a/interpreters/git/compiler.c b/interpreters/git/compiler.c
new file mode 100644 (file)
index 0000000..6faa94c
--- /dev/null
@@ -0,0 +1,579 @@
+// $Id: compiler.c,v 1.27 2004/12/10 00:37:00 iain Exp $
+
+#include "git.h"
+#include <assert.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <string.h>
+
+// -------------------------------------------------------------
+// Constants
+
+enum
+{
+    LONGJMP_NO_ERROR = 0,
+    LONGJMP_CACHE_FULL = 1,
+    LONGJMP_BAD_OPCODE = 2
+};
+
+// -------------------------------------------------------------
+// Globals
+
+int gPeephole = 1;
+int gDebug = 0;
+int gCacheRAM = 0;
+
+BlockHeader * gBlockHeader;
+
+const char * gLabelNames [] = {
+#define LABEL(label) #label,
+#include "labels.inc"
+    NULL
+};
+
+HashNode ** gHashTable; // Hash table of glulx address -> code.
+git_uint32 gHashSize;   // Number of slots in the hash table.
+
+// -------------------------------------------------------------
+// Types.
+
+typedef struct PatchNode
+{
+    git_uint32 address;       // The glulx address of this instruction.
+    git_sint16 codeOffset;    // Offset from the block header to the compiled code for this instruction.
+    git_sint16 branchOffset;  // If non-zero, offset to a branch opcode followed by a glulx address.
+    union {
+        int isReferenced;     // Set to TRUE if this can be the destination of a jump.
+        HashNode* pad;        // This pad assures that PatchNode and HashNode are the same size.
+    } u;
+}
+PatchNode;
+
+// -------------------------------------------------------------
+// Static variables.
+
+static git_uint32 * sBuffer;   // The buffer where everything is stored.
+static git_uint32 sBufferSize; // Size of the buffer, in 4-byte words.
+
+static Block       sCodeStart; // Start of code cache.
+static Block       sCodeTop;   // Next free space in code cache.
+static PatchNode*  sTempStart; // Start of temporary storage.
+static PatchNode*  sTempEnd;   // End of temporary storage.
+
+static jmp_buf sJumpBuf; // setjmp buffer, used to abort compilation when the buffer is full.
+
+// This is the patch node for the opcode currently being compiled.
+// The 'address' and 'code' fields will be filled in. The other
+// fields can be updated during compilation as necessary.
+static PatchNode * sPatch;
+
+static int sNextInstructionIsReferenced;
+static git_uint32 sLastAddr;
+
+// -------------------------------------------------------------
+// Functions
+
+void initCompiler (size_t size)
+{
+    static BlockHeader dummyHeader;
+    gBlockHeader = &dummyHeader;
+
+    // Make sure various assumptions we're making are correct.
+
+    assert (sizeof(HashNode) <= sizeof(PatchNode));
+
+    // Allocate the buffer. As far as possible, we're going to 
+    // use this buffer for everything compiler-related, and
+    // avoid further dynamic allocation.
+
+    sBuffer = malloc (size);
+    if (sBuffer == NULL)
+        fatalError ("Couldn't allocate code cache");
+    
+    memset (sBuffer, 0, size);
+    sBufferSize = size / 4;
+
+    // Pick a reasonable size for the hash table. This should be
+    // a power of two, and take up about a tenth of the buffer.
+    // (If the buffer is itself a power of two in size, the hash
+    // table will take up a sixteenth of it, which is fine.)
+
+    gHashSize = 1;
+    while (gHashSize < (sBufferSize / 20))
+        gHashSize *= 2;
+
+    // The hash table is stored at the beginning of the buffer,
+    // and the rest is used for code and temporary storage.
+
+    gHashTable = (HashNode**) sBuffer;
+
+    sCodeStart = sCodeTop = (Block) (gHashTable + gHashSize);
+    sTempStart = sTempEnd = (PatchNode*) (sBuffer + sBufferSize);
+}
+
+void shutdownCompiler ()
+{
+    free (sBuffer);
+
+    sBuffer = NULL;
+    sCodeStart = sCodeTop = NULL;
+    sTempStart = sTempEnd = NULL;
+    
+    gHashTable = NULL;
+    gBlockHeader = NULL;
+}
+
+static void abortIfBufferFull ()
+{
+    // Make sure we have at least two words free,
+    // because we'll need them to store a jumpabs
+    // instruction at the very end of the buffer.
+
+    if ((void*) (sCodeTop + 2) >= (void*) sTempStart)
+        longjmp (sJumpBuf, LONGJMP_CACHE_FULL);
+}
+
+void abortCompilation ()
+{
+    longjmp (sJumpBuf, LONGJMP_BAD_OPCODE);
+}
+
+void nextInstructionIsReferenced ()
+{
+    sNextInstructionIsReferenced = 1;
+}
+
+Block compile (git_uint32 pc)
+{
+    git_uint32 endOfBlock;
+    int i, numNodes;
+
+    // Make sure we have enough room for, at a minimum:
+    // - the block header
+    // - one patch node
+    // - one jumpabs instruction (two words).
+
+    int spaceNeeded = (sizeof(BlockHeader) + sizeof(PatchNode) + 8) / 4;
+    if ((void*) (sCodeTop + spaceNeeded) >= (void*) sTempStart)
+    {
+        compressCodeCache();
+    }
+
+    // Emit the header for this block.
+
+    gBlockHeader = (BlockHeader*) sCodeTop;
+    sCodeTop = (git_uint32*) (gBlockHeader + 1);
+
+    sLastAddr = 0;
+    sNextInstructionIsReferenced = 1;
+    resetPeepholeOptimiser();
+
+    sPatch = NULL;
+
+    i = setjmp (sJumpBuf);    
+    if (i == LONGJMP_NO_ERROR)
+    {
+        git_uint32 patchSize = 0;
+        git_uint32 codeSize = 0;
+
+        int done = 0;
+
+        while (!done)
+        {
+               // If we don't have room for more code, abort.
+                       if ((void*) (sCodeTop + 2) >= (void*) (sTempStart - 1))
+                       {
+                               longjmp (sJumpBuf, LONGJMP_CACHE_FULL);
+                       }
+               
+            // Create a temporary patch node for this instruction.
+            --sTempStart;
+            sPatch = sTempStart;
+            sPatch->address = pc;
+            sPatch->codeOffset = sCodeTop - (git_uint32*)gBlockHeader;
+            sPatch->branchOffset = 0;
+            sPatch->u.isReferenced = sNextInstructionIsReferenced;
+
+            sNextInstructionIsReferenced = 0;
+
+            // Make sure we haven't generated over 32K of code.
+
+            patchSize += sizeof(PatchNode) / 4;
+            codeSize = sCodeTop - (git_uint32*)gBlockHeader;
+
+            if (codeSize + patchSize > 32000)
+            {
+                // We've generated almost 32K words of code, which will
+                // start to cause problems for the 16-bit offsets we use
+                // in the hash nodes, so let's just stop here.
+                longjmp (sJumpBuf, LONGJMP_CACHE_FULL);
+            }
+
+            // Parse the next instruction.
+
+            parseInstruction (&pc, &done);
+
+            if (pc < sLastAddr)
+                done = 0;
+        }
+    }
+    else    
+    {
+        // Compilation was aborted, but we should have a
+        // patch node and at least two words of space free.
+        
+        assert (sPatch != NULL);
+        sPatch->branchOffset = 0; // Make sure the patch isn't treated as a branch.
+        
+        sCodeTop = ((git_uint32*)gBlockHeader) + sPatch->codeOffset;
+
+        if (i == LONGJMP_CACHE_FULL)
+        {
+            // The buffer is full. We'll replace the partially-compiled
+            // instruction with a jumpabs, forcing another cache lookup
+            // when the terp hits this point in the code.
+    
+            *sCodeTop++ = (git_uint32) labelToOpcode (label_recompile);
+            *sCodeTop++ = sPatch->address;
+                       
+            // Make sure this node doesn't get put into the hash table.
+            sPatch->u.isReferenced = 0;
+        }
+        else if (i == LONGJMP_BAD_OPCODE)
+        {
+            // We found a badly-formed instruction. We'll replace the
+            // partially-compiled instruction with a label that raises
+            // an error if the terp hits this code location.
+            
+            *sCodeTop++ = (git_uint32) labelToOpcode (label_error_bad_opcode);
+            *sCodeTop++ = sPatch->address;
+        }
+        else
+        {
+            fatalError ("unknown error in compile (BUG)");
+        }
+    }
+    
+    assert ((void*) sCodeTop <= (void*) sTempStart);
+
+    // We now know where the block ends.
+    
+    endOfBlock = pc;
+
+    // Fix up the constant branches.
+
+    numNodes = sTempEnd - sTempStart;
+    for (i = 0 ; i < numNodes ; ++i)
+    {
+        git_uint32* constBranch;
+            
+        git_uint32 dest;
+        git_uint32 lower = 0;
+        git_uint32 upper = numNodes;
+        
+        PatchNode * p = sTempStart + i;
+        if (p->branchOffset == 0)
+            continue;
+       
+        constBranch = ((git_uint32*)gBlockHeader) + p->branchOffset;
+        dest = constBranch [1];
+        while (upper > lower)
+        {
+            git_uint32 guess = (lower + upper) / 2;
+            PatchNode * p2 = sTempStart + guess;
+            if (p2->address == dest)
+            {
+                git_uint32 * op = constBranch;
+                git_uint32 * by = constBranch + 1;
+
+                // Change the 'const' branch to a 'by' branch.
+                *op = *op - label_jump_const + label_jump_by;
+
+                // Turn the address into a relative offset.
+                *by = ((git_uint32*)gBlockHeader + p2->codeOffset) - (constBranch + 2);
+
+                // And we're done.
+                break;
+            }
+            else if (p2->address > dest)
+                lower = guess + 1;
+            else
+                upper = guess;
+        }
+
+        // Whether we found the branch destination or not,
+        // turn the label into a real opcode.
+        *constBranch = (git_uint32) labelToOpcode (*constBranch);
+    }
+
+    // Convert all the referenced addresses into hash table nodes,
+    // as long as they're not in RAM.
+
+    numNodes = 0;
+    for ( ; sTempStart < sTempEnd ; ++sTempStart)
+    {
+        // 'pc' holds the address of *end* of the instruction,
+        // so we'll use that to determine whether it overlaps
+        // the start of RAM.
+        
+        int isInRAM = (pc > gRamStart);
+        
+        // Set the PC to the start of the instruction, since
+        // that's equal to the end of the previous instruction.
+        
+        pc = sTempStart->address;
+        
+        if (isInRAM && !gCacheRAM)
+            continue;
+
+        // If we're not skipping this instruction, and it's
+        // referenced somewhere, attach it to the hash table.
+                
+        if (sTempStart->u.isReferenced)
+        {
+            HashNode * node = (HashNode*) sCodeTop;
+            sCodeTop = (git_uint32*) (node + 1);
+
+            node->address = sTempStart->address;
+            node->headerOffset = (git_uint32*)gBlockHeader - (git_uint32*)node;
+            node->codeOffset = node->headerOffset + sTempStart->codeOffset;
+
+            node->u.next = gHashTable [node->address & (gHashSize-1)];
+            gHashTable [node->address & (gHashSize-1)] = node;
+
+            ++numNodes;
+        }
+    }
+
+    // Write the block header.
+
+    assert (sCodeTop - (git_uint32*) gBlockHeader < 32767);
+
+    gBlockHeader->numHashNodes = numNodes;
+    gBlockHeader->compiledSize = sCodeTop - (git_uint32*) gBlockHeader;
+    gBlockHeader->glulxSize = endOfBlock - pc;
+    gBlockHeader->runCounter = 0;
+    
+    assert(gBlockHeader->compiledSize > 0);
+
+    // And we're done.
+    return (git_uint32*) (gBlockHeader + 1);
+}
+
+#define END_OF_BLOCK(header) ((void*) (((git_uint32*)header) + header->compiledSize))
+
+static git_uint32 findCutoffPoint ()
+{
+    BlockHeader * start = (BlockHeader*) sCodeStart;
+    BlockHeader * top = (BlockHeader*) sCodeTop;
+    BlockHeader * h;
+
+    git_uint32 blockCount = 0;
+    git_uint32 runCount = 0;
+
+    for (h = start ; h < top ; h = END_OF_BLOCK(h))
+    {
+        if (h->glulxSize > 0)
+        {
+            ++blockCount;
+        }
+    }
+
+    for (h = start ; h < top ; h = END_OF_BLOCK(h))
+    {
+        if (h->glulxSize > 0)
+        {
+            runCount += (h->runCounter + blockCount + 1) / blockCount;
+        }
+    }
+
+    return runCount / 2;
+}
+
+static void compressWithCutoff (git_uint32 cutoff)
+{
+    BlockHeader * start = (BlockHeader*) sCodeStart;
+    BlockHeader * top = (BlockHeader*) sCodeTop;
+    BlockHeader * h = start;
+
+    git_uint32 saveCount = 0;
+    git_uint32 deleteCount = 0;
+
+    sCodeTop = sCodeStart;
+
+    while (h < top)
+    {
+        BlockHeader * next = END_OF_BLOCK(h);
+        if (h->runCounter >= cutoff && h->glulxSize > 0)
+        {
+               git_uint32 size = h->compiledSize;
+               
+            // Lower the run count of the saved blocks so that they'll
+            // stick around in the short term, but eventually fall out
+            // of the cache if they're not used much in the future.
+            h->runCounter /= 2;
+            memmove (sCodeTop, h, size * sizeof(git_uint32));
+            sCodeTop += size;
+            ++saveCount;
+        }
+        else
+        {
+            ++deleteCount;
+        }
+        h = next;
+    }
+}
+
+static void rebuildHashTable ()
+{
+    BlockHeader * start = (BlockHeader*) sCodeStart;
+    BlockHeader * top = (BlockHeader*) sCodeTop;
+    BlockHeader * h;
+
+    memset (gHashTable, 0, gHashSize * sizeof(HashNode*));
+
+    for (h = start ; h < top ; h = END_OF_BLOCK(h))
+    {
+        if (h->glulxSize > 0)
+        {
+            HashNode * node = END_OF_BLOCK(h);
+            git_uint32 i;
+            for (i = 0 ; i < h->numHashNodes ; ++i) 
+            {
+                --node;
+                node->u.next = gHashTable [node->address & (gHashSize-1)];
+                gHashTable [node->address & (gHashSize-1)] = node;
+            }    
+        }
+    }
+}
+
+static void removeHashNode (HashNode* deadNode)
+{
+    HashNode* n = gHashTable [deadNode->address & (gHashSize-1)];
+    assert (deadNode != NULL);
+    
+    if (n == NULL)
+    {
+        // This hash bucket is empty! We have nothing to do.
+    }
+    else if (n == deadNode)
+    {
+        // The node to be removed is the first one in its bucket.        
+        gHashTable [deadNode->address & (gHashSize-1)] = NULL;
+    }
+    else
+    {
+        // The node to be removed is somewhere in the middle
+        // of the bucket. Step along the linked list until
+        // we find it.
+                
+        while (n->u.next != deadNode)
+            n = n->u.next;
+        
+        // Unlink it from the linked list.        
+        n->u.next = deadNode->u.next;
+    }
+}
+
+void pruneCodeCache (git_uint32 address, git_uint32 size)
+{
+    BlockHeader * start = (BlockHeader*) sCodeStart;
+    BlockHeader * top = (BlockHeader*) sCodeTop;
+    BlockHeader * h;
+
+    // Step through the cache, looking for blocks that overlap the
+    // specified range. If we find any, remove their nodes from the
+    // hash table, and set glulxSize to 0 so that they're dropped
+    // the next time we clean up the cache.
+    
+    for (h = start ; h < top ; h = END_OF_BLOCK(h))
+    {
+        // The start address of the block is in its final hash node.
+        
+        HashNode * node = END_OF_BLOCK(h);
+        git_uint32 glulxAddr = node[-1].address;
+        
+        if (glulxAddr < (address + size) && (glulxAddr + h->glulxSize) > address)
+        {
+            // This block overlaps the range of code that has to be pruned.
+            
+            git_uint32 i;
+            for (i = 0 ; i < h->numHashNodes ; ++i) 
+            {
+                --node;
+                removeHashNode (node);
+            }
+    
+            h->glulxSize = 0;
+        }
+    }
+}
+
+void compressCodeCache ()
+{
+    git_uint32 n;
+    git_uint32 spaceUsed, spaceFree;
+    
+    n = findCutoffPoint();
+    compressWithCutoff (n);
+    rebuildHashTable ();
+
+    spaceUsed = sCodeTop - sCodeStart;
+    spaceFree = sBufferSize - spaceUsed - gHashSize;
+
+//    {
+//        char buffer [100];
+//        sprintf (buffer, "[Cache cleanup: %d bytes used, %d free]\n",
+//            spaceUsed * 4, spaceFree * 4);
+//        glk_put_string (buffer);
+//    }
+
+    // If that didn't free up at least a quarter of the cache,
+    // clear it out entirely.
+
+    if (spaceFree * 3 < spaceUsed)
+        resetCodeCache();
+}
+
+void resetCodeCache ()
+{
+//    glk_put_string ("[resetting cache]\n");
+
+    memset (sBuffer, 0, sBufferSize * 4);
+    sCodeStart = sCodeTop = (Block) (gHashTable + gHashSize);
+    sTempStart = sTempEnd = (PatchNode*) (sBuffer + sBufferSize);
+}
+
+Block peekAtEmittedStuff (int numOpcodes)
+{
+    return sCodeTop - numOpcodes;
+}
+
+void emitConstBranch (Label op, git_uint32 address)
+{
+    sPatch->branchOffset = sCodeTop - (git_uint32*)gBlockHeader;
+    emitData (op);
+    emitData (address);
+
+    if (sLastAddr < address)
+        sLastAddr = address;
+}
+
+void emitData (git_uint32 val)
+{
+    abortIfBufferFull ();
+    *sCodeTop++ = val;
+}
+
+extern void emitFinalCode (Label op)
+{
+    abortIfBufferFull ();
+    *sCodeTop++ = (git_uint32) labelToOpcode (op);
+}
+
+extern git_uint32 undoEmit ()
+{
+    return *--sCodeTop;
+}
diff --git a/interpreters/git/compiler.h b/interpreters/git/compiler.h
new file mode 100644 (file)
index 0000000..4ee39c6
--- /dev/null
@@ -0,0 +1,108 @@
+// Header for compiler.c
+// $Id: compiler.h,v 1.11 2004/02/02 00:13:46 iain Exp $
+
+#ifndef GIT_COMPILER_H
+#define GIT_COMPILER_H
+
+// -------------------------------------------------------------
+// Types
+
+typedef enum
+{
+#define LABEL(foo) label_ ## foo,
+#include "labels.inc"
+    MAX_LABEL
+}
+Label;
+
+#ifdef USE_DIRECT_THREADING
+typedef void* Opcode; // Generated opcode: pointer to a label in exec().
+#else
+typedef Label Opcode;
+#endif
+
+typedef git_uint32* Block; // Generated code block: array of labels.
+
+// -------------------------------------------------------------
+// Settings
+
+extern int gPeephole; // Peephole optimisation of generated code?
+extern int gDebug;    // Insert debug statements into generated code?
+extern int gCacheRAM; // Keep RAM-based code in the JIT cache?
+
+// -------------------------------------------------------------
+// Compiling code
+
+extern const char* gLabelNames[];
+
+extern void initCompiler (size_t cacheSize);
+extern void shutdownCompiler ();
+
+extern void emitData (git_uint32);
+extern void emitFinalCode (Label);
+extern void emitConstBranch (Label op, git_uint32 address);
+
+extern void abortCompilation ();
+
+extern git_uint32 undoEmit();
+extern void nextInstructionIsReferenced ();
+
+extern Block peekAtEmittedStuff (int numOpcodes);
+
+// -------------------------------------------------------------
+// Accessing compiled code
+
+extern void pruneCodeCache (git_uint32 start, git_uint32 size);
+extern void resetCodeCache ();
+extern void compressCodeCache ();
+
+extern Block compile (git_uint32 pc);
+
+typedef struct HashNode HashNode;
+
+struct HashNode
+{
+    git_uint32 address;      // Glulx address for this entry.
+    git_sint16 codeOffset;   // Offset in 4-byte words from this hash node to the compiled code.
+    git_sint16 headerOffset; // Offset in 4-byte words from this hash node to the block header.
+    union {
+        int pad;             // This pad assures that PatchNode and HashNode are the same size.
+        HashNode * next;     // Next node in the same hash table slot.
+    } u;
+};
+
+typedef struct BlockHeader
+{
+    git_uint16 numHashNodes; // Number of lookup-able addresses in this block.
+    git_uint16 compiledSize; // Total size of this block, in 4-byte words.
+    git_uint32 glulxSize;    // Size of the glulx code this block represents, in bytes.
+    git_uint32 runCounter;   // Total number of opcodes executed in this block.
+}                            // (used to determine which blocks stay in the cache)
+BlockHeader;
+
+// This is the header for the block currently being executed --
+// that is, the one containing the return value of the last call
+// to getCode().
+extern BlockHeader * gBlockHeader;
+
+// Hash table for code lookup -- inlined for speed
+
+extern HashNode ** gHashTable; // Hash table of glulx address -> code.
+extern git_uint32 gHashSize;   // Number of slots in the hash table.
+
+GIT_INLINE Block getCode (git_uint32 pc)
+{
+    HashNode * n = gHashTable [pc & (gHashSize-1)];
+    while (n)
+    {
+        if (n->address == pc)
+        {
+            gBlockHeader = (BlockHeader*) ((git_uint32*)n + n->headerOffset);
+            return (git_uint32*)n + n->codeOffset;
+        }
+        n = n->u.next;
+    }
+    return compile (pc);
+}
+
+#endif // GIT_COMPILER_H
diff --git a/interpreters/git/config.h b/interpreters/git/config.h
new file mode 100644 (file)
index 0000000..d1dea0a
--- /dev/null
@@ -0,0 +1,79 @@
+// $Id: config.h,v 1.4 2003/10/18 23:19:52 iain Exp $
+// Platform-dependent configuration for Git
+
+#ifndef GIT_CONFIG_H
+#define GIT_CONFIG_H
+
+// Various compile-time options. You can define them in the
+// makefile or uncomment them here, whichever's easiest.
+
+// Define if we're big-endian and can read and write unaligned data.
+// #define USE_BIG_ENDIAN_UNALIGNED
+
+// Define this to use GCC's labels-as-values extension for a big speedup.
+// #define USE_DIRECT_THREADING
+
+// Define this if we can use the "inline" keyword.
+// #define USE_INLINE
+
+// Define this to memory-map the game file to speed up loading. (Unix-specific)
+// #define USE_MMAP
+
+// -------------------------------------------------------------------
+
+// Make sure we're compiling for a sane platform. For now, this means
+// 8-bit bytes and 32-bit pointers. We'll support 64-bit machines at
+// some point in the future, but we will probably never support machines
+// that can't read memory 8 bits at a time; it's just too much hassle.
+
+#include <limits.h>
+
+#if CHAR_BIT != 8
+#error "Git needs 8-bit bytes"
+#endif
+
+// This check doesn't work on all compilers, unfortunately.
+// It's checked by an assert() at runtime in initCompiler().
+#if 0
+// #if sizeof(void*) != 4
+#error "Git needs 32-bit pointers"
+#endif
+
+// Now we determine what types to use for 8-bit, 16-bit and 32-bit ints.
+
+#if UCHAR_MAX==0xff
+typedef signed char   git_sint8;
+typedef unsigned char git_uint8;
+#else
+#error "Can't find an 8-bit integer type"
+#endif
+
+#if SHRT_MAX==0x7fff
+typedef signed   short git_sint16;
+typedef unsigned short git_uint16;
+#elif INT_MAX==0x7fff
+typedef signed   int git_sint16;
+typedef unsigned int git_uint16;
+#else
+#error "Can't find a 16-bit integer type"
+#endif
+
+#if INT_MAX==0x7fffffff
+typedef signed   int git_sint32;
+typedef unsigned int git_uint32;
+#elif LONG_MAX==0x7fffffff
+typedef signed   long git_sint32;
+typedef unsigned long git_uint32;
+#else
+#error "Can't find a 32-bit integer type"
+#endif
+
+// USE_INLINE is pretty simple to deal with.
+
+#ifdef USE_INLINE
+#define GIT_INLINE static inline
+#else
+#define GIT_INLINE static
+#endif
+
+#endif // GIT_CONFIG_H
diff --git a/interpreters/git/gestalt.c b/interpreters/git/gestalt.c
new file mode 100644 (file)
index 0000000..fb58280
--- /dev/null
@@ -0,0 +1,51 @@
+#include "git.h"
+
+git_uint32 gestalt (enum GestaltSelector sel, git_uint32 param)
+{
+    switch (sel)
+    {
+        case GESTALT_SPEC_VERSION:
+            return 0x00030100;
+    
+        case GESTALT_TERP_VERSION:
+            return GIT_VERSION_NUM;
+    
+        case GESTALT_RESIZEMEM:
+            return 1;
+    
+        case GESTALT_UNDO:
+            return 1;
+    
+        case GESTALT_IO_SYSTEM:
+            if (param == IO_NULL || param == IO_FILTER || param == IO_GLK)
+                return 1;
+            else
+                return 0;
+                
+        case GESTALT_UNICODE:
+            return 1;
+            
+        case GESTALT_MEM_COPY:
+            return 1;
+            
+        case GESTALT_MALLOC:
+            return 1;
+            
+        case GESTALT_ACCELERATION:
+            return 1;
+
+        case GESTALT_ACCELFUNC:
+            if (accel_find_func(param))
+                return 1;
+            return 0;
+
+        case GESTALT_MALLOC_HEAP:
+          return heap_get_start();
+            
+        case GESTALT_GIT_CACHE_CONTROL:
+            return 1;
+            
+        default: // Unknown selector.
+            return 0;
+    }
+}
diff --git a/interpreters/git/git.c b/interpreters/git/git.c
new file mode 100644 (file)
index 0000000..2b5f0b3
--- /dev/null
@@ -0,0 +1,176 @@
+// $Id: git.c,v 1.21 2004/12/22 12:40:07 iain Exp $
+
+#include "git.h"
+#include <gi_blorb.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+// The four-char code 'FORM' as a big-endian value.
+// This is the magic number at the start of Blorb files.
+#define FORM 0x464f524d
+
+static void gitMain (const git_uint8 * game, git_uint32 gameSize, git_uint32 cacheSize, git_uint32 undoSize)
+{
+    git_uint32 version;
+    enum IOMode ioMode = IO_NULL;
+    
+    init_accel ();
+
+    // Initialise the Glk dispatch layer.
+    git_init_dispatch();
+
+    // Set various globals.    
+    gPeephole = 1;
+    gDebug = 0;
+    
+    // Load the gamefile into memory
+    // and initialise undo records.
+    initMemory (game, gameSize);
+    initUndo (undoSize);
+    
+    // Check that we're compatible with the
+    // glulx spec version that the game uses.
+    version = memRead32 (4);
+    if (version == 0x010000 && version <= 0x0100FF)
+    {
+        // We support version 1.0.0 even though it's
+        // officially obsolete. The only significant
+        // difference is the lack of I/O modes. In 1.0,
+        // all output goes directly to the Glk library.
+        ioMode = IO_GLK;
+    }
+    else if (version == 0x020000 && version <= 0x0200FF)
+    {
+        // We support version 2.0, which most people currently use.
+    }
+    else if (version >= 0x030000 && version <= 0x0300FF)
+    {
+        // We support version 3.0, which adds Unicode functionality.
+    }
+    else if (version >= 0x030100 && version <= 0x0301FF)
+    {
+        // We support version 3.1, which adds some memory-management opcodes.
+    }
+    else
+    {
+        fatalError ("Can't run this game, because it uses a newer version "
+            "of the gamefile format than Git understands. You should check "
+            "whether a newer version of Git is available.");
+    }
+    
+    // Call the top-level function.
+    startProgram (cacheSize, ioMode);
+    
+    // Shut everything down cleanly.
+    shutdownUndo();
+    shutdownMemory();
+}
+
+static giblorb_result_t handleBlorb (strid_t stream)
+{
+    giblorb_err_t err;
+    giblorb_result_t blorbres;
+    giblorb_map_t *map;
+
+    err = giblorb_set_resource_map (stream);
+    switch (err)
+    {
+        case giblorb_err_None:
+            break;
+            
+        case giblorb_err_CompileTime:
+            fatalError ("Can't read the Blorb file because something is compiled wrong in the Blorb library.");
+        case giblorb_err_Alloc:
+            fatalError ("Can't read the Blorb file because there isn't enough memory available.");
+        case giblorb_err_Read:
+            fatalError ("Can't read data from the Blorb file.");
+        case giblorb_err_Format:
+            fatalError ("Can't read the Blorb file because it seems to be corrupted.");
+        default:
+            fatalError ("Can't read the Blorb file because an unknown error occurred.");
+    }
+    
+    map = giblorb_get_resource_map();
+    if (map == NULL)
+        fatalError ("Can't find the Blorb file's resource map.");
+        
+    err = giblorb_load_resource(map, giblorb_method_FilePos, &blorbres, giblorb_ID_Exec, 0);
+    if (err)
+        fatalError ("This Blorb file does not contain an executable Glulx chunk.");
+
+    if (blorbres.chunktype != giblorb_make_id('G', 'L', 'U', 'L'))
+        fatalError ("This Blorb file contains an executable chunk, but it is not a Glulx file.");
+
+    return blorbres;
+}
+
+void gitWithStream (strid_t str, git_uint32 cacheSize, git_uint32 undoSize)
+{
+    char * game;
+    git_uint32 gamePos;
+    git_uint32 gameSize;
+    
+    git_uint32 remaining;
+    char * ptr;
+    
+    char buffer [4];
+    
+    glk_stream_set_position (str, 0, seekmode_Start);
+    if (4 != glk_get_buffer_stream (str, buffer, 4))
+        fatalError ("can't read from game file stream");
+    
+    if (read32 (buffer) == FORM)
+    {
+        giblorb_result_t result = handleBlorb (str);
+        gamePos = result.data.startpos;
+        gameSize = result.length;
+    }
+    else
+    {
+        gamePos = 0;
+        glk_stream_set_position (str, 0, seekmode_End);
+        gameSize = glk_stream_get_position (str);        
+    }
+    
+    game = malloc (gameSize);
+    if (game == NULL)
+        fatalError ("failed to allocate memory to store game file");
+    
+    glk_stream_set_position (str, gamePos, seekmode_Start);
+    
+    remaining = gameSize;
+    ptr = game;    
+    while (remaining > 0)
+    {
+        git_uint32 n = glk_get_buffer_stream (str, ptr, remaining);
+        if (n == 0)
+            fatalError ("failed to read entire game file");
+        remaining -= n;
+        ptr += n;
+    }
+    
+    gitMain ((git_uint8 *) game, gameSize, cacheSize, undoSize);
+    free (game);
+}
+
+void git (const git_uint8 * game, git_uint32 gameSize, git_uint32 cacheSize, git_uint32 undoSize)
+{
+    // If this is a blorb file, register it
+    // with glk and find the gamefile chunk.
+
+    if (read32 (game) == FORM)
+    {
+        strid_t stream;
+        giblorb_result_t result;
+        
+        stream = glk_stream_open_memory ((char *) game, gameSize, filemode_Read, 0);
+        if (stream == NULL)
+            fatalError ("Can't open the Blorb file as a Glk memory stream.");
+            
+        result = handleBlorb (stream);
+        game += result.data.startpos;
+        gameSize = result.length;
+    }
+    
+    gitMain (game, gameSize, cacheSize, undoSize);
+}
diff --git a/interpreters/git/git.h b/interpreters/git/git.h
new file mode 100644 (file)
index 0000000..3a56a44
--- /dev/null
@@ -0,0 +1,175 @@
+// Main header for git
+// $Id: git.h,v 1.32 2004/12/22 12:40:07 iain Exp $
+
+#ifndef GIT_H
+#define GIT_H
+
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <glk.h>
+
+#include "version.h"
+#include "config.h"
+
+// Version number formatting
+
+#define GIT_VERSION_NUM (GIT_MAJOR << 16) \
+                      | (GIT_MINOR << 8)  \
+                      | (GIT_PATCH)
+
+#define _str2(s) #s
+#define _str(s) _str2(s)
+
+#if GIT_PATCH == 0
+#define GIT_VERSION_STR \
+_str(GIT_MAJOR) "." _str(GIT_MINOR)
+#else
+#define GIT_VERSION_STR \
+_str(GIT_MAJOR) "." _str(GIT_MINOR) "." _str(GIT_PATCH)
+#endif
+
+// git.c
+
+extern void gitWithStream (strid_t stream,
+                           git_uint32 cacheSize,
+                           git_uint32 undoSize);
+
+extern void git (const git_uint8 * game,
+                 git_uint32 gameSize,
+                 git_uint32 cacheSize,
+                 git_uint32 undoSize);
+
+extern void fatalError (const char *);
+
+// memory.c
+
+#include "memory.h"
+
+// gestalt.c
+
+enum IOMode
+{
+    IO_NULL   = 0,
+    IO_FILTER = 1,
+    IO_GLK    = 2,
+    IO_MAX
+};
+
+enum GestaltSelector
+{
+    GESTALT_SPEC_VERSION = 0,
+    GESTALT_TERP_VERSION = 1,
+    GESTALT_RESIZEMEM    = 2,
+    GESTALT_UNDO         = 3,
+    GESTALT_IO_SYSTEM    = 4,
+    GESTALT_UNICODE      = 5,
+    GESTALT_MEM_COPY     = 6,
+    GESTALT_MALLOC       = 7,
+    GESTALT_MALLOC_HEAP  = 8,
+    GESTALT_ACCELERATION = 9,
+    GESTALT_ACCELFUNC    = 10,
+    
+    // This special selector returns 1 if the cache control
+    // opcodes 'git_setcacheram' and 'git_prunecache' are available.
+    
+    GESTALT_GIT_CACHE_CONTROL = 0x7940
+};
+
+extern git_uint32 gestalt (enum GestaltSelector sel, git_uint32 param);
+
+// opcodes.c
+
+extern void parseInstruction (git_uint32 * pc, int * done);
+
+// operand.c
+
+typedef enum { reg_L1, reg_L2, reg_L3, reg_L4, reg_L5, reg_L6, reg_L7 } LoadReg;
+typedef enum { reg_S1, reg_S2 } StoreReg;
+typedef enum { size32, size16, size8 } TransferSize;
+
+extern git_uint32 parseLoad  (git_uint32 * pc, LoadReg reg, int mode, TransferSize, git_sint32 * constVal);
+extern void       parseStore (git_uint32 * pc, StoreReg reg, int mode, TransferSize);
+
+extern void parseCallStub  (git_uint32 * pc, int mode);
+extern void parseCatchStub (git_uint32 * pc, int mode);
+extern void parseSaveStub  (git_uint32 * pc, int mode);
+extern void parseUndoStub  (git_uint32 * pc, int mode);
+
+// compiler.c
+
+#include "compiler.h"
+
+// peephole.c
+
+extern void resetPeepholeOptimiser();
+extern void emitCode (Label);
+
+// terp.c
+
+#ifdef USE_DIRECT_THREADING
+    extern Opcode* gOpcodeTable;
+#   define labelToOpcode(label) (gOpcodeTable[label])
+#else
+#   define labelToOpcode(label) label
+#endif
+
+extern git_sint32* gStackPointer;
+
+extern void startProgram (size_t cacheSize, enum IOMode ioMode);
+
+// glkop.c
+
+extern int git_init_dispatch();
+extern glui32 git_perform_glk(glui32 funcnum, glui32 numargs, glui32 *arglist);
+extern strid_t git_find_stream_by_id(glui32 id);
+
+// git_search.c
+
+extern glui32 git_binary_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options);
+
+extern glui32 git_linked_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 keyoffset, glui32 nextoffset, glui32 options);
+
+extern glui32 git_linear_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options);
+
+// savefile.c
+
+extern git_sint32 saveToFile (git_sint32* base, git_sint32 * sp, git_sint32 file);
+extern git_sint32 restoreFromFile (git_sint32* base, git_sint32 file,
+                      git_uint32 protectPos, git_uint32 protectSize);
+
+// saveundo.c
+
+extern void initUndo (git_uint32 size);
+extern void resetUndo ();
+extern void shutdownUndo ();
+
+extern int  saveUndo (git_sint32* base, git_sint32* sp);
+extern int  restoreUndo (git_sint32* base,
+                git_uint32 protectPos, git_uint32 protectSize);
+
+// heap.c
+
+extern glui32 heap_get_start ();
+extern glui32 heap_alloc (glui32 len);
+extern void heap_free (glui32 addr);
+extern int heap_is_active ();
+extern void heap_clear ();
+extern int heap_get_summary (glui32 *valcount, glui32 **summary);
+extern int heap_apply_summary (glui32 valcount, glui32 *summary);
+
+// accel.c
+
+typedef glui32 (*acceleration_func)(glui32 argc, glui32 *argv);
+extern void init_accel ();
+extern acceleration_func accel_find_func (glui32 index);
+extern acceleration_func accel_get_func (glui32 addr);
+extern void accel_set_func (glui32 index, glui32 addr);
+extern void accel_set_param (glui32 index, glui32 val);
+
+#endif // GIT_H
diff --git a/interpreters/git/git_unix.c b/interpreters/git/git_unix.c
new file mode 100644 (file)
index 0000000..04cfe60
--- /dev/null
@@ -0,0 +1,106 @@
+// $Id: git_unix.c,v 1.5 2004/01/25 18:44:51 iain Exp $
+
+// unixstrt.c: Unix-specific code for Glulxe.
+// Designed by Andrew Plotkin <erkyrath@eblong.com>
+// http://www.eblong.com/zarf/glulx/index.html
+
+#include "git.h"
+#include <glk.h>
+#include <glkstart.h> // This comes with the Glk library.
+
+#ifdef USE_MMAP
+#include <fcntl.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#include <errno.h>
+#endif
+
+// The only command-line argument is the filename.
+glkunix_argumentlist_t glkunix_arguments[] =
+{
+    { "", glkunix_arg_ValueFollows, "filename: The game file to load." },
+    { NULL, glkunix_arg_End, NULL }
+};
+
+#define CACHE_SIZE (256 * 1024L)
+#define UNDO_SIZE (512 * 1024L)
+
+void fatalError (const char * s)
+{
+    fprintf (stderr, "*** fatal error: %s ***\n", s);
+    exit (1);
+}
+
+#ifdef USE_MMAP
+// Fast loader that uses some fancy Unix features.
+
+const char * gFilename = 0;
+
+int glkunix_startup_code(glkunix_startup_t *data)
+{
+    if (data->argc <= 1)
+    {
+        printf ("usage: git gamefile.ulx\n");
+        return 0;
+    }
+    gFilename = data->argv[1];
+    return 1;
+}
+
+void glk_main ()
+{
+    int          file;
+    struct stat  info;
+    const char * ptr;
+    
+    file = open (gFilename, O_RDONLY);
+    if (file < 0)
+        goto error;
+
+    if (fstat (file, &info) != 0)
+        goto error;
+    
+    if (info.st_size < 256)
+    {
+        fprintf (stderr, "This is too small to be a glulx file.\n");
+        exit (1);
+    }
+
+    ptr = mmap (NULL, info.st_size, PROT_READ, MAP_PRIVATE, file, 0);
+    if (ptr == MAP_FAILED)
+        goto error;
+        
+    git (ptr, info.st_size, CACHE_SIZE, UNDO_SIZE);
+    munmap ((void*) ptr, info.st_size);
+    return;
+    
+error:
+    perror ("git");
+    exit (errno);
+}
+
+#else
+// Generic loader that should work anywhere.
+
+strid_t gStream = 0;
+
+int glkunix_startup_code(glkunix_startup_t *data)
+{
+    if (data->argc <= 1)
+    {
+        printf ("usage: git gamefile.ulx\n");
+        return 0;
+    }
+    gStream = glkunix_stream_open_pathname ((char*) data->argv[1], 0, 0);
+    return 1;
+}
+
+void glk_main ()
+{
+    if (gStream == NULL)
+        fatalError ("could not open game file");
+
+    gitWithStream (gStream, CACHE_SIZE, UNDO_SIZE);
+}
+
+#endif // USE_MMAP
diff --git a/interpreters/git/glkop.c b/interpreters/git/glkop.c
new file mode 100644 (file)
index 0000000..71452ef
--- /dev/null
@@ -0,0 +1,1150 @@
+// $Id: glkop.c,v 1.4 2004/12/22 14:33:40 iain Exp $
+
+// glkop.c: Glulxe code for Glk API dispatching.
+//  Designed by Andrew Plotkin <erkyrath@eblong.com>
+//  http://www.eblong.com/zarf/glulx/index.html
+
+/* This code is actually very general; it could work for almost any
+   32-bit VM which remotely resembles Glulxe or the Z-machine in design.
+   
+   To be precise, we make the following assumptions:
+
+   - An argument list is an array of 32-bit values, which can represent
+     either integers or addresses.
+   - We can read or write to a 32-bit integer in VM memory using the macros
+     ReadMemory(addr) and WriteMemory(addr), where addr is an address
+     taken from the argument list.
+   - A character array is an actual array of bytes somewhere in terp
+     memory, whose actual address can be computed by the macro
+     AddressOfArray(addr). Again, addr is a VM address from the argument
+     list.
+   - An integer array is a sequence of integers somewhere in VM memory.
+     The array can be turned into a C integer array by the macro
+     CaptureIArray(addr, len), and released by ReleaseIArray().
+     These macros are responsible for fixing byte-order and alignment
+     (if the C ABI does not match the VM's). The passin, passout hints
+     may be used to avoid unnecessary copying.
+   - A Glk structure (such as event_t) is a set of integers somewhere
+     in VM memory, which can be read and written with the macros
+     ReadStructField(addr, fieldnum) and WriteStructField(addr, fieldnum).
+     The fieldnum is an integer (from 0 to 3, for event_t.)
+   - A VM string can be turned into a C-style string with the macro
+     ptr = DecodeVMString(addr). After the string is used, this code
+     calls ReleaseVMString(ptr), which should free any memory that
+     DecodeVMString allocates.
+   - A VM Unicode string can be turned into a zero-terminated array
+     of 32-bit integers, in the same way, with DecodeVMUstring
+     and ReleaseVMUstring.
+
+     To work this code over for a new VM, just diddle the macros.
+*/
+
+#define Stk1(sp)   \
+  (*((unsigned char *)(sp)))
+#define Stk2(sp)   \
+  (*((glui16 *)(sp)))
+#define Stk4(sp)   \
+  (*((glui32 *)(sp)))
+
+#define StkW1(sp, vl)   \
+  (*((unsigned char *)(sp)) = (unsigned char)(vl))
+#define StkW2(sp, vl)   \
+  (*((glui16 *)(sp)) = (glui16)(vl))
+#define StkW4(sp, vl)   \
+  (*((glui32 *)(sp)) = (glui32)(vl))
+
+
+#define ReadMemory(addr)  \
+    (((addr) == 0xffffffff) \
+      ? (gStackPointer -= 1, Stk4(gStackPointer)) \
+      : (memRead32(addr)))
+#define WriteMemory(addr, val)  \
+    if ((addr) == 0xffffffff) \
+    { StkW4(gStackPointer, (val)); gStackPointer += 1;} \
+       else memWrite32((addr), (val))
+#define AddressOfArray(addr)  \
+       ((addr) < gRamStart ? (gRom + (addr)) : (gRam + (addr)))
+#define AddressOfIArray(addr)  \
+       ((addr) < gRamStart ? (gRom + (addr)) : (gRam + (addr)))
+#define CaptureIArray(addr, len, passin)  \
+    (grab_temp_array(addr, len, passin))
+#define ReleaseIArray(ptr, addr, len, passout)  \
+    (release_temp_array(ptr, addr, len, passout))
+#define ReadStructField(addr, fieldnum)  \
+    (((addr) == 0xffffffff) \
+      ? (gStackPointer -= 1, Stk4(gStackPointer)) \
+      : (memRead32((addr)+(fieldnum)*4)))
+#define WriteStructField(addr, fieldnum, val)  \
+    if ((addr) == 0xffffffff) \
+    { StkW4(gStackPointer, (val)); gStackPointer += 1;} \
+       else memWrite32((addr)+(fieldnum)*4, (val))
+
+#define glulx_malloc malloc
+#define glulx_free free
+#define glulx_random rand
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+#include "glk.h"
+#include "git.h"
+#include "gi_dispa.h"
+
+static char * DecodeVMString (git_uint32 addr)
+{
+    glui32 end;
+    char * data;
+    char * c;
+    
+    // The string must be a C string.
+    if (memRead8(addr) != 0xE0)
+    {
+        fatalError ("Illegal string type passed to Glk function");
+    }
+    addr += 1;
+    
+    end = addr;
+    while (memRead8(end) != 0)
+        ++end;
+    
+    data = glulx_malloc (end - addr + 1);
+    if (data == NULL)
+        fatalError ("Couldn't allocate string");
+
+    c = data;
+    while (addr < end)
+        *c++ = memRead8(addr++);
+    *c = 0;
+    
+    return data;
+}
+
+static glui32 * DecodeVMUstring (git_uint32 addr)
+{
+    glui32 end;
+    glui32 * data;
+    glui32 * c;
+    
+    // The string must be a Unicode string.
+    if (memRead8(addr) != 0xE2)
+    {
+        fatalError ("Illegal string type passed to Glk function");
+    }
+    addr += 4;
+    
+    end = addr;
+    while (memRead32(end) != 0)
+        end += 4;
+    
+    data = glulx_malloc (end - addr + 4);
+    if (data == NULL)
+        fatalError ("Couldn't allocate string");
+
+    c = data;
+    while (addr < end)
+    {
+        *c++ = memRead32(addr);
+        addr += 4;
+    }
+    *c = 0;
+    
+    return data;
+}
+
+static void ReleaseVMString (char * ptr)
+{
+    glulx_free (ptr);
+}
+
+static void ReleaseVMUstring (glui32 * ptr)
+{
+    glulx_free (ptr);
+}
+
+typedef struct dispatch_splot_struct {
+  int numwanted;
+  int maxargs;
+  gluniversal_t *garglist;
+  glui32 *varglist;
+  int numvargs;
+  glui32 *retval;
+} dispatch_splot_t;
+
+/* We maintain a linked list of arrays being used for Glk calls. It is
+   only used for integer (glui32) arrays -- char arrays are handled in
+   place. It's not worth bothering with a hash table, since most
+   arrays appear here only momentarily. */
+
+typedef struct arrayref_struct arrayref_t;
+struct arrayref_struct {
+  void *array;
+  glui32 addr;
+  glui32 elemsize;
+  glui32 len; /* elements */
+  int retained;
+  arrayref_t *next;
+};
+
+static arrayref_t *arrays = NULL;
+
+/* We maintain a hash table for each opaque Glk class. classref_t are the
+    nodes of the table, and classtable_t are the tables themselves. */
+
+typedef struct classref_struct classref_t;
+struct classref_struct {
+  void *obj;
+  glui32 id;
+  int bucknum;
+  classref_t *next;
+};
+
+#define CLASSHASH_SIZE (31)
+typedef struct classtable_struct {
+  glui32 lastid;
+  classref_t *bucket[CLASSHASH_SIZE];
+} classtable_t;
+
+/* The list of hash tables, for the git_classes. */
+static int num_classes = 0;
+classtable_t **git_classes = NULL;
+
+static classtable_t *new_classtable(glui32 firstid);
+static void *classes_get(int classid, glui32 objid);
+static classref_t *classes_put(int classid, void *obj);
+static void classes_remove(int classid, void *obj);
+
+static gidispatch_rock_t glulxe_classtable_register(void *obj, 
+  glui32 objclass);
+static void glulxe_classtable_unregister(void *obj, glui32 objclass, 
+  gidispatch_rock_t objrock);
+static gidispatch_rock_t glulxe_retained_register(void *array,
+  glui32 len, char *typecode);
+static void glulxe_retained_unregister(void *array, glui32 len, 
+  char *typecode, gidispatch_rock_t objrock);
+
+static glui32 *grab_temp_array(glui32 addr, glui32 len, int passin);
+static void release_temp_array(glui32 *arr, glui32 addr, glui32 len, int passout);
+
+static void prepare_glk_args(char *proto, dispatch_splot_t *splot);
+static void parse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassin);
+static void unparse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassout);
+
+/* init_dispatch():
+   Set up the class hash tables and other startup-time stuff. 
+*/
+int git_init_dispatch()
+{
+  int ix;
+    
+  /* Allocate the class hash tables. */
+  num_classes = gidispatch_count_classes();
+  git_classes = (classtable_t **)glulx_malloc(num_classes 
+    * sizeof(classtable_t *));
+  if (!git_classes)
+    return FALSE;
+    
+  for (ix=0; ix<num_classes; ix++) {
+    git_classes[ix] = new_classtable((glulx_random() % (glui32)(101)) + 1);
+    if (!git_classes[ix])
+      return FALSE;
+  }
+    
+  /* Set up the two callbacks. */
+  gidispatch_set_object_registry(&glulxe_classtable_register, 
+    &glulxe_classtable_unregister);
+  gidispatch_set_retained_registry(&glulxe_retained_register, 
+    &glulxe_retained_unregister);
+    
+  return TRUE;
+}
+
+/* perform_glk():
+   Turn a list of Glulx arguments into a list of Glk arguments,
+   dispatch the function call, and return the result. 
+*/
+glui32 git_perform_glk(glui32 funcnum, glui32 numargs, glui32 *arglist)
+{
+  glui32 retval = 0;
+
+  switch (funcnum) {
+    /* To speed life up, we implement commonly-used Glk functions
+       directly -- instead of bothering with the whole prototype 
+       mess. */
+
+  case 0x0080: /* put_char */
+    if (numargs != 1)
+      goto WrongArgNum;
+    glk_put_char(arglist[0] & 0xFF);
+    break;
+  case 0x0081: /* put_char_stream */
+    if (numargs != 2)
+      goto WrongArgNum;
+    glk_put_char_stream(git_find_stream_by_id(arglist[0]), arglist[1] & 0xFF);
+    break;
+  case 0x00A0: /* char_to_lower */
+    if (numargs != 1)
+      goto WrongArgNum;
+    retval = glk_char_to_lower(arglist[0] & 0xFF);
+    break;
+  case 0x00A1: /* char_to_upper */
+    if (numargs != 1)
+      goto WrongArgNum;
+    retval = glk_char_to_upper(arglist[0] & 0xFF);
+    break;
+
+  WrongArgNum:
+    fatalError("Wrong number of arguments to Glk function.");
+    break;
+
+  default: {
+    /* Go through the full dispatcher prototype foo. */
+    char *proto, *cx;
+    dispatch_splot_t splot;
+    int argnum;
+
+    /* Grab the string. */
+    proto = gidispatch_prototype(funcnum);
+    if (!proto)
+      fatalError("Unknown Glk function.");
+
+    splot.varglist = arglist;
+    splot.numvargs = numargs;
+    splot.retval = &retval;
+
+    /* The work goes in four phases. First, we figure out how many
+       arguments we want, and allocate space for the Glk argument
+       list. Then we go through the Glulxe arguments and load them 
+       into the Glk list. Then we call. Then we go through the 
+       arguments again, unloading the data back into Glulx memory. */
+
+    /* Phase 0. */
+    prepare_glk_args(proto, &splot);
+
+    /* Phase 1. */
+    argnum = 0;
+    cx = proto;
+    parse_glk_args(&splot, &cx, 0, &argnum, 0, 0);
+
+    /* Phase 2. */
+    gidispatch_call(funcnum, argnum, splot.garglist);
+
+    /* Phase 3. */
+    argnum = 0;
+    cx = proto;
+    unparse_glk_args(&splot, &cx, 0, &argnum, 0, 0);
+
+    break;
+  }
+  }
+
+  return retval;
+}
+
+/* read_prefix():
+   Read the prefixes of an argument string -- the "<>&+:#!" chars. 
+*/
+static char *read_prefix(char *cx, int *isref, int *isarray,
+  int *passin, int *passout, int *nullok, int *isretained, 
+  int *isreturn)
+{
+  *isref = FALSE;
+  *passin = FALSE;
+  *passout = FALSE;
+  *nullok = TRUE;
+  *isarray = FALSE;
+  *isretained = FALSE;
+  *isreturn = FALSE;
+  while (1) {
+    if (*cx == '<') {
+      *isref = TRUE;
+      *passout = TRUE;
+    }
+    else if (*cx == '>') {
+      *isref = TRUE;
+      *passin = TRUE;
+    }
+    else if (*cx == '&') {
+      *isref = TRUE;
+      *passout = TRUE;
+      *passin = TRUE;
+    }
+    else if (*cx == '+') {
+      *nullok = FALSE;
+    }
+    else if (*cx == ':') {
+      *isref = TRUE;
+      *passout = TRUE;
+      *nullok = FALSE;
+      *isreturn = TRUE;
+    }
+    else if (*cx == '#') {
+      *isarray = TRUE;
+    }
+    else if (*cx == '!') {
+      *isretained = TRUE;
+    }
+    else {
+      break;
+    }
+    cx++;
+  }
+  return cx;
+}
+
+/* prepare_glk_args():
+   This reads through the prototype string, and pulls Floo objects off the
+   stack. It also works out the maximal number of gluniversal_t objects
+   which could be used by the Glk call in question. It then allocates
+   space for them.
+*/
+static void prepare_glk_args(char *proto, dispatch_splot_t *splot)
+{
+  static gluniversal_t *garglist = NULL;
+  static int garglist_size = 0;
+
+  int ix;
+  int numwanted, numvargswanted, maxargs;
+  char *cx;
+
+  cx = proto;
+  numwanted = 0;
+  while (*cx >= '0' && *cx <= '9') {
+    numwanted = 10 * numwanted + (*cx - '0');
+    cx++;
+  }
+  splot->numwanted = numwanted;
+
+  maxargs = 0; 
+  numvargswanted = 0; 
+  for (ix = 0; ix < numwanted; ix++) {
+    int isref, passin, passout, nullok, isarray, isretained, isreturn;
+    cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
+      &isretained, &isreturn);
+    if (isref) {
+      maxargs += 2;
+    }
+    else {
+      maxargs += 1;
+    }
+    if (!isreturn) {
+      if (isarray) {
+        numvargswanted += 2;
+      }
+      else {
+        numvargswanted += 1;
+      }
+    }
+        
+    if (*cx == 'I' || *cx == 'C') {
+      cx += 2;
+    }
+    else if (*cx == 'Q') {
+      cx += 2;
+    }
+    else if (*cx == 'S' || *cx == 'U') {
+      cx += 1;
+    }
+    else if (*cx == '[') {
+      int refdepth, nwx;
+      cx++;
+      nwx = 0;
+      while (*cx >= '0' && *cx <= '9') {
+        nwx = 10 * nwx + (*cx - '0');
+        cx++;
+      }
+      maxargs += nwx; /* This is *only* correct because all structs contain
+                         plain values. */
+      refdepth = 1;
+      while (refdepth > 0) {
+        if (*cx == '[')
+          refdepth++;
+        else if (*cx == ']')
+          refdepth--;
+        cx++;
+      }
+    }
+    else {
+      fatalError("Illegal format string.");
+    }
+  }
+
+  if (*cx != ':' && *cx != '\0')
+    fatalError("Illegal format string.");
+
+  splot->maxargs = maxargs;
+
+  if (splot->numvargs != numvargswanted)
+    fatalError("Wrong number of arguments to Glk function.");
+
+  if (garglist && garglist_size < maxargs) {
+    glulx_free(garglist);
+    garglist = NULL;
+    garglist_size = 0;
+  }
+  if (!garglist) {
+    garglist_size = maxargs + 16;
+    garglist = (gluniversal_t *)glulx_malloc(garglist_size 
+      * sizeof(gluniversal_t));
+  }
+  if (!garglist)
+    fatalError("Unable to allocate storage for Glk arguments.");
+
+  splot->garglist = garglist;
+}
+
+/* parse_glk_args():
+   This long and unpleasant function translates a set of Floo objects into
+   a gluniversal_t array. It's recursive, too, to deal with structures.
+*/
+static void parse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassin)
+{
+  char *cx;
+  int ix, argx;
+  int gargnum, numwanted;
+  void *opref;
+  gluniversal_t *garglist;
+  glui32 *varglist;
+  
+  garglist = splot->garglist;
+  varglist = splot->varglist;
+  gargnum = *argnumptr;
+  cx = *proto;
+
+  numwanted = 0;
+  while (*cx >= '0' && *cx <= '9') {
+    numwanted = 10 * numwanted + (*cx - '0');
+    cx++;
+  }
+
+  for (argx = 0, ix = 0; argx < numwanted; argx++, ix++) {
+    char typeclass;
+    int skipval;
+    int isref, passin, passout, nullok, isarray, isretained, isreturn;
+    cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
+      &isretained, &isreturn);
+    
+    typeclass = *cx;
+    cx++;
+
+    skipval = FALSE;
+    if (isref) {
+      if (!isreturn && varglist[ix] == 0) {
+        if (!nullok)
+          fatalError("Zero passed invalidly to Glk function.");
+        garglist[gargnum].ptrflag = FALSE;
+        gargnum++;
+        skipval = TRUE;
+      }
+      else {
+        garglist[gargnum].ptrflag = TRUE;
+        gargnum++;
+      }
+    }
+    if (!skipval) {
+      glui32 thisval;
+
+      if (typeclass == '[') {
+
+        parse_glk_args(splot, &cx, depth+1, &gargnum, varglist[ix], passin);
+
+      }
+      else if (isarray) {
+        /* definitely isref */
+
+        switch (typeclass) {
+        case 'C':
+          garglist[gargnum].array = (void*) AddressOfArray(varglist[ix]);
+          gargnum++;
+          ix++;
+          garglist[gargnum].uint = varglist[ix];
+          gargnum++;
+          cx++;
+          break;
+        case 'I':
+          garglist[gargnum].array = CaptureIArray(varglist[ix], varglist[ix+1], passin);
+          gargnum++;
+          ix++;
+          garglist[gargnum].uint = varglist[ix];
+          gargnum++;
+          cx++;
+          break;
+        default:
+          fatalError("Illegal format string.");
+          break;
+        }
+      }
+      else {
+        /* a plain value or a reference to one. */
+
+        if (isreturn) {
+          thisval = 0;
+        }
+        else if (depth > 0) {
+          /* Definitely not isref or isarray. */
+          if (subpassin)
+            thisval = ReadStructField(subaddress, ix);
+          else
+            thisval = 0;
+        }
+        else if (isref) {
+          if (passin)
+            thisval = ReadMemory(varglist[ix]);
+          else
+            thisval = 0;
+        }
+        else {
+          thisval = varglist[ix];
+        }
+
+        switch (typeclass) {
+        case 'I':
+          if (*cx == 'u')
+            garglist[gargnum].uint = (glui32)(thisval);
+          else if (*cx == 's')
+            garglist[gargnum].sint = (glsi32)(thisval);
+          else
+            fatalError("Illegal format string.");
+          gargnum++;
+          cx++;
+          break;
+        case 'Q':
+          if (thisval) {
+            opref = classes_get(*cx-'a', thisval);
+            if (!opref) {
+              fatalError("Reference to nonexistent Glk object.");
+            }
+          }
+          else {
+            opref = NULL;
+          }
+          garglist[gargnum].opaqueref = opref;
+          gargnum++;
+          cx++;
+          break;
+        case 'C':
+          if (*cx == 'u') 
+            garglist[gargnum].uch = (unsigned char)(thisval);
+          else if (*cx == 's')
+            garglist[gargnum].sch = (signed char)(thisval);
+          else if (*cx == 'n')
+            garglist[gargnum].ch = (char)(thisval);
+          else
+            fatalError("Illegal format string.");
+          gargnum++;
+          cx++;
+          break;
+        case 'S':
+          garglist[gargnum].charstr = DecodeVMString(thisval);
+          gargnum++;
+          break;
+#ifdef GLK_MODULE_UNICODE
+        case 'U':
+          garglist[gargnum].unicharstr = DecodeVMUstring(thisval);
+             gargnum++;
+          break;
+#endif
+        default:
+          fatalError("Illegal format string.");
+          break;
+        }
+      }
+    }
+    else {
+      /* We got a null reference, so we have to skip the format element. */
+      if (typeclass == '[') {
+        int numsubwanted, refdepth;
+        numsubwanted = 0;
+        while (*cx >= '0' && *cx <= '9') {
+          numsubwanted = 10 * numsubwanted + (*cx - '0');
+          cx++;
+        }
+        refdepth = 1;
+        while (refdepth > 0) {
+          if (*cx == '[')
+            refdepth++;
+          else if (*cx == ']')
+            refdepth--;
+          cx++;
+        }
+      }
+      else if (typeclass == 'S' || typeclass == 'U') {
+        /* leave it */
+      }
+      else {
+        cx++;
+      }
+    }    
+  }
+
+  if (depth > 0) {
+    if (*cx != ']')
+      fatalError("Illegal format string.");
+    cx++;
+  }
+  else {
+    if (*cx != ':' && *cx != '\0')
+      fatalError("Illegal format string.");
+  }
+  
+  *proto = cx;
+  *argnumptr = gargnum;
+}
+
+/* unparse_glk_args():
+   This is about the reverse of parse_glk_args(). 
+*/
+static void unparse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassout)
+{
+  char *cx;
+  int ix, argx;
+  int gargnum, numwanted;
+  void *opref;
+  gluniversal_t *garglist;
+  glui32 *varglist;
+  
+  garglist = splot->garglist;
+  varglist = splot->varglist;
+  gargnum = *argnumptr;
+  cx = *proto;
+
+  numwanted = 0;
+  while (*cx >= '0' && *cx <= '9') {
+    numwanted = 10 * numwanted + (*cx - '0');
+    cx++;
+  }
+
+  for (argx = 0, ix = 0; argx < numwanted; argx++, ix++) {
+    char typeclass;
+    int skipval;
+    int isref, passin, passout, nullok, isarray, isretained, isreturn;
+    cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
+      &isretained, &isreturn);
+    
+    typeclass = *cx;
+    cx++;
+
+    skipval = FALSE;
+    if (isref) {
+      if (!isreturn && varglist[ix] == 0) {
+        if (!nullok)
+          fatalError("Zero passed invalidly to Glk function.");
+        garglist[gargnum].ptrflag = FALSE;
+        gargnum++;
+        skipval = TRUE;
+      }
+      else {
+        garglist[gargnum].ptrflag = TRUE;
+        gargnum++;
+      }
+    }
+    if (!skipval) {
+      glui32 thisval = 0;
+
+      if (typeclass == '[') {
+
+        unparse_glk_args(splot, &cx, depth+1, &gargnum, varglist[ix], passout);
+
+      }
+      else if (isarray) {
+        /* definitely isref */
+
+        switch (typeclass) {
+        case 'C':
+          gargnum++;
+          ix++;
+          gargnum++;
+          cx++;
+          break;
+        case 'I':
+          ReleaseIArray(garglist[gargnum].array, varglist[ix], varglist[ix+1], passout);
+          gargnum++;
+          ix++;
+          gargnum++;
+          cx++;
+          break;
+        default:
+          fatalError("Illegal format string.");
+          break;
+        }
+      }
+      else {
+        /* a plain value or a reference to one. */
+
+       if (isreturn || (depth > 0 && subpassout) || (isref && passout)) {
+         skipval = FALSE;
+       }
+       else {
+         skipval = TRUE;
+       }
+
+       switch (typeclass) {
+       case 'I':
+         if (!skipval) {
+           if (*cx == 'u')
+             thisval = (glui32)garglist[gargnum].uint;
+           else if (*cx == 's')
+             thisval = (glui32)garglist[gargnum].sint;
+           else
+             fatalError("Illegal format string.");
+         }
+         gargnum++;
+         cx++;
+         break;
+       case 'Q':
+         if (!skipval) {
+           opref = garglist[gargnum].opaqueref;
+           if (opref) {
+             gidispatch_rock_t objrock = 
+               gidispatch_get_objrock(opref, *cx-'a');
+             thisval = ((classref_t *)objrock.ptr)->id;
+           }
+           else {
+             thisval = 0;
+           }
+         }
+         gargnum++;
+         cx++;
+         break;
+       case 'C':
+         if (!skipval) {
+           if (*cx == 'u') 
+             thisval = (glui32)garglist[gargnum].uch;
+           else if (*cx == 's')
+             thisval = (glui32)garglist[gargnum].sch;
+           else if (*cx == 'n')
+             thisval = (glui32)garglist[gargnum].ch;
+           else
+             fatalError("Illegal format string.");
+         }
+         gargnum++;
+         cx++;
+         break;
+       case 'S':
+         if (garglist[gargnum].charstr)
+           ReleaseVMString(garglist[gargnum].charstr);
+          gargnum++;
+          break;
+#ifdef GLK_MODULE_UNICODE
+        case 'U':
+          if (garglist[gargnum].unicharstr)
+            ReleaseVMUstring(garglist[gargnum].unicharstr);
+         gargnum++;
+         break;
+#endif
+       default:
+         fatalError("Illegal format string.");
+         break;
+       }
+
+        if (isreturn) {
+          *(splot->retval) = thisval;
+        }
+        else if (depth > 0) {
+          /* Definitely not isref or isarray. */
+          if (subpassout)
+          {
+            WriteStructField(subaddress, ix, thisval);
+          }
+        }
+        else if (isref) {
+          if (passout)
+          {
+            WriteMemory(varglist[ix], thisval);
+          }
+        }
+      }
+    }
+    else {
+      /* We got a null reference, so we have to skip the format element. */
+      if (typeclass == '[') {
+        int numsubwanted, refdepth;
+        numsubwanted = 0;
+        while (*cx >= '0' && *cx <= '9') {
+          numsubwanted = 10 * numsubwanted + (*cx - '0');
+          cx++;
+        }
+        refdepth = 1;
+        while (refdepth > 0) {
+          if (*cx == '[')
+            refdepth++;
+          else if (*cx == ']')
+            refdepth--;
+          cx++;
+        }
+      }
+      else if (typeclass == 'S' || typeclass == 'U') {
+        /* leave it */
+      }
+      else {
+        cx++;
+      }
+    }    
+  }
+
+  if (depth > 0) {
+    if (*cx != ']')
+      fatalError("Illegal format string.");
+    cx++;
+  }
+  else {
+    if (*cx != ':' && *cx != '\0')
+      fatalError("Illegal format string.");
+  }
+  
+  *proto = cx;
+  *argnumptr = gargnum;
+}
+
+/* find_stream_by_id():
+   This is used by some interpreter code which has to, well, find a Glk
+   stream given its ID. 
+*/
+strid_t git_find_stream_by_id(glui32 objid)
+{
+  if (!objid)
+    return NULL;
+
+  /* Recall that class 1 ("b") is streams. */
+  return classes_get(1, objid);
+}
+
+/* Build a hash table to hold a set of Glk objects. */
+static classtable_t *new_classtable(glui32 firstid)
+{
+  int ix;
+  classtable_t *ctab = (classtable_t *)glulx_malloc(sizeof(classtable_t));
+  if (!ctab)
+    return NULL;
+    
+  for (ix=0; ix<CLASSHASH_SIZE; ix++)
+    ctab->bucket[ix] = NULL;
+    
+  ctab->lastid = firstid;
+    
+  return ctab;
+}
+
+/* Find a Glk object in the appropriate hash table. */
+static void *classes_get(int classid, glui32 objid)
+{
+  classtable_t *ctab;
+  classref_t *cref;
+  if (classid < 0 || classid >= num_classes)
+    return NULL;
+  ctab = git_classes[classid];
+  cref = ctab->bucket[objid % CLASSHASH_SIZE];
+  for (; cref; cref = cref->next) {
+    if (cref->id == objid)
+      return cref->obj;
+  }
+  return NULL;
+}
+
+/* Put a Glk object in the appropriate hash table. */
+static classref_t *classes_put(int classid, void *obj)
+{
+  int bucknum;
+  classtable_t *ctab;
+  classref_t *cref;
+  if (classid < 0 || classid >= num_classes)
+    return NULL;
+  ctab = git_classes[classid];
+  cref = (classref_t *)glulx_malloc(sizeof(classref_t));
+  if (!cref)
+    return NULL;
+  cref->obj = obj;
+  cref->id = ctab->lastid;
+  ctab->lastid++;
+  bucknum = cref->id % CLASSHASH_SIZE;
+  cref->bucknum = bucknum;
+  cref->next = ctab->bucket[bucknum];
+  ctab->bucket[bucknum] = cref;
+  return cref;
+}
+
+/* Delete a Glk object from the appropriate hash table. */
+static void classes_remove(int classid, void *obj)
+{
+  classtable_t *ctab;
+  classref_t *cref;
+  classref_t **crefp;
+  gidispatch_rock_t objrock;
+  if (classid < 0 || classid >= num_classes)
+    return;
+  ctab = git_classes[classid];
+  objrock = gidispatch_get_objrock(obj, classid);
+  cref = objrock.ptr;
+  if (!cref)
+    return;
+  crefp = &(ctab->bucket[cref->bucknum]);
+  for (; *crefp; crefp = &((*crefp)->next)) {
+    if ((*crefp) == cref) {
+      *crefp = cref->next;
+      if (!cref->obj) {
+        fprintf(stderr, "attempt to free NULL object!\n");
+      }
+      cref->obj = NULL;
+      cref->id = 0;
+      cref->next = NULL;
+      glulx_free(cref);
+      return;
+    }
+  }
+  return;
+}
+
+/* The object registration/unregistration callbacks that the library calls
+    to keep the hash tables up to date. */
+    
+static gidispatch_rock_t glulxe_classtable_register(void *obj, 
+  glui32 objclass)
+{
+  classref_t *cref;
+  gidispatch_rock_t objrock;
+  cref = classes_put(objclass, obj);
+  objrock.ptr = cref;
+  return objrock;
+}
+
+static void glulxe_classtable_unregister(void *obj, glui32 objclass, 
+  gidispatch_rock_t objrock)
+{
+  classes_remove(objclass, obj);
+}
+
+static glui32 *grab_temp_array(glui32 addr, glui32 len, int passin)
+{
+  arrayref_t *arref = NULL;
+  glui32 *arr = NULL;
+  glui32 ix, addr2;
+
+  if (len) {
+    arr = (glui32 *)glulx_malloc(len * sizeof(glui32));
+    arref = (arrayref_t *)glulx_malloc(sizeof(arrayref_t));
+    if (!arr || !arref) 
+      fatalError("Unable to allocate space for array argument to Glk call.");
+
+    arref->array = arr;
+    arref->addr = addr;
+    arref->elemsize = 4;
+    arref->retained = FALSE;
+    arref->len = len;
+    arref->next = arrays;
+    arrays = arref;
+
+    if (passin) {
+      for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
+        arr[ix] = memRead32(addr2);
+      }
+    }
+  }
+
+  return arr;
+}
+
+static void release_temp_array(glui32 *arr, glui32 addr, glui32 len, int passout)
+{
+  arrayref_t *arref = NULL;
+  arrayref_t **aptr;
+  glui32 ix, val, addr2;
+
+  if (arr) {
+    for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
+      if ((*aptr)->array == arr)
+        break;
+    }
+    arref = *aptr;
+    if (!arref)
+      fatalError("Unable to re-find array argument in Glk call.");
+    if (arref->addr != addr || arref->len != len)
+      fatalError("Mismatched array argument in Glk call.");
+
+    if (arref->retained) {
+      return;
+    }
+
+    *aptr = arref->next;
+    arref->next = NULL;
+
+    if (passout) {
+      for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
+        val = arr[ix];
+        memWrite32(addr2, val);
+      }
+    }
+    glulx_free(arr);
+    glulx_free(arref);
+  }
+}
+
+gidispatch_rock_t glulxe_retained_register(void *array,
+  glui32 len, char *typecode)
+{
+  gidispatch_rock_t rock;
+  arrayref_t *arref = NULL;
+  arrayref_t **aptr;
+
+  if (typecode[4] != 'I' || array == NULL) {
+    /* We only retain integer arrays. */
+    rock.ptr = NULL;
+    return rock;
+  }
+
+  for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
+    if ((*aptr)->array == array)
+      break;
+  }
+  arref = *aptr;
+  if (!arref)
+    fatalError("Unable to re-find array argument in Glk call.");
+  if (arref->elemsize != 4 || arref->len != len)
+    fatalError("Mismatched array argument in Glk call.");
+
+  arref->retained = TRUE;
+
+  rock.ptr = arref;
+  return rock;
+}
+
+void glulxe_retained_unregister(void *array, glui32 len, 
+  char *typecode, gidispatch_rock_t objrock)
+{
+  arrayref_t *arref = NULL;
+  arrayref_t **aptr;
+  glui32 ix, addr2, val;
+
+  if (typecode[4] != 'I' || array == NULL) {
+    /* We only retain integer arrays. */
+    return;
+  }
+
+  for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
+    if ((*aptr)->array == array)
+      break;
+  }
+  arref = *aptr;
+  if (!arref)
+    fatalError("Unable to re-find array argument in Glk call.");
+  if (arref != objrock.ptr)
+    fatalError("Mismatched array reference in Glk call.");
+  if (!arref->retained)
+    fatalError("Unretained array reference in Glk call.");
+  if (arref->elemsize != 4 || arref->len != len)
+    fatalError("Mismatched array argument in Glk call.");
+
+  for (ix=0, addr2=arref->addr; ix<arref->len; ix++, addr2+=4) {
+    val = ((glui32 *)array)[ix];
+    memWrite32(addr2, val);
+  }
+  glulx_free(array);
+  glulx_free(arref);
+}
+
diff --git a/interpreters/git/heap.c b/interpreters/git/heap.c
new file mode 100644 (file)
index 0000000..3dfade1
--- /dev/null
@@ -0,0 +1,380 @@
+/* heap.c: Glulxe code related to the dynamic allocation heap.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#define glulx_malloc malloc
+#define glulx_free free
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+#include "glk.h"
+#include "git.h"
+
+typedef struct heapblock_struct {
+  glui32 addr;
+  glui32 len;
+  int isfree;
+  struct heapblock_struct *next;
+  struct heapblock_struct *prev;
+} heapblock_t;
+
+static glui32 heap_start = 0; /* zero for inactive heap */
+static int alloc_count = 0;
+
+/* The heap_head/heap_tail is a doubly-linked list of blocks, both
+   free and allocated. It is kept in address order. It should be
+   complete -- that is, the first block starts at heap_start, and each
+   block ends at the beginning of the next block, until the last one,
+   which ends at gEndMem.
+
+   (Heap_start is never the same as end_mem; if there is no heap space,
+   then the heap is inactive and heap_start is zero.)
+
+   Adjacent free blocks may be merged at heap_alloc() time.
+
+   ### To make alloc more efficient, we could keep a separate
+   free-list. To make free more efficient, we could keep a hash
+   table of allocations.
+ */
+static heapblock_t *heap_head = NULL;
+static heapblock_t *heap_tail = NULL;
+
+/* heap_clear():
+   Set the heap state to inactive, and free the block lists. This is
+   called when the game starts or restarts.
+*/
+void heap_clear()
+{
+  while (heap_head) {
+    heapblock_t *blo = heap_head;
+    heap_head = blo->next;
+    blo->next = NULL;
+    blo->prev = NULL;
+    glulx_free(blo);
+  }
+  heap_tail = NULL;
+
+  if (heap_start) {
+    glui32 res = resizeMemory(heap_start, 1);
+    if (res)
+      fatalError("Unable to revert memory size when deactivating heap.");
+  }
+
+  heap_start = 0;
+  alloc_count = 0;
+  /* heap_sanity_check(); */
+}
+
+/* heap_is_active():
+   Returns whether the heap is active.
+*/
+int heap_is_active() {
+  return (heap_start != 0);
+}
+
+/* heap_get_start():
+   Returns the start address of the heap, or 0 if the heap is not active.
+ */
+glui32 heap_get_start() {
+  return heap_start;
+}
+
+/* heap_alloc(): 
+   Allocate a block. If necessary, activate the heap and/or extend memory.
+   Returns the memory address of the block, or 0 if the operation failed.
+*/
+glui32 heap_alloc(glui32 len)
+{
+  heapblock_t *blo, *newblo;
+
+  if (len <= 0)
+    fatalError("Heap allocation length must be positive.");
+
+  blo = heap_head;
+  while (blo) {
+    if (blo->isfree && blo->len >= len)
+      break;
+
+    if (!blo->isfree) {
+      blo = blo->next;
+      continue;
+    }
+
+    if (!blo->next || !blo->next->isfree) {
+      blo = blo->next;
+      continue;
+    }
+
+    /* This is a free block, but the next block in the list is also
+       free, so we "advance" by merging rather than by going to
+       blo->next. */
+    newblo = blo->next;
+    blo->len += newblo->len;
+    if (newblo->next) {
+      blo->next = newblo->next;
+      newblo->next->prev = blo;
+    }
+    else {
+      blo->next = NULL;
+      heap_tail = blo;
+    }
+    newblo->next = NULL;
+    newblo->prev = NULL;
+    glulx_free(newblo);
+    newblo = NULL;
+    continue;
+  }
+
+  if (!blo) {
+    /* No free area is visible on the list. Try extending memory. How
+       much? Double the heap size, or by 256 bytes, or by the memory
+       length requested -- whichever is greatest. */
+    glui32 res;
+    glui32 extension;
+    glui32 oldendmem = gEndMem;
+
+    extension = 0;
+    if (heap_start)
+      extension = gEndMem - heap_start;
+    if (extension < len)
+      extension = len;
+    if (extension < 256)
+      extension = 256;
+    /* And it must be rounded up to a multiple of 256. */
+    extension = (extension + 0xFF) & (~(glui32)0xFF);
+
+    res = resizeMemory(gEndMem+extension, 1);
+    if (res)
+      return 0;
+
+    /* If we just started the heap, note that. */
+    if (heap_start == 0)
+      heap_start = oldendmem;
+
+    if (heap_tail && heap_tail->isfree) {
+      /* Append the new space to the last block. */
+      blo = heap_tail;
+      blo->len += extension;
+    }
+    else {
+      /* Append the new space to the block list, as a new block. */
+      newblo = glulx_malloc(sizeof(heapblock_t));
+      if (!newblo)
+        fatalError("Unable to allocate record for heap block.");
+      newblo->addr = oldendmem;
+      newblo->len = extension;
+      newblo->isfree = TRUE;
+      newblo->next = NULL;
+      newblo->prev = NULL;
+
+      if (!heap_tail) {
+        heap_head = newblo;
+        heap_tail = newblo;
+      }
+      else {
+        blo = heap_tail;
+        heap_tail = newblo;
+        blo->next = newblo;
+        newblo->prev = blo;
+      }
+
+      blo = newblo;
+      newblo = NULL;
+    }
+
+    /* and continue forwards, using this new block (blo). */
+  }
+
+  /* Something strange happened. */
+  if (!blo || !blo->isfree || blo->len < len)
+    return 0;
+
+  /* We now have a free block of size len or longer. */
+
+  if (blo->len == len) {
+    blo->isfree = FALSE;
+  }
+  else {
+    newblo = glulx_malloc(sizeof(heapblock_t));
+    if (!newblo)
+      fatalError("Unable to allocate record for heap block.");
+    newblo->isfree = TRUE;
+    newblo->addr = blo->addr + len;
+    newblo->len = blo->len - len;
+    blo->len = len;
+    blo->isfree = FALSE;
+    newblo->next = blo->next;
+    if (newblo->next)
+      newblo->next->prev = newblo;
+    newblo->prev = blo;
+    blo->next = newblo;
+    if (heap_tail == blo)
+      heap_tail = newblo;
+  }
+
+  alloc_count++;
+  /* heap_sanity_check(); */
+  return blo->addr;
+}
+
+/* heap_free():
+   Free a heap block. If necessary, deactivate the heap.
+*/
+void heap_free(glui32 addr)
+{
+  heapblock_t *blo;
+
+  for (blo = heap_head; blo; blo = blo->next) { 
+    if (blo->addr == addr)
+      break;
+  };
+  if (!blo || blo->isfree)
+    fatalError("Attempt to free unallocated address from heap.");
+
+  blo->isfree = TRUE;
+  alloc_count--;
+  if (alloc_count <= 0) {
+    heap_clear();
+  }
+
+  /* heap_sanity_check(); */
+}
+
+/* heap_get_summary():
+   Create an array of words, in the VM serialization format:
+
+     heap_start
+     alloc_count
+     addr of first block
+     len of first block
+     ...
+
+   (Note that these are glui32 values -- native byte ordering. Also,
+   the blocks will be in address order, which is a stricter guarantee
+   than the VM specifies; that'll help in heap_apply_summary().)
+
+   If the heap is inactive, store NULL. Return 0 for success;
+   otherwise, the operation failed.
+
+   The array returned in summary must be freed with glulx_free() after
+   the caller uses it.
+*/
+int heap_get_summary(glui32 *valcount, glui32 **summary)
+{
+  glui32 *arr, len, pos;
+  heapblock_t *blo;
+
+  *valcount = 0;
+  *summary = NULL;
+
+  if (heap_start == 0)
+    return 0;
+
+  len = 2 + 2*alloc_count;
+  arr = glulx_malloc(len * sizeof(glui32));
+  if (!arr)
+    return 1;
+
+  pos = 0;
+  arr[pos++] = heap_start;
+  arr[pos++] = alloc_count;
+
+  for (blo = heap_head; blo; blo = blo->next) {
+    if (blo->isfree)
+      continue;
+    arr[pos++] = blo->addr;
+    arr[pos++] = blo->len;
+  }
+
+  if (pos != len)
+    fatalError("Wrong number of active blocks in heap");
+
+  *valcount = len;
+  *summary = arr;
+  return 0;
+}
+
+/* heap_apply_summary():
+   Given an array of words in the above format, set up the heap to
+   contain it. As noted above, the caller must ensure that the blocks
+   are in address order. When this is called, the heap must be
+   inactive.
+
+   Return 0 for success. Otherwise the operation failed (and, most
+   likely, caused a fatal error).
+*/
+int heap_apply_summary(glui32 valcount, glui32 *summary)
+{
+  glui32 lx, jx, lastend;
+
+  if (heap_start)
+    fatalError("Heap active when heap_apply_summary called");
+
+  if (valcount == 0 || summary == NULL)
+    return 0;
+  if (valcount == 2 && summary[0] == 0 && summary[1] == 0)
+    return 0;
+
+  lx = 0;
+  heap_start = summary[lx++];
+  alloc_count = summary[lx++];
+
+  for (jx=lx; jx+2<valcount; jx+=2) {
+    if (summary[jx] >= summary[jx+2])
+      fatalError("Heap block summary is out of order.");
+  }
+
+  lastend = heap_start;
+
+  while (lx < valcount || lastend < gEndMem) {
+    heapblock_t *blo;
+
+    blo = glulx_malloc(sizeof(heapblock_t));
+    if (!blo)
+      fatalError("Unable to allocate record for heap block.");
+
+    if (lx >= valcount) {
+      blo->addr = lastend;
+      blo->len = gEndMem - lastend;
+      blo->isfree = TRUE;
+    }
+    else {
+      if (lastend < summary[lx]) {
+        blo->addr = lastend;
+        blo->len = summary[lx] - lastend;
+        blo->isfree = TRUE;
+      }
+      else {
+        blo->addr = summary[lx++];
+        blo->len = summary[lx++];
+        blo->isfree = FALSE;
+      }
+    }
+
+    blo->prev = NULL;
+    blo->next = NULL;
+
+    if (!heap_head) {
+      heap_head = blo;
+      heap_tail = blo;
+    }
+    else {
+      heap_tail->next = blo;
+      blo->prev = heap_tail;
+      heap_tail = blo;
+    }
+
+    lastend = blo->addr + blo->len;
+  }
+
+  /* heap_sanity_check(); */
+
+  return 0;
+}
+
diff --git a/interpreters/git/labels.inc b/interpreters/git/labels.inc
new file mode 100644 (file)
index 0000000..5268616
--- /dev/null
@@ -0,0 +1,205 @@
+// Pseudo-operations.
+
+LABEL (jump_abs_L7)
+LABEL (enter_function_L1)
+
+LABEL (debug_step)
+
+LABEL (args_stack_call_stub_discard)
+LABEL (args_stack_call_stub_addr)
+LABEL (args_stack_call_stub_local)
+LABEL (args_stack_call_stub_stack)
+
+LABEL (args_stack)
+LABEL (args_0)
+LABEL (args_1)
+LABEL (args_2)
+LABEL (args_3)
+
+LABEL (call_stub_discard)
+LABEL (call_stub_addr)
+LABEL (call_stub_local)
+LABEL (call_stub_stack)
+
+LABEL (catch_stub_discard)
+LABEL (catch_stub_addr)
+LABEL (catch_stub_local)
+LABEL (catch_stub_stack)
+
+LABEL (save_stub_discard)
+LABEL (save_stub_addr)
+LABEL (save_stub_local)
+LABEL (save_stub_stack)
+
+LABEL (undo_stub_discard)
+LABEL (undo_stub_addr)
+LABEL (undo_stub_local)
+LABEL (undo_stub_stack)
+
+LABEL (tailcall)
+LABEL (throw)
+
+// Loading and storing registers.
+
+#define LOAD_LABELS(tag)                       \
+       LABEL (L1_ ## tag)                              \
+       LABEL (L2_ ## tag)                              \
+       LABEL (L3_ ## tag)                              \
+       LABEL (L4_ ## tag)                              \
+       LABEL (L5_ ## tag)                              \
+       LABEL (L6_ ## tag)                              \
+       LABEL (L7_ ## tag)                              \
+       LABEL (L1_const_L2_ ## tag)             \
+       LABEL (L1_stack_L2_ ## tag)             \
+       LABEL (L1_local_L2_ ## tag)             \
+       LABEL (L1_addr_L2_ ## tag)
+
+#define STORE_LABELS(tag)                      \
+       LABEL (S1_ ## tag)                              \
+       LABEL (S2_ ## tag)
+
+LOAD_LABELS(const)
+LOAD_LABELS(stack)
+LOAD_LABELS(local)
+LOAD_LABELS(addr)
+
+STORE_LABELS(stack)
+STORE_LABELS(local)
+STORE_LABELS(addr)
+
+LABEL(L1_addr16)
+LABEL(L1_addr8)
+
+LABEL(S1_addr16)
+LABEL(S1_addr8)
+
+#undef LOAD_LABELS
+#undef STORE_LABELS
+
+// Labels corresponding to glulx opcodes.
+
+LABEL (nop)
+
+#define PEEPHOLE_STORE_LABELS(tag) \
+       LABEL (add ## tag) \
+       LABEL (sub ## tag) \
+       LABEL (mul ## tag) \
+       LABEL (div ## tag) \
+       LABEL (mod ## tag) \
+       LABEL (neg ## tag) \
+       LABEL (bitand ## tag) \
+       LABEL (bitor ## tag) \
+       LABEL (bitxor ## tag) \
+       LABEL (bitnot ## tag) \
+       LABEL (shiftl ## tag) \
+       LABEL (sshiftr ## tag) \
+       LABEL (ushiftr ## tag) \
+       LABEL (copys ## tag) \
+       LABEL (copyb ## tag) \
+       LABEL (sexs ## tag) \
+       LABEL (sexb ## tag) \
+       LABEL (aload ## tag) \
+       LABEL (aloads ## tag) \
+       LABEL (aloadb ## tag) \
+       LABEL (aloadbit ## tag)
+
+PEEPHOLE_STORE_LABELS(_discard)
+PEEPHOLE_STORE_LABELS(_S1_stack)
+PEEPHOLE_STORE_LABELS(_S1_local)
+PEEPHOLE_STORE_LABELS(_S1_addr)
+
+#define PEEPHOLE_LOAD_LABELS(tag) \
+       LABEL (return_L1_ ## tag) \
+       LABEL (astore_L3_ ## tag) \
+       LABEL (astores_L3_ ## tag) \
+       LABEL (astoreb_L3_ ## tag) \
+       LABEL (astorebit_L3_ ## tag)
+
+PEEPHOLE_LOAD_LABELS(const)
+PEEPHOLE_LOAD_LABELS(stack)
+PEEPHOLE_LOAD_LABELS(addr)
+PEEPHOLE_LOAD_LABELS(local)
+
+LABEL (return)
+LABEL (astore)
+LABEL (astores)
+LABEL (astoreb)
+LABEL (astorebit)
+
+#undef PEEPHOLE_STORE_LABELS
+
+#define BRANCH_LABELS(tag)   \
+       LABEL (jump ## tag)  \
+       LABEL (jz ## tag)    \
+       LABEL (jnz ## tag)   \
+       LABEL (jeq ## tag)   \
+       LABEL (jne ## tag)   \
+       LABEL (jlt ## tag)   \
+       LABEL (jge ## tag)   \
+       LABEL (jgt ## tag)   \
+       LABEL (jle ## tag)   \
+       LABEL (jltu ## tag)  \
+       LABEL (jgeu ## tag)  \
+       LABEL (jgtu ## tag)  \
+       LABEL (jleu ## tag)
+
+BRANCH_LABELS(_var)
+BRANCH_LABELS(_const)
+BRANCH_LABELS(_by)
+BRANCH_LABELS(_return0)
+BRANCH_LABELS(_return1)
+
+LABEL (stkcount)
+LABEL (stkpeek)
+LABEL (stkswap)
+LABEL (stkroll)
+LABEL (stkcopy)
+
+LABEL (streamchar)
+LABEL (streamnum)
+LABEL (streamstr)
+LABEL (streamunichar)
+
+LABEL (gestalt)
+LABEL (debugtrap)
+LABEL (getmemsize)
+LABEL (setmemsize)
+LABEL (jumpabs)
+
+LABEL (random)
+LABEL (setrandom)
+
+LABEL (quit)
+LABEL (verify)
+LABEL (restart)
+LABEL (restore)
+LABEL (restoreundo)
+LABEL (protect)
+
+LABEL (glk)
+
+LABEL (getstringtbl)
+LABEL (setstringtbl)
+LABEL (getiosys)
+LABEL (setiosys)
+
+LABEL (linearsearch)
+LABEL (binarysearch)
+LABEL (linkedsearch)
+
+LABEL (mzero)
+LABEL (mcopy)
+LABEL (malloc)
+LABEL (mfree)
+
+LABEL (accelfunc)
+LABEL (accelparam)
+
+LABEL (git_setcacheram)
+LABEL (git_prunecache)
+
+LABEL (error_bad_opcode)
+LABEL (recompile)
+
+// No more labels to define.
+#undef LABEL
diff --git a/interpreters/git/memory.c b/interpreters/git/memory.c
new file mode 100644 (file)
index 0000000..b5f0729
--- /dev/null
@@ -0,0 +1,179 @@
+// $Id: memory.c,v 1.11 2004/01/25 21:04:19 iain Exp $
+
+#include "git.h"
+#include <stdlib.h>
+#include <string.h>
+
+const git_uint8 * gRom;
+git_uint8 * gRam;
+
+git_uint32 gRamStart;
+git_uint32 gExtStart;
+git_uint32 gEndMem;
+git_uint32 gOriginalEndMem;
+
+#define RAM_OVERLAP 8
+
+void initMemory (const git_uint8 * gamefile, git_uint32 size)
+{
+       // Make sure we have at least enough
+       // data for the standard glulx header.
+
+       if (size < 36)
+               fatalError("This file is too small to be a valid glulx gamefile");
+       
+       // Set up a basic environment that will
+       // let us inspect the header.
+
+       gRom = gamefile;
+       gRamStart = 36;
+
+       // Check the magic number. From the spec:
+       //     * Magic number: 47 6C 75 6C, which is to say ASCII 'Glul'.
+
+       if (memRead32 (0) != 0x476c756c)
+               fatalError("This is not a glulx game file");
+
+       // Load the correct values for ramstart, extstart and endmem.
+       // (Load ramstart last because it's required by memRead32 --
+       // if we get a wonky ramstart, the other reads could fail.)
+
+       gOriginalEndMem = gEndMem = memRead32 (16);
+       gExtStart = memRead32 (12);
+       gRamStart = memRead32 (8);
+
+       // Make sure the values are sane.
+
+    if (gRamStart < 36)
+           fatalError ("Bad header (RamStart is too low)");
+        
+    if (gRamStart > size)
+           fatalError ("Bad header (RamStart is bigger than the entire gamefile)");
+        
+    if (gExtStart > size)
+           fatalError ("Bad header (ExtStart is bigger than the entire gamefile)");
+        
+    if (gExtStart < gRamStart)
+           fatalError ("Bad header (ExtStart is lower than RamStart)");
+        
+    if (gEndMem < gExtStart)
+           fatalError ("Bad header (EndMem is lower than ExtStart)");
+        
+       if (gRamStart & 255)
+           fatalError ("Bad header (RamStart is not a multiple of 256)");
+
+       if (gExtStart & 255)
+           fatalError ("Bad header (ExtStart is not a multiple of 256)");
+
+       if (gEndMem & 255)
+           fatalError ("Bad header (EndMem is not a multiple of 256)");
+
+       // Allocate the RAM. We'll duplicate the last few bytes of ROM
+       // here so that reads which cross the ROM/RAM boundary don't fail.
+
+       gRamStart -= RAM_OVERLAP; // Adjust RAM boundary to include some ROM.
+
+       gRam = malloc (gEndMem - gRamStart);
+    if (gRam == NULL)
+        fatalError ("Failed to allocate game RAM");
+
+       gRam -= gRamStart;
+
+       // Copy the initial contents of RAM.
+       memcpy (gRam + gRamStart, gRom + gRamStart, gExtStart - gRamStart);
+
+       // Zero out the extended RAM.
+       memset (gRam + gExtStart, 0, gEndMem - gExtStart);
+
+       gRamStart += RAM_OVERLAP; // Restore boundary to its previous value.
+}
+
+int verifyMemory ()
+{
+    git_uint32 checksum = 0;
+
+    git_uint32 n;
+    for (n = 0 ; n < gExtStart ; n += 4)
+        checksum += read32 (gRom + n);
+    
+    checksum -= read32 (gRom + 32);
+    return (checksum == read32 (gRom + 32)) ? 0 : 1;
+}
+
+int resizeMemory (git_uint32 newSize, int isInternal)
+{
+    git_uint8* newRam;
+    
+    if (newSize == gEndMem)
+        return 0; // Size is not changed.
+    if (!isInternal && heap_is_active())
+        fatalError ("Cannot resize Glulx memory space while heap is active.");
+    if (newSize < gOriginalEndMem)
+        fatalError ("Cannot resize Glulx memory space smaller than it started.");
+    if (newSize & 0xFF)
+        fatalError ("Can only resize Glulx memory space to a 256-byte boundary.");
+    
+    gRamStart -= RAM_OVERLAP; // Adjust RAM boundary to include some ROM.
+    newRam = realloc(gRam + gRamStart, newSize - gRamStart);
+    if (!newRam)
+    {  
+        gRamStart += RAM_OVERLAP; // Restore boundary to its previous value.
+        return 1; // Failed to extend memory.
+    }
+    if (newSize > gEndMem)
+        memset (newRam + gEndMem - gRamStart, 0, newSize - gEndMem);
+
+    gRam = newRam - gRamStart;
+    gEndMem = newSize;
+    gRamStart += RAM_OVERLAP; // Restore boundary to its previous value.
+    return 0;
+}
+
+void resetMemory (git_uint32 protectPos, git_uint32 protectSize)
+{
+    git_uint32 protectEnd = protectPos + protectSize;
+    git_uint32 i;
+
+    // Deactivate the heap (if it was active).
+    heap_clear();
+
+    gEndMem = gOriginalEndMem;
+      
+    // Copy the initial contents of RAM.
+    for (i = gRamStart; i < gExtStart; ++i)
+    {
+        if (i >= protectEnd || i < protectPos)
+            gRam [i] = gRom [i];
+    }
+
+    // Zero out the extended RAM.
+    for (i = gExtStart; i < gEndMem; ++i)
+    {
+        if (i >= protectEnd || i < protectPos)
+            gRam [i] = 0;
+    }
+}
+
+void shutdownMemory ()
+{
+    // We didn't allocate the ROM, so we
+    // only need to dispose of the RAM.
+    
+    free (gRam + gRamStart - RAM_OVERLAP);
+    
+    // Zero out all our globals.
+    
+    gRamStart = gExtStart = gEndMem = gOriginalEndMem = 0;
+    gRom = gRam = NULL;
+}
+
+git_uint32 memReadError (git_uint32 address)
+{
+    fatalError ("Out-of-bounds memory access");
+    return 0;
+}
+
+void memWriteError (git_uint32 address)
+{
+    fatalError ("Out-of-bounds memory access");
+}
diff --git a/interpreters/git/memory.h b/interpreters/git/memory.h
new file mode 100644 (file)
index 0000000..3cb3916
--- /dev/null
@@ -0,0 +1,160 @@
+// $Id: memory.h,v 1.7 2004/01/25 21:04:19 iain Exp $
+// Functions and macros for accessing game memory.
+
+#ifndef GIT_MEMORY_H
+#define GIT_MEMORY_H
+
+#include "config.h"
+
+// --------------------------------------------------------------
+// Macros for reading and writing big-endian data.
+
+#ifdef USE_BIG_ENDIAN_UNALIGNED
+// We're on a big-endian platform which can handle unaligned
+// accesses, such as the PowerPC. This means we can read and
+// write multi-byte values in glulx memory directly, without
+// having to pack and unpack each byte.
+
+#define read32(ptr)    (*((git_uint32*)(ptr)))
+#define read16(ptr)    (*((git_uint16*)(ptr)))
+#define write32(ptr,v) (read32(ptr)=(git_uint32)(v))
+#define write16(ptr,v) (read16(ptr)=(git_uint16)(v))
+
+#else
+// We're on a little-endian platform, such as the x86, or a
+// big-endian platform that doesn't like unaligned accesses,
+// such as the 68K. This means we have to read and write the
+// slow and tedious way.
+
+#define read32(ptr)    \
+  ( (git_uint32)(((git_uint8 *)(ptr))[0] << 24) \
+  | (git_uint32)(((git_uint8 *)(ptr))[1] << 16) \
+  | (git_uint32)(((git_uint8 *)(ptr))[2] << 8)  \
+  | (git_uint32)(((git_uint8 *)(ptr))[3]))
+#define read16(ptr)    \
+  ( (git_uint16)(((git_uint8 *)(ptr))[0] << 8)  \
+  | (git_uint16)(((git_uint8 *)(ptr))[1]))
+
+#define write32(ptr, v)   \
+  (((ptr)[0] = (git_uint8)(((git_uint32)(v)) >> 24)), \
+   ((ptr)[1] = (git_uint8)(((git_uint32)(v)) >> 16)), \
+   ((ptr)[2] = (git_uint8)(((git_uint32)(v)) >> 8)),  \
+   ((ptr)[3] = (git_uint8)(((git_uint32)(v)))))
+#define write16(ptr, v)   \
+  (((ptr)[0] = (git_uint8)(((git_uint32)(v)) >> 8)),  \
+   ((ptr)[1] = (git_uint8)(((git_uint32)(v)))))
+
+#endif // USE_BIG_ENDIAN_UNALIGNED
+
+// Accessing single bytes is easy on any platform.
+
+#define read8(ptr)     (*((git_uint8*)(ptr)))
+#define write8(ptr, v) (read8(ptr)=(git_uint8)(v))
+
+// --------------------------------------------------------------
+// Globals
+
+extern git_uint32 gRamStart; // The start of RAM.
+extern git_uint32 gExtStart; // The start of extended memory (initialised to zero).
+extern git_uint32 gEndMem;   // The current end of memory.
+extern git_uint32 gOriginalEndMem; // The value of EndMem when the game was first loaded.
+
+// This is the entire gamefile, as read-only memory. It contains
+// both the ROM, which is constant for the entire run of the program,
+// and the original RAM, which is useful for checking what's changed
+// when saving to disk or remembering a position for UNDO.
+extern const git_uint8 * gRom;
+
+// This is the current contents of RAM. This pointer actually points
+// to the start of ROM, so that you don't have to keep adding and
+// subtracting gRamStart, but don't try to access ROM via this pointer.
+extern git_uint8 * gRam;
+
+// --------------------------------------------------------------
+// Functions
+
+// Initialise game memory. This sets up all the global variables
+// declared above. Note that it does *not* copy the given memory
+// image: it must be valid for the lifetime of the program.
+
+extern void initMemory (const git_uint8 * game, git_uint32 gameSize);
+
+// Verifies the gamefile based on its checksum. 0 on success, 1 on failure.
+
+extern int verifyMemory ();
+
+// Resizes the game's memory. Returns 0 on success, 1 on failure.
+
+extern int resizeMemory (git_uint32 newSize, int isInternal);
+
+// Resets memory to its initial state. Call this when the game restarts.
+
+extern void resetMemory (git_uint32 protectPos, git_uint32 protectSize);
+
+// Disposes of all the data structures allocated in initMemory().
+
+extern void shutdownMemory ();
+
+// Utility functions -- these just pass an appropriate
+// string to fatalError().
+
+extern git_uint32 memReadError (git_uint32 address);
+extern void memWriteError (git_uint32 address);
+
+// Functions for reading and writing game memory.
+
+GIT_INLINE git_uint32 memRead32 (git_uint32 address)
+{
+       if (address <= gRamStart - 4)
+               return read32 (gRom + address);
+       else if (address <= gEndMem - 4)
+               return read32 (gRam + address);
+    else
+        return memReadError (address);
+}
+
+GIT_INLINE git_uint32 memRead16 (git_uint32 address)
+{
+       if (address <= gRamStart - 4)
+               return read16 (gRom + address);
+       else if (address <= gEndMem - 2)
+               return read16 (gRam + address);
+    else
+        return memReadError (address);
+}
+
+GIT_INLINE git_uint32 memRead8 (git_uint32 address)
+{
+    if (address <= gRamStart - 4)
+        return read8 (gRom + address);
+    else if (address < gEndMem)
+        return read8 (gRam + address);
+    else
+        return memReadError (address);
+}
+
+GIT_INLINE void memWrite32 (git_uint32 address, git_uint32 val)
+{
+       if (address >= gRamStart && address <= (gEndMem - 4))
+               write32 (gRam + address, val);
+       else
+        memWriteError (address);
+}
+
+GIT_INLINE void memWrite16 (git_uint32 address, git_uint32 val)
+{
+       if (address >= gRamStart && address <= (gEndMem - 2))
+               write16 (gRam + address, val);
+       else
+        memWriteError (address);
+}
+
+GIT_INLINE void memWrite8 (git_uint32 address, git_uint32 val)
+{
+       if (address >= gRamStart && address < gEndMem)
+               write8 (gRam + address, val);
+       else
+        memWriteError (address);
+}
+
+#endif // GIT_MEMORY_H
diff --git a/interpreters/git/opcodes.c b/interpreters/git/opcodes.c
new file mode 100644 (file)
index 0000000..a57abb3
--- /dev/null
@@ -0,0 +1,466 @@
+// $Id: opcodes.c,v 1.20 2004/12/22 12:40:07 iain Exp $
+
+#include "git.h"
+#include "opcodes.h"
+
+static void parseModeNibbles (git_uint32* pc, int numModes, int * modeBuffer)
+{
+    int * mode = modeBuffer;
+
+    while (numModes > 0)
+    {
+        // Load byte.
+        git_uint32 byte = memRead8((*pc)++);
+
+        // Load low nibble.
+        *mode++ = byte & 0x0f;
+        --numModes;
+
+        // Check whether we need to load any more.
+        if (numModes == 0)
+            break;
+
+        // Load high nibble.
+        *mode++ = (byte >> 4) & 0x0f;
+        --numModes;
+    }
+}
+
+static void parseLS (git_uint32* pc, Label op)
+{
+    int modes [2];
+    parseModeNibbles (pc, 2, modes);
+
+    parseLoad (pc, reg_L1, modes [0], size32, NULL);
+    emitCode (op);
+    parseStore (pc, reg_S1, modes [1], size32);
+}
+static void parseLLS (git_uint32* pc, Label op)
+{
+    int modes [3];
+    parseModeNibbles (pc, 3, modes);
+
+    parseLoad (pc, reg_L1, modes [0], size32, NULL);
+    parseLoad (pc, reg_L2, modes [1], size32, NULL);
+    emitCode (op);
+    parseStore (pc, reg_S1, modes [2], size32);
+}
+static void parseL (git_uint32* pc, Label op)
+{
+    int modes [1];
+    parseModeNibbles (pc, 1, modes);
+
+    parseLoad (pc, reg_L1, modes [0], size32, NULL);
+    emitCode (op);
+}
+static void parseLL (git_uint32* pc, Label op)
+{
+    int modes [2];
+    parseModeNibbles (pc, 2, modes);
+
+    parseLoad (pc, reg_L1, modes [0], size32, NULL);
+    parseLoad (pc, reg_L2, modes [1], size32, NULL);
+    emitCode (op);
+}
+static void parse_finish_branch (git_uint32* pc, Label op, LoadReg reg, int mode)
+{
+    git_sint32 val;
+    if (parseLoad (pc, reg, mode, size32, &val))
+    {
+        // The branch offset is a constant, so we can
+        // check for the special values 0 and 1 right here.
+        
+        if (val == 0)
+        {
+            emitCode (op - label_jeq_var + label_jeq_return0);
+        }
+        else if (val == 1)
+        {
+            emitCode (op - label_jeq_var + label_jeq_return1);
+        }
+        else
+        {
+            // Calculate the destination address and
+            // emit a constant branch opcode.
+            emitConstBranch (op - label_jeq_var + label_jeq_const, *pc + val - 2);
+        }
+    }
+    else
+    {
+        // The branch offset isn't a constant, so just
+        // emit the normal opcode plus the current PC.
+        
+        emitCode (op);
+        emitData(*pc);
+    }
+}
+static void parseLLL_branch (git_uint32* pc, Label op)
+{
+    int modes [3];
+    parseModeNibbles (pc, 3, modes);
+
+    parseLoad (pc, reg_L1, modes [0], size32, NULL);
+    parseLoad (pc, reg_L2, modes [1], size32, NULL);
+    parse_finish_branch (pc, op, reg_L3, modes [2]);
+}
+static void parseLL_branch (git_uint32* pc, Label op)
+{
+    int modes [2];
+    parseModeNibbles (pc, 2, modes);
+
+    parseLoad (pc, reg_L1, modes [0], size32, NULL);
+    parse_finish_branch (pc, op, reg_L2, modes [1]);
+}
+static void parseL_branch (git_uint32* pc, Label op)
+{
+    int modes [1];
+    parseModeNibbles (pc, 1, modes);
+
+    parse_finish_branch (pc, op, reg_L1, modes [0]);
+}
+static void parseLLL (git_uint32* pc, Label op)
+{
+    int modes [3];
+    parseModeNibbles (pc, 3, modes);
+
+    parseLoad (pc, reg_L1, modes [0], size32, NULL);
+    parseLoad (pc, reg_L2, modes [1], size32, NULL);
+    parseLoad (pc, reg_L3, modes [2], size32, NULL);
+    emitCode (op);
+}
+static void parseS (git_uint32* pc, Label op)
+{
+    int modes [1];
+    parseModeNibbles (pc, 1, modes);
+
+    emitCode (op);
+    parseStore (pc, reg_S1, modes [0], size32);
+}
+static void parseSS (git_uint32* pc, Label op)
+{
+    int modes [2];
+    parseModeNibbles (pc, 2, modes);
+
+    emitCode (op);
+    parseStore (pc, reg_S1, modes [0], size32);
+    parseStore (pc, reg_S2, modes [1], size32);
+}
+static void parseCatch (git_uint32 * pc)
+{
+    Block stubCode;
+    int modes [2];
+    parseModeNibbles (pc, 2, modes);
+
+    parseCatchStub (pc, modes[0]);
+
+    // This is a little nasty. The last thing emitted by
+    // parseCatchStub() is the current value of the PC,
+    // which is where execution will resume when and if
+    // the stub is used; but execution should resume
+    // after the branch we're about to do, so we'll need
+    // to fix up that emitted value.
+
+    stubCode = peekAtEmittedStuff (1);
+
+    parseLoad (pc, reg_L1, modes[1], size32, NULL);
+    emitCode (label_jump_var);
+    emitData(*pc);
+
+    // Fix up the end of the stub, as described above.
+    *stubCode = *pc;
+}
+void parseInstruction (git_uint32* pc, int * done)
+{
+    git_uint32 pcStart = *pc;
+    int modes [8];
+    git_uint32 opcode;
+    
+    static int ops = 0;
+    ++ops;
+    
+    // Fetch the opcode.
+    opcode = memRead8((*pc)++);
+
+    // Check for multi-byte opcode.
+    if (opcode & 0x80)
+    {
+        if (opcode & 0x40)
+        {
+            // Four-byte opcode.
+            opcode &= 0x3F;
+            opcode = (opcode << 8) | memRead8((*pc)++);
+            opcode = (opcode << 8) | memRead8((*pc)++);
+            opcode = (opcode << 8) | memRead8((*pc)++);
+        }
+        else
+        {
+            // Two-byte opcode.
+            opcode &= 0x7F;
+            opcode = (opcode << 8) | memRead8((*pc)++);
+        }
+    }
+
+    if (gDebug)
+    {
+        emitCode (label_debug_step);
+        emitData (pcStart);
+        emitData (opcode);
+    }
+    
+    // printf (" opcode=0x%x", opcode);
+    
+    // Now we have an opcode number,
+    // parse the operands and emit code.
+    
+    switch (opcode)
+    {
+        case op_nop: emitCode (label_nop); break;
+
+        // Arithmetic and logic
+
+        case op_add: parseLLS (pc, label_add_discard); break;
+        case op_sub: parseLLS (pc, label_sub_discard); break;        
+        case op_mul: parseLLS (pc, label_mul_discard); break;
+        case op_div: parseLLS (pc, label_div_discard); break;
+        case op_mod: parseLLS (pc, label_mod_discard); break;
+        
+        case op_bitand: parseLLS (pc, label_bitand_discard); break;
+        case op_bitor:  parseLLS (pc, label_bitor_discard);  break;
+        case op_bitxor: parseLLS (pc, label_bitxor_discard); break;
+
+        case op_neg:    parseLS (pc, label_neg_discard);    break;
+        case op_bitnot: parseLS (pc, label_bitnot_discard); break;
+
+        case op_shiftl:  parseLLS (pc, label_shiftl_discard);  break;
+        case op_ushiftr: parseLLS (pc, label_ushiftr_discard); break;
+        case op_sshiftr: parseLLS (pc, label_sshiftr_discard); break;
+
+        // Branches
+
+        case op_jump: parseL_branch (pc, label_jump_var); *done = 1; break;
+        case op_jz:   parseLL_branch (pc, label_jz_var);  break;
+        case op_jnz:  parseLL_branch (pc, label_jnz_var); break;
+        case op_jeq:  parseLLL_branch (pc, label_jeq_var);  break;
+        case op_jne:  parseLLL_branch (pc, label_jne_var);  break;
+        case op_jlt:  parseLLL_branch (pc, label_jlt_var);  break;
+        case op_jgt:  parseLLL_branch (pc, label_jgt_var);  break;
+        case op_jle:  parseLLL_branch (pc, label_jle_var);  break;
+        case op_jge:  parseLLL_branch (pc, label_jge_var);  break;
+        case op_jltu: parseLLL_branch (pc, label_jltu_var); break;
+        case op_jgtu: parseLLL_branch (pc, label_jgtu_var); break;
+        case op_jleu: parseLLL_branch (pc, label_jleu_var); break;
+        case op_jgeu: parseLLL_branch (pc, label_jgeu_var); break;
+        
+        case op_jumpabs: parseL (pc, label_jumpabs); *done = 1; break;
+
+        // Moving data
+
+        case op_copy:
+            parseModeNibbles (pc, 2, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseStore (pc, reg_S1, modes [1], size32);
+            break;
+
+        case op_copys:
+            parseModeNibbles (pc, 2, modes);
+            parseLoad (pc, reg_L1, modes [0], size16, NULL);
+            emitCode (label_copys_discard);
+            parseStore (pc, reg_S1, modes [1], size16);
+            break;
+        
+        case op_copyb:
+            parseModeNibbles (pc, 2, modes);
+            parseLoad (pc, reg_L1, modes [0], size8, NULL);
+            emitCode (label_copyb_discard);
+            parseStore (pc, reg_S1, modes [1], size8);
+            break;
+
+        case op_sexs: parseLS (pc, label_sexs_discard); break;
+        case op_sexb: parseLS (pc, label_sexb_discard); break;
+
+        // Array data
+
+        case op_aload:    parseLLS (pc, label_aload_discard);    break;
+        case op_aloads:   parseLLS (pc, label_aloads_discard);   break;
+        case op_aloadb:   parseLLS (pc, label_aloadb_discard);   break;
+        case op_aloadbit: parseLLS (pc, label_aloadbit_discard); break;
+        
+        case op_astore:    parseLLL (pc, label_astore);    break;
+        case op_astores:   parseLLL (pc, label_astores);   break;
+        case op_astoreb:   parseLLL (pc, label_astoreb);   break;
+        case op_astorebit: parseLLL (pc, label_astorebit); break;
+
+        // The stack
+
+        case op_stkcount: parseS (pc, label_stkcount);  break;
+        case op_stkpeek:  parseLS (pc, label_stkpeek);  break;
+        case op_stkswap:  emitCode (label_stkswap); break;
+        case op_stkcopy:  parseL (pc, label_stkcopy);   break;
+        case op_stkroll:  parseLL (pc, label_stkroll);  break;
+
+        // Functions
+
+        case op_call:
+            parseModeNibbles (pc, 3, modes);        
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseLoad (pc, reg_L2, modes [1], size32, NULL);
+            emitCode (label_args_stack);
+            parseCallStub (pc, modes [2]);
+            break;
+
+        case op_callf:
+            parseModeNibbles (pc, 2, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            emitCode (label_args_0);
+            parseCallStub (pc, modes [1]);
+            break;
+
+        case op_callfi:
+            parseModeNibbles (pc, 3, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseLoad (pc, reg_L2, modes [1], size32, NULL);
+            emitCode (label_args_1);
+            parseCallStub (pc, modes [2]);
+            break;
+
+        case op_callfii:
+            parseModeNibbles (pc, 4, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseLoad (pc, reg_L2, modes [1], size32, NULL);
+            parseLoad (pc, reg_L3, modes [2], size32, NULL);
+            emitCode (label_args_2);
+            parseCallStub (pc, modes [3]);
+            break;
+
+        case op_callfiii:
+            parseModeNibbles (pc, 5, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseLoad (pc, reg_L2, modes [1], size32, NULL);
+            parseLoad (pc, reg_L3, modes [2], size32, NULL);
+            parseLoad (pc, reg_L4, modes [3], size32, NULL);
+            emitCode (label_args_3);
+            parseCallStub (pc, modes [4]);
+            break;
+
+        case op_return:
+            parseL (pc, label_return);
+            *done = 1;
+            break;
+
+        case op_tailcall:
+            parseModeNibbles (pc, 2, modes);        
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseLoad (pc, reg_L2, modes [1], size32, NULL);
+            emitCode (label_args_stack);
+            emitCode (label_tailcall);
+            *done = 1;
+            break;
+
+        // Continuations
+
+        case op_catch: parseCatch (pc); break;
+           case op_throw:
+            parseLL (pc, label_throw);
+            *done = 1;
+            break;
+
+        case op_random:  parseLS (pc, label_random); break;
+        case op_setrandom:  parseL (pc, label_setrandom); break;
+
+        case op_getmemsize: parseS (pc, label_getmemsize); break;
+        case op_setmemsize: parseLS (pc, label_setmemsize); break;
+        
+        case op_quit:
+            emitCode (label_quit);
+            *done = 1;
+            break;
+        
+        case op_restart:
+            emitCode (label_restart);
+            *done = 1;
+            break;
+        
+        case op_restore: parseLS (pc, label_restore); break;
+        case op_restoreundo: parseS (pc, label_restoreundo); break;
+        case op_protect: parseLL (pc, label_protect); break;
+        case op_verify: parseS (pc, label_verify); break;
+
+        case op_save:
+            parseModeNibbles (pc, 2, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseSaveStub (pc, modes [1]);
+            break;
+
+        case op_saveundo:
+            parseModeNibbles (pc, 1, modes);
+            parseUndoStub (pc, modes [0]);
+            break;
+
+        case op_getiosys: parseSS (pc, label_getiosys);  break;
+        case op_setiosys: parseLL (pc, label_setiosys);  break;
+
+        case op_getstringtbl: parseS (pc, label_getstringtbl);  break;
+        case op_setstringtbl: parseL (pc, label_setstringtbl);  break;
+
+        case op_streamchar:    parseL (pc, label_streamchar);    emitData(*pc); break;
+        case op_streamnum:     parseL (pc, label_streamnum);     emitData(*pc); break;
+        case op_streamstr:     parseL (pc, label_streamstr);     emitData(*pc); break;
+        case op_streamunichar: parseL (pc, label_streamunichar); emitData(*pc); break;
+        case op_glk: parseLLS (pc, label_glk); break;
+        case op_gestalt: parseLLS (pc, label_gestalt); break;
+
+        case op_binarysearch:
+        case op_linearsearch:
+            parseModeNibbles (pc, 8, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseLoad (pc, reg_L2, modes [1], size32, NULL);
+            parseLoad (pc, reg_L3, modes [2], size32, NULL);
+            parseLoad (pc, reg_L4, modes [3], size32, NULL);
+            parseLoad (pc, reg_L5, modes [4], size32, NULL);
+            parseLoad (pc, reg_L6, modes [5], size32, NULL);
+            parseLoad (pc, reg_L7, modes [6], size32, NULL);
+            emitCode (opcode == op_linearsearch ? label_linearsearch : label_binarysearch);
+            parseStore (pc, reg_S1, modes [7], size32);
+            break;
+
+        case op_linkedsearch:
+            parseModeNibbles (pc, 7, modes);
+            parseLoad (pc, reg_L1, modes [0], size32, NULL);
+            parseLoad (pc, reg_L2, modes [1], size32, NULL);
+            parseLoad (pc, reg_L3, modes [2], size32, NULL);
+            parseLoad (pc, reg_L4, modes [3], size32, NULL);
+            parseLoad (pc, reg_L5, modes [4], size32, NULL);
+            parseLoad (pc, reg_L6, modes [5], size32, NULL);
+            emitCode (label_linkedsearch);
+            parseStore (pc, reg_S1, modes [6], size32);
+            break;
+        
+        case op_debugtrap:
+            parseL (pc, label_debugtrap);
+            break;
+        
+        // Memory management
+            
+        case op_mzero: parseLL (pc, label_mzero); break;
+        case op_mcopy: parseLLL (pc, label_mcopy); break;
+        
+        case op_malloc: parseLS (pc, label_malloc); break;
+        case op_mfree: parseL (pc, label_mfree); break;
+        
+        // Function acceleration
+            
+        case op_accelfunc: parseLL (pc, label_accelfunc); break;
+        case op_accelparam: parseLL (pc, label_accelparam); break;
+       
+        // Special Git opcodes
+        
+        case op_git_setcacheram: parseL (pc, label_git_setcacheram); break;
+        case op_git_prunecache: parseLL (pc, label_git_prunecache); break;
+        
+        default:
+            // Unknown opcode.
+            abortCompilation();
+            break;
+    }
+}
diff --git a/interpreters/git/opcodes.h b/interpreters/git/opcodes.h
new file mode 100644 (file)
index 0000000..677c450
--- /dev/null
@@ -0,0 +1,116 @@
+// $Id: opcodes.h,v 1.7 2004/12/22 12:40:07 iain Exp $
+
+#ifndef OPCODES_H
+#define OPCODES_H
+
+// Glulx opcodes.
+
+#define op_nop          (0x00)
+
+#define op_add          (0x10)
+#define op_sub          (0x11)
+#define op_mul          (0x12)
+#define op_div          (0x13)
+#define op_mod          (0x14)
+#define op_neg          (0x15)
+#define op_bitand       (0x18)
+#define op_bitor        (0x19)
+#define op_bitxor       (0x1A)
+#define op_bitnot       (0x1B)
+#define op_shiftl       (0x1C)
+#define op_sshiftr      (0x1D)
+#define op_ushiftr      (0x1E)
+
+#define op_jump         (0x20)
+#define op_jz           (0x22)
+#define op_jnz          (0x23)
+#define op_jeq          (0x24)
+#define op_jne          (0x25)
+#define op_jlt          (0x26)
+#define op_jge          (0x27)
+#define op_jgt          (0x28)
+#define op_jle          (0x29)
+#define op_jltu         (0x2A)
+#define op_jgeu         (0x2B)
+#define op_jgtu         (0x2C)
+#define op_jleu         (0x2D)
+
+#define op_call         (0x30)
+#define op_return       (0x31)
+#define op_catch        (0x32)
+#define op_throw        (0x33)
+#define op_tailcall     (0x34)
+
+#define op_copy         (0x40)
+#define op_copys        (0x41)
+#define op_copyb        (0x42)
+#define op_sexs         (0x44)
+#define op_sexb         (0x45)
+#define op_aload        (0x48)
+#define op_aloads       (0x49)
+#define op_aloadb       (0x4A)
+#define op_aloadbit     (0x4B)
+#define op_astore       (0x4C)
+#define op_astores      (0x4D)
+#define op_astoreb      (0x4E)
+#define op_astorebit    (0x4F)
+
+#define op_stkcount     (0x50)
+#define op_stkpeek      (0x51)
+#define op_stkswap      (0x52)
+#define op_stkroll      (0x53)
+#define op_stkcopy      (0x54)
+
+#define op_streamchar   (0x70)
+#define op_streamnum    (0x71)
+#define op_streamstr    (0x72)
+#define op_streamunichar (0x73)
+
+#define op_gestalt      (0x100)
+#define op_debugtrap    (0x101)
+#define op_getmemsize   (0x102)
+#define op_setmemsize   (0x103)
+#define op_jumpabs      (0x104)
+
+#define op_random       (0x110)
+#define op_setrandom    (0x111)
+
+#define op_quit         (0x120)
+#define op_verify       (0x121)
+#define op_restart      (0x122)
+#define op_save         (0x123)
+#define op_restore      (0x124)
+#define op_saveundo     (0x125)
+#define op_restoreundo  (0x126)
+#define op_protect      (0x127)
+
+#define op_glk          (0x130)
+
+#define op_getstringtbl (0x140)
+#define op_setstringtbl (0x141)
+#define op_getiosys     (0x148)
+#define op_setiosys     (0x149)
+
+#define op_linearsearch (0x150)
+#define op_binarysearch (0x151)
+#define op_linkedsearch (0x152)
+
+#define op_callf        (0x160)
+#define op_callfi       (0x161)
+#define op_callfii      (0x162)
+#define op_callfiii     (0x163)
+
+#define op_mzero        (0x170)
+#define op_mcopy        (0x171)
+#define op_malloc       (0x178)
+#define op_mfree        (0x179)
+
+#define op_accelfunc    (0x180)
+#define op_accelparam   (0x181)
+
+// Special cache control opcodes.
+
+#define op_git_setcacheram (0x7940)
+#define op_git_prunecache  (0x7941)
+
+#endif // OPCODES_H
diff --git a/interpreters/git/operands.c b/interpreters/git/operands.c
new file mode 100644 (file)
index 0000000..a4b6e0b
--- /dev/null
@@ -0,0 +1,307 @@
+// $Id: operands.c,v 1.11 2004/02/02 00:13:46 iain Exp $
+
+#include "git.h"
+#include <assert.h>
+
+git_uint32 parseLoad (git_uint32 * pc, LoadReg reg, int mode, TransferSize size, git_sint32 * constVal)
+{
+    git_uint32 value;
+
+    switch (mode)
+    {
+        case 0x0: // Constant zero. (Zero bytes)
+            value = 0;
+            goto load_const;
+
+        case 0x1: // Constant, -80 to 7F. (One byte)
+            value = (git_sint32) ((git_sint8) memRead8(*pc));
+            *pc += 1;
+            goto load_const;
+
+        case 0x2: // Constant, -8000 to 7FFF. (Two bytes)
+            value = (git_sint32) ((git_sint16) memRead16(*pc));
+            *pc += 2;
+            goto load_const;
+
+        case 0x3: // Constant, any value. (Four bytes)
+            value = memRead32(*pc);
+            *pc += 4;
+            goto load_const;
+
+        case 0x5: // Contents of address 00 to FF. (One byte)
+            value = memRead8(*pc);
+            *pc += 1;
+            goto load_addr;
+
+        case 0x6: // Contents of address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc);
+            *pc += 2;
+            goto load_addr;
+
+        case 0x7: // Contents of any address. (Four bytes)
+            value = memRead32(*pc);
+            *pc += 4;
+            goto load_addr;
+
+        case 0x8: // Value popped off stack. (Zero bytes)
+            goto load_stack;
+
+        case 0x9: // Call frame local at address 00 to FF. (One byte)
+            value = memRead8(*pc);
+            *pc += 1;
+            goto load_local;
+
+        case 0xA: // Call frame local at address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc);
+            *pc += 2;
+            goto load_local;
+
+        case 0xB: // Call frame local at any address. (Four bytes)
+            value = memRead32(*pc);
+            *pc += 4;
+            goto load_local;
+
+        case 0xD: // Contents of RAM address 00 to FF. (One byte)
+            value = memRead8(*pc) + gRamStart;
+            *pc += 1;
+            goto load_addr;
+
+        case 0xE: // Contents of RAM address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc) + gRamStart;
+            *pc += 2;
+            goto load_addr;
+
+        case 0xF: // Contents of RAM, any address. (Four bytes)
+            value = memRead32(*pc) + gRamStart;
+            *pc += 4;
+            goto load_addr;
+
+        default: // Illegal addressing mode
+            abortCompilation();
+            break;
+
+        // ------------------------------------------------------
+
+        load_const:
+            if (constVal)
+            {
+                *constVal = value;
+                return 1;
+            }
+            else
+            {
+                emitCode (label_L1_const + reg);
+                emitData (value);
+            }
+            break;
+
+        load_stack:
+                       emitCode (label_L1_stack + reg);
+                       break;
+
+        load_addr:
+            if (value < gRamStart)
+            {
+                if (size == size32)
+                    value = memRead32(value);
+                else if (size == size16)
+                    value = memRead16(value);
+                else
+                    value = memRead8(value);
+                               goto load_const;
+            }
+                       switch (size)
+                       {
+                               case size8:
+                                       assert (reg == reg_L1);
+                                       emitCode (label_L1_addr8);
+                                       break;
+
+                               case size16:
+                                       assert (reg == reg_L1);
+                                       emitCode (label_L1_addr16);
+                                       break;
+
+                               case size32:
+                                       emitCode (label_L1_addr + reg);
+                                       break;
+                       }
+                       emitData (value);
+                       break;
+
+        load_local:
+            emitCode (label_L1_local + reg);
+            emitData (value / 4); // Convert byte offset to word offset.
+            break;
+    }
+
+    return 0;
+}
+
+void parseStore (git_uint32 * pc, StoreReg reg, int mode, TransferSize size)
+{
+    git_uint32 value;
+
+    switch (mode)
+    {
+        case 0x0: // Discard
+            break;
+
+        case 0x5: // Contents of address 00 to FF. (One byte)
+            value = memRead8(*pc);
+            *pc += 1;
+            goto store_addr;
+
+        case 0x6: // Contents of address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc);
+            *pc += 2;
+            goto store_addr;
+
+        case 0x7: // Contents of any address. (Four bytes)
+            value = memRead32(*pc);
+            *pc += 4;
+            goto store_addr;
+
+        case 0x8: // Value popped off stack. (Zero bytes)
+            goto store_stack;
+
+        case 0x9: // Call frame local at store_address 00 to FF. (One byte)
+            value = memRead8(*pc);
+            *pc += 1;
+            goto store_local;
+
+        case 0xA: // Call frame local at store_address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc);
+            *pc += 2;
+            goto store_local;
+
+        case 0xB: // Call frame local at any store_address. (Four bytes)
+            value = memRead32(*pc);
+            *pc += 4;
+            goto store_local;
+
+        case 0xD: // Contents of RAM address 00 to FF. (One byte)
+            value = memRead8(*pc) + gRamStart;
+            *pc += 1;
+            goto store_addr;
+
+        case 0xE: // Contents of RAM address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc) + gRamStart;
+            *pc += 2;
+            goto store_addr;
+
+        case 0xF: // Contents of RAM, any address. (Four bytes)
+            value = memRead32(*pc) + gRamStart;
+            *pc += 4;
+            goto store_addr;
+
+        // ------------------------------------------------------
+
+        store_stack:
+            emitCode (reg == reg_S1 ? label_S1_stack : label_S2_stack);
+            break;
+
+        store_addr:
+            if (size == size32)
+                       {
+                emitCode (reg == reg_S1 ? label_S1_addr : label_S2_addr);
+            }
+                       else
+                       {
+                               assert (reg == reg_S1);
+                               emitCode (size == size16 ? label_S1_addr16 : label_S1_addr8);
+                       }
+            emitData (value);
+            break;
+
+        store_local:
+            emitCode (reg == reg_S1 ? label_S1_local : label_S2_local);
+            emitData (value / 4); // Convert byte offset to word offset.
+            break;
+    }
+}
+
+static void parseStub (git_uint32 * pc, int mode, Label discardOp)
+{
+    git_uint32 value;
+    switch (mode)
+    {
+        case 0x0: // Discard
+            goto store_discard;
+        case 0x5: // Contents of address 00 to FF. (One byte)
+            value = memRead8(*pc);
+            *pc += 1;
+            goto store_addr;
+        case 0x6: // Contents of address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc);
+            *pc += 2;
+            goto store_addr;
+        case 0x7: // Contents of any address. (Four bytes)
+            value = memRead32(*pc);
+            *pc += 4;
+            goto store_addr;
+        case 0x8: // Value popped off stack. (Zero bytes)
+            goto store_stack;
+        case 0x9: // Call frame local at store_address 00 to FF. (One byte)
+            value = memRead8(*pc);
+            *pc += 1;
+            goto store_local;
+        case 0xA: // Call frame local at store_address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc);
+            *pc += 2;
+            goto store_local;
+        case 0xB: // Call frame local at any store_address. (Four bytes)
+            value = memRead32(*pc);
+            *pc += 4;
+            goto store_local;
+        case 0xD: // Contents of RAM address 00 to FF. (One byte)
+            value = memRead8(*pc) + gRamStart;
+            *pc += 1;
+            goto store_addr;
+        case 0xE: // Contents of RAM address 0000 to FFFF. (Two bytes)
+            value = memRead16(*pc) + gRamStart;
+            *pc += 2;
+            goto store_addr;
+        case 0xF: // Contents of RAM, any address. (Four bytes)
+            value = memRead32(*pc) + gRamStart;
+            *pc += 4;
+            goto store_addr;
+        // ------------------------------------------------------
+        store_discard:
+            emitCode (discardOp);
+            break;
+        store_stack:
+            emitCode (discardOp + (label_call_stub_stack - label_call_stub_discard));
+            break;
+        store_addr:
+            emitCode (discardOp + (label_call_stub_addr - label_call_stub_discard));
+            emitData (value);
+            break;
+        store_local:
+            emitCode (discardOp + (label_call_stub_local - label_call_stub_discard));
+            emitData (value); // Convert byte offset to word offset.
+            break;
+    }
+    
+    // Every call stub ends with the glulx return address.
+    emitData (*pc);
+
+    // ...which means that every call stub references the next instruction.
+    nextInstructionIsReferenced ();
+}
+void parseCallStub (git_uint32 * pc, int mode)
+{
+    parseStub (pc, mode, label_call_stub_discard);
+}
+void parseCatchStub (git_uint32 * pc, int mode)
+{
+    parseStub (pc, mode, label_catch_stub_discard);
+}
+void parseSaveStub (git_uint32 * pc, int mode)
+{
+    parseStub (pc, mode, label_save_stub_discard);
+}
+void parseUndoStub (git_uint32 * pc, int mode)
+{
+    parseStub (pc, mode, label_undo_stub_discard);
+}
diff --git a/interpreters/git/peephole.c b/interpreters/git/peephole.c
new file mode 100644 (file)
index 0000000..4068b67
--- /dev/null
@@ -0,0 +1,131 @@
+// $Id: peephole.c,v 1.6 2003/10/13 22:53:04 iain Exp $
+// Peephole optimiser for git
+
+#include "git.h"
+
+static Label sLastOp;
+
+extern void resetPeepholeOptimiser ()
+{
+    sLastOp = label_nop;
+}
+
+#define REPLACE_SINGLE(lastOp,thisOp,newOp) \
+    case label_ ## thisOp:                  \
+        if (sLastOp == label_ ## lastOp)    \
+        {                                   \
+            op = label_ ## newOp;           \
+            goto replaceNoOperands;         \
+        }                                   \
+        break
+
+#define CASE_NO_OPERANDS(lastOp,newOp) \
+    case label_ ## lastOp: op = label_ ## newOp; goto replaceNoOperands
+
+#define CASE_ONE_OPERAND(lastOp,newOp) \
+    case label_ ## lastOp: op = label_ ## newOp; goto replaceOneOperand
+
+#define REPLACE_STORE(storeOp) \
+    case label_ ## storeOp:                                             \
+        switch(sLastOp)                                                 \
+        {                                                               \
+            CASE_NO_OPERANDS (add_discard,      add_ ## storeOp);       \
+            CASE_NO_OPERANDS (sub_discard,      sub_ ## storeOp);       \
+            CASE_NO_OPERANDS (mul_discard,      mul_ ## storeOp);       \
+            CASE_NO_OPERANDS (div_discard,      div_ ## storeOp);       \
+            CASE_NO_OPERANDS (mod_discard,      mod_ ## storeOp);       \
+            CASE_NO_OPERANDS (neg_discard,      neg_ ## storeOp);       \
+            CASE_NO_OPERANDS (bitand_discard,   bitand_ ## storeOp);    \
+            CASE_NO_OPERANDS (bitor_discard,    bitor_ ## storeOp);     \
+            CASE_NO_OPERANDS (bitxor_discard,   bitxor_ ## storeOp);    \
+            CASE_NO_OPERANDS (bitnot_discard,   bitnot_ ## storeOp);    \
+            CASE_NO_OPERANDS (shiftl_discard,   shiftl_ ## storeOp);    \
+            CASE_NO_OPERANDS (sshiftr_discard,  sshiftr_ ## storeOp);   \
+            CASE_NO_OPERANDS (ushiftr_discard,  ushiftr_ ## storeOp);   \
+            CASE_NO_OPERANDS (copys_discard,    copys_ ## storeOp);     \
+            CASE_NO_OPERANDS (copyb_discard,    copyb_ ## storeOp);     \
+            CASE_NO_OPERANDS (sexs_discard,     sexs_ ## storeOp);      \
+            CASE_NO_OPERANDS (sexb_discard,     sexb_ ## storeOp);      \
+            CASE_NO_OPERANDS (aload_discard,    aload_ ## storeOp);     \
+            CASE_NO_OPERANDS (aloads_discard,   aloads_ ## storeOp);    \
+            CASE_NO_OPERANDS (aloadb_discard,   aloadb_ ## storeOp);    \
+            CASE_NO_OPERANDS (aloadbit_discard, aloadbit_ ## storeOp);  \
+            default: break;                                             \
+        }                                                               \
+        break
+
+#define REPLACE_L1_L2(mode2)                                    \
+    case label_L2_ ## mode2:                                    \
+        switch(sLastOp)                                         \
+        {                                                       \
+            CASE_ONE_OPERAND (L1_const, L1_const_L2_ ## mode2); \
+            CASE_NO_OPERANDS (L1_stack, L1_stack_L2_ ## mode2); \
+            CASE_ONE_OPERAND (L1_local, L1_local_L2_ ## mode2); \
+            CASE_ONE_OPERAND (L1_addr,  L1_addr_L2_ ## mode2);  \
+            default: break;                                     \
+        }                                                       \
+        break
+
+#define REPLACE_LOAD_OP(loadOp,reg)                                         \
+    case label_ ## loadOp:                                                  \
+        switch(sLastOp)                                                     \
+        {                                                                   \
+            CASE_ONE_OPERAND (reg ## _const, loadOp ## _ ## reg ## _const); \
+            CASE_NO_OPERANDS (reg ## _stack, loadOp ## _ ## reg ## _stack); \
+            CASE_ONE_OPERAND (reg ## _local, loadOp ## _ ## reg ## _local); \
+            CASE_ONE_OPERAND (reg ## _addr,  loadOp ## _ ## reg ## _addr);  \
+            default: break;                                                 \
+        }                                                                   \
+        break
+
+extern void emitCode (Label op)
+{
+    git_uint32 temp;
+
+    if (gPeephole)
+    {
+        switch (op)
+        {
+            REPLACE_SINGLE (args_stack, call_stub_discard, args_stack_call_stub_discard);
+            REPLACE_SINGLE (args_stack, call_stub_addr,    args_stack_call_stub_addr);
+            REPLACE_SINGLE (args_stack, call_stub_local,   args_stack_call_stub_local);
+            REPLACE_SINGLE (args_stack, call_stub_stack,   args_stack_call_stub_stack);
+
+            REPLACE_STORE (S1_stack);
+            REPLACE_STORE (S1_local);
+            REPLACE_STORE (S1_addr);
+
+            REPLACE_L1_L2 (const);
+            REPLACE_L1_L2 (stack);
+            REPLACE_L1_L2 (local);
+            REPLACE_L1_L2 (addr);
+
+            REPLACE_LOAD_OP (return, L1);
+            REPLACE_LOAD_OP (astore, L3);
+            REPLACE_LOAD_OP (astores, L3);
+            REPLACE_LOAD_OP (astoreb, L3);
+            REPLACE_LOAD_OP (astorebit, L3);
+            
+            default: break;
+        }
+    }
+    goto noPeephole;
+
+replaceOneOperand:
+    // The previous opcode has one operand, so
+    // we have to go back two steps to update it.
+    temp = undoEmit();  // Save the operand.
+    undoEmit();         // Remove the old opcode.
+    emitFinalCode (op); // Emit the new opcode.
+    emitData (temp);    // Emit the operand again.
+    goto done;
+
+replaceNoOperands:
+    undoEmit();
+    // ... fall through
+noPeephole:
+    emitFinalCode (op);
+    // ... fall through
+done:
+    sLastOp = op;
+}
diff --git a/interpreters/git/savefile.c b/interpreters/git/savefile.c
new file mode 100644 (file)
index 0000000..88894fe
--- /dev/null
@@ -0,0 +1,318 @@
+// $Id: savefile.c,v 1.6 2003/10/20 16:05:06 iain Exp $
+
+#include "git.h"
+
+static void writeWord (git_sint32 word)
+{
+    char buffer [4];
+    write32 (buffer, word);
+    glk_put_buffer (buffer, 4);
+}
+
+static git_uint32 readWord (strid_t file)
+{
+    char buffer [4];
+    glk_get_buffer_stream (file, buffer, 4);
+    return (git_uint32) read32 (buffer);
+}
+
+static int sort_heap_summary(const void *p1, const void *p2)
+{
+    const glui32 *v1 = (const glui32 *)p1;
+    const glui32 *v2 = (const glui32 *)p2;
+
+    if (v1 < v2)
+        return -1;
+    if (v1 > v2)
+        return 1;
+    return 0;
+}
+
+git_sint32 restoreFromFile (git_sint32 * base, git_sint32 id,
+    git_uint32 protectPos, git_uint32 protectSize)
+{
+    git_uint32 protectEnd = protectPos + protectSize;
+    git_uint32 i;
+    strid_t file;
+    glui32 fileSize, fileStart;
+
+    int gotIdent = 0;
+    int gotMemory = 0;
+    int gotStack = 0;
+    int gotHeap = 0;
+
+    // Find out what stream they want to use, and make sure it's valid.
+    file = git_find_stream_by_id (id);
+    if (file == 0)
+        return 1;
+
+    // Read IFF header.
+    if (readWord (file) != read32("FORM"))
+        return 1; // Not an IFF file.
+    
+    fileSize = readWord (file);
+    fileStart = glk_stream_get_position (file);
+    
+    if (readWord (file) != read32("IFZS"))
+        return 1; // Not a Quetzal file.
+    
+    // Discard the current heap.
+    heap_clear();
+    
+    // Read all the chunks.
+    
+    while (glk_stream_get_position(file) < fileStart + fileSize)
+    {
+        git_uint32 chunkType, chunkSize, chunkStart;
+        chunkType = readWord (file);
+        chunkSize = readWord (file);
+        chunkStart = glk_stream_get_position (file);
+
+        if (chunkType == read32("IFhd"))
+        {
+            if (gotIdent)
+                return 1;
+
+            gotIdent = 1;
+
+            if (chunkSize != 128)
+                return 1;
+
+            for (i = 0 ; i < 128 ; ++i)
+            {
+                glui32 c = glk_get_char_stream (file);
+                if (gRom [i] != c)
+                    return 1;
+            }
+        }
+        else if (chunkType == read32("Stks"))
+        {
+            if (gotStack)
+                return 1;
+
+            gotStack = 1;
+
+            if (chunkSize & 3)
+                return 1;
+
+            gStackPointer = base;
+            for ( ; chunkSize > 0 ; chunkSize -= 4)
+                *gStackPointer++ = readWord(file);
+        }
+        else if (chunkType == read32("CMem"))
+        {
+            git_uint32 bytesRead = 0;
+            if (gotMemory)
+                return 1;
+
+            gotMemory = 1;
+
+            if (resizeMemory (readWord(file), 1))
+                fatalError ("Can't resize memory map");
+
+            bytesRead = 4;
+            i = gRamStart;
+            while (i < gExtStart && bytesRead < chunkSize)
+            {
+                int mult = 0;
+                char c = (char) glk_get_char_stream(file);
+                ++bytesRead;
+                
+                if (c == 0)
+                {
+                    mult = (unsigned char) glk_get_char_stream(file);
+                    ++bytesRead;
+                }
+                
+                for (++mult ; mult > 0 ; --mult, ++i)
+                    if (i >= protectEnd || i < protectPos)
+                        gRam [i] = gRom [i] ^ c;
+            }
+
+            while (i < gEndMem && bytesRead < chunkSize)
+            {
+                int mult = 0;
+                char c = (char) glk_get_char_stream(file);
+                ++bytesRead;
+                
+                if (c == 0)
+                {
+                    mult = (unsigned char) glk_get_char_stream(file);
+                    ++bytesRead;
+                }
+                
+                for (++mult ; mult > 0 ; --mult, ++i)
+                    if (i >= protectEnd || i < protectPos)
+                        gRam [i] = c;
+            }
+
+            while (i < gExtStart)
+                if (i >= protectEnd || i < protectPos)
+                    gRam [i] = gRom [i], ++i;
+
+            while (i < gEndMem)
+                if (i >= protectEnd || i < protectPos)
+                    gRam [i] = 0, ++i;
+
+            if (bytesRead != chunkSize)
+                return 1; // Too much data!
+
+            if (chunkSize & 1)
+                glk_get_char_stream (file);
+        }
+        else if (chunkType == read32("MAll"))
+        {
+            glui32 heapSize = 0;
+            glui32 * heap = 0;
+
+            if (gotHeap)
+                return 1;
+
+            gotHeap = 1;
+
+            if (chunkSize & 3)
+                return 1;
+
+            if (chunkSize > 0)
+            {
+                heap = malloc (chunkSize);
+                heapSize = chunkSize / 4;
+                for (i = 0 ; i < heapSize ; ++i)
+                    heap[i] = readWord(file);
+
+                /* The summary might have come from any interpreter, so it could
+                  be out of order. We'll sort it. */
+                qsort(heap+2, (heapSize-2)/2, 8, &sort_heap_summary);
+
+                if (heap_apply_summary (heapSize, heap))
+                    fatalError ("Couldn't apply heap summary");
+                free (heap);
+            }
+        }
+        else
+        {
+            // Unknown chunk type -- just skip it.
+            glk_stream_set_position (file, (chunkSize + 1) & ~1, seekmode_Current);
+        }
+    }
+
+    // Make sure we have all the chunks we need.
+
+    if (!gotIdent)
+        fatalError ("No ident chunk in save file");
+
+    if (!gotStack)
+        fatalError ("No stack chunk in save file");
+
+    if (!gotMemory)
+        fatalError ("No memory chunk in save file");
+
+    // If we reach this point, we restored successfully.
+
+    return 0;
+}
+
+git_sint32 saveToFile (git_sint32 * base, git_sint32 * sp, git_sint32 id)
+{
+    git_uint32 n, zeroCount;
+    glui32 fileSize, fileSizePos;
+    glui32 memSize, memSizePos;
+    glui32 heapSize;
+    glui32* heap;
+
+    strid_t file, oldFile;
+
+    // Find out what stream they want to use, and make sure it's valid.
+    file = git_find_stream_by_id (id);
+    if (file == 0)
+        return 1;
+
+    // Get the state of the heap.
+    if (heap_get_summary (&heapSize, &heap))
+        fatalError ("Couldn't get heap summary");
+
+    // Make the given stream the default.
+    oldFile = glk_stream_get_current ();
+    glk_stream_set_current (file);
+
+    // Write Quetzal header.
+    glk_put_string ("FORM");
+
+    fileSizePos = glk_stream_get_position (file);
+    writeWord (0);
+
+    glk_put_string ("IFZS");
+
+    // Header chunk.
+    glk_put_string ("IFhd");
+    writeWord (128);
+    glk_put_buffer ((char *) gRom, 128);
+
+    // Stack chunk.
+    glk_put_string ("Stks");
+    writeWord ((sp - base) * 4);
+    for (n = 0 ; n < (git_uint32) (sp - base) ; ++n)
+        writeWord (base [n]);
+
+    // Heap chunk.
+    if (heap != 0)
+    {
+        glk_put_string ("MAll");
+        writeWord (heapSize * 4);
+        for (n = 0 ; n < heapSize ; ++n)
+            writeWord (heap [n]);
+        free(heap);
+    }
+
+    // Memory chunk.
+    glk_put_string ("CMem");
+    memSizePos = glk_stream_get_position (file);
+    writeWord (0);
+
+    writeWord (gEndMem);
+    for (zeroCount = 0, n = gRamStart ; n < gEndMem ; ++n)
+    {
+        unsigned char romC = (n < gExtStart) ? gRom[n] : 0;
+        unsigned char c = ((git_uint32) romC) ^ ((git_uint32) gRam[n]);
+        if (c == 0)
+            ++zeroCount;
+        else
+        {
+            for ( ; zeroCount > 256 ; zeroCount -= 256)
+            {
+                glk_put_char (0);
+                glk_put_char (0xff);
+            }
+
+            if (zeroCount > 0)
+            {
+                glk_put_char (0);
+                glk_put_char ((char) (zeroCount - 1));
+                zeroCount = 0;
+            }
+
+            glk_put_char (c);
+        }
+    }
+    // Note: we don't bother writing out any remaining zeroes,
+    // because the memory is padded out with zeroes on restore.
+
+    memSize = glk_stream_get_position (file) - memSizePos - 4;
+    if (memSize & 1)
+       glk_put_char (0);
+
+    // Back up and fill in the lengths.
+    fileSize = glk_stream_get_position (file) - fileSizePos - 4;
+
+    glk_stream_set_position (file, fileSizePos, seekmode_Start);
+    writeWord (fileSize);
+
+    glk_stream_set_position (file, memSizePos, seekmode_Start);
+    writeWord (memSize);
+
+    // Restore the previous default stream.
+    glk_stream_set_current (oldFile);
+
+    // And we're done.
+    return 0;
+}
diff --git a/interpreters/git/saveundo.c b/interpreters/git/saveundo.c
new file mode 100644 (file)
index 0000000..13620f3
--- /dev/null
@@ -0,0 +1,347 @@
+// $Id: saveundo.c,v 1.15 2003/10/20 16:05:06 iain Exp $
+
+#include "git.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+typedef const git_uint8 * MemoryPage;
+typedef MemoryPage * MemoryMap;
+
+typedef struct UndoRecord UndoRecord;
+
+struct UndoRecord
+{
+    git_uint32   endMem;
+    MemoryMap    memoryMap;
+    git_sint32   stackSize;
+    git_sint32 * stack;
+    glui32       heapSize;
+    glui32     * heap;
+    UndoRecord * prev;
+    UndoRecord * next;
+};
+
+static UndoRecord * gUndo = NULL;
+static git_uint32 gUndoSize = 0;
+static git_uint32 gMaxUndoSize = 256 * 1024;
+
+static void reserveSpace (git_uint32);
+static void deleteRecord (UndoRecord * u);
+
+void initUndo (git_uint32 size)
+{
+    gMaxUndoSize = size;
+    gUndoSize = 0;
+    gUndo = NULL;
+}
+
+int saveUndo (git_sint32 * base, git_sint32 * sp)
+{
+    git_uint32 undoSize = sizeof(UndoRecord);
+    git_uint32 mapSize = sizeof(MemoryPage*) * (gEndMem - gRamStart) / 256;
+    git_uint32 stackSize = sizeof(git_sint32*) * (sp - base);
+    git_uint32 totalSize = undoSize + mapSize + stackSize;
+
+    git_uint32 addr = gRamStart; // Address in glulx memory.
+    git_uint32 slot = 0;         // Slot in our memory map.
+    
+    UndoRecord * undo = malloc (undoSize);
+    if (undo == NULL)
+        fatalError ("Couldn't allocate undo record");
+        
+    undo->endMem = gEndMem;
+    undo->memoryMap = malloc (mapSize);
+    undo->stackSize = stackSize;
+    undo->stack = malloc (stackSize);
+    undo->prev = NULL;
+    undo->next = NULL;
+
+    if (undo->memoryMap == NULL || undo->stack == NULL)
+        fatalError ("Couldn't allocate memory for undo");
+
+    // Save the stack.
+    memcpy (undo->stack, base, undo->stackSize);
+
+    // Are we diffing against the previous undo record,
+    // or against the initial gamefile state?
+    if (gUndo == NULL)
+    {
+        // We're diffing against the gamefile.        
+        for ( ; addr < gExtStart ; addr += 256, ++slot)
+        {
+            if (memcmp (gRom + addr, gRam + addr, 256) != 0)
+            {
+                // We need to save this page.
+                git_uint8 * page = malloc(256);
+                if (page == NULL)
+                    fatalError ("Couldn't allocate memory for undo");
+                    
+                memcpy (page, gRam + addr, 256);
+                undo->memoryMap[slot] = page;
+                totalSize += 256;
+            }
+            else
+            {
+                // We don't need to save this page.
+                // Just make it point into ROM.
+                undo->memoryMap[slot] = gRom + addr;
+            }
+        }
+
+        // If the memory map has been extended, save the exended area
+        for (addr = gExtStart ; addr < gEndMem ; addr += 256, ++slot)
+        {
+            git_uint8 * page = malloc(256);
+            if (page == NULL)
+                fatalError ("Couldn't allocate memory for undo");
+                
+            memcpy (page, gRam + addr, 256);
+            undo->memoryMap[slot] = page;
+            totalSize += 256;
+        }
+    }
+    else
+    {
+        // We're diffing against the most recent undo record.
+        git_uint32 endMem = (gUndo->endMem < gEndMem) ? gUndo->endMem : gEndMem;
+        for ( ; addr < endMem ; addr += 256, ++slot)
+        {
+            if (memcmp (gUndo->memoryMap [slot], gRam + addr, 256) != 0)
+            {
+                // We need to save this page.
+                git_uint8 * page = malloc(256);
+                memcpy (page, gRam + addr, 256);
+                undo->memoryMap[slot] = page;
+                totalSize += 256;
+            }
+            else
+            {
+                // We don't need to save this page. Just copy
+                // the pointer from the previous undo record.
+                undo->memoryMap[slot] = gUndo->memoryMap[slot];
+            }
+        }
+
+        // If the memory map has been extended, save the exended area
+        for (addr = endMem ; addr < gEndMem ; addr += 256, ++slot)
+        {
+            git_uint8 * page = malloc(256);
+            if (page == NULL)
+                fatalError ("Couldn't allocate memory for undo");
+                
+            memcpy (page, gRam + addr, 256);
+            undo->memoryMap[slot] = page;
+            totalSize += 256;
+        }
+    }
+
+    // Save the heap.
+    if (heap_get_summary (&(undo->heapSize), &(undo->heap)))
+        fatalError ("Couldn't get heap summary");
+    totalSize += undo->heapSize * 4;
+
+    // Link this record into the undo list.
+    
+    undo->prev = gUndo;
+    if (gUndo)
+        gUndo->next = undo;
+    
+    gUndo = undo;
+    gUndoSize += totalSize;
+
+    // Delete old records until we have enough free space.
+    reserveSpace (0);
+
+    // And we're done.
+    return 0;
+}
+
+int restoreUndo (git_sint32* base, git_uint32 protectPos, git_uint32 protectSize)
+{
+    if (gUndo == NULL)
+    {
+        // Nothing to undo!
+        return 1;
+    }
+    else
+    {
+        UndoRecord * undo = gUndo;
+
+        git_uint32 addr = gRamStart;     // Address in glulx memory.
+        MemoryMap map = undo->memoryMap; // Glulx memory map.
+
+        // Restore the size of the memory map
+        heap_clear ();
+        resizeMemory (undo->endMem, 1);
+
+        // Restore the stack.
+        memcpy (base, undo->stack, undo->stackSize);
+        gStackPointer = base + (undo->stackSize / sizeof(git_sint32));
+
+        // Restore the contents of RAM.
+
+        if (protectSize > 0 && protectPos < gEndMem)
+        {
+            for ( ; addr < (protectPos & ~0xff) ; addr += 256, ++map)
+                memcpy (gRam + addr, *map, 256);
+            
+            memcpy (gRam + addr, *map, protectPos & 0xff);
+            protectSize += protectPos & 0xff;
+            
+            while (protectSize > 256)
+                addr += 256, ++map, protectSize -= 256;
+
+            if (addr < gEndMem)
+            {
+                memcpy (gRam + addr + protectSize,
+                        *map + protectSize,
+                        256 - protectSize);
+            }
+            addr += 256, ++map;
+        }
+
+        for ( ; addr < gEndMem ; addr += 256, ++map)
+            memcpy (gRam + addr, *map, 256);
+
+        // Restore the heap.
+        if (heap_apply_summary (undo->heapSize, undo->heap))
+            fatalError ("Couldn't apply heap summary");
+
+        // Delete the undo record.
+
+        gUndo = undo->prev;
+        deleteRecord (undo);
+
+        if (gUndo)
+            gUndo->next = NULL;
+        else
+            assert (gUndoSize == 0);
+
+        // And we're done.
+        return 0;
+    }
+}
+
+void resetUndo ()
+{
+    reserveSpace (gMaxUndoSize);
+    assert (gUndo == NULL);
+    assert (gUndoSize == 0);
+}
+
+void shutdownUndo ()
+{
+    resetUndo();
+}
+
+static void reserveSpace (git_uint32 n)
+{
+    UndoRecord * u = gUndo;
+    if (u == NULL)
+        return;
+
+    // Find the oldest undo record.
+
+    while (u->prev)
+        u = u->prev;
+
+    // Delete records until we've freed up the required amount of space.
+
+    while (gUndoSize + n > gMaxUndoSize)
+    {
+        if (u->next)
+        {
+            assert (u->next->prev == u);
+            u = u->next;
+
+            deleteRecord (u->prev);
+            u->prev = NULL;
+        }
+        else
+        {
+            assert (u == gUndo);
+            gUndo = NULL;
+
+            deleteRecord (u);
+            assert (gUndoSize == 0);
+            break;
+        }
+    }
+}
+
+static void deleteRecord (UndoRecord * u)
+{
+    git_uint32 addr = gRamStart; // Address in glulx memory.
+    git_uint32 slot = 0;         // Slot in our memory map.
+
+    // Zero out all the slots which are duplicates
+    // of pages held in older undo records.
+
+    if (u->prev)
+    {
+        // We're diffing against the previous undo record.
+        while (addr < u->endMem && addr < u->prev->endMem)
+        {
+            if (u->memoryMap [slot] == u->prev->memoryMap [slot])
+                u->memoryMap [slot] = NULL;
+            addr += 256, ++slot;
+        }
+    }
+    else
+    {
+        // We're diffing against the gamefile.
+        while (addr < u->endMem && addr < gExtStart)
+        {
+            if (u->memoryMap [slot] == (gRom + addr))
+                u->memoryMap [slot] = NULL;
+            addr += 256, ++slot;
+        }
+    }
+
+    // Zero out all the slots which are duplicates
+    // of newer undo records.
+
+    if (u->next)
+    {
+        addr = gRamStart;
+        slot = 0;
+
+        while (addr < u->endMem && addr < u->next->endMem)
+        {
+            if (u->memoryMap [slot] == u->next->memoryMap [slot])
+                u->memoryMap [slot] = NULL;
+            addr += 256, ++slot;
+        }
+    }
+
+    // Free all the slots which are owned by this record only.
+
+    addr = gRamStart;
+    slot = 0;
+    while (addr < u->endMem)
+    {
+        if (u->memoryMap [slot])
+        {
+            free ((void*) u->memoryMap [slot]);
+            gUndoSize -= 256;
+        }
+        addr += 256, ++slot;
+    }
+
+    // Free the memory map itself.
+    free ((void*) u->memoryMap);
+    gUndoSize -= sizeof(MemoryPage*) * (u->endMem - gRamStart) / 256;
+
+    // Free the stack.
+    free (u->stack);
+    gUndoSize -= u->stackSize;
+
+    // Free the heap.
+    free (u->heap);
+    gUndoSize -= u->heapSize * 4;
+
+    // Finally, free the record.
+    free (u);
+    gUndoSize -= sizeof(UndoRecord);
+}
diff --git a/interpreters/git/search.c b/interpreters/git/search.c
new file mode 100644 (file)
index 0000000..d09fa8a
--- /dev/null
@@ -0,0 +1,275 @@
+// $Id: search.c,v 1.1 2003/10/18 20:06:41 iain Exp $
+
+// search.c: Glulxe code for built-in search opcodes
+// Designed by Andrew Plotkin <erkyrath@eblong.com>
+// http://www.eblong.com/zarf/glulx/index.html
+
+#include "glk.h"
+#include "git.h"
+#include "opcodes.h"
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+#define serop_KeyIndirect (0x01)
+#define serop_ZeroKeyTerminates (0x02)
+#define serop_ReturnIndex (0x04)
+/* ### KeyZeroBounded? variants? */
+/* ### LowerBoundKey? */
+
+/* In general, these search functions look through a bunch of structures
+   in memory, searching for one whose key (a fixed-size sequence of bytes
+   within the structure) matches a given key. The result can indicate a
+   particular structure within the bunch, or it can be NULL ("not found".)
+
+   Any or all of these options can be applied:
+
+   KeyIndirect: If this is true, the key argument is taken to be the
+   start of an array of bytes in memory (whose length is keysize).
+   If it is false, the key argument contains the key itself. In
+   this case, keysize *must* be 1, 2, or 4. The key is stored in the
+   lower bytes of the key argument, big-endian. (The upper bytes are
+   ignored.)
+
+   ZeroKeyTerminates: If this is true, when the search reaches a struct
+   whose key is all zeroes, the search terminates (and returns NULL).
+   If the searched-for key happens to also be zeroes, the key-match
+   (returning the struct) takes precedence over the zero-match (returning
+   NULL.)
+
+   ReturnIndex: If this is false, the return value is the memory address
+   of the matching struct, or 0 to indicate NULL. If true, the return value
+   is the array index of the matching struct, or -1 to indicate NULL. 
+*/
+
+static void fetchkey(unsigned char *keybuf, glui32 key, glui32 keysize, 
+  glui32 options);
+
+/* linear_search():
+   An array of data structures is stored in memory, beginning at start,
+   each structure being structsize bytes. Within each struct, there is
+   a key value keysize bytes long, starting at position keyoffset (from
+   the start of the structure.) Search through these in order. If one
+   is found whose key matches, return it. If numstructs are searched
+   with no result, return NULL.
+   
+   numstructs may be -1 (0xFFFFFFFF) to indicate no upper limit to the
+   number of structures to search. The search will continue until a match
+   is found, or (if ZeroKeyTerminates is set) a zero key.
+
+   The KeyIndirect, ZeroKeyTerminates, and ReturnIndex options may be
+   used.
+*/
+glui32 git_linear_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options)
+{
+  unsigned char keybuf[4];
+  glui32 count;
+  int ix;
+  int retindex = ((options & serop_ReturnIndex) != 0);
+  int zeroterm = ((options & serop_ZeroKeyTerminates) != 0);
+
+  fetchkey(keybuf, key, keysize, options);
+
+  for (count=0; count<numstructs; count++, start+=structsize) {
+    int match = TRUE;
+    if (keysize <= 4) {
+      for (ix=0; match && ix<keysize; ix++) {
+       if (memRead8(start + keyoffset + ix) != keybuf[ix])
+         match = FALSE;
+      }
+    }
+    else {
+      for (ix=0; match && ix<keysize; ix++) {
+       if (memRead8(start + keyoffset + ix) != memRead8(key + ix))
+         match = FALSE;
+      }
+    }
+
+    if (match) {
+      if (retindex)
+       return count;
+      else
+       return start;
+    }
+
+    if (zeroterm) {
+      match = TRUE;
+      for (ix=0; match && ix<keysize; ix++) {
+       if (memRead8(start + keyoffset + ix) != 0)
+         match = FALSE;
+      }
+      if (match) {
+       break;
+      }
+    }
+  }
+  
+  if (retindex)
+    return -1;
+  else
+    return 0;
+}
+
+/* binary_search():
+   An array of data structures is in memory, as above. However, the
+   structs must be stored in forward order of their keys (taking each key
+   to be a multibyte unsigned integer.) There can be no duplicate keys. 
+   numstructs must indicate the exact length of the array; it cannot
+   be -1.
+
+   The KeyIndirect and ReturnIndex options may be used.
+*/
+glui32 git_binary_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options)
+{
+  unsigned char keybuf[4];
+  unsigned char byte, byte2;
+  glui32 top, bot, val, addr;
+  int ix;
+  int retindex = ((options & serop_ReturnIndex) != 0);
+
+  fetchkey(keybuf, key, keysize, options);
+  
+  bot = 0;
+  top = numstructs;
+  while (bot < top) {
+    int cmp = 0;
+    val = (top+bot) / 2;
+    addr = start + val * structsize;
+
+    if (keysize <= 4) {
+      for (ix=0; (!cmp) && ix<keysize; ix++) {
+       byte = memRead8(addr + keyoffset + ix);
+       byte2 = keybuf[ix];
+       if (byte < byte2)
+         cmp = -1;
+       else if (byte > byte2)
+         cmp = 1;
+      }
+    }
+    else {
+      for (ix=0; (!cmp) && ix<keysize; ix++) {
+       byte = memRead8(addr + keyoffset + ix);
+       byte2 = memRead8(key + ix);
+       if (byte < byte2)
+         cmp = -1;
+       else if (byte > byte2)
+         cmp = 1;
+      }
+    }
+
+    if (!cmp) {
+      if (retindex)
+       return val;
+      else
+       return addr;
+    }
+
+    if (cmp < 0) {
+      bot = val+1;
+    }
+    else {
+      top = val;
+    }
+  }
+
+  if (retindex)
+    return -1;
+  else
+    return 0;
+}
+
+/* linked_search():
+   The structures may be anywhere in memory, in any order. They are
+   linked by a four-byte address field, which is found in each struct
+   at position nextoffset. If this field contains zero, it indicates
+   the end of the linked list.
+
+   The KeyIndirect and ZeroKeyTerminates options may be used.
+*/
+glui32 git_linked_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 keyoffset, glui32 nextoffset, glui32 options)
+{
+  unsigned char keybuf[4];
+  int ix;
+  glui32 val;
+  int zeroterm = ((options & serop_ZeroKeyTerminates) != 0);
+
+  fetchkey(keybuf, key, keysize, options);
+
+  while (start != 0) {
+    int match = TRUE;
+    if (keysize <= 4) {
+      for (ix=0; match && ix<keysize; ix++) {
+       if (memRead8(start + keyoffset + ix) != keybuf[ix])
+         match = FALSE;
+      }
+    }
+    else {
+      for (ix=0; match && ix<keysize; ix++) {
+       if (memRead8(start + keyoffset + ix) != memRead8(key + ix))
+         match = FALSE;
+      }
+    }
+
+    if (match) {
+      return start;
+    }
+
+    if (zeroterm) {
+      match = TRUE;
+      for (ix=0; match && ix<keysize; ix++) {
+       if (memRead8(start + keyoffset + ix) != 0)
+         match = FALSE;
+      }
+      if (match) {
+       break;
+      }
+    }
+    
+    val = start + nextoffset;
+    start = memRead32(val);
+  }
+
+  return 0;
+}
+
+/* fetchkey():
+   This massages the key into a form that's easier to handle. When it
+   returns, the key will be stored in keybuf if keysize <= 4; otherwise,
+   it will be in memory.
+*/
+static void fetchkey(unsigned char *keybuf, glui32 key, glui32 keysize, 
+  glui32 options)
+{
+  int ix;
+
+  if (options & serop_KeyIndirect) {
+    if (keysize <= 4) {
+      for (ix=0; ix<keysize; ix++)
+       keybuf[ix] = memRead8(key+ix);
+    }
+  }
+  else {
+    switch (keysize) {
+    case 4:
+      write32(keybuf, key);
+      break;
+    case 2:
+      write16(keybuf, key);
+      break;
+    case 1:
+      write8(keybuf, key);
+      break;
+    default:
+      fatalError("Direct search key must hold one, two, or four bytes.");
+    }
+  }
+}
diff --git a/interpreters/git/terp.c b/interpreters/git/terp.c
new file mode 100644 (file)
index 0000000..8377c5d
--- /dev/null
@@ -0,0 +1,1300 @@
+// $Id: terp.c,v 1.42 2004/12/22 14:33:40 iain Exp $
+// Interpreter engine.
+
+#include "git.h"
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <time.h>
+
+// -------------------------------------------------------------
+// Global variables
+
+git_sint32* gStackPointer;
+
+#ifdef USE_DIRECT_THREADING
+Opcode* gOpcodeTable;
+#endif
+
+// -------------------------------------------------------------
+// Useful macros for manipulating the stack
+
+#define LOCAL(n)   (locals[(n)])
+
+#define PUSH(n)    *sp++ = (n)
+#define POP        (*--sp)
+#define READ_PC    ((git_uint32)(*pc++))
+
+#define CHECK_FREE(n) if ((top - sp) < (n)) goto stack_overflow
+#define CHECK_USED(n) if ((sp - values) < (n)) goto stack_underflow
+
+// -------------------------------------------------------------
+// Functions
+
+void startProgram (size_t cacheSize, enum IOMode ioMode)
+{
+    Block pc; // Program counter (pointer into dynamically generated code)
+
+    git_sint32 L1=0, L2=0, L3=0, L4=0, L5=0, L6=0, L7=0;
+#define S1 L1
+#define S2 L2
+
+    git_sint32* base;   // Bottom of the stack.
+    git_sint32* frame;  // Bottom of the current stack frame.
+    git_sint32* locals; // Start of the locals section of the current frame.
+    git_sint32* values; // Start of the values section of the current frame.
+    git_sint32* sp;     // Next free stack slot.
+    git_sint32* top;    // The top of the stack -- that is, the first unusable slot.
+
+    git_sint32 args [64]; // Array of arguments. Count is stored in L2.
+    git_uint32 runCounter = 0;
+
+    git_uint32 ioRock = 0;
+
+    git_uint32 stringTable = memRead32(28);    
+    git_uint32 startPos    = memRead32(24);
+    git_uint32 stackSize   = memRead32(20);
+
+    git_uint32 protectPos = 0;
+    git_uint32 protectSize = 0;
+    
+    git_uint32 glulxPC = 0;
+    git_uint32 glulxOpcode = 0;
+
+    acceleration_func accelfunc;
+
+    // Initialise the code cache.
+
+#ifdef USE_DIRECT_THREADING
+    static Opcode opcodeTable [] = {
+#define LABEL(label) &&do_ ## label,
+#include "labels.inc"
+    NULL};
+    gOpcodeTable = opcodeTable;
+#endif    
+
+    initCompiler (cacheSize);
+
+    // Initialise the random number generator.
+    srand (time(NULL));
+
+    // Set up the stack.
+
+    base = malloc (stackSize);
+    if (base == NULL)
+        fatalError ("Couldn't allocate stack");
+        
+    top = base + (stackSize / 4);
+    frame = locals = values = sp = base;
+
+    // Call the first function.
+
+    L1 = startPos; // Initial PC.
+    L2 = 0; // No arguments.
+    goto do_enter_function_L1;
+
+#ifdef USE_DIRECT_THREADING
+#define NEXT do { ++runCounter; goto **(pc++); } while(0)
+#else
+#define NEXT goto next
+//#define NEXT do { CHECK_USED(0); CHECK_FREE(0); goto next; } while (0)
+next:
+    ++runCounter;
+    switch (*pc++)
+    {
+#define LABEL(foo) case label_ ## foo: goto do_ ## foo;
+#include "labels.inc"
+    default: fatalError("exec: bad opcode");
+    }
+#endif
+
+do_debug_step:
+    // This opcode lets us keep track of how the compiled
+    // code relates to the original glulx code.
+    glulxPC = READ_PC;     // Glulx program counter.
+    glulxOpcode = READ_PC; // Glulx opcode number.
+//    fprintf (stdout, "\nPC: 0x%08x\nOpcode: 0x%04x\n", glulxPC, glulxOpcode);
+//    fprintf (stdout, "Stack:");
+//    for (L7 = 0 ; L7 < (sp - base) ; ++L7)
+//        fprintf (stdout," 0x%x", base[L7]);
+//    fprintf (stdout, "\n");
+    NEXT;
+
+#define LOAD_INSTRUCTIONS(reg)                                  \
+    do_ ## reg ## _const:   reg = READ_PC; NEXT;                \
+    do_ ## reg ## _stack:   CHECK_USED(1); reg = POP; NEXT;     \
+    do_ ## reg ## _addr:    reg = memRead32 (READ_PC); NEXT;    \
+    do_ ## reg ## _local:   reg = LOCAL (READ_PC); NEXT
+
+    LOAD_INSTRUCTIONS(L1);
+    LOAD_INSTRUCTIONS(L2);
+    LOAD_INSTRUCTIONS(L3);
+    LOAD_INSTRUCTIONS(L4);
+    LOAD_INSTRUCTIONS(L5);
+    LOAD_INSTRUCTIONS(L6);
+    LOAD_INSTRUCTIONS(L7);
+
+#define STORE_INSTRUCTIONS(reg)                                 \
+    do_ ## reg ## _stack:   CHECK_FREE(1); PUSH(reg); NEXT;     \
+    do_ ## reg ## _addr:    memWrite32 (READ_PC, reg); NEXT;    \
+    do_ ## reg ## _local:   LOCAL (READ_PC) = reg; NEXT
+
+    STORE_INSTRUCTIONS(S1);
+    STORE_INSTRUCTIONS(S2);
+
+#define DOUBLE_LOAD(mode2) \
+    do_L1_const_L2_ ## mode2: L1 = READ_PC;             goto do_L2_ ## mode2; \
+    do_L1_stack_L2_ ## mode2: CHECK_USED(1); L1 = POP;  goto do_L2_ ## mode2; \
+    do_L1_local_L2_ ## mode2: L1 = LOCAL (READ_PC);     goto do_L2_ ## mode2; \
+    do_L1_addr_L2_ ## mode2:  L1 = memRead32 (READ_PC); goto do_L2_ ## mode2
+
+    DOUBLE_LOAD(const);
+    DOUBLE_LOAD(stack);
+    DOUBLE_LOAD(local);
+    DOUBLE_LOAD(addr);
+
+#undef LOAD_INSTRUCTIONS
+#undef STORE_INSTRUCTIONS
+#undef DOUBLE_LOAD
+
+do_L1_addr16: L1 = memRead16 (READ_PC); NEXT; 
+do_L1_addr8:  L1 = memRead8 (READ_PC); NEXT;
+do_S1_addr16: memWrite16 (READ_PC, S1); NEXT;
+do_S1_addr8:  memWrite8 (READ_PC, S1); NEXT;
+
+#define UL7 ((git_uint32)L7)
+
+do_recompile:
+    gBlockHeader->runCounter = runCounter;
+    pc = compile (READ_PC);
+    runCounter = 0;
+       NEXT;
+       
+do_jump_abs_L7:
+    gBlockHeader->runCounter = runCounter;
+    pc = getCode (UL7);
+    runCounter = gBlockHeader->runCounter;
+    NEXT;
+
+do_enter_function_L1: // Arg count is in L2.
+
+    // Check for an accelerated function
+    accelfunc = accel_get_func(L1);
+    if (accelfunc) {
+        S1 = accelfunc(L2, (glui32 *) args);
+        goto do_pop_call_stub;
+    }
+
+    frame = sp;
+    // Read the function type.
+    L7 = memRead8(L1++);
+    // Parse the local variables descriptor.
+    L6 = L5 = L4 = 0;
+    do
+    {
+        L6 = memRead8(L1++); // LocalType
+        L5 = memRead8(L1++); // LocalCount
+        if (L6 != 4 && L6 != 0) // We only support 4-byte locals.
+            fatalError("Local variable wasn't 4 bytes wide");
+        L4 += L5; // Cumulative local count.
+    }
+    while (L5 != 0);
+
+    // Write out the stack frame.
+    // Recall that the number of locals is stored in L4.
+
+    CHECK_FREE(3 + L4);
+    
+    PUSH (L4*4 + 12); // FrameLen
+    PUSH (12);        // LocalsPos
+    if (L4 == 0)
+        L6 = 0;
+    else
+        L6 = (4 << 24) | (L4 << 16);
+    PUSH (L6);         // format of locals
+
+    // This is where the local variables start, so:
+    locals = sp;
+    
+    // Read the arguments, based on the function type.
+    switch (L7)
+    {
+        case 0xC0: // arguments should be placed on the stack.
+            // argc is in L2; we'll randomly use L5 as scratch.
+            CHECK_FREE(L5 + 1);
+            // Initialise the local variables.
+            for ( ; L4 > 0 ; --L4)
+                PUSH (0);
+            // This is where the temporary values start, so:
+            values = sp;
+            // Push the args onto the stack.
+            for (L5 = 0 ; L5 < L2 ; ++L5)
+                PUSH (args [L5]);
+            // Push the arg count.
+            PUSH (L2);
+            break;
+    
+        case 0xC1: // arguments should be written into locals.
+            // argc is in L2, num locals is in L4.
+            // Stuff as many locals as possible with arguments.
+            for (L5 = 1 ; L5 <= L2 && L4 > 0 ; ++L5, --L4)
+                PUSH (args [L2 - L5]);
+            // Initialise any remaining locals.
+            for ( ; L4 > 0 ; --L4)
+                PUSH (0);
+            // This is where the temporary values start, so:
+            values = sp;
+            break;
+    
+        default:
+            // This isn't a function!
+            fatalError("Not a function");
+            break;
+    }
+        
+    // Start executing the function.
+    L7 = L1;
+    goto do_jump_abs_L7;
+
+    do_nop:     NEXT;
+
+#define PEEPHOLE_STORE(tag, code)                     \
+    do_ ## tag ## _discard:  code; NEXT;              \
+    do_ ## tag ## _S1_stack: code; goto do_S1_stack;  \
+    do_ ## tag ## _S1_local: code; goto do_S1_local;  \
+    do_ ## tag ## _S1_addr:  code; goto do_S1_addr
+
+    PEEPHOLE_STORE(add,     S1 = L1 + L2);
+    PEEPHOLE_STORE(sub,     S1 = L1 - L2);
+    PEEPHOLE_STORE(mul,     S1 = L1 * L2);
+    PEEPHOLE_STORE(div,     if (L2 == 0) fatalError ("Divide by zero"); S1 = L1 / L2);
+    PEEPHOLE_STORE(mod,     if (L2 == 0) fatalError ("Divide by zero"); S1 = L1 % L2);
+
+    PEEPHOLE_STORE(neg,     S1 = -L1);
+    PEEPHOLE_STORE(bitnot,  S1 = ~L1);
+
+    PEEPHOLE_STORE(bitand,  S1 = L1 & L2);
+    PEEPHOLE_STORE(bitor,   S1 = L1 | L2);
+    PEEPHOLE_STORE(bitxor,  S1 = L1 ^ L2);
+
+    PEEPHOLE_STORE(shiftl,  if (L2 > 31) S1 = 0; else S1 = L1 << ((git_uint32) L2));
+    PEEPHOLE_STORE(sshiftr, if (L2 > 31) L2 = 31; S1 = ((git_sint32) L1) >> ((git_uint32) L2));
+    PEEPHOLE_STORE(ushiftr, if (L2 > 31) S1 = 0; else S1 = ((git_uint32) L1) >> ((git_uint32) L2));
+
+    PEEPHOLE_STORE(aload,   S1 = memRead32 (L1 + (L2<<2)));
+    PEEPHOLE_STORE(aloads,  S1 = memRead16 (L1 + (L2<<1)));
+    PEEPHOLE_STORE(aloadb,  S1 = memRead8  (L1 + L2));
+    PEEPHOLE_STORE(aloadbit,S1 = (memRead8 (L1 + (L2>>3)) >> (L2 & 7)) & 1);
+
+    PEEPHOLE_STORE(copys,   S1 = L1 & 0xFFFF);
+    PEEPHOLE_STORE(copyb,   S1 = L1 & 0x00FF);
+    PEEPHOLE_STORE(sexs,    S1 = (git_sint32)((signed short)(L1 & 0xFFFF)));
+    PEEPHOLE_STORE(sexb,    S1 = (git_sint32)((signed char)(L1 & 0x00FF)));
+
+#define PEEPHOLE_LOAD(tag,reg) \
+    do_ ## tag ## _ ## reg ## _const: reg = READ_PC; goto do_ ## tag; \
+    do_ ## tag ## _ ## reg ## _stack: CHECK_USED(1); reg = POP; goto do_ ## tag; \
+    do_ ## tag ## _ ## reg ## _local: reg = LOCAL(READ_PC); goto do_ ## tag; \
+    do_ ## tag ## _ ## reg ## _addr:  reg = memRead32(READ_PC); goto do_ ## tag
+
+    PEEPHOLE_LOAD (return, L1);
+    PEEPHOLE_LOAD (astore, L3);
+    PEEPHOLE_LOAD (astores, L3);
+    PEEPHOLE_LOAD (astoreb, L3);
+    PEEPHOLE_LOAD (astorebit, L3);
+
+#undef PEEPHOLE_STORE
+
+    do_astore:    memWrite32 (L1 + (L2<<2), L3); NEXT;
+    do_astores:   memWrite16 (L1 + (L2<<1), L3); NEXT;
+    do_astoreb:   memWrite8  (L1 + L2, L3); NEXT;
+    do_astorebit:
+        L4 = memRead8(L1 + (L2>>3));
+        if (L3 == 0)
+            L4 &= ~(1 << (L2 & 7));
+        else
+            L4 |= (1 << (L2 & 7));
+        memWrite8(L1 + (L2>>3), L4);
+        NEXT;
+
+#define DO_JUMP(tag, reg, cond) \
+    do_ ## tag ## _var:     L7 = READ_PC; if (cond) goto do_goto_ ## reg ## _from_L7; NEXT; \
+    do_ ## tag ## _const:   L7 = READ_PC; if (cond) goto do_jump_abs_L7; NEXT;              \
+    do_ ## tag ## _by:      L7 = READ_PC; if (cond) pc += L7; NEXT;                         \
+    do_ ## tag ## _return0: if (cond) { L1 = 0; goto do_return; } NEXT;                     \
+    do_ ## tag ## _return1: if (cond) { L1 = 1; goto do_return; } NEXT
+    
+    DO_JUMP(jump, L1, 1 == 1);
+    DO_JUMP(jz,   L2, L1 == 0);
+    DO_JUMP(jnz,  L2, L1 != 0);
+    DO_JUMP(jeq,  L3, L1 == L2);
+    DO_JUMP(jne,  L3, L1 != L2);
+    DO_JUMP(jlt,  L3, L1 < L2);
+    DO_JUMP(jge,  L3, L1 >= L2);
+    DO_JUMP(jgt,  L3, L1 > L2);
+    DO_JUMP(jle,  L3, L1 <= L2);
+    DO_JUMP(jltu, L3, ((git_uint32)L1 < (git_uint32)L2));
+    DO_JUMP(jgeu, L3, ((git_uint32)L1 >= (git_uint32)L2));
+    DO_JUMP(jgtu, L3, ((git_uint32)L1 > (git_uint32)L2));
+    DO_JUMP(jleu, L3, ((git_uint32)L1 <= (git_uint32)L2));
+
+#undef DO_JUMP
+
+    do_jumpabs: L7 = L1; goto do_jump_abs_L7; NEXT;
+
+    do_goto_L3_from_L7: L1 = L3; goto do_goto_L1_from_L7;
+    do_goto_L2_from_L7: L1 = L2; goto do_goto_L1_from_L7;
+    do_goto_L1_from_L7:
+        if (L1 == 0 || L1 == 1) goto do_return;
+        L7 = L7 + L1 - 2; goto do_jump_abs_L7;
+
+    do_args_stack:
+        // The first argument is topmost in the stack; the count is in L2.
+        CHECK_USED(L2);
+        // We want to store the arguments in 'args' in the same order.
+        for (L3 = L2 - 1 ; L3 >= 0 ; --L3)
+            args [L3] = POP;
+        NEXT;
+
+    // Specialised versions of above:
+    do_args_stack_call_stub_discard:
+        CHECK_USED(L2);
+        for (L3 = L2 - 1 ; L3 >= 0 ; --L3)
+            args [L3] = POP;
+        goto do_call_stub_discard;
+        
+    do_args_stack_call_stub_addr:
+        CHECK_USED(L2);
+        for (L3 = L2 - 1 ; L3 >= 0 ; --L3)
+            args [L3] = POP;
+        goto do_call_stub_addr;
+
+    do_args_stack_call_stub_local:
+        CHECK_USED(L2);
+        for (L3 = L2 - 1 ; L3 >= 0 ; --L3)
+            args [L3] = POP;
+        goto do_call_stub_local;
+
+    do_args_stack_call_stub_stack:
+        CHECK_USED(L2);
+        for (L3 = L2 - 1 ; L3 >= 0 ; --L3)
+            args [L3] = POP;
+        goto do_call_stub_stack;
+
+    do_args_3:
+        args [0] = L4;
+        args [1] = L3;
+        args [2] = L2;
+        L2 = 3;
+        NEXT;
+
+    do_args_2:
+        args [0] = L3;
+        args [1] = L2;
+        L2 = 2;
+        NEXT;
+
+    do_args_1:
+        args [0] = L2;
+        L2 = 1;
+        NEXT;
+
+    do_args_0:
+        L2 = 0;
+        NEXT;
+
+    do_undo_stub_discard:
+        CHECK_FREE(4);
+        PUSH (0); // DestType
+        PUSH (0); // DestAddr
+        goto finish_undo_stub;
+
+    do_undo_stub_addr:
+        CHECK_FREE(4);
+        PUSH (1);       // DestType
+        PUSH (READ_PC); // DestAddr
+        goto finish_undo_stub;
+
+    do_undo_stub_local:
+        CHECK_FREE(4);
+        PUSH (2);       // DestType
+        PUSH (READ_PC); // DestAddr
+        goto finish_undo_stub;
+
+    do_undo_stub_stack:
+        CHECK_FREE(4);
+        PUSH (3); // DestType
+        PUSH (0); // DestAddr
+        goto finish_undo_stub;
+
+finish_undo_stub:
+        PUSH (READ_PC);             // PC
+        PUSH ((frame - base) * 4);  // FramePtr
+        saveUndo (base, sp);
+        S1 = 0;
+        goto do_pop_call_stub;
+
+    do_restoreundo:
+        if (restoreUndo (base, protectPos, protectSize) == 0)
+        {
+            sp = gStackPointer;
+            S1 = -1;
+            goto do_pop_call_stub;
+        }
+        S1 = 1;
+        NEXT;
+
+    do_save_stub_discard:
+        CHECK_FREE(4);
+        PUSH (0); // DestType
+        PUSH (0); // DestAddr
+        goto finish_save_stub;
+
+    do_save_stub_addr:
+        CHECK_FREE(4);
+        PUSH (1);       // DestType
+        PUSH (READ_PC); // DestAddr
+        goto finish_save_stub;
+
+    do_save_stub_local:
+        CHECK_FREE(4);
+        PUSH (2);       // DestType
+        PUSH (READ_PC); // DestAddr
+        goto finish_save_stub;
+
+    do_save_stub_stack:
+        CHECK_FREE(4);
+        PUSH (3); // DestType
+        PUSH (0); // DestAddr
+        goto finish_save_stub;
+
+finish_save_stub:
+        PUSH (READ_PC);                        // PC
+        PUSH ((frame - base) * 4);  // FramePtr
+        if (ioMode == IO_GLK)
+            S1 = saveToFile (base, sp, L1);
+        else
+            S1 = 1;
+        goto do_pop_call_stub;
+
+    do_restore:
+        if (ioMode == IO_GLK
+         && restoreFromFile (base, L1, protectPos, protectSize) == 0)
+        {
+            sp = gStackPointer;
+            S1 = -1;
+            goto do_pop_call_stub;
+        }
+        S1 = 1;
+        NEXT;
+
+    do_catch_stub_discard:
+        CHECK_FREE(4);
+        L7 = 0;
+        PUSH (0); // DestType
+        goto finish_catch_stub_addr_L7;
+
+    do_catch_stub_addr:
+        CHECK_FREE(4);
+        L7 = READ_PC;
+        memWrite32(L7, (sp-base+4)*4);
+        PUSH (1);       // DestType
+        goto finish_catch_stub_addr_L7;
+
+    do_catch_stub_local:
+        CHECK_FREE(4);
+        L7 = READ_PC;
+        memWrite32(L7, (sp-base+4)*4);
+        PUSH (2);       // DestType
+        goto finish_catch_stub_addr_L7;
+
+    do_catch_stub_stack:
+        CHECK_FREE(5);
+        PUSH (3);                  // DestType
+        PUSH (0);                  // DestAddr
+        PUSH (READ_PC);            // PC
+        PUSH ((frame - base) * 4); // FramePtr
+        L7 = (sp - base)*4;        // Catch token.
+           PUSH (L7);
+        NEXT;
+
+finish_catch_stub_addr_L7:
+        PUSH (L7);                 // DestAddr
+        PUSH (READ_PC);            // PC
+        PUSH ((frame - base) * 4); // FramePtr
+        NEXT;
+
+    do_throw:
+        if (L2 < 16 || L2 > ((sp-base)*4))
+            fatalError ("Invalid catch token in throw");
+        sp = base + L2 / 4;
+        goto do_pop_call_stub;
+    
+do_call_stub_discard:
+        CHECK_FREE(4);
+        PUSH (0); // DestType
+        PUSH (0); // DestAddr
+        goto finish_call_stub;
+
+    do_call_stub_addr:
+        CHECK_FREE(4);
+        PUSH (1);       // DestType
+        PUSH (READ_PC); // DestAddr
+        goto finish_call_stub;
+
+    do_call_stub_local:
+        CHECK_FREE(4);
+        PUSH (2);       // DestType
+        PUSH (READ_PC); // DestAddr
+        goto finish_call_stub;
+
+    do_call_stub_stack:
+        CHECK_FREE(4);
+        PUSH (3); // DestType
+        PUSH (0); // DestAddr
+        goto finish_call_stub;
+
+finish_call_stub:
+        PUSH (READ_PC);             // PC
+        PUSH ((frame - base) * 4);  // FramePtr
+        goto do_enter_function_L1;
+    
+do_tailcall:
+        // Zap the current stack frame, down to its call stub.
+        sp = frame;
+        // Call the function!
+        goto do_enter_function_L1;
+    
+    do_return:
+        sp = frame;
+        // ...
+        // fall through
+        // ...
+    do_pop_call_stub:// L1 holds the return value.
+        if (sp - base < 4)
+        {
+            if (sp == base)
+                // We just exited the top-level function.
+                goto finished;
+            else
+                // Something nasty happened.
+                goto stack_underflow;
+        }
+        L2 = POP;    // FramePtr
+        L7 = POP;    // PC
+        L6 = POP;    // DestAddr
+        switch (POP) // DestType
+        {
+            case 0: // Do not store.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                break;
+
+            case 1: // Store in main memory.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                memWrite32 (L6, L1);
+                break;
+
+            case 2: // Store in local variable.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                LOCAL(L6/4) = L1;
+                break;
+
+            case 3: // Push on stack.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                PUSH (L1);
+                break;
+            
+            case 10: // Resume printing a compressed (E1) string.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                goto resume_compressed_string_L7_bit_L6;
+                
+            case 11: // Resume executing function code after a string completes.
+                // Don't restore the frame pointer.
+                break;
+                
+            case 12: // Resume printing a signed decimal integer.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                goto resume_number_L7_digit_L6;
+                
+            case 13: // Resume printing a C-style (E0) string.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                goto resume_c_string_L7;
+                
+            case 14: // Resume printing a Unicode (E2) string.
+                frame = base + L2 / 4;
+                locals = frame + frame[1]/4;
+                values = frame + frame[0]/4;
+                goto resume_uni_string_L7;
+
+            default:
+                fatalError("Bad call stub");
+        }
+        // Restore the PC.
+        goto do_jump_abs_L7;
+
+    do_stkcount:
+        S1 = sp - values; NEXT;
+    
+    do_stkpeek:
+        if (L1 < 0 || L1 > (sp - values))
+            fatalError("Out of bounds in stkpeek");
+        S1 = sp[-1 - L1]; NEXT;
+
+    do_stkswap:
+        CHECK_USED(2);
+        L1 = POP; L2 = POP; PUSH(L1); PUSH(L2); NEXT;
+
+    do_stkcopy:
+        CHECK_USED(L1);
+        for (L2 = L1 ; L2 > 0 ; --L2)
+        {
+            L3 = sp[-L1];
+            PUSH (L3);
+        }
+        NEXT;
+
+    resume_number_L7_digit_L6:
+    {
+        char buffer [16];
+        
+        // If the IO mode is 'null', do nothing.
+        if (ioMode == IO_NULL)
+            goto do_pop_call_stub;
+
+        // Write the number into the buffer.
+        L1 = (L7 < 0) ? -L7 : L7; // Absolute value of number.
+        L2 = 0;                   // Current buffer position.
+        do
+        {
+            buffer [L2++] = '0' + (L1 % 10);
+            L1 /= 10;
+        }
+        while (L1 > 0);
+
+        if (L7 < 0)
+            buffer [L2++] = '-';
+        
+        if (L6 >= L2)
+            goto do_pop_call_stub; // We printed the whole number already.
+
+        // If we're in filter mode, push a call stub
+        // and filter the next character.
+        if (ioMode == IO_FILTER)
+        {
+            // Store the next character in the args array.
+            args[0] = buffer [L2 - L6 - 1];
+            ++L6;
+            
+            // Push a call stub to print the next character.
+            CHECK_FREE(4);
+            PUSH(12); // DestType
+            PUSH(L6); // DestAddr (next digit)
+            PUSH(L7); // PC       (number to print)
+            PUSH ((frame - base) * 4); // FramePtr
+
+            // Call the filter function.
+            L1 = ioRock;
+            L2 = 1;
+            goto do_enter_function_L1;
+        }
+        else
+        {
+            // We're in Glk mode. Just print all the characters.
+            for ( ; L6 < L2 ; ++L6)
+                glk_put_char (buffer [L2 - L6 - 1]);
+        }
+    }
+        goto do_pop_call_stub;
+
+    resume_c_string_L7:
+        // If the IO mode is 'null', or if we've reached the
+        // end of the string, do nothing.
+        L2 = memRead8(L7++);
+        if (L2 == 0 || ioMode == IO_NULL)
+            goto do_pop_call_stub;
+        // Otherwise we're going to have to print something,
+        // If the IO mode is 'filter', filter the next char.
+        if (ioMode == IO_FILTER)
+        {
+            // Store this character in the args array.
+            args [0] = L2;
+            // Push a call stub.
+            CHECK_FREE(4);
+            PUSH(13); // DestType (resume C string)
+            PUSH(L6); // DestAddr (ignored)
+            PUSH(L7); // PC       (next char to print)
+            PUSH ((frame - base) * 4); // FramePtr
+            // Call the filter function.
+            L1 = ioRock;
+            L2 = 1;
+            goto do_enter_function_L1;
+        }
+        // We're in Glk mode. Just print all the characters.
+        while (L2 != 0)
+        {
+            glk_put_char ((unsigned char) L2);
+            L2 = memRead8(L7++);
+        }
+        goto do_pop_call_stub;
+
+    resume_uni_string_L7:
+        // If the IO mode is 'null', or if we've reached the
+        // end of the string, do nothing.
+        L2 = memRead32(L7);
+        L7 += 4;
+        if (L2 == 0 || ioMode == IO_NULL)
+            goto do_pop_call_stub;
+        // Otherwise we're going to have to print something,
+        // If the IO mode is 'filter', filter the next char.
+        if (ioMode == IO_FILTER)
+        {
+            // Store this character in the args array.
+            args [0] = L2;
+            // Push a call stub.
+            CHECK_FREE(4);
+            PUSH(14); // DestType (resume Unicode string)
+            PUSH(L6); // DestAddr (ignored)
+            PUSH(L7); // PC       (next char to print)
+            PUSH ((frame - base) * 4); // FramePtr
+            // Call the filter function.
+            L1 = ioRock;
+            L2 = 1;
+            goto do_enter_function_L1;
+        }
+        // We're in Glk mode. Just print all the characters.
+        while (L2 != 0)
+        {
+#ifdef GLK_MODULE_UNICODE
+            glk_put_char_uni ((glui32) L2);
+#else
+            unsigned char c = (L2 > 0 && L2 < 256) ? L2 : '?';
+            glk_put_char (c);
+#endif // GLK_MODULE_UNICODE
+            L2 = memRead32(L7);
+            L7 += 4;
+        }
+        goto do_pop_call_stub;
+
+    resume_compressed_string_L7_bit_L6:
+        // Load the first string table node into L1.
+        // Its address is stored at stringTable + 8.
+        L1 = memRead32 (stringTable + 8);
+        // Load the node's type byte.
+        L2 = memRead8 (L1++);
+        // Is the root node a branch?
+        if (L2 == 0)
+        {
+            // We'll keep a reservoir of input bits in L5.
+            L5 = memRead8(L7);
+            // Keep following branch nodes until we hit a leaf node.
+            while (L2 == 0)
+            {
+                // Read the next bit.
+                L4 = (L5 >> L6) & 1;
+                // If we're finished reading this byte,
+                // move on to the next one.
+                if (++L6 > 7)
+                {
+                    L6 -= 8;
+                    L5 = memRead8(++L7);
+                }
+                // Follow the branch.
+                L1 = memRead32(L1 + 4 * L4);
+                L2 = memRead8 (L1++);
+            }
+        }
+        else if (L2 == 2 || L2 == 3)
+        {
+            // The root node prints a single character or a string.
+            // This will produce infinite output in the Null or Glk
+            // I/O modes, so we'll catch that here.
+
+            if (ioMode != IO_FILTER)
+                fatalError ("String table prints infinite strings!");
+
+            // In Filter mode, the output will be sent to the current
+            // filter function, which can change the string table
+            // before returning, so we'll continue and see what happens.
+        }
+        // We're at a leaf node.
+        switch (L2)
+        {
+            case 1: // Terminator.
+                goto do_pop_call_stub;
+
+            case 2: // Single char.
+                if (ioMode == IO_NULL)
+                    { /* Do nothing */ }
+                else if (ioMode == IO_GLK)
+                    glk_put_char ((unsigned char) memRead8(L1));
+                else
+                {
+                    // Store this character in the args array.
+                    args [0] = memRead8(L1);
+                    // Push a call stub.
+                    CHECK_FREE(4);
+                    PUSH(10); // DestType
+                    PUSH(L6); // DestAddr (bit number in string)
+                    PUSH(L7); // PC       (byte address in string)
+                    PUSH ((frame - base) * 4); // FramePtr
+                    // Call the filter function.
+                    L1 = ioRock;
+                    L2 = 1;
+                    goto do_enter_function_L1;
+                }
+                break;
+
+            case 3: // C string.
+                // Push a 'resume compressed string' call stub.
+                CHECK_FREE(4);
+                PUSH (10); // DestType
+                PUSH (L6); // DestAddr (bit number in string)
+                PUSH (L7); // PC       (byte address in string)
+                PUSH ((frame - base) * 4); // FramePtr
+                // Print the C string.
+                L7 = L1;
+                goto resume_c_string_L7;
+                
+            case 4: // Unicode char
+                if (ioMode == IO_NULL)
+                    { /* Do nothing */ }
+                else if (ioMode == IO_GLK)
+                {
+#ifdef GLK_MODULE_UNICODE
+                    glk_put_char_uni (memRead32(L1));
+#else
+                    git_uint32 c = memRead32(L1);
+                    if (c > 255) c = '?';
+                    glk_put_char ((unsigned char) c);
+#endif // GLK_MODULE_UNICODE
+                }
+                else
+                {
+                    // Store this character in the args array.
+                    args [0] = memRead32(L1);
+                    // Push a call stub.
+                    CHECK_FREE(4);
+                    PUSH(10); // DestType
+                    PUSH(L6); // DestAddr (bit number in string)
+                    PUSH(L7); // PC       (byte address in string)
+                    PUSH ((frame - base) * 4); // FramePtr
+                    // Call the filter function.
+                    L1 = ioRock;
+                    L2 = 1;
+                    goto do_enter_function_L1;
+                }
+                break;
+
+            case 5: // Unicode string.
+                // Push a 'resume compressed string' call stub.
+                CHECK_FREE(4);
+                PUSH (10); // DestType
+                PUSH (L6); // DestAddr (bit number in string)
+                PUSH (L7); // PC       (byte address in string)
+                PUSH ((frame - base) * 4); // FramePtr
+                // Print the Unicode string.
+                L7 = L1;
+                goto resume_uni_string_L7;
+
+            case 8:  // Indirect reference.
+                L3 = memRead32(L1);
+                L2 = 0; goto indirect_L3_args_L2;
+
+            case 9:  // Double-indirect reference.
+                L3 = memRead32(L1); L3 = memRead32(L3);
+                L2 = 0; goto indirect_L3_args_L2;
+
+            case 10: // Indirect reference with args.
+                L3 = memRead32(L1);
+                L2 = memRead32(L1 + 4); goto indirect_L3_args_L2;
+
+            case 11: // Double-indirect reference with args.
+                L3 = memRead32(L1); L3 = memRead32(L3);
+                L2 = memRead32(L1 + 4); goto indirect_L3_args_L2;
+
+            indirect_L3_args_L2:
+                // Push a 'resume compressed string' call stub.
+                CHECK_FREE(4);
+                PUSH (10); // DestType
+                PUSH (L6); // DestAddr (bit number in string)
+                PUSH (L7); // PC       (byte address in string)
+                PUSH ((frame - base) * 4); // FramePtr
+                // Check the type of the embedded object.
+                switch (memRead8(L3))
+                {
+                    case 0xE0: // C string.
+                        L7 = L3 + 1;
+                        goto resume_c_string_L7;
+
+                    case 0xE1: // Compressed string.
+                        L7 = L3 + 1;
+                        L6 = 0;
+                        goto resume_compressed_string_L7_bit_L6;
+                        
+                    case 0xE2: // Unicode string.
+                        L7 = L3 + 4; // Skip extra three padding bytes.
+                        goto resume_uni_string_L7;
+
+                    case 0xC0: case 0xC1: // Function.
+                        // Retrieve arguments.
+                        for (L1 += 8, L4 = 0; L4 < L2 ; ++L4, L1+=4)
+                            args[L4] = memRead32(L1);
+                        // Enter function.
+                        L1 = L3;
+                        goto do_enter_function_L1;
+                    
+                    default: fatalError ("Embedded object in string has unknown type");
+                }
+                break;
+
+            default: fatalError ("Unknown string table node type");
+        }
+        // Start back at the root node again.
+        goto resume_compressed_string_L7_bit_L6;
+
+    do_streamstr:
+        // Push a 'resume function' call stub.
+        CHECK_FREE(4);
+        PUSH (11);                            // DestType
+        PUSH (0);                             // Addr
+        PUSH (READ_PC);                       // PC
+        PUSH ((frame - base) * 4); // FramePtr
+
+        // Load the string's type byte.
+        L2 = memRead8(L1++);
+        if (L2 == 0xE0)
+        {
+            // Uncompressed string.
+            L7 = L1;
+            goto resume_c_string_L7;
+        }
+        else if (L2 == 0xE1)
+        {
+            // Compressed string.
+            L7 = L1;
+            L6 = 0;
+            goto resume_compressed_string_L7_bit_L6;
+        }
+        else if (L2 == 0xE2)
+        {
+            // Uncompressed Unicode string.
+            L7 = L1 + 3; // Skip three padding bytes.
+            goto resume_uni_string_L7;
+        }
+        else
+        {
+            fatalError ("Value used in streamstr was not a string");
+            goto finished;
+        }
+
+    do_streamchar:
+        L7 = READ_PC;
+        if (ioMode == IO_NULL)
+            { /* Do nothing */ }
+        else if (ioMode == IO_GLK)
+        {
+            unsigned char c = (L1 & 0xff);
+            glk_put_char (c);
+        }
+        else
+        {
+            // Store this character in the args array.
+            args [0] = (L1 & 0xff);
+            // Push a 'resume function' call stub.
+            CHECK_FREE(4);
+            PUSH (0);                  // DestType
+            PUSH (0);                  // Addr
+            PUSH (L7);                 // PC
+            PUSH ((frame - base) * 4); // FramePtr
+            // Call the filter function.
+            L1 = ioRock;
+            L2 = 1;
+            goto do_enter_function_L1;
+        }
+        NEXT;
+
+    do_streamunichar:
+        L7 = READ_PC;
+        if (ioMode == IO_NULL)
+            { /* Do nothing */ }
+        else if (ioMode == IO_GLK)
+        {
+#ifdef GLK_MODULE_UNICODE
+            glk_put_char_uni ((glui32) L1);
+#else
+            unsigned char c = (L1 > 0 && L1 < 256) ? L1 : '?';
+            glk_put_char (c);
+#endif // GLK_MODULE_UNICODE
+        }
+        else
+        {
+            // Store this character in the args array.
+            args [0] = L1;
+            // Push a 'resume function' call stub.
+            CHECK_FREE(4);
+            PUSH (0);                  // DestType
+            PUSH (0);                  // Addr
+            PUSH (L7);                 // PC
+            PUSH ((frame - base) * 4); // FramePtr
+            // Call the filter function.
+            L1 = ioRock;
+            L2 = 1;
+            goto do_enter_function_L1;
+        }
+        NEXT;
+
+    do_streamnum:
+        // Push a 'resume function' call stub.
+        CHECK_FREE(4);
+        PUSH (11);                            // DestType
+        PUSH (0);                             // Addr
+        PUSH (READ_PC);                       // PC
+        PUSH ((frame - base) * 4); // FramePtr
+
+        // Print the number.
+        L7 = L1;
+        L6 = 0;
+        goto resume_number_L7_digit_L6;
+
+    // Stub opcodes:
+
+    do_getmemsize:
+        S1 = gEndMem;
+        NEXT;
+
+    do_getiosys:
+        S1 = ioMode;
+        S2 = ioRock;
+        NEXT;
+
+    do_setiosys:    
+        switch (L1)
+        {
+            case IO_NULL:
+            case IO_FILTER:
+            case IO_GLK:
+                ioMode = (enum IOMode) L1;
+                ioRock = L2;
+                break;
+            
+            default:
+                fatalError ("Illegal I/O mode");
+                break;
+        }
+        NEXT;
+
+    do_quit:
+        goto finished;
+        
+    do_restart:
+        // Reset game memory to its initial state.
+        resetMemory(protectPos, protectSize);
+        resetUndo();
+
+        // Reset all the stack pointers.
+        frame = locals = values = sp = base;
+
+        // Call the first function.
+        L1 = startPos; // Initial PC.
+        L2 = 0; // No arguments.
+        goto do_enter_function_L1;        
+
+    do_verify:
+        S1 = verifyMemory();
+        NEXT;
+
+    do_random:
+        if (L1 > 0)
+            S1 = rand() % L1;
+        else if (L1 < 0)
+            S1 = -(rand() % -L1);
+        else
+        {
+            // The parameter is zero, so we should generate a
+            // random number in "the full 32-bit range". The rand()
+            // function might not cover the entire range, so we'll
+            // generate the high 16 bits and low 16 bits separately.
+            S1 = (rand() & 0xffff) | (rand() << 16);
+        }
+        NEXT;
+
+    do_setrandom:
+        srand (L1 ? L1 : time(NULL));
+        NEXT;
+
+    do_glk:
+        // The first argument is topmost in the stack; count is in L2.
+        CHECK_USED(L2);
+        // We want to store the arguments in 'args' in the same order.
+        for (L3 = 0 ; L3 < L2 ; ++L3)
+            args [L3] = POP;
+        gStackPointer = sp;
+        S1 = git_perform_glk (L1, L2, (glui32*) args);
+        sp = gStackPointer;
+        NEXT;
+
+    do_binarysearch:
+        S1 = git_binary_search (L1, L2, L3, L4, L5, L6, L7);
+        NEXT;
+
+    do_linearsearch:
+        S1 = git_linear_search (L1, L2, L3, L4, L5, L6, L7);
+        NEXT;
+
+    do_linkedsearch:
+        S1 = git_linked_search (L1, L2, L3, L4, L5, L6);
+        NEXT;
+
+    do_gestalt:
+        S1 = gestalt (L1, L2);
+        NEXT;
+
+    do_getstringtbl: S1 = stringTable; NEXT;
+    do_setstringtbl: stringTable = L1; NEXT;
+        
+    do_debugtrap:
+        // TODO: do something useful here.
+        NEXT;
+
+    do_stkroll:
+        // We need to rotate the top L1 elements by L2 places.
+        if (L1 < 0)
+            fatalError ("Negative number of elements to rotate in stkroll");
+        if (L1 > (sp - values))
+            fatalError ("Tried to rotate too many elements in stkroll");
+        // Now, let's normalise L2 into the range [0..L1).
+        if (L2 >= 0)
+            L2 = L2 % L1;
+        else
+            L2 = L1 - (-L2 % L1);
+        // Avoid trivial cases.
+        if (L1 == 0 || L2 == 0 || L2 == L1)
+            NEXT;
+        L2 = L1 - L2;
+        // The problem is reduced to swapping elements [0..L2) with
+        // elements [L2..L1). Let's call these two sequences A and B,
+        // so we need to transform AB into BA. We do this sneakily
+        // with reversals, as follows: AB -> A'B -> A'B' -> (A'B')',
+        // where X' is the reverse of the sequence X.
+#define SWAP(x,y) \
+        do { L4 = sp[(x)-L1];sp[(x)-L1]=sp[(y)-L1];sp[(y)-L1]=L4; } while (0)
+
+        // Reverse [0..L2).
+        for (L3 = 0 ; L3 < L2/2 ; ++L3)
+            SWAP (L3, L2-1-L3);
+        // Reverse [L2..L1).
+        for (L3 = L2 ; L3 < (L2 + (L1-L2)/2) ; ++L3)
+            SWAP (L3, L1-1-(L3-L2));
+        // Reverse [0..L1).
+        for (L3 = 0 ; L3 < L1/2 ; ++L3)
+            SWAP (L3, L1-1-L3);
+
+#undef SWAP
+        // And we're done!
+        NEXT;
+        
+    do_setmemsize:
+        S1 = resizeMemory (L1, 0);
+        NEXT;
+        
+    do_protect:
+        protectPos = L1;
+        protectSize = L2;
+        NEXT;
+    
+    // Memory management (new with glulx spec 3.1)
+    
+    do_mzero:
+        if (L1 > 0) {
+                       if (L2 < gRamStart || (L2 + L1) > gEndMem)
+                               memWriteError(L2);
+                       memset(gRam + L2, 0, L1);
+               }
+        NEXT;
+        
+    do_mcopy:
+        if (L1 > 0) {
+            if (L2 < 0 || (L2 + L1) > gEndMem)
+                memReadError(L2);
+            if (L3 < gRamStart || (L3 + L1) > gEndMem)
+                memWriteError(L3);
+            // ROM and ROM are stored separately, so this is a bit fiddly...
+            if (L2 > gRamStart) {
+                // Only need to copy from RAM. Might be overlapping, so use memmove.
+                memmove(gRam + L3, gRam + L2, L1);
+            } else if ((L2 + L1) <= gRamStart) {
+                // Only need to copy from ROM. Can't overlap, so memcpy is safe.
+                memcpy(gRam + L3, gRom + L2, L1);
+            } else {
+                // Need to copy from both ROM and RAM.
+                L4 = (L2 + L1) - gRamStart; // Amount of ROM to copy.
+                memcpy(gRam + L3, gRom + L2, L4);
+                memmove(gRam + L3 + L4, gRam + L2 + L4, L1 - L4);
+            }
+        }
+        NEXT;
+        
+    do_malloc:
+        S1 = heap_alloc(L1);
+        NEXT;
+        
+    do_mfree:
+        heap_free(L1);
+        NEXT;
+        
+    // Function acceleration (new with glulx spec 3.1.1)
+        
+    do_accelfunc:
+        accel_set_func(L1, L2);
+        NEXT;
+        
+    do_accelparam:
+        accel_set_param(L1, L2);
+        NEXT;
+        
+    // Special Git opcodes
+    
+    do_git_setcacheram:
+        gCacheRAM = (L1 == 0) ? 0 : 1;
+        NEXT;
+        
+    do_git_prunecache:
+        pruneCodeCache (L1, L2);
+        NEXT;
+    
+    // Error conditions:
+    
+    do_error_bad_opcode:
+        fatalError ("Illegal instruction");
+        goto finished;
+    
+    stack_overflow:
+        fatalError ("Stack overflow");
+        goto finished;
+    
+    stack_underflow:
+        fatalError ("Stack underflow");
+        goto finished;
+        
+// ---------------------------------
+
+finished:
+
+    free (base);
+    shutdownCompiler();
+}
diff --git a/interpreters/git/test/Alabaster.gblorb b/interpreters/git/test/Alabaster.gblorb
new file mode 100644 (file)
index 0000000..923b704
Binary files /dev/null and b/interpreters/git/test/Alabaster.gblorb differ
diff --git a/interpreters/git/test/Alabaster.golden b/interpreters/git/test/Alabaster.golden
new file mode 100644 (file)
index 0000000..482f9db
--- /dev/null
@@ -0,0 +1,536 @@
+Welcome to the Cheap Glk Implementation, library version 0.9.0.
+
+
+
+
+It is the bitterest night you can remember since the dwarrows last marched against men. The sky is too cold, the village too still. There is smoke in the air but no voices from the doorways. The Queen's light burns in the tower window behind you. She is watching, as far as she can.
+
+You and the girl move through the narrow lanes without speaking, past the muted inns and shuttered bakeries, until you reach the narrowing path beyond the churchyard.
+
+Pass in silence the graves of veterans and good wives, and then at the outskirts the graves of suicides, which are granted no markers. Come to the place where the village ends and the trees begin to grow.
+
+Enter the forest like two spies, one sent to kill the other.
+
+Walk for hours.
+
+Alabaster
+An Interactive Experiment by John Cater, Rob Dubbin, Eric Eve, Elizabeth Heller, Jayzee, Kazuki Mishima, Sarah Morayati, Mark Musante, Emily Short, Adam Thornton, and Ziv Wities
+Release 30 / Serial number 090217 / Inform 7 build 5Z68 (I6/v6.31 lib 6/12N) 
+
+Dark Woods
+It is a moonless night. The lantern light does not reach far. You are seldom frightened in these woods, but tonight is unusual.
+
+Snow White is with you. Her wrists are bound behind her back. She has made as much of a nuisance of herself as she could, deliberately stumbling over every root in the dark, until you had to half-carry her this far.
+
+Earlier, you killed a hart and left it here. It was a preparation: you didn't want to have to hunt such an animal in the darkness.
+
+Now, you can't help wondering whether you should have spared the noble beast.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 0 / A 0.Glk library error: window_move_cursor: invalid id.
+0/37/73/415Glk library error: window_move_cursor: invalid id.
+You slice the heart out of the dead animal. It is cold now, just like any ordinary sort of meat.
+
+She goes awkwardly over to the corpse and goes to one knee beside it. "Thank you," she whispers -- to it, not to you. Then she leans down and-- what, exactly? You can't see. Maybe she kisses it. Maybe she licks its blood. Maybe neither.
+
+When she's done she struggles back to her feet and looks at you defiantly.
+
+Of course you could ask what she was doing, but who is to say that she would answer?
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 1 / A 0.Glk library error: window_move_cursor: invalid id.
+1/41/74/415Glk library error: window_move_cursor: invalid id.
+"What was that?" you ask. "What did you do to the hart?"
+
+"It died for my sake; I repaid a little of the debt." Her lips look dark, almost black.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/42/75/415Glk library error: window_move_cursor: invalid id.
+You wait for Snow White to become tired of glaring at you and after a few moments she obliges, turning toward a scurrying sound in the underbrush with a hungry glint in her eye.
+
+Seizing the opportunity, you kneel before the heartless hart and ask, "Hello?"
+
+Several things happen at once. Firstly, Snow White whirls toward you, her face livid. "YOU CAN'T --"
+
+But before she can finish her sentence, in point of fact as she's starting it, the once-dark forest flashes with frantic, ice-blue energy, the air fills with a steady, ethereal hum, and you see the pallid princess lifted before you, suspended in the thick, vibrating air, her rage caught in her throat.
+
+The immediate impulse is to taunt your suddenly riposte-incapable companion, but petty vengeance quickly dissolves in the face of a final sudden development.
+
+Namely, the hart -- which now stands proudly upright, its eyes and empty chest cavity glowing an incongruous silver.
+
+It has what can only be described as a wry expression on its face. "I suppose I should begin by thanking you."
+
+You can ask why he thanks you, say that he's welcome, or ask what his name is.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+3/18/31/415Glk library error: window_move_cursor: invalid id.
+You've hunted and bested many harts through the years, but this is the first to comment on the exchange afterward. Awestruck, you manage to stammer "Th-thanking me?"
+
+The decomposing hart corpse glances into the canyon that used to power its circulatory system. "You've been through a lot. Please forgive my sarcasm."
+
+The woods are eerily silent.
+
+The decomposing hart corpse peers at you sardonically. "Before we go any further, is there anything else you'd like to carve out of what's left of my body?"
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/3/32/415Glk library error: window_move_cursor: invalid id.
+"No," you reply sheepishly.
+
+"Very well," says the hart corpse, "then let us get down to business."
+
+No one speaks, though only the two of you experience any pause.
+
+"I will tell you exactly what just happened, and indeed provide enough information to turn the tables on your know-it-all prisoner over there, if you agree to my terms."
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/17/28/415Glk library error: window_move_cursor: invalid id.
+No time passes at all.
+
+As though to add to the disturbing qualities of the moment, the hart gives you something that might be intended as a reassuring smile.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/17/28/415Glk library error: window_move_cursor: invalid id.
+You try smiling back, but it doesn't feel at all sincere.
+
+The hart corpse paws the ground innocently. "It's very simple, really. I want my heart back."
+
+It's hard to imagine how that would be possible.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+1/17/28/415Glk library error: window_move_cursor: invalid id.
+For what you realize is, incredibly, the first time, you feel disgusted. "Back... in there?" you ask, gesturing at the decomposing hart corpse's glowing rib cage.
+
+The hart corpse rears upward, clattering back to the ground with enough force to jar a few loose gobbets from its body cavity. "Don't be grotesque. I mean that I want it back in a more cosmic sense."
+
+Which raises the obvious question of what he means by "cosmic".
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+1/1/28/415Glk library error: window_move_cursor: invalid id.
+"What exactly do you mean, 'in a more cosmic sense?'" You can't believe you're negotiating with a decomposing hart corpse.
+
+The hart blinks, heedless of the fact that silver light continues to escape from its torn left eyelid. "Unfortunately, I can't answer that question without revealing too much of my hand, such as it is. I am proposing you a pact. Do you say yes or do you say no?"
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/2/29/415Glk library error: window_move_cursor: invalid id.
+You figure there's no harm in collecting pacts. "I accept," you intone solemnly.
+
+The decomposing hart corpse clatters excitedly, and its silver glow momentarily surges while the urgent blue prison surrounding Snow White flickers and dulls. "Excellent. It is done. I believe you are in possession of a small wooden box?"
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/2/29/415Glk library error: window_move_cursor: invalid id.
+"Yes, I have such a box," you admit.
+
+"Very well," says the undead hart, "Then you must burn the box with my heart inside, and scatter the ashes round this spot."
+
+The light from your lantern casts an unusually steady glow over the scene. "Only that way can I be made whole - and set free," he tells you, "So, will you do that for me?"
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/2/28/415Glk library error: window_move_cursor: invalid id.
+"Very well, if that is what you wish," you agree.
+
+"Good," the hart replies, "And in return, I will aid you against your prisoner. But do not delay, the deed must be done 'ere the night is o'er."
+
+The wind has dropped completely. "I should have introduced myself. The name's Happy Blue, professional juggler and itinerant dwarf-about-town," declares the hart corpse proudly, crooking a fractured forelimb and dipping its matted shoulder in salute.
+
+You could ask where its name came from or ask whether he was a servant of Snow White.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+2/23/28/415Glk library error: window_move_cursor: invalid id.
+"Where is the King?" You lean towards him eagerly. "He vanished, but where did he go? Did the Queen kill him?"
+
+His laughter is sharp. "You are the King."
+
+You could always request that he repeat himself.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+1/1/28/415Glk library error: window_move_cursor: invalid id.
+"I'm sorry -- what did you just say?"
+
+"This is fun," he says. "I could do this all day. I said that you are the King. Not that you'll find it easy to retain that information. Try to hold onto it, or it will slip out of your head again."
+
+You could always ask what happened to you.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+1/23/28/415Glk library error: window_move_cursor: invalid id.
+"That's impossible -- I don't remember being King. I grew up nearby... I have cousins in the village. The King on the other hand--"
+
+"Probably has cousins in the village as well, considering the way his father and grandfather behaved while they were alive," says Happy dryly. "But you wouldn't remember."
+
+No one speaks, though only the two of you experience any pause. "You've been blood-sundered. It is a magic that unmakes families, destroys the connections between people, and in so doing yields great power that can be used for other purposes."
+
+You could ask who performed the magic.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+1/24/29/415Glk library error: window_move_cursor: invalid id.
+"But -- who would have done such a thing to me?
+
+"As King, you were not kind to the dwarrows," he says, his voice harder than you have heard ever before. "You provoked us. You gave plain preference to your own kind, allowing them to mistreat us, upsetting the balance that your father had -- with great difficulty -- established. There was suffering and war."
+
+You could ask how the current peace came about.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+1/1/29/415Glk library error: window_move_cursor: invalid id.
+"I don't understand." This makes less and less sense as you go. "If I provoked the dwarrows -- if I was such a bad King --" (and how could you have been the King at all?) "-- then how is it that there is peace now?"
+
+"When you saw what you had done, you felt-- you regretted it." He tilts his head at you. "You decided to create a peace. But that is very difficult work, and it is not the usual use of magic." He smirks, if an animal's face can be said to hold such an expression. "Demons arrange magic, and as a rule they prefer to do more harm than good. So you were forced to sacrifice yourself, your family, and lose your throne, and dwindle into no one. In exchange for this, we have had this-- ragged sort of calm.
+
+Even the clouds seem to have stopped.
+
+"Don't mistake me," he adds. "A poor peace is better than none. I appreciate the gift -- though I doubt that anyone else does. It cannot be known what you did, you see. So the dwarrows still hate your name."
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/23/28/415Glk library error: window_move_cursor: invalid id.
+No time passes at all.
+
+The silver glow surrounding the hart begins to fade. "Alas, I can stay no longer," he tells you, "Farewell - and beware!"
+
+He sinks to the ground, a final sigh escaping his decaying throat, "Do not delay - box - heart - burn."
+
+Then the glow is gone, and the hart is still once more, with nothing to show he ever moved..
+
+Snow White returns to earth. She looks around her, blinking: she seems a little confused. Perhaps she does not remember you speaking to the hart.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 0.Glk library error: window_move_cursor: invalid id.
+0/45/77/415Glk library error: window_move_cursor: invalid id.
+"I meant to mention earlier," you say, "you're going to have to start doing your walking on your own, your royal highness, and start watching where you're going. You may be willing to risk your own neck with this deliberate clumsiness, but I assure you, I'm not risking mine."
+
+Snow White gazes at you coldly. "I see. You think I'm being difficult on purpose.
+
+"It didn't occur to you that the Queen might have wounded me, or wearied me with her spells. Nor have you considered that a palace girl with her hands bound might have difficulty making her way through the forest at night. No; it's quite clear that I'm intentionally delaying, risking my only chance to escape, isn't it now.
+
+"Be honest now, woodsman: which of these sounds most likely to you?"
+
+It seems unlikely that the Queen hurt her or that a creature like her is having real trouble (though you could ask). But you still have the feeling that she is delaying on purpose.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+menacing:  S 2 / A 1.Glk library error: window_move_cursor: invalid id.
+0/4/80/415Glk library error: window_move_cursor: invalid id.
+"The last one," you say darkly. "I'll be damned if I know why, but you're deliberately slowing us down every step of the way."
+
+For the first time, Snow White smiles. The expression is not reassuring; in fact, the temperature seems to dive and your lantern nearly extinguishes itself. "Correct," she says. "You are learning, huntsman. I do nothing that is not deliberate, mark my words."
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 3 / A 2.Glk library error: window_move_cursor: invalid id.
+0/45/76/415Glk library error: window_move_cursor: invalid id.
+"Listen, princess, if you expect me to help you, you'd best explain why it is you're so carefully tripping over roots instead of fleeing for your life."
+
+She considers before speaking. Then, "I am searching for something," she says, "which is as necessary to my safety as reaching my haven. I'd hoped, though, to make my find far earlier, before you noticed." 
+
+She muses for a moment. "I should not tell you. But you would hardly let me stay silent, would you?"
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 2 / A 2.Glk library error: window_move_cursor: invalid id.
+0/2/77/415Glk library error: window_move_cursor: invalid id.
+"No, I wouldn't. I'd be a fool to, and well you know it."
+
+"Fair enough. Since we have no bond, though, I cannot tell you directly. A riddle, then:
+
+"Red and sweet - the perfect meal;
+Sustenance with such appeal
+With a bite release its charm
+Thus shall ye be safe from harm
+Lilith had none, yet her man
+Could not share his - no one can."
+
+Tempting to refuse to guess.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 2 / A 2.Glk library error: window_move_cursor: invalid id.
+1/53/82/415Glk library error: window_move_cursor: invalid id.
+"Who was Lilith?"
+
+"You don't care to guess the answer to my riddle, then?" 
+
+"Not now," you reply.
+
+"Lilith," she repeats, sing-song. "The first wife of Adam, before the milkmaid Eve came to the garden. She was formed from fire as Adam was formed from earth: she was his equal, and said so, and so he cast her out."
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 2 / A 2.Glk library error: window_move_cursor: invalid id.
+0/55/80/415Glk library error: window_move_cursor: invalid id.
+"Why did you mention Adam?"
+
+"All men are like Adam." She looks you over, then adds, "...though some less than others."
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 2 / A 2.Glk library error: window_move_cursor: invalid id.
+0/54/79/415Glk library error: window_move_cursor: invalid id.
+"Is the answer to your riddle an apple? If so, you have the wrong sort of woods -- the trees here are pine and aspen."
+
+"You answer right, and yet you don't understand." Her expression, dimly seen in the lantern light, is almost frustrated, as though there is something she wishes to tell you, but cannot.
+
+But it's not clear how an apple would help her.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 1 / A 2.Glk library error: window_move_cursor: invalid id.
+1/48/72/415Glk library error: window_move_cursor: invalid id.
+"What good would an apple do you?" It seems more and more that you are humoring the mad.
+
+"It is the food of mortals," she says. (Wistfully, you might think.) "Those who eat, die; those who die, live beforehand."
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 0 / A 2.Glk library error: window_move_cursor: invalid id.
+0/48/72/415Glk library error: window_move_cursor: invalid id.
+"And you are immortal?"
+
+"Partly." She walks away from you, around a tree, out of sight, and then circles back into view. "It grows tiring. Under the proper conditions, I would change my situation."
+
+She shifts her weight, breaking a twig. "Perhaps we should begin with the Queen. Her magic is to blame for all our situations."
+
+You could now ask whether the Queen herself made the magic mirror or ask if the Queen is a witch.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+furious:  S 0 / A 2.Glk library error: window_move_cursor: invalid id.
+2/47/71/415Glk library error: window_move_cursor: invalid id.
+"Is the Queen a witch?" you ask.
+
+"She may fancy herself as one," Snow White sneers. "In truth she dabbles with powers she does not comprehend."
+
+You might ask what powers the Queen dabbles with.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+furious:  S 0 / A 2.Glk library error: window_move_cursor: invalid id.
+1/47/71/415Glk library error: window_move_cursor: invalid id.
+"What are these powers the Queen dabbles with?" you want to know.
+
+She kicks with irritable energy at the base of the nearest aspen. "Even for a huntsman your ignorance is remarkable. All sorcery involves the manipulation of demons. I thought everyone knew that."
+
+You consider whether to ask if the Queen is possessed or ask what demons the Queen invoked.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+furious:  S 1 / A 3.Glk library error: window_move_cursor: invalid id.
+2/50/74/415Glk library error: window_move_cursor: invalid id.
+"So, what demons did the Queen try to invoke for her witchcraft?" you ask.
+
+"Lilith, for one," she tells you, "She wanted great beauty, and foolishly thought Lilith could endow it."
+
+You might ask if the Queen is possessed or ask whether Lilith made the Queen beautiful.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 1 / A 3.Glk library error: window_move_cursor: invalid id.
+2/49/72/415Glk library error: window_move_cursor: invalid id.
+"Is the Queen demon-possessed?" you ask.
+
+You brace as Snow White inflicts another smile upon you. "No, she managed to avoid that."
+
+You could now ask how the Queen avoided possession or ask whether Lilith made the Queen beautiful.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 1 / A 3.Glk library error: window_move_cursor: invalid id.
+2/49/72/415Glk library error: window_move_cursor: invalid id.
+"How did the Queen avoid possession?" you inquire.
+
+"By making a bargain with the demon that wishes to possess her, of course," she replies.
+
+You can ask what bargain the Queen made.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 1 / A 3.Glk library error: window_move_cursor: invalid id.
+1/49/72/415Glk library error: window_move_cursor: invalid id.
+"What manner of bargain did the Queen make to avoid possession?" you ask.
+
+"She provided another victim," she shrugs.
+
+You could discuss the Queen, witchcraft, the souls, or the demons.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 1 / A 3.Glk library error: window_move_cursor: invalid id.
+0/49/71/415Glk library error: window_move_cursor: invalid id.
+"Is that it?" you ask, with a flash of terrifying insight. "Are you possessed? Is that why you have developed this taste for blood, and why..."
+
+Snow White's glance suffices to silence your babbling, but the look she gives you convinces you that you have hit upon the truth of the matter.
+
+You could ask whether the Queen herself made the magic mirror, ask whether Lilith likes drinking blood, or ask what the apple would do.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 12 / A 4.Glk library error: window_move_cursor: invalid id.
+3/47/77/415Glk library error: window_move_cursor: invalid id.
+"What do you-- Lilith-- want?"
+
+"I kill boy-children: did you know? I suck out their lives and leave them to die. It is punishment for all the children of my own that Adam stole from me, when he cast me out of Eden, when he rejected me and sent me away."
+
+But it does not seem to you that you have heard what she wants.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 13 / A 4.Glk library error: window_move_cursor: invalid id.
+1/46/76/415Glk library error: window_move_cursor: invalid id.
+"But is that what you want?"
+
+She looks up at you and her eyes are filled with grief beyond tears. "I want Adam," she says. "And he wanted me. When he had Eve, that docile witless blonde, he saw the bargain he had made and he wanted to take it back, and at night it was my body he dreamed and my name he called. But it was too late. And I was cast out into the storm and the desert and I had no equal on earth." 
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 13 / A 4.Glk library error: window_move_cursor: invalid id.
+0/47/77/415Glk library error: window_move_cursor: invalid id.
+You edge a little further away from her.
+
+"You ask what I want," she says slowly. "I want what Adam should have been, if he had chosen differently. I want a man who is my match, who is clever and private and wise; one who likes the wasteland and the night-time and the open sea rather than the daylight crowd of Eve's feckless brood. With such a man, I would be mortal, live my days, and die, not cursed but reconciled."
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 13 / A 4.Glk library error: window_move_cursor: invalid id.
+0/48/78/415Glk library error: window_move_cursor: invalid id.
+"I prefer the wasteland and the night-time."
+
+Speaking this is like the moment a bit of metal, coming too close to a lodestone, snaps to its side.
+
+She is no less terrifying, and yet you know her as clearly as you have ever known anyone. You also know yourself. You have no desires that you would need to hide from her; no secrets that she could not know; there is nothing in the beauty of the forest or in the joy of the bloody hunt that would shame you in her eyes. All the restlessness of your life, your failure to take a wife, your discomfort in company, your awkward otherness -- all that is translated from disorder into function, as she sees it.
+
+She frowns, and her eyes search yours. "You are no one. An ordinary man."
+
+But only ordinary men now populate the earth.
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 13 / A 4.Glk library error: window_move_cursor: invalid id.
+1/3/81/415Glk library error: window_move_cursor: invalid id.
+"I was once the King," you tell her. "I performed a blood-sundering in order to reconcile my kingdom with the dwarfs. The Queen's magic is nothing to that which I performed, but mine was an act of expiation."
+
+Her mouth opens. You have surprised Lilith.
+
+"I didn't see that," she says. "You didn't know until--" She frowns, and looks at Happy. "Yes, I see. And now instead of reversing the sundering, you are willing to come away with me? Snow White is your daughter after all, then -- you are willing to leave her to her fate, and the Queen that was your wife, and your kingdom, being destroyed by the Queen's malicious magics, and simply go?"
+
+>Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 13 / A 4.Glk library error: window_move_cursor: invalid id.
+0/0/77/415Glk library error: window_move_cursor: invalid id.
+"Yes. There is nothing more I can do for the kingdom; I have offered it all I have. As bad as it is now, I think it would get worse if I were to revoke the sundering -- if I could even find a way to do it."
+
+She takes up the rest of the explanation. "And besides this, though you still sometimes desire the Queen, you do not feel as a husband feels towards her; and though you protect Snow White, you do not feel that you are her father; and you do not want to feel those things."
+
+You do not meet her glance, but you and she both know that she can see into your mind at times.
+
+"Your weakness before was that you were too gentle to your own people, and did not punish them sufficiently when they showed cruelty to the dwarrows, and the injustice led to war, and war to death -- but a war that you were winning, nonetheless. You did not act to save your own; you acted to save the dwarrows when you saw what you had done to them." She has crept closer to you as she spoke, her gentle voice laying open old wounds, and now she tucks her hand under your elbow and stands beside you in what is almost an embrace. "I too was cut away from what was mine. I know."
+
+
+Please press SPACE to continue.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+As you look, Snow White becomes two women: one the princess, your daughter-that-was, who does not recognize you. The pink returns to her cheeks and she looks, again, like an ordinary girl.
+
+The other is stranger, older, an archaic face, framed in a tangle of nut-brown hair, and as Snow White was ice, this woman is a creation of fire. She reaches out to you and takes your hand, and your fingers are shocked by the warmth.
+
+"Go," says Lilith to Snow White. "Find your place among the dwarrow. In time -- if you can remember -- tell them what has happened. Fight the Queen together, and reclaim your kingdom."
+
+Snow White looks dazed -- just a little girl now. "I can't," she says, in her smallest voice.
+
+Lilith reaches out and presses her finger to the girl's forehead, and when she takes it away there is a fiery brand. "You will," Lilith says. "For the sake of this man, who was your father, and now can do nothing more for his kingdom. You will do the rest, so that his sacrifice will not have been in vain."
+
+Then Snow White straightens her back and takes the lantern -- a fair bargain, you suppose, since you have Lilith instead -- and she walks away into the forest to the north, never turning back her head. You feel the ember of something that might have been pride. But she is cut off from you and will never again be your own daughter.
+
+
+Please press SPACE to continue.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+"The Queen was not a bad woman, before," you say, remembering.
+
+Lilith's mouth quirks. "But she is unquestionably of the stock of Eve." She looks at the tip of her finger, which appears a little numb. "I will be your equal, if you will be mine."
+
+
+
+    *** You and Lilith are free ***
+
+
+
+Would you like to RESTART, RESTORE a saved game, or QUIT?
+> Glk library error: window_move_cursor: invalid id.
+                                                                                Glk library error: window_move_cursor: invalid id.
+aggressive:  S 13 / A 4.Glk library error: window_move_cursor: invalid id.
+0/0/77/415Glk library error: window_move_cursor: invalid id.
diff --git a/interpreters/git/test/Alabaster.walk b/interpreters/git/test/Alabaster.walk
new file mode 100644 (file)
index 0000000..e81aa2f
--- /dev/null
@@ -0,0 +1,44 @@
+
+cut hart
+ask Snow White about what she was doing
+wake hart
+ask why
+no
+z
+smile
+a how
+a cosmic
+yes
+yes
+yes
+a king
+a repeat
+ask what happened
+a who performed
+a current peace
+z
+t roots
+say she is delaying
+ask her about delay
+no
+a lilith
+a adam
+t apple
+a apple
+a mortals
+ask if the queen is a witch
+ask what powers
+ask what demons
+a queen is possessed
+a how
+a bargain
+a victim
+ask what lilith wants
+g
+z
+t me
+t king
+yes
+quit
diff --git a/interpreters/git/test/test.sh b/interpreters/git/test/test.sh
new file mode 100644 (file)
index 0000000..e33dbf7
--- /dev/null
@@ -0,0 +1,18 @@
+#!/bin/sh
+
+TEST_DIR=`dirname $0`
+
+echo "Running Alabaster.glorb..."
+${TEST_DIR}/../git ${TEST_DIR}/Alabaster.gblorb \
+    < ${TEST_DIR}/Alabaster.walk > ${TEST_DIR}/Alabaster.tmp
+
+echo "Comparing output against Alabaster.golden..."
+if diff -q ${TEST_DIR}/Alabaster.tmp ${TEST_DIR}/Alabaster.golden; then
+  echo "TEST PASSED"
+else
+  echo
+  echo "*** TEST FAILED ***"
+  echo
+  echo "The Alabaster walkthrough is not producing the same output as before."
+  echo "Please check Alabaster.tmp manually."
+fi
diff --git a/interpreters/git/version.h b/interpreters/git/version.h
new file mode 100644 (file)
index 0000000..8e542f8
--- /dev/null
@@ -0,0 +1,4 @@
+// Automatically generated file -- do not edit!
+#define GIT_MAJOR 1
+#define GIT_MINOR 2
+#define GIT_PATCH 4
diff --git a/interpreters/glulxe/Makefile.am b/interpreters/glulxe/Makefile.am
new file mode 100644 (file)
index 0000000..eb2b661
--- /dev/null
@@ -0,0 +1,13 @@
+PLUGIN_LIBTOOL_FLAGS=-module -avoid-version -export-symbols-regex "^glk"
+
+pkglib_LTLIBRARIES = glulxe.la
+glulxe_la_SOURCES = accel.c exec.c files.c funcs.c gestalt.c gestalt.h glkop.c \
+    glulxe.h heap.c main.c opcodes.h operand.c osdepend.c profile.c search.c \
+    serial.c string.c unixstrt.c vm.c 
+glulxe_la_CPPFLAGS = -I$(top_srcdir) -I$(top_srcdir)/libchimara
+glulxe_la_CFLAGS = -Wall -Wmissing-prototypes -Wstrict-prototypes -Wno-unused \
+    -DOS_UNIX $(AM_CFLAGS)
+glulxe_la_LDFLAGS = $(PLUGIN_LIBTOOL_FLAGS)
+
+glulxedocdir = $(datadir)/doc/$(PACKAGE)/glulxe
+dist_glulxedoc_DATA = README
diff --git a/interpreters/glulxe/README b/interpreters/glulxe/README
new file mode 100644 (file)
index 0000000..2ba34f4
--- /dev/null
@@ -0,0 +1,96 @@
+Glulxe: the Glulx VM interpreter
+Version 0.4.4
+
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+
+* Compiling
+
+Since this is a Glk program, it must be built with a Glk library. See
+the Glk home page at
+
+http://eblong.com/zarf/glk/index.html
+
+The Unix Makefile that comes with this package is designed to link any
+of the Unix libraries (XGlk, GlkTerm, and CheapGlk.) You'll have to
+go into the Makefile and set three variables to find the library. There
+are instructions at the top of the Makefile. Then just type
+
+    make glulxe
+
+That should suffice. When the program is built, type
+
+    ./glulxe filename.ulx
+
+where "filename.ulx" is a Glulx game file to execute.
+
+To build this program on a Macintosh, you'll need the MacGlk library.
+See the instructions that come with that. It's fairly straightforward;
+compile the library, the source code, and the "macstart.c" file.
+
+Ditto for Windows, using "winstart.c".
+
+* Version
+
+0.4.4:
+    Added profiling code, which is turned off by default. To compile it 
+    in, define VM_PROFILING in Makefile or in glulxe.h.
+    Added function-accleration feature.
+    Fixed bug where @random 0 was returning only positive numbers.
+
+0.4.3:
+    Verify the presence of Unicode calls in the Glk library at runtime.
+    (Thanks Simon Baldwin.)
+    Added a compile-time option to check for invalid memory accesses.
+    (This is slower, but safer. Define VERIFY_MEMORY_ACCESS in Makefile
+    or in glulxe.h. Thanks Evin Robertson.)
+    Fixed a memory leak of undo states. (Thanks Matthew Wightman.)
+    Fixed a linked-list handling error for Glk unicode arrays. (Thanks
+    David Kinder.)
+
+0.4.2:
+    Fixed a bug that preventing compiling with old (pre-Unicode) Glk
+    libraries.
+
+0.4.1:
+    Added array copy and heap allocation functionality. (Glulx spec 
+    3.1.0.)
+
+0.4.0:
+    Added Unicode functionality. (Glulx spec 3.0.0.)
+
+0.3.5:
+    Fixed El-Stupido bug in the modulo opcode.
+
+0.3.4:
+    Finally supports string arguments to Glk calls.
+
+0.3.3:
+    Added setiosys, getiosys opcodes.
+    Fixed bug in binarysearch.
+
+0.3.2:
+    Added search, jumpabs, callf, and gestalt opcodes.
+
+0.3.1:
+    Startup code now handles Blorb files correctly.
+
+0.3.0:
+    Added support for compressed strings.
+
+0.2.2:
+    Another pre-release version.
+
+0.2.0:
+    A pre-release version.
+
+* Permissions
+
+The source code in this package is copyright 1999 by Andrew Plotkin. You
+may copy and distribute it freely, by any means and under any conditions,
+as long as the code and documentation is not changed. You may also
+incorporate this code into your own program and distribute that, or modify
+this code and use and distribute the modified version, as long as you retain
+a notice in your program or documentation which mentions my name and the
+URL shown above.
+
diff --git a/interpreters/glulxe/accel.c b/interpreters/glulxe/accel.c
new file mode 100644 (file)
index 0000000..3309173
--- /dev/null
@@ -0,0 +1,401 @@
+/* accel.c: Glulxe code for accelerated functions
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+
+/* Git passes along function arguments in reverse order. To make our lives
+   more interesting. */
+#ifdef ARGS_REVERSED
+#define ARG(argv, argc, ix) (argv[(argc-1)-ix])
+#else
+#define ARG(argv, argc, ix) (argv[ix])
+#endif
+
+/* Any function can be called with any number of arguments. This macro
+   lets us snarf a given argument, or zero if it wasn't supplied. */
+#define ARG_IF_GIVEN(argv, argc, ix)  ((argc > ix) ? (ARG(argv, argc, ix)) : 0)
+
+static void accel_error(char *msg);
+static glui32 func_1_z__region(glui32 argc, glui32 *argv);
+static glui32 func_2_cp__tab(glui32 argc, glui32 *argv);
+static glui32 func_3_ra__pr(glui32 argc, glui32 *argv);
+static glui32 func_4_rl__pr(glui32 argc, glui32 *argv);
+static glui32 func_5_oc__cl(glui32 argc, glui32 *argv);
+static glui32 func_6_rv__pr(glui32 argc, glui32 *argv);
+static glui32 func_7_op__pr(glui32 argc, glui32 *argv);
+
+static int obj_in_class(glui32 obj);
+static glui32 get_prop(glui32 obj, glui32 id);
+
+/* Parameters, set by @accelparam. */
+static glui32 classes_table = 0;     /* class object array */
+static glui32 indiv_prop_start = 0;  /* first individual prop ID */
+static glui32 class_metaclass = 0;   /* "Class" class object */
+static glui32 object_metaclass = 0;  /* "Object" class object */
+static glui32 routine_metaclass = 0; /* "Routine" class object */
+static glui32 string_metaclass = 0;  /* "String" class object */
+static glui32 self = 0;              /* address of global "self" */
+static glui32 num_attr_bytes = 0;    /* number of attributes / 8 */
+static glui32 cpv__start = 0;        /* array of common prop defaults */
+
+typedef struct accelentry_struct {
+    glui32 addr;
+    acceleration_func func;
+    struct accelentry_struct *next;
+} accelentry_t;
+
+#define ACCEL_HASH_SIZE (511)
+
+static accelentry_t **accelentries = NULL;
+
+void init_accel()
+{
+    accelentries = NULL;
+}
+
+acceleration_func accel_find_func(glui32 index)
+{
+    switch (index) {
+        case 0: return NULL; /* 0 always means no acceleration */
+        case 1: return func_1_z__region;
+        case 2: return func_2_cp__tab;
+        case 3: return func_3_ra__pr;
+        case 4: return func_4_rl__pr;
+        case 5: return func_5_oc__cl;
+        case 6: return func_6_rv__pr;
+        case 7: return func_7_op__pr;
+    }
+    return NULL;
+}
+
+acceleration_func accel_get_func(glui32 addr)
+{
+    int bucknum;
+    accelentry_t *ptr;
+
+    if (!accelentries)
+        return NULL;
+
+    bucknum = (addr % ACCEL_HASH_SIZE);
+    for (ptr = accelentries[bucknum]; ptr; ptr = ptr->next) {
+        if (ptr->addr == addr)
+            return ptr->func;
+    }
+    return NULL;
+}
+
+void accel_set_func(glui32 index, glui32 addr)
+{
+    int bucknum;
+    accelentry_t *ptr;
+    int functype;
+    acceleration_func new_func = NULL;
+
+    /* Check the Glulx type identifier byte. */
+    functype = Mem1(addr);
+    if (functype != 0xC0 && functype != 0xC1) {
+        fatal_error_i("Attempt to accelerate non-function.", addr);
+    }
+
+    if (!accelentries) {
+        accelentries = (accelentry_t **)glulx_malloc(ACCEL_HASH_SIZE 
+            * sizeof(accelentry_t *));
+        if (!accelentries) 
+            fatal_error("Cannot malloc acceleration table.");
+        for (bucknum=0; bucknum<ACCEL_HASH_SIZE; bucknum++)
+            accelentries[bucknum] = NULL;
+    }
+
+    new_func = accel_find_func(index);
+
+    bucknum = (addr % ACCEL_HASH_SIZE);
+    for (ptr = accelentries[bucknum]; ptr; ptr = ptr->next) {
+        if (ptr->addr == addr)
+            break;
+    }
+    if (!ptr) {
+        if (!new_func) {
+            return; /* no need for a new entry */
+        }
+        ptr = (accelentry_t *)glulx_malloc(sizeof(accelentry_t));
+        if (!ptr)
+            fatal_error("Cannot malloc acceleration entry.");
+        ptr->addr = addr;
+        ptr->func = NULL;
+        ptr->next = accelentries[bucknum];
+        accelentries[bucknum] = ptr;
+    }
+
+    ptr->func = new_func;
+}
+
+void accel_set_param(glui32 index, glui32 val)
+{
+    switch (index) {
+        case 0: classes_table = val; break;
+        case 1: indiv_prop_start = val; break;
+        case 2: class_metaclass = val; break;
+        case 3: object_metaclass = val; break;
+        case 4: routine_metaclass = val; break;
+        case 5: string_metaclass = val; break;
+        case 6: self = val; break;
+        case 7: num_attr_bytes = val; break;
+        case 8: cpv__start = val; break;
+    }
+}
+
+static void accel_error(char *msg)
+{
+    glk_put_char('\n');
+    glk_put_string(msg);
+    glk_put_char('\n');
+}
+
+static int obj_in_class(glui32 obj)
+{
+    /* This checks whether obj is contained in Class, not whether
+       it is a member of Class. */
+    return (Mem4(obj + 13 + num_attr_bytes) == class_metaclass);
+}
+
+static glui32 get_prop(glui32 obj, glui32 id)
+{
+    glui32 cla = 0;
+    glui32 prop;
+    glui32 call_argv[2];
+
+    if (id & 0xFFFF0000) {
+        cla = Mem4(classes_table+((id & 0xFFFF) * 4));
+        ARG(call_argv, 2, 0) = obj;
+        ARG(call_argv, 2, 1) = cla;
+        if (func_5_oc__cl(2, call_argv) == 0)
+            return 0;
+
+        id >>= 16;
+        obj = cla;
+    }
+
+    ARG(call_argv, 2, 0) = obj;
+    ARG(call_argv, 2, 1) = id;
+    prop = func_2_cp__tab(2, call_argv);
+    if (prop == 0)
+        return 0;
+
+    if (obj_in_class(obj) && (cla == 0)) {
+        if ((id < indiv_prop_start) || (id >= indiv_prop_start+8))
+            return 0;
+    }
+
+    if (Mem4(self) != obj) {
+        if (Mem1(prop + 9) & 1)
+            return 0;
+    }
+    return prop;
+}
+
+static glui32 func_1_z__region(glui32 argc, glui32 *argv)
+{
+    glui32 addr;
+    glui32 tb;
+
+    if (argc < 1)
+        return 0;
+
+    addr = ARG(argv, argc, 0);
+    if (addr < 36)
+        return 0;
+    if (addr >= endmem)
+        return 0;
+
+    tb = Mem1(addr);
+    if (tb >= 0xE0) {
+        return 3;
+    }
+    if (tb >= 0xC0) {
+        return 2;
+    }
+    if (tb >= 0x70 && tb <= 0x7F && addr >= ramstart) {
+        return 1;
+    }
+    return 0;
+}
+
+static glui32 func_2_cp__tab(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 otab, max;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    if (func_1_z__region(1, &obj) != 1) {
+        accel_error("[** Programming error: tried to find the \".\" of (something) **]");
+        return 0;
+    }
+
+    otab = Mem4(obj + 16);
+    if (!otab)
+        return 0;
+
+    max = Mem4(otab);
+    otab += 4;
+    /* @binarysearch id 2 otab 10 max 0 0 res; */
+    return binary_search(id, 2, otab, 10, max, 0, 0);
+}
+
+static glui32 func_3_ra__pr(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 prop;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    prop = get_prop(obj, id);
+    if (prop == 0)
+        return 0;
+
+    return Mem4(prop + 4);
+}
+
+static glui32 func_4_rl__pr(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 prop;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    prop = get_prop(obj, id);
+    if (prop == 0)
+        return 0;
+
+    return 4 * Mem2(prop + 2);
+}
+
+static glui32 func_5_oc__cl(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 cla;
+    glui32 zr, prop, inlist, inlistlen, jx;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    cla = ARG_IF_GIVEN(argv, argc, 1);
+
+    zr = func_1_z__region(1, &obj);
+    if (zr == 3)
+        return (cla == string_metaclass) ? 1 : 0;
+    if (zr == 2)
+        return (cla == routine_metaclass) ? 1 : 0;
+    if (zr != 1)
+        return 0;
+
+    if (cla == class_metaclass) {
+        if (obj_in_class(obj))
+            return 1;
+        if (obj == class_metaclass)
+            return 1;
+        if (obj == string_metaclass)
+            return 1;
+        if (obj == routine_metaclass)
+            return 1;
+        if (obj == object_metaclass)
+            return 1;
+        return 0;
+    }
+    if (cla == object_metaclass) {
+        if (obj_in_class(obj))
+            return 0;
+        if (obj == class_metaclass)
+            return 0;
+        if (obj == string_metaclass)
+            return 0;
+        if (obj == routine_metaclass)
+            return 0;
+        if (obj == object_metaclass)
+            return 0;
+        return 1;
+    }
+    if ((cla == string_metaclass) || (cla == routine_metaclass))
+        return 0;
+
+    if (!obj_in_class(cla)) {
+        accel_error("[** Programming error: tried to apply 'ofclass' with non-class **]");
+        return 0;
+    }
+
+    prop = get_prop(obj, 2);
+    if (prop == 0)
+       return 0;
+
+    inlist = Mem4(prop + 4);
+    if (inlist == 0)
+       return 0;
+
+    inlistlen = Mem2(prop + 2);
+    for (jx = 0; jx < inlistlen; jx++) {
+        if (Mem4(inlist + (4 * jx)) == cla)
+            return 1;
+    }
+    return 0;
+}
+
+static glui32 func_6_rv__pr(glui32 argc, glui32 *argv)
+{
+    glui32 id;
+    glui32 addr;
+
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    addr = func_3_ra__pr(argc, argv);
+
+    if (addr == 0) {
+        if ((id > 0) && (id < indiv_prop_start))
+            return Mem4(cpv__start + (4 * id));
+
+        accel_error("[** Programming error: tried to read (something) **]");
+        return 0;
+    }
+
+    return Mem4(addr);
+}
+
+static glui32 func_7_op__pr(glui32 argc, glui32 *argv)
+{
+    glui32 obj;
+    glui32 id;
+    glui32 zr;
+
+    obj = ARG_IF_GIVEN(argv, argc, 0);
+    id = ARG_IF_GIVEN(argv, argc, 1);
+
+    zr = func_1_z__region(1, &obj);
+    if (zr == 3) {
+        /* print is INDIV_PROP_START+6 */
+        if (id == indiv_prop_start+6)
+            return 1;
+        /* print_to_array is INDIV_PROP_START+7 */
+        if (id == indiv_prop_start+7)
+            return 1;
+        return 0;
+    }
+    if (zr == 2) {
+        /* call is INDIV_PROP_START+5 */
+        return ((id == indiv_prop_start+5) ? 1 : 0);
+    }
+    if (zr != 1)
+        return 0;
+
+    if ((id >= indiv_prop_start) && (id < indiv_prop_start+8)) {
+        if (obj_in_class(obj))
+            return 1;
+    }
+
+    return ((func_3_ra__pr(argc, argv)) ? 1 : 0);
+}
diff --git a/interpreters/glulxe/exec.c b/interpreters/glulxe/exec.c
new file mode 100644 (file)
index 0000000..03ac456
--- /dev/null
@@ -0,0 +1,750 @@
+/* exec.c: Glulxe code for program execution. The main interpreter loop.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+#include "opcodes.h"
+
+/* execute_loop():
+   The main interpreter loop. This repeats until the program is done.
+*/
+void execute_loop()
+{
+  int done_executing = FALSE;
+  int ix;
+  glui32 opcode;
+  operandlist_t *oplist;
+  instruction_t inst;
+  glui32 value, addr, val0, val1;
+  glsi32 vals0, vals1;
+  glui32 *arglist;
+  glui32 arglistfix[3];
+
+  while (!done_executing) {
+
+    profile_tick();
+    /* Do OS-specific processing, if appropriate. */
+    glk_tick();
+
+    /* Fetch the opcode number. */
+    opcode = Mem1(pc);
+    pc++;
+    if (opcode & 0x80) {
+      /* More than one-byte opcode. */
+      if (opcode & 0x40) {
+        /* Four-byte opcode */
+        opcode &= 0x3F;
+        opcode = (opcode << 8) | Mem1(pc);
+        pc++;
+        opcode = (opcode << 8) | Mem1(pc);
+        pc++;
+        opcode = (opcode << 8) | Mem1(pc);
+        pc++;
+      }
+      else {
+        /* Two-byte opcode */
+        opcode &= 0x7F;
+        opcode = (opcode << 8) | Mem1(pc);
+        pc++;
+      }
+    }
+
+    /* Now we have an opcode number. */
+    
+    /* Fetch the structure that describes how the operands for this
+       opcode are arranged. This is a pointer to an immutable, 
+       static object. */
+    if (opcode < 0x80)
+      oplist = fast_operandlist[opcode];
+    else
+      oplist = lookup_operandlist(opcode);
+
+    if (!oplist)
+      fatal_error_i("Encountered unknown opcode.", opcode);
+
+    /* Based on the oplist structure, load the actual operand values
+       into inst. This moves the PC up to the end of the instruction. */
+    parse_operands(&inst, oplist);
+
+    /* Perform the opcode. This switch statement is split in two, based
+       on some paranoid suspicions about the ability of compilers to
+       optimize large-range switches. Ignore that. */
+
+    if (opcode < 0x80) {
+
+      switch (opcode) {
+
+      case op_nop:
+        break;
+
+      case op_add:
+        value = inst.value[0] + inst.value[1];
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_sub:
+        value = inst.value[0] - inst.value[1];
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_mul:
+        value = inst.value[0] * inst.value[1];
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_div:
+        vals0 = inst.value[0];
+        vals1 = inst.value[1];
+        if (vals1 == 0)
+          fatal_error("Division by zero.");
+        /* Since C doesn't guarantee the results of division of negative
+           numbers, we carefully convert everything to positive values
+           first. */
+        if (vals1 < 0) {
+          vals0 = (-vals0);
+          vals1 = (-vals1);
+        }
+        if (vals0 >= 0) {
+          value = vals0 / vals1;
+        }
+        else {
+          value = -((-vals0) / vals1);
+        }
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_mod:
+        vals0 = inst.value[0];
+        vals1 = inst.value[1];
+        if (vals1 == 0)
+          fatal_error("Division by zero doing remainder.");
+        if (vals1 < 0) {
+          vals1 = (-vals1);
+        }
+        if (vals0 >= 0) {
+          value = vals0 % vals1;
+        }
+        else {
+          value = -((-vals0) % vals1);
+        }
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_neg:
+        vals0 = inst.value[0];
+        value = (-vals0);
+        store_operand(inst.desttype, inst.value[1], value);
+        break;
+
+      case op_bitand:
+        value = (inst.value[0] & inst.value[1]);
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_bitor:
+        value = (inst.value[0] | inst.value[1]);
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_bitxor:
+        value = (inst.value[0] ^ inst.value[1]);
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_bitnot:
+        value = ~(inst.value[0]);
+        store_operand(inst.desttype, inst.value[1], value);
+        break;
+
+      case op_shiftl:
+        vals0 = inst.value[1];
+        if (vals0 < 0 || vals0 >= 32)
+          value = 0;
+        else
+          value = ((glui32)(inst.value[0]) << (glui32)vals0);
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_ushiftr:
+        vals0 = inst.value[1];
+        if (vals0 < 0 || vals0 >= 32)
+          value = 0;
+        else
+          value = ((glui32)(inst.value[0]) >> (glui32)vals0);
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+      case op_sshiftr:
+        vals0 = inst.value[1];
+        if (vals0 < 0 || vals0 >= 32) {
+          if (inst.value[0] & 0x80000000)
+            value = 0xFFFFFFFF;
+          else
+            value = 0;
+        }
+        else {
+          /* This is somewhat foolhardy -- C doesn't guarantee that
+             right-shifting a signed value replicates the sign bit.
+             We'll assume it for now. */
+          value = ((glsi32)(inst.value[0]) >> (glsi32)vals0);
+        }
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+
+      case op_jump:
+        value = inst.value[0];
+        /* fall through to PerformJump label. */
+
+      PerformJump: /* goto label for successful jumping... ironic, no? */
+        if (value == 0 || value == 1) {
+          /* Return from function. This is exactly what happens in
+             return_op, but it's only a few lines of code, so I won't
+             bother with a "goto". */
+          leave_function();
+          if (stackptr == 0) {
+            done_executing = TRUE;
+            break;
+          }
+          pop_callstub(value); /* zero or one */
+        }
+        else {
+          /* Branch to a new PC value. */
+          pc = (pc + value - 2);
+        }
+        break;
+
+      case op_jz:
+        if (inst.value[0] == 0) {
+          value = inst.value[1];
+          goto PerformJump;
+        }
+        break;
+      case op_jnz:
+        if (inst.value[0] != 0) {
+          value = inst.value[1];
+          goto PerformJump;
+        }
+        break;
+      case op_jeq:
+        if (inst.value[0] == inst.value[1]) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jne:
+        if (inst.value[0] != inst.value[1]) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jlt:
+        vals0 = inst.value[0];
+        vals1 = inst.value[1];
+        if (vals0 < vals1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jgt:
+        vals0 = inst.value[0];
+        vals1 = inst.value[1];
+        if (vals0 > vals1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jle:
+        vals0 = inst.value[0];
+        vals1 = inst.value[1];
+        if (vals0 <= vals1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jge:
+        vals0 = inst.value[0];
+        vals1 = inst.value[1];
+        if (vals0 >= vals1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jltu:
+        val0 = inst.value[0];
+        val1 = inst.value[1];
+        if (val0 < val1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jgtu:
+        val0 = inst.value[0];
+        val1 = inst.value[1];
+        if (val0 > val1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jleu:
+        val0 = inst.value[0];
+        val1 = inst.value[1];
+        if (val0 <= val1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+      case op_jgeu:
+        val0 = inst.value[0];
+        val1 = inst.value[1];
+        if (val0 >= val1) {
+          value = inst.value[2];
+          goto PerformJump;
+        }
+        break;
+
+      case op_call:
+        value = inst.value[1];
+        arglist = pop_arguments(value, 0);
+        push_callstub(inst.desttype, inst.value[2]);
+        enter_function(inst.value[0], value, arglist);
+        break;
+      case op_return:
+        leave_function();
+        if (stackptr == 0) {
+          done_executing = TRUE;
+          break;
+        }
+        pop_callstub(inst.value[0]);
+        break;
+      case op_tailcall:
+        value = inst.value[1];
+        arglist = pop_arguments(value, 0);
+        leave_function();
+        enter_function(inst.value[0], value, arglist);
+        break;
+
+      case op_catch:
+        push_callstub(inst.desttype, inst.value[0]);
+        value = inst.value[1];
+        val0 = stackptr;
+        store_operand(inst.desttype, inst.value[0], val0);
+        goto PerformJump;
+        break;
+      case op_throw:
+        profile_fail("throw");
+        value = inst.value[0];
+        stackptr = inst.value[1];
+        pop_callstub(value);
+        break;
+
+      case op_copy:
+        value = inst.value[0];
+        store_operand(inst.desttype, inst.value[1], value);
+        break;
+      case op_copys:
+        value = inst.value[0];
+        store_operand_s(inst.desttype, inst.value[1], value);
+        break;
+      case op_copyb:
+        value = inst.value[0];
+        store_operand_b(inst.desttype, inst.value[1], value);
+        break;
+
+      case op_sexs:
+        val0 = inst.value[0];
+        if (val0 & 0x8000)
+          val0 |= 0xFFFF0000;
+        else
+          val0 &= 0x0000FFFF;
+        store_operand(inst.desttype, inst.value[1], val0);
+        break;
+      case op_sexb:
+        val0 = inst.value[0];
+        if (val0 & 0x80)
+          val0 |= 0xFFFFFF00;
+        else
+          val0 &= 0x000000FF;
+        store_operand(inst.desttype, inst.value[1], val0);
+        break;
+
+      case op_aload:
+        value = inst.value[0];
+        value += 4 * inst.value[1];
+        val0 = Mem4(value);
+        store_operand(inst.desttype, inst.value[2], val0);
+        break;
+      case op_aloads:
+        value = inst.value[0];
+        value += 2 * inst.value[1];
+        val0 = Mem2(value);
+        store_operand(inst.desttype, inst.value[2], val0);
+        break;
+      case op_aloadb:
+        value = inst.value[0];
+        value += inst.value[1];
+        val0 = Mem1(value);
+        store_operand(inst.desttype, inst.value[2], val0);
+        break;
+      case op_aloadbit:
+        value = inst.value[0];
+        vals0 = inst.value[1];
+        val1 = (vals0 & 7);
+        if (vals0 >= 0)
+          value += (vals0 >> 3);
+        else
+          value -= ((-1 - vals0) >> 3);
+        if (Mem1(value) & (1 << val1))
+          val0 = 1;
+        else
+          val0 = 0;
+        store_operand(inst.desttype, inst.value[2], val0);
+        break;
+
+      case op_astore:
+        value = inst.value[0];
+        value += 4 * inst.value[1];
+        val0 = inst.value[2];
+        MemW4(value, val0);
+        break;
+      case op_astores:
+        value = inst.value[0];
+        value += 2 * inst.value[1];
+        val0 = inst.value[2];
+        MemW2(value, val0);
+        break;
+      case op_astoreb:
+        value = inst.value[0];
+        value += inst.value[1];
+        val0 = inst.value[2];
+        MemW1(value, val0);
+        break;
+      case op_astorebit:
+        value = inst.value[0];
+        vals0 = inst.value[1];
+        val1 = (vals0 & 7);
+        if (vals0 >= 0)
+          value += (vals0 >> 3);
+        else
+          value -= ((-1 - vals0) >> 3);
+        val0 = Mem1(value);
+        if (inst.value[2])
+          val0 |= (1 << val1);
+        else
+          val0 &= ~((glui32)(1 << val1));
+        MemW1(value, val0);
+        break;
+
+      case op_stkcount:
+        value = (stackptr - valstackbase) / 4;
+        store_operand(inst.desttype, inst.value[0], value);
+        break;
+      case op_stkpeek:
+        vals0 = inst.value[0] * 4;
+        if (vals0 < 0 || vals0 >= (stackptr - valstackbase))
+          fatal_error("Stkpeek outside current stack range.");
+        value = Stk4(stackptr - (vals0+4));
+        store_operand(inst.desttype, inst.value[1], value);
+        break;
+      case op_stkswap:
+        if (stackptr < valstackbase+8) {
+          fatal_error("Stack underflow in stkswap.");
+        }
+        val0 = Stk4(stackptr-4);
+        val1 = Stk4(stackptr-8);
+        StkW4(stackptr-4, val1);
+        StkW4(stackptr-8, val0);
+        break;
+      case op_stkcopy:
+        vals0 = inst.value[0];
+        if (vals0 < 0)
+          fatal_error("Negative operand in stkcopy.");
+        if (vals0 == 0)
+          break;
+        if (stackptr < valstackbase+vals0*4)
+          fatal_error("Stack underflow in stkcopy.");
+        if (stackptr + vals0*4 > stacksize) 
+          fatal_error("Stack overflow in stkcopy.");
+        addr = stackptr - vals0*4;
+        for (ix=0; ix<vals0; ix++) {
+          value = Stk4(addr + ix*4);
+          StkW4(stackptr + ix*4, value);
+        }
+        stackptr += vals0*4;
+        break;
+      case op_stkroll:
+        vals0 = inst.value[0];
+        vals1 = inst.value[1];
+        if (vals0 < 0)
+          fatal_error("Negative operand in stkroll.");
+        if (stackptr < valstackbase+vals0*4)
+          fatal_error("Stack underflow in stkroll.");
+        if (vals0 == 0)
+          break;
+        /* The following is a bit ugly. We want to do vals1 = vals0-vals1,
+           because rolling down is sort of easier than rolling up. But
+           we also want to take the result mod vals0. The % operator is
+           annoying for negative numbers, so we need to do this in two 
+           cases. */
+        if (vals1 > 0) {
+          vals1 = vals1 % vals0;
+          vals1 = (vals0) - vals1;
+        }
+        else {
+          vals1 = (-vals1) % vals0;
+        }
+        if (vals1 == 0)
+          break;
+        addr = stackptr - vals0*4;
+        for (ix=0; ix<vals1; ix++) {
+          value = Stk4(addr + ix*4);
+          StkW4(stackptr + ix*4, value);
+        }
+        for (ix=0; ix<vals0; ix++) {
+          value = Stk4(addr + (vals1+ix)*4);
+          StkW4(addr + ix*4, value);
+        }
+        break;
+
+      case op_streamchar:
+        profile_in(2, FALSE);
+        value = inst.value[0] & 0xFF;
+        (*stream_char_handler)(value);
+        profile_out();
+        break;
+      case op_streamunichar:
+        profile_in(2, FALSE);
+        value = inst.value[0];
+        (*stream_unichar_handler)(value);
+        profile_out();
+        break;
+      case op_streamnum:
+        profile_in(2, FALSE);
+        vals0 = inst.value[0];
+        stream_num(vals0, FALSE, 0);
+        profile_out();
+        break;
+      case op_streamstr:
+        profile_in(2, FALSE);
+        stream_string(inst.value[0], 0, 0);
+        profile_out();
+        break;
+
+      default:
+        fatal_error_i("Executed unknown opcode.", opcode);
+      }
+    }
+    else {
+
+      switch (opcode) {
+
+      case op_gestalt:
+        value = do_gestalt(inst.value[0], inst.value[1]);
+        store_operand(inst.desttype, inst.value[2], value);
+        break;
+
+      case op_debugtrap:
+        fatal_error_i("user debugtrap encountered.", inst.value[0]);
+
+      case op_jumpabs:
+        pc = inst.value[0];
+        break;
+
+      case op_callf:
+        push_callstub(inst.desttype, inst.value[1]);
+        enter_function(inst.value[0], 0, arglistfix);
+        break;
+      case op_callfi:
+        arglistfix[0] = inst.value[1];
+        push_callstub(inst.desttype, inst.value[2]);
+        enter_function(inst.value[0], 1, arglistfix);
+        break;
+      case op_callfii:
+        arglistfix[0] = inst.value[1];
+        arglistfix[1] = inst.value[2];
+        push_callstub(inst.desttype, inst.value[3]);
+        enter_function(inst.value[0], 2, arglistfix);
+        break;
+      case op_callfiii:
+        arglistfix[0] = inst.value[1];
+        arglistfix[1] = inst.value[2];
+        arglistfix[2] = inst.value[3];
+        push_callstub(inst.desttype, inst.value[4]);
+        enter_function(inst.value[0], 3, arglistfix);
+        break;
+
+      case op_getmemsize:
+        store_operand(inst.desttype, inst.value[0], endmem);
+        break;
+      case op_setmemsize:
+        value = change_memsize(inst.value[0], FALSE);
+        store_operand(inst.desttype, inst.value[1], value);
+        break;
+
+      case op_getstringtbl:
+        value = stream_get_table();
+        store_operand(inst.desttype, inst.value[0], value);
+        break;
+      case op_setstringtbl:
+        stream_set_table(inst.value[0]);
+        break;
+
+      case op_getiosys:
+        stream_get_iosys(&val0, &val1);
+        store_operand(inst.desttype, inst.value[0], val0);
+        store_operand(inst.desttype, inst.value[1], val1);
+        break;
+      case op_setiosys:
+        stream_set_iosys(inst.value[0], inst.value[1]);
+        break;
+
+      case op_glk:
+        profile_in(1, FALSE);
+        value = inst.value[1];
+        arglist = pop_arguments(value, 0);
+        val0 = perform_glk(inst.value[0], value, arglist);
+        store_operand(inst.desttype, inst.value[2], val0);
+        profile_out();
+        break;
+
+      case op_random:
+        vals0 = inst.value[0];
+        if (vals0 == 0)
+          value = glulx_random() ^ (glulx_random() << 16);
+        else if (vals0 >= 1)
+          value = glulx_random() % (glui32)(vals0);
+        else 
+          value = -(glulx_random() % (glui32)(-vals0));
+        store_operand(inst.desttype, inst.value[1], value);
+        break;
+      case op_setrandom:
+        glulx_setrandom(inst.value[0]);
+        break;
+
+      case op_verify:
+        value = perform_verify();
+        store_operand(inst.desttype, inst.value[0], value);
+        break;
+
+      case op_restart:
+        profile_fail("restart");
+        vm_restart();
+        break;
+
+      case op_protect:
+        val0 = inst.value[0];
+        val1 = val0 + inst.value[1];
+        if (val0 == val1) {
+          val0 = 0;
+          val1 = 0;
+        }
+        protectstart = val0;
+        protectend = val1;
+        break;
+
+      case op_save:
+        push_callstub(inst.desttype, inst.value[1]);
+        value = perform_save(find_stream_by_id(inst.value[0]));
+        pop_callstub(value);
+        break;
+
+      case op_restore:
+        profile_fail("restore");
+        value = perform_restore(find_stream_by_id(inst.value[0]));
+        if (value == 0) {
+          /* We've succeeded, and the stack now contains the callstub
+             saved during saveundo. Ignore this opcode's operand. */
+          value = -1;
+          pop_callstub(value);
+        }
+        else {
+          /* We've failed, so we must store the failure in this opcode's
+             operand. */
+          store_operand(inst.desttype, inst.value[1], value);
+        }
+        break;
+
+      case op_saveundo:
+        push_callstub(inst.desttype, inst.value[0]);
+        value = perform_saveundo();
+        pop_callstub(value);
+        break;
+
+      case op_restoreundo:
+        profile_fail("restoreundo");
+        value = perform_restoreundo();
+        if (value == 0) {
+          /* We've succeeded, and the stack now contains the callstub
+             saved during saveundo. Ignore this opcode's operand. */
+          value = -1;
+          pop_callstub(value);
+        }
+        else {
+          /* We've failed, so we must store the failure in this opcode's
+             operand. */
+          store_operand(inst.desttype, inst.value[0], value);
+        }
+        break;
+
+      case op_quit:
+        done_executing = TRUE;
+        break;
+
+      case op_linearsearch:
+        value = linear_search(inst.value[0], inst.value[1], inst.value[2], 
+          inst.value[3], inst.value[4], inst.value[5], inst.value[6]);
+        store_operand(inst.desttype, inst.value[7], value);
+        break;
+      case op_binarysearch:
+        value = binary_search(inst.value[0], inst.value[1], inst.value[2], 
+          inst.value[3], inst.value[4], inst.value[5], inst.value[6]);
+        store_operand(inst.desttype, inst.value[7], value);
+        break;
+      case op_linkedsearch:
+        value = linked_search(inst.value[0], inst.value[1], inst.value[2], 
+          inst.value[3], inst.value[4], inst.value[5]);
+        store_operand(inst.desttype, inst.value[6], value);
+        break;
+
+      case op_mzero: {
+        glui32 lx;
+        glui32 count = inst.value[0];
+        addr = inst.value[1];
+        for (lx=0; lx<count; lx++, addr++) {
+          MemW1(addr, 0);
+        }
+        }
+        break;
+      case op_mcopy: {
+        glui32 lx;
+        glui32 count = inst.value[0];
+        glui32 addrsrc = inst.value[1];
+        glui32 addrdest = inst.value[2];
+        if (addrdest < addrsrc) {
+          for (lx=0; lx<count; lx++, addrsrc++, addrdest++) {
+            value = Mem1(addrsrc);
+            MemW1(addrdest, value);
+          }
+        }
+        else {
+          addrsrc += (count-1);
+          addrdest += (count-1);
+          for (lx=0; lx<count; lx++, addrsrc--, addrdest--) {
+            value = Mem1(addrsrc);
+            MemW1(addrdest, value);
+          }
+        }
+        }
+        break;
+      case op_malloc:
+        value = heap_alloc(inst.value[0]);
+        store_operand(inst.desttype, inst.value[1], value);
+        break;
+      case op_mfree:
+        heap_free(inst.value[0]);
+        break;
+
+      case op_accelfunc:
+        accel_set_func(inst.value[0], inst.value[1]);
+        break;
+      case op_accelparam:
+        accel_set_param(inst.value[0], inst.value[1]);
+        break;
+
+      default:
+        fatal_error_i("Executed unknown opcode.", opcode);
+      }
+    }
+  }
+}
diff --git a/interpreters/glulxe/files.c b/interpreters/glulxe/files.c
new file mode 100644 (file)
index 0000000..d575c98
--- /dev/null
@@ -0,0 +1,89 @@
+/* files.c: Glulxe file-handling code.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "gi_blorb.h"
+#include "glulxe.h"
+
+/* is_gamefile_valid():
+   Check guess what.
+*/
+int is_gamefile_valid()
+{
+  unsigned char buf[8];
+  int res;
+  glui32 version;
+
+  glk_stream_set_position(gamefile, gamefile_start, seekmode_Start);
+  res = glk_get_buffer_stream(gamefile, (char *)buf, 8);
+
+  if (res != 8) {
+    fatal_error("This is too short to be a valid Glulx file.");
+    return FALSE;
+  }
+
+  if (buf[0] != 'G' || buf[1] != 'l' || buf[2] != 'u' || buf[3] != 'l') {
+    fatal_error("This is not a valid Glulx file.");
+    return FALSE;
+  }
+
+  /* We support version 2.0 through 3.1.*. */
+
+  version = Read4(buf+4);
+  if (version < 0x20000) {
+    fatal_error("This Glulx file is too old a version to execute.");
+    return FALSE;
+  }
+  if (version >= 0x30200) {
+    fatal_error("This Glulx file is too new a version to execute.");
+    return FALSE;
+  }
+
+  return TRUE;
+}
+
+/* locate_gamefile: 
+   Given that gamefile contains a Glk stream, which may be a Glulx
+   file or a Blorb archive containing one, locate the beginning and
+   end of the Glulx data.
+*/
+int locate_gamefile(int isblorb)
+{
+  if (!isblorb) {
+    /* The simple case. A bare Glulx file was opened, so we don't use
+       Blorb at all. */
+    gamefile_start = 0;
+    glk_stream_set_position(gamefile, 0, seekmode_End);
+    gamefile_len = glk_stream_get_position(gamefile);
+    return TRUE;
+  }
+  else {
+    /* A Blorb file. We now have to open it and find the Glulx chunk. */
+    giblorb_err_t err;
+    giblorb_result_t blorbres;
+    giblorb_map_t *map;
+
+    err = giblorb_set_resource_map(gamefile);
+    if (err) {
+      init_err = "This Blorb file seems to be invalid.";
+      return FALSE;
+    }
+    map = giblorb_get_resource_map();
+    err = giblorb_load_resource(map, giblorb_method_FilePos, 
+      &blorbres, giblorb_ID_Exec, 0);
+    if (err) {
+      init_err = "This Blorb file does not contain an executable Glulx chunk.";
+      return FALSE;
+    }
+    if (blorbres.chunktype != giblorb_make_id('G', 'L', 'U', 'L')) {
+      init_err = "This Blorb file contains an executable chunk, but it is not a Glulx file.";
+      return FALSE;
+    }
+    gamefile_start = blorbres.data.startpos;
+    gamefile_len = blorbres.length;
+    return TRUE;
+  }
+}
+
diff --git a/interpreters/glulxe/funcs.c b/interpreters/glulxe/funcs.c
new file mode 100644 (file)
index 0000000..c0aac4d
--- /dev/null
@@ -0,0 +1,307 @@
+/* funcs.c: Glulxe function-handling functions.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+
+/* enter_function():
+   This writes a new call frame onto the stack, at stackptr. It leaves
+   frameptr pointing to the frame (ie, the original stackptr value.) 
+   argc and argv are an array of arguments. Note that if argc is zero,
+   argv may be NULL.
+*/
+void enter_function(glui32 addr, glui32 argc, glui32 *argv)
+{
+  int ix, jx;
+  acceleration_func accelfunc;
+  int locallen;
+  int functype;
+  glui32 modeaddr, opaddr, val;
+  int loctype, locnum;
+
+  accelfunc = accel_get_func(addr);
+  if (accelfunc) {
+    profile_in(addr, TRUE);
+    val = accelfunc(argc, argv);
+    profile_out();
+    pop_callstub(val);
+    return;
+  }
+    
+  profile_in(addr, FALSE);
+
+  /* Check the Glulx type identifier byte. */
+  functype = Mem1(addr);
+  if (functype != 0xC0 && functype != 0xC1) {
+    if (functype >= 0xC0 && functype <= 0xDF)
+      fatal_error_i("Call to unknown type of function.", addr);
+    else
+      fatal_error_i("Call to non-function.", addr);
+  }
+  addr++;
+
+  /* Bump the frameptr to the top. */
+  frameptr = stackptr;
+
+  /* Go through the function's locals-format list, copying it to the
+     call frame. At the same time, we work out how much space the locals
+     will actually take up. (Including padding.) */
+  ix = 0;
+  locallen = 0;
+  while (1) {
+    /* Grab two bytes from the locals-format list. These are 
+       unsigned (0..255 range). */
+    loctype = Mem1(addr);
+    addr++;
+    locnum = Mem1(addr);
+    addr++;
+
+    /* Copy them into the call frame. */
+    StkW1(frameptr+8+2*ix, loctype);
+    StkW1(frameptr+8+2*ix+1, locnum);
+    ix++;
+
+    /* If the type is zero, we're done, except possibly for two more
+       zero bytes in the call frame (to ensure 4-byte alignment.) */
+    if (loctype == 0) {
+      /* Make sure ix is even. */
+      if (ix & 1) {
+        StkW1(frameptr+8+2*ix, 0);
+        StkW1(frameptr+8+2*ix+1, 0);
+        ix++;
+      }
+      break;
+    }
+
+    /* Pad to 4-byte or 2-byte alignment if these locals are 4 or 2
+       bytes long. */
+    if (loctype == 4) {
+      while (locallen & 3)
+        locallen++;
+    }
+    else if (loctype == 2) {
+      while (locallen & 1)
+        locallen++;
+    }
+    else if (loctype == 1) {
+      /* no padding */
+    }
+    else {
+      fatal_error("Illegal local type in locals-format list.");
+    }
+
+    /* Add the length of the locals themselves. */
+    locallen += (loctype * locnum);
+  }
+
+  /* Pad the locals to 4-byte alignment. */
+  while (locallen & 3)
+    locallen++;
+
+  /* We now know how long the locals-frame and locals segments are. */
+  localsbase = frameptr+8+2*ix;
+  valstackbase = localsbase+locallen;
+
+  /* Test for stack overflow. */
+  /* This really isn't good enough; if the format list overflowed the
+     stack, we've already written outside the stack array. */
+  if (valstackbase >= stacksize)
+    fatal_error("Stack overflow in function call.");
+
+  /* Fill in the beginning of the stack frame. */
+  StkW4(frameptr+4, 8+2*ix);
+  StkW4(frameptr, 8+2*ix+locallen);
+
+  /* Set the stackptr and PC. */
+  stackptr = valstackbase;
+  pc = addr;
+
+  /* Zero out all the locals. */
+  for (jx=0; jx<locallen; jx++) 
+    StkW1(localsbase+jx, 0);
+
+  if (functype == 0xC0) {
+    /* Push the function arguments on the stack. The locals have already
+       been zeroed. */
+    if (stackptr+4*(argc+1) >= stacksize)
+      fatal_error("Stack overflow in function arguments."); 
+    for (ix=0; ix<argc; ix++) {
+      val = argv[(argc-1)-ix];
+      StkW4(stackptr, val);
+      stackptr += 4;
+    }
+    StkW4(stackptr, argc);
+    stackptr += 4;
+  }
+  else {
+    /* Copy in function arguments. This is a bit gross, since we have to
+       follow the locals format. If there are fewer arguments than locals,
+       that's fine -- we've already zeroed out this space. If there are
+       more arguments than locals, the extras are silently dropped. */
+    modeaddr = frameptr+8;
+    opaddr = localsbase;
+    ix = 0;
+    while (ix < argc) {
+      loctype = Stk1(modeaddr);
+      modeaddr++;
+      locnum = Stk1(modeaddr);
+      modeaddr++;
+      if (loctype == 0)
+        break;
+      if (loctype == 4) {
+        while (opaddr & 3)
+          opaddr++;
+        while (ix < argc && locnum) {
+          val = argv[ix];
+          StkW4(opaddr, val);
+          opaddr += 4;
+          ix++;
+          locnum--;
+        }
+      }
+      else if (loctype == 2) {
+        while (opaddr & 1)
+          opaddr++;
+        while (ix < argc && locnum) {
+          val = argv[ix] & 0xFFFF;
+          StkW2(opaddr, val);
+          opaddr += 2;
+          ix++;
+          locnum--;
+        }
+      }
+      else if (loctype == 1) {
+        while (ix < argc && locnum) {
+          val = argv[ix] & 0xFF;
+          StkW1(opaddr, val);
+          opaddr += 1;
+          ix++;
+          locnum--;
+        }
+      }
+    }
+  }
+}
+
+/* leave_function():
+   Pop the current call frame off the stack. This is very simple.
+*/
+void leave_function()
+{
+  stackptr = frameptr;
+  profile_out();
+}
+
+/* push_callstub():
+   Push the magic four values on the stack: result destination,
+   PC, and frameptr. 
+*/
+void push_callstub(glui32 desttype, glui32 destaddr)
+{
+  if (stackptr+16 > stacksize)
+    fatal_error("Stack overflow in callstub.");
+  StkW4(stackptr+0, desttype);
+  StkW4(stackptr+4, destaddr);
+  StkW4(stackptr+8, pc);
+  StkW4(stackptr+12, frameptr);
+  stackptr += 16;
+}
+
+/* pop_callstub():
+   Remove the magic four values from the stack, and use them. The
+   returnvalue, whatever it is, is put at the result destination;
+   the PC and frameptr registers are set.
+*/
+void pop_callstub(glui32 returnvalue)
+{
+  glui32 desttype, destaddr;
+  glui32 newpc, newframeptr;
+
+  if (stackptr < 16)
+    fatal_error("Stack underflow in callstub.");
+  stackptr -= 16;
+
+  newframeptr = Stk4(stackptr+12);
+  newpc = Stk4(stackptr+8);
+  destaddr = Stk4(stackptr+4);
+  desttype = Stk4(stackptr+0);
+
+  pc = newpc;
+  frameptr = newframeptr;
+
+  /* Recompute valstackbase and localsbase */
+  valstackbase = frameptr + Stk4(frameptr);
+  localsbase = frameptr + Stk4(frameptr+4);
+
+  switch (desttype) {
+
+  case 0x11:
+    fatal_error("String-terminator call stub at end of function call.");
+    break;
+
+  case 0x10:
+    /* This call stub was pushed during a string-decoding operation!
+       We have to restart it. (Note that the return value is discarded.) */
+    stream_string(pc, 0xE1, destaddr); 
+    break;
+
+  case 0x12:
+    /* This call stub was pushed during a number-printing operation.
+       Restart that. (Return value discarded.) */
+    stream_num(pc, TRUE, destaddr);
+    break;
+
+  case 0x13:
+    /* This call stub was pushed during a C-string printing operation.
+       We have to restart it. (Note that the return value is discarded.) */
+    stream_string(pc, 0xE0, destaddr); 
+    break;
+
+  case 0x14:
+    /* This call stub was pushed during a Unicode printing operation.
+       We have to restart it. (Note that the return value is discarded.) */
+    stream_string(pc, 0xE2, destaddr); 
+    break;
+
+  default:
+    /* We're back in the original frame, so we can store the returnvalue. 
+       (If we tried to do this before resetting frameptr, a result
+       destination on the stack would go astray.) */
+    store_operand(desttype, destaddr, returnvalue);
+    break;
+  }
+}
+
+/* pop_callstub_string():
+   Remove the magic four values, but interpret them as a string restart
+   state. Returns zero if it's a termination stub, or returns the
+   restart address. The bitnum is extra.
+*/
+glui32 pop_callstub_string(int *bitnum)
+{
+  glui32 desttype, destaddr, newpc;
+
+  if (stackptr < 16)
+    fatal_error("Stack underflow in callstub.");
+  stackptr -= 16;
+
+  newpc = Stk4(stackptr+8);
+  destaddr = Stk4(stackptr+4);
+  desttype = Stk4(stackptr+0);
+
+  pc = newpc;
+
+  if (desttype == 0x11) {
+    return 0;
+  }
+  if (desttype == 0x10) {
+    *bitnum = destaddr;
+    return pc;
+  }
+
+  fatal_error("Function-terminator call stub at end of string.");
+  return 0;
+}
+
diff --git a/interpreters/glulxe/gestalt.c b/interpreters/glulxe/gestalt.c
new file mode 100644 (file)
index 0000000..c1c933f
--- /dev/null
@@ -0,0 +1,70 @@
+/* gestalt.c: Glulxe code for gestalt selectors
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+#include "gestalt.h"
+
+glui32 do_gestalt(glui32 val, glui32 val2)
+{
+  switch (val) {
+
+  case gestulx_GlulxVersion:
+    return 0x00030101; /* Glulx spec version 3.1.1 */
+
+  case gestulx_TerpVersion:
+    return 0x00000404; /* Glulxe version 0.4.4 */
+
+  case gestulx_ResizeMem:
+#ifdef FIXED_MEMSIZE
+    return 0; /* The setmemsize opcodes are compiled out. */
+#else /* FIXED_MEMSIZE */
+    return 1; /* We can handle setmemsize. */
+#endif /* FIXED_MEMSIZE */
+
+  case gestulx_Undo:
+    return 1; /* We can handle saveundo and restoreundo. */
+
+  case gestulx_IOSystem:
+    switch (val2) {
+    case 0:
+      return 1; /* The "null" system always works. */
+    case 1:
+      return 1; /* The "filter" system always works. */
+    case 2:
+      return 1; /* A Glk library is hooked up. */
+    default:
+      return 0;
+    }
+
+  case gestulx_Unicode:
+    return 1; /* We can handle Unicode. */
+
+  case gestulx_MemCopy:
+    return 1; /* We can do mcopy/mzero. */
+
+  case gestulx_MAlloc:
+#ifdef FIXED_MEMSIZE
+    return 0; /* The malloc opcodes are compiled out. */
+#else /* FIXED_MEMSIZE */
+    return 1; /* We can handle malloc/mfree. */
+#endif /* FIXED_MEMSIZE */
+
+  case gestulx_MAllocHeap:
+    return heap_get_start();
+
+  case gestulx_Acceleration:
+    return 1; /* We can do accelfunc/accelparam. */
+
+  case gestulx_AccelFunc:
+    if (accel_find_func(val2))
+      return 1; /* We know this accelerated function. */
+    return 0;
+
+  default:
+    return 0;
+
+  }
+}
diff --git a/interpreters/glulxe/gestalt.h b/interpreters/glulxe/gestalt.h
new file mode 100644 (file)
index 0000000..5c9b5be
--- /dev/null
@@ -0,0 +1,22 @@
+/* gestalt.h: The list of gestalt selectors for Glulxe.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#ifndef _GESTALT_H
+#define _GESTALT_H
+
+#define gestulx_GlulxVersion (0)
+#define gestulx_TerpVersion (1)
+#define gestulx_ResizeMem (2)
+#define gestulx_Undo (3)
+#define gestulx_IOSystem (4)
+#define gestulx_Unicode (5)
+#define gestulx_MemCopy (6)
+#define gestulx_MAlloc (7)
+#define gestulx_MAllocHeap (8)
+#define gestulx_Acceleration (9)
+#define gestulx_AccelFunc (10)
+
+#endif /* _GESTALT_H */
+
diff --git a/interpreters/glulxe/glkop.c b/interpreters/glulxe/glkop.c
new file mode 100644 (file)
index 0000000..e9c5191
--- /dev/null
@@ -0,0 +1,1057 @@
+/* glkop.c: Glulxe code for Glk API dispatching.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+/* This code is actually very general; it could work for almost any
+   32-bit VM which remotely resembles Glulxe or the Z-machine in design.
+   
+   To be precise, we make the following assumptions:
+
+   - An argument list is an array of 32-bit values, which can represent
+     either integers or addresses.
+   - We can read or write to a 32-bit integer in VM memory using the macros
+     ReadMemory(addr) and WriteMemory(addr), where addr is an address
+     taken from the argument list.
+   - A character array is an actual array of bytes somewhere in terp
+     memory, whose actual address can be computed by the macro
+     AddressOfArray(addr). Again, addr is a VM address from the argument
+     list.
+   - An integer array is a sequence of integers somewhere in VM memory.
+     The array can be turned into a C integer array by the macro
+     CaptureIArray(addr, len), and released by ReleaseIArray().
+     These macros are responsible for fixing byte-order and alignment
+     (if the C ABI does not match the VM's). The passin, passout hints
+     may be used to avoid unnecessary copying.
+   - A Glk structure (such as event_t) is a set of integers somewhere
+     in VM memory, which can be read and written with the macros
+     ReadStructField(addr, fieldnum) and WriteStructField(addr, fieldnum).
+     The fieldnum is an integer (from 0 to 3, for event_t.)
+   - A VM string can be turned into a C-style string with the macro
+     ptr = DecodeVMString(addr). After the string is used, this code
+     calls ReleaseVMString(ptr), which should free any memory that
+     DecodeVMString allocates.
+   - A VM Unicode string can be turned into a zero-terminated array
+     of 32-bit integers, in the same way, with DecodeVMUstring
+     and ReleaseVMUstring.
+
+     To work this code over for a new VM, just diddle the macros.
+*/
+
+#define ReadMemory(addr)  \
+    (((addr) == 0xffffffff) \
+      ? (stackptr -= 4, Stk4(stackptr)) \
+      : (Mem4(addr)))
+#define WriteMemory(addr, val)  \
+    (((addr) == 0xffffffff) \
+      ? (StkW4(stackptr, (val)), stackptr += 4) \
+      : (MemW4((addr), (val))))
+#define AddressOfArray(addr)  \
+    (memmap + (addr))
+#define CaptureIArray(addr, len, passin)  \
+    (grab_temp_array(addr, len, passin))
+#define ReleaseIArray(ptr, addr, len, passout)  \
+    (release_temp_array(ptr, addr, len, passout))
+#define ReadStructField(addr, fieldnum)  \
+    (((addr) == 0xffffffff) \
+      ? (stackptr -= 4, Stk4(stackptr)) \
+      : (Mem4((addr)+(fieldnum)*4)))
+#define WriteStructField(addr, fieldnum, val)  \
+    (((addr) == 0xffffffff) \
+      ? (StkW4(stackptr, (val)), stackptr += 4) \
+      : (MemW4((addr)+(fieldnum)*4, (val))))
+#define DecodeVMString(addr)  \
+    (make_temp_string(addr))
+#define ReleaseVMString(ptr)  \
+    (free_temp_string(ptr))
+#define DecodeVMUstring(addr)  \
+    (make_temp_ustring(addr))
+#define ReleaseVMUstring(ptr)  \
+    (free_temp_ustring(ptr))
+
+#include "glk.h"
+#include "glulxe.h"
+#include "gi_dispa.h"
+
+typedef struct dispatch_splot_struct {
+  int numwanted;
+  int maxargs;
+  gluniversal_t *garglist;
+  glui32 *varglist;
+  int numvargs;
+  glui32 *retval;
+} dispatch_splot_t;
+
+/* We maintain a linked list of arrays being used for Glk calls. It is
+   only used for integer (glui32) arrays -- char arrays are handled in
+   place. It's not worth bothering with a hash table, since most
+   arrays appear here only momentarily. */
+
+typedef struct arrayref_struct arrayref_t;
+struct arrayref_struct {
+  void *array;
+  glui32 addr;
+  glui32 elemsize;
+  glui32 len; /* elements */
+  int retained;
+  arrayref_t *next;
+};
+
+static arrayref_t *arrays = NULL;
+
+/* We maintain a hash table for each opaque Glk class. classref_t are the
+    nodes of the table, and classtable_t are the tables themselves. */
+
+typedef struct classref_struct classref_t;
+struct classref_struct {
+  void *obj;
+  glui32 id;
+  int bucknum;
+  classref_t *next;
+};
+
+#define CLASSHASH_SIZE (31)
+typedef struct classtable_struct {
+  glui32 lastid;
+  classref_t *bucket[CLASSHASH_SIZE];
+} classtable_t;
+
+/* The list of hash tables, for the classes. */
+static int num_classes = 0;
+classtable_t **classes = NULL;
+
+static classtable_t *new_classtable(glui32 firstid);
+static void *classes_get(int classid, glui32 objid);
+static classref_t *classes_put(int classid, void *obj);
+static void classes_remove(int classid, void *obj);
+
+static gidispatch_rock_t glulxe_classtable_register(void *obj, 
+  glui32 objclass);
+static void glulxe_classtable_unregister(void *obj, glui32 objclass, 
+  gidispatch_rock_t objrock);
+static gidispatch_rock_t glulxe_retained_register(void *array,
+  glui32 len, char *typecode);
+static void glulxe_retained_unregister(void *array, glui32 len, 
+  char *typecode, gidispatch_rock_t objrock);
+
+static glui32 *grab_temp_array(glui32 addr, glui32 len, int passin);
+static void release_temp_array(glui32 *arr, glui32 addr, glui32 len, int passout);
+
+static void prepare_glk_args(char *proto, dispatch_splot_t *splot);
+static void parse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassin);
+static void unparse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassout);
+
+/* init_dispatch():
+   Set up the class hash tables and other startup-time stuff. 
+*/
+int init_dispatch()
+{
+  int ix;
+    
+  /* Allocate the class hash tables. */
+  num_classes = gidispatch_count_classes();
+  classes = (classtable_t **)glulx_malloc(num_classes 
+    * sizeof(classtable_t *));
+  if (!classes)
+    return FALSE;
+    
+  for (ix=0; ix<num_classes; ix++) {
+    classes[ix] = new_classtable((glulx_random() % (glui32)(101)) + 1);
+    if (!classes[ix])
+      return FALSE;
+  }
+    
+  /* Set up the two callbacks. */
+  gidispatch_set_object_registry(&glulxe_classtable_register, 
+    &glulxe_classtable_unregister);
+  gidispatch_set_retained_registry(&glulxe_retained_register, 
+    &glulxe_retained_unregister);
+    
+  return TRUE;
+}
+
+/* perform_glk():
+   Turn a list of Glulx arguments into a list of Glk arguments,
+   dispatch the function call, and return the result. 
+*/
+glui32 perform_glk(glui32 funcnum, glui32 numargs, glui32 *arglist)
+{
+  glui32 retval = 0;
+
+  switch (funcnum) {
+    /* To speed life up, we implement commonly-used Glk functions
+       directly -- instead of bothering with the whole prototype 
+       mess. */
+
+  case 0x0080: /* put_char */
+    if (numargs != 1)
+      goto WrongArgNum;
+    glk_put_char(arglist[0] & 0xFF);
+    break;
+  case 0x0081: /* put_char_stream */
+    if (numargs != 2)
+      goto WrongArgNum;
+    glk_put_char_stream(find_stream_by_id(arglist[0]), arglist[1] & 0xFF);
+    break;
+  case 0x00A0: /* char_to_lower */
+    if (numargs != 1)
+      goto WrongArgNum;
+    retval = glk_char_to_lower(arglist[0] & 0xFF);
+    break;
+  case 0x00A1: /* char_to_upper */
+    if (numargs != 1)
+      goto WrongArgNum;
+    retval = glk_char_to_upper(arglist[0] & 0xFF);
+    break;
+
+  WrongArgNum:
+    fatal_error("Wrong number of arguments to Glk function.");
+    break;
+
+  default: {
+    /* Go through the full dispatcher prototype foo. */
+    char *proto, *cx;
+    dispatch_splot_t splot;
+    int argnum;
+
+    /* Grab the string. */
+    proto = gidispatch_prototype(funcnum);
+    if (!proto)
+      fatal_error("Unknown Glk function.");
+
+    splot.varglist = arglist;
+    splot.numvargs = numargs;
+    splot.retval = &retval;
+
+    /* The work goes in four phases. First, we figure out how many
+       arguments we want, and allocate space for the Glk argument
+       list. Then we go through the Glulxe arguments and load them 
+       into the Glk list. Then we call. Then we go through the 
+       arguments again, unloading the data back into Glulx memory. */
+
+    /* Phase 0. */
+    prepare_glk_args(proto, &splot);
+
+    /* Phase 1. */
+    argnum = 0;
+    cx = proto;
+    parse_glk_args(&splot, &cx, 0, &argnum, 0, 0);
+
+    /* Phase 2. */
+    gidispatch_call(funcnum, argnum, splot.garglist);
+
+    /* Phase 3. */
+    argnum = 0;
+    cx = proto;
+    unparse_glk_args(&splot, &cx, 0, &argnum, 0, 0);
+
+    break;
+  }
+  }
+
+  return retval;
+}
+
+/* read_prefix():
+   Read the prefixes of an argument string -- the "<>&+:#!" chars. 
+*/
+static char *read_prefix(char *cx, int *isref, int *isarray,
+  int *passin, int *passout, int *nullok, int *isretained, 
+  int *isreturn)
+{
+  *isref = FALSE;
+  *passin = FALSE;
+  *passout = FALSE;
+  *nullok = TRUE;
+  *isarray = FALSE;
+  *isretained = FALSE;
+  *isreturn = FALSE;
+  while (1) {
+    if (*cx == '<') {
+      *isref = TRUE;
+      *passout = TRUE;
+    }
+    else if (*cx == '>') {
+      *isref = TRUE;
+      *passin = TRUE;
+    }
+    else if (*cx == '&') {
+      *isref = TRUE;
+      *passout = TRUE;
+      *passin = TRUE;
+    }
+    else if (*cx == '+') {
+      *nullok = FALSE;
+    }
+    else if (*cx == ':') {
+      *isref = TRUE;
+      *passout = TRUE;
+      *nullok = FALSE;
+      *isreturn = TRUE;
+    }
+    else if (*cx == '#') {
+      *isarray = TRUE;
+    }
+    else if (*cx == '!') {
+      *isretained = TRUE;
+    }
+    else {
+      break;
+    }
+    cx++;
+  }
+  return cx;
+}
+
+/* prepare_glk_args():
+   This reads through the prototype string, and pulls Floo objects off the
+   stack. It also works out the maximal number of gluniversal_t objects
+   which could be used by the Glk call in question. It then allocates
+   space for them.
+*/
+static void prepare_glk_args(char *proto, dispatch_splot_t *splot)
+{
+  static gluniversal_t *garglist = NULL;
+  static int garglist_size = 0;
+
+  int ix;
+  int numwanted, numvargswanted, maxargs;
+  char *cx;
+
+  cx = proto;
+  numwanted = 0;
+  while (*cx >= '0' && *cx <= '9') {
+    numwanted = 10 * numwanted + (*cx - '0');
+    cx++;
+  }
+  splot->numwanted = numwanted;
+
+  maxargs = 0; 
+  numvargswanted = 0; 
+  for (ix = 0; ix < numwanted; ix++) {
+    int isref, passin, passout, nullok, isarray, isretained, isreturn;
+    cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
+      &isretained, &isreturn);
+    if (isref) {
+      maxargs += 2;
+    }
+    else {
+      maxargs += 1;
+    }
+    if (!isreturn) {
+      if (isarray) {
+        numvargswanted += 2;
+      }
+      else {
+        numvargswanted += 1;
+      }
+    }
+        
+    if (*cx == 'I' || *cx == 'C') {
+      cx += 2;
+    }
+    else if (*cx == 'Q') {
+      cx += 2;
+    }
+    else if (*cx == 'S' || *cx == 'U') {
+      cx += 1;
+    }
+    else if (*cx == '[') {
+      int refdepth, nwx;
+      cx++;
+      nwx = 0;
+      while (*cx >= '0' && *cx <= '9') {
+        nwx = 10 * nwx + (*cx - '0');
+        cx++;
+      }
+      maxargs += nwx; /* This is *only* correct because all structs contain
+                         plain values. */
+      refdepth = 1;
+      while (refdepth > 0) {
+        if (*cx == '[')
+          refdepth++;
+        else if (*cx == ']')
+          refdepth--;
+        cx++;
+      }
+    }
+    else {
+      fatal_error("Illegal format string.");
+    }
+  }
+
+  if (*cx != ':' && *cx != '\0')
+    fatal_error("Illegal format string.");
+
+  splot->maxargs = maxargs;
+
+  if (splot->numvargs != numvargswanted)
+    fatal_error("Wrong number of arguments to Glk function.");
+
+  if (garglist && garglist_size < maxargs) {
+    glulx_free(garglist);
+    garglist = NULL;
+    garglist_size = 0;
+  }
+  if (!garglist) {
+    garglist_size = maxargs + 16;
+    garglist = (gluniversal_t *)glulx_malloc(garglist_size 
+      * sizeof(gluniversal_t));
+  }
+  if (!garglist)
+    fatal_error("Unable to allocate storage for Glk arguments.");
+
+  splot->garglist = garglist;
+}
+
+/* parse_glk_args():
+   This long and unpleasant function translates a set of Floo objects into
+   a gluniversal_t array. It's recursive, too, to deal with structures.
+*/
+static void parse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassin)
+{
+  char *cx;
+  int ix, argx;
+  int gargnum, numwanted;
+  void *opref;
+  gluniversal_t *garglist;
+  glui32 *varglist;
+  
+  garglist = splot->garglist;
+  varglist = splot->varglist;
+  gargnum = *argnumptr;
+  cx = *proto;
+
+  numwanted = 0;
+  while (*cx >= '0' && *cx <= '9') {
+    numwanted = 10 * numwanted + (*cx - '0');
+    cx++;
+  }
+
+  for (argx = 0, ix = 0; argx < numwanted; argx++, ix++) {
+    char typeclass;
+    int skipval;
+    int isref, passin, passout, nullok, isarray, isretained, isreturn;
+    cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
+      &isretained, &isreturn);
+    
+    typeclass = *cx;
+    cx++;
+
+    skipval = FALSE;
+    if (isref) {
+      if (!isreturn && varglist[ix] == 0) {
+        if (!nullok)
+          fatal_error("Zero passed invalidly to Glk function.");
+        garglist[gargnum].ptrflag = FALSE;
+        gargnum++;
+        skipval = TRUE;
+      }
+      else {
+        garglist[gargnum].ptrflag = TRUE;
+        gargnum++;
+      }
+    }
+    if (!skipval) {
+      glui32 thisval;
+
+      if (typeclass == '[') {
+
+        parse_glk_args(splot, &cx, depth+1, &gargnum, varglist[ix], passin);
+
+      }
+      else if (isarray) {
+        /* definitely isref */
+
+        switch (typeclass) {
+        case 'C':
+          garglist[gargnum].array = AddressOfArray(varglist[ix]);
+          gargnum++;
+          ix++;
+          garglist[gargnum].uint = varglist[ix];
+          gargnum++;
+          cx++;
+          break;
+        case 'I':
+          garglist[gargnum].array = CaptureIArray(varglist[ix], varglist[ix+1], passin);
+          gargnum++;
+          ix++;
+          garglist[gargnum].uint = varglist[ix];
+          gargnum++;
+          cx++;
+          break;
+        default:
+          fatal_error("Illegal format string.");
+          break;
+        }
+      }
+      else {
+        /* a plain value or a reference to one. */
+
+        if (isreturn) {
+          thisval = 0;
+        }
+        else if (depth > 0) {
+          /* Definitely not isref or isarray. */
+          if (subpassin)
+            thisval = ReadStructField(subaddress, ix);
+          else
+            thisval = 0;
+        }
+        else if (isref) {
+          if (passin)
+            thisval = ReadMemory(varglist[ix]);
+          else
+            thisval = 0;
+        }
+        else {
+          thisval = varglist[ix];
+        }
+
+        switch (typeclass) {
+        case 'I':
+          if (*cx == 'u')
+            garglist[gargnum].uint = (glui32)(thisval);
+          else if (*cx == 's')
+            garglist[gargnum].sint = (glsi32)(thisval);
+          else
+            fatal_error("Illegal format string.");
+          gargnum++;
+          cx++;
+          break;
+        case 'Q':
+          if (thisval) {
+            opref = classes_get(*cx-'a', thisval);
+            if (!opref) {
+              fatal_error("Reference to nonexistent Glk object.");
+            }
+          }
+          else {
+            opref = NULL;
+          }
+          garglist[gargnum].opaqueref = opref;
+          gargnum++;
+          cx++;
+          break;
+        case 'C':
+          if (*cx == 'u') 
+            garglist[gargnum].uch = (unsigned char)(thisval);
+          else if (*cx == 's')
+            garglist[gargnum].sch = (signed char)(thisval);
+          else if (*cx == 'n')
+            garglist[gargnum].ch = (char)(thisval);
+          else
+            fatal_error("Illegal format string.");
+          gargnum++;
+          cx++;
+          break;
+        case 'S':
+          garglist[gargnum].charstr = DecodeVMString(thisval);
+          gargnum++;
+          break;
+#ifdef GLK_MODULE_UNICODE
+        case 'U':
+          garglist[gargnum].unicharstr = DecodeVMUstring(thisval);
+          gargnum++;
+          break;
+#endif /* GLK_MODULE_UNICODE */
+        default:
+          fatal_error("Illegal format string.");
+          break;
+        }
+      }
+    }
+    else {
+      /* We got a null reference, so we have to skip the format element. */
+      if (typeclass == '[') {
+        int numsubwanted, refdepth;
+        numsubwanted = 0;
+        while (*cx >= '0' && *cx <= '9') {
+          numsubwanted = 10 * numsubwanted + (*cx - '0');
+          cx++;
+        }
+        refdepth = 1;
+        while (refdepth > 0) {
+          if (*cx == '[')
+            refdepth++;
+          else if (*cx == ']')
+            refdepth--;
+          cx++;
+        }
+      }
+      else if (typeclass == 'S' || typeclass == 'U') {
+        /* leave it */
+      }
+      else {
+        cx++;
+      }
+    }    
+  }
+
+  if (depth > 0) {
+    if (*cx != ']')
+      fatal_error("Illegal format string.");
+    cx++;
+  }
+  else {
+    if (*cx != ':' && *cx != '\0')
+      fatal_error("Illegal format string.");
+  }
+  
+  *proto = cx;
+  *argnumptr = gargnum;
+}
+
+/* unparse_glk_args():
+   This is about the reverse of parse_glk_args(). 
+*/
+static void unparse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
+  int *argnumptr, glui32 subaddress, int subpassout)
+{
+  char *cx;
+  int ix, argx;
+  int gargnum, numwanted;
+  void *opref;
+  gluniversal_t *garglist;
+  glui32 *varglist;
+  
+  garglist = splot->garglist;
+  varglist = splot->varglist;
+  gargnum = *argnumptr;
+  cx = *proto;
+
+  numwanted = 0;
+  while (*cx >= '0' && *cx <= '9') {
+    numwanted = 10 * numwanted + (*cx - '0');
+    cx++;
+  }
+
+  for (argx = 0, ix = 0; argx < numwanted; argx++, ix++) {
+    char typeclass;
+    int skipval;
+    int isref, passin, passout, nullok, isarray, isretained, isreturn;
+    cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
+      &isretained, &isreturn);
+    
+    typeclass = *cx;
+    cx++;
+
+    skipval = FALSE;
+    if (isref) {
+      if (!isreturn && varglist[ix] == 0) {
+        if (!nullok)
+          fatal_error("Zero passed invalidly to Glk function.");
+        garglist[gargnum].ptrflag = FALSE;
+        gargnum++;
+        skipval = TRUE;
+      }
+      else {
+        garglist[gargnum].ptrflag = TRUE;
+        gargnum++;
+      }
+    }
+    if (!skipval) {
+      glui32 thisval;
+
+      if (typeclass == '[') {
+
+        unparse_glk_args(splot, &cx, depth+1, &gargnum, varglist[ix], passout);
+
+      }
+      else if (isarray) {
+        /* definitely isref */
+
+        switch (typeclass) {
+        case 'C':
+          gargnum++;
+          ix++;
+          gargnum++;
+          cx++;
+          break;
+        case 'I':
+          ReleaseIArray(garglist[gargnum].array, varglist[ix], varglist[ix+1], passout);
+          gargnum++;
+          ix++;
+          gargnum++;
+          cx++;
+          break;
+        default:
+          fatal_error("Illegal format string.");
+          break;
+        }
+      }
+      else {
+        /* a plain value or a reference to one. */
+
+        if (isreturn || (depth > 0 && subpassout) || (isref && passout)) {
+          skipval = FALSE;
+        }
+        else {
+          skipval = TRUE;
+        }
+
+        switch (typeclass) {
+        case 'I':
+          if (!skipval) {
+            if (*cx == 'u')
+              thisval = (glui32)garglist[gargnum].uint;
+            else if (*cx == 's')
+              thisval = (glui32)garglist[gargnum].sint;
+            else
+              fatal_error("Illegal format string.");
+          }
+          gargnum++;
+          cx++;
+          break;
+        case 'Q':
+          if (!skipval) {
+            opref = garglist[gargnum].opaqueref;
+            if (opref) {
+              gidispatch_rock_t objrock = 
+                gidispatch_get_objrock(opref, *cx-'a');
+              thisval = ((classref_t *)objrock.ptr)->id;
+            }
+            else {
+              thisval = 0;
+            }
+          }
+          gargnum++;
+          cx++;
+          break;
+        case 'C':
+          if (!skipval) {
+            if (*cx == 'u') 
+              thisval = (glui32)garglist[gargnum].uch;
+            else if (*cx == 's')
+              thisval = (glui32)garglist[gargnum].sch;
+            else if (*cx == 'n')
+              thisval = (glui32)garglist[gargnum].ch;
+            else
+              fatal_error("Illegal format string.");
+          }
+          gargnum++;
+          cx++;
+          break;
+        case 'S':
+          if (garglist[gargnum].charstr)
+            ReleaseVMString(garglist[gargnum].charstr);
+          gargnum++;
+          break;
+#ifdef GLK_MODULE_UNICODE
+        case 'U':
+          if (garglist[gargnum].unicharstr)
+            ReleaseVMUstring(garglist[gargnum].unicharstr);
+          gargnum++;
+          break;
+#endif /* GLK_MODULE_UNICODE */
+        default:
+          fatal_error("Illegal format string.");
+          break;
+        }
+
+        if (isreturn) {
+          *(splot->retval) = thisval;
+        }
+        else if (depth > 0) {
+          /* Definitely not isref or isarray. */
+          if (subpassout)
+            WriteStructField(subaddress, ix, thisval);
+        }
+        else if (isref) {
+          if (passout)
+            WriteMemory(varglist[ix], thisval); 
+        }
+      }
+    }
+    else {
+      /* We got a null reference, so we have to skip the format element. */
+      if (typeclass == '[') {
+        int numsubwanted, refdepth;
+        numsubwanted = 0;
+        while (*cx >= '0' && *cx <= '9') {
+          numsubwanted = 10 * numsubwanted + (*cx - '0');
+          cx++;
+        }
+        refdepth = 1;
+        while (refdepth > 0) {
+          if (*cx == '[')
+            refdepth++;
+          else if (*cx == ']')
+            refdepth--;
+          cx++;
+        }
+      }
+      else if (typeclass == 'S' || typeclass == 'U') {
+        /* leave it */
+      }
+      else {
+        cx++;
+      }
+    }    
+  }
+
+  if (depth > 0) {
+    if (*cx != ']')
+      fatal_error("Illegal format string.");
+    cx++;
+  }
+  else {
+    if (*cx != ':' && *cx != '\0')
+      fatal_error("Illegal format string.");
+  }
+  
+  *proto = cx;
+  *argnumptr = gargnum;
+}
+
+/* find_stream_by_id():
+   This is used by some interpreter code which has to, well, find a Glk
+   stream given its ID. 
+*/
+strid_t find_stream_by_id(glui32 objid)
+{
+  if (!objid)
+    return NULL;
+
+  /* Recall that class 1 ("b") is streams. */
+  return classes_get(1, objid);
+}
+
+/* Build a hash table to hold a set of Glk objects. */
+static classtable_t *new_classtable(glui32 firstid)
+{
+  int ix;
+  classtable_t *ctab = (classtable_t *)glulx_malloc(sizeof(classtable_t));
+  if (!ctab)
+    return NULL;
+    
+  for (ix=0; ix<CLASSHASH_SIZE; ix++)
+    ctab->bucket[ix] = NULL;
+    
+  ctab->lastid = firstid;
+    
+  return ctab;
+}
+
+/* Find a Glk object in the appropriate hash table. */
+static void *classes_get(int classid, glui32 objid)
+{
+  classtable_t *ctab;
+  classref_t *cref;
+  if (classid < 0 || classid >= num_classes)
+    return NULL;
+  ctab = classes[classid];
+  cref = ctab->bucket[objid % CLASSHASH_SIZE];
+  for (; cref; cref = cref->next) {
+    if (cref->id == objid)
+      return cref->obj;
+  }
+  return NULL;
+}
+
+/* Put a Glk object in the appropriate hash table. */
+static classref_t *classes_put(int classid, void *obj)
+{
+  int bucknum;
+  classtable_t *ctab;
+  classref_t *cref;
+  if (classid < 0 || classid >= num_classes)
+    return NULL;
+  ctab = classes[classid];
+  cref = (classref_t *)glulx_malloc(sizeof(classref_t));
+  if (!cref)
+    return NULL;
+  cref->obj = obj;
+  cref->id = ctab->lastid;
+  ctab->lastid++;
+  bucknum = cref->id % CLASSHASH_SIZE;
+  cref->bucknum = bucknum;
+  cref->next = ctab->bucket[bucknum];
+  ctab->bucket[bucknum] = cref;
+  return cref;
+}
+
+/* Delete a Glk object from the appropriate hash table. */
+static void classes_remove(int classid, void *obj)
+{
+  classtable_t *ctab;
+  classref_t *cref;
+  classref_t **crefp;
+  gidispatch_rock_t objrock;
+  if (classid < 0 || classid >= num_classes)
+    return;
+  ctab = classes[classid];
+  objrock = gidispatch_get_objrock(obj, classid);
+  cref = objrock.ptr;
+  if (!cref)
+    return;
+  crefp = &(ctab->bucket[cref->bucknum]);
+  for (; *crefp; crefp = &((*crefp)->next)) {
+    if ((*crefp) == cref) {
+      *crefp = cref->next;
+      if (!cref->obj) {
+        nonfatal_warning("attempt to free NULL object!");
+      }
+      cref->obj = NULL;
+      cref->id = 0;
+      cref->next = NULL;
+      glulx_free(cref);
+      return;
+    }
+  }
+  return;
+}
+
+/* The object registration/unregistration callbacks that the library calls
+    to keep the hash tables up to date. */
+    
+static gidispatch_rock_t glulxe_classtable_register(void *obj, 
+  glui32 objclass)
+{
+  classref_t *cref;
+  gidispatch_rock_t objrock;
+  cref = classes_put(objclass, obj);
+  objrock.ptr = cref;
+  return objrock;
+}
+
+static void glulxe_classtable_unregister(void *obj, glui32 objclass, 
+  gidispatch_rock_t objrock)
+{
+  classes_remove(objclass, obj);
+}
+
+static glui32 *grab_temp_array(glui32 addr, glui32 len, int passin)
+{
+  arrayref_t *arref = NULL;
+  glui32 *arr = NULL;
+  glui32 ix, addr2;
+
+  if (len) {
+    arr = (glui32 *)glulx_malloc(len * sizeof(glui32));
+    arref = (arrayref_t *)glulx_malloc(sizeof(arrayref_t));
+    if (!arr || !arref) 
+      fatal_error("Unable to allocate space for array argument to Glk call.");
+
+    arref->array = arr;
+    arref->addr = addr;
+    arref->elemsize = 4;
+    arref->retained = FALSE;
+    arref->len = len;
+    arref->next = arrays;
+    arrays = arref;
+
+    if (passin) {
+      for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
+        arr[ix] = Mem4(addr2);
+      }
+    }
+  }
+
+  return arr;
+}
+
+static void release_temp_array(glui32 *arr, glui32 addr, glui32 len, int passout)
+{
+  arrayref_t *arref = NULL;
+  arrayref_t **aptr;
+  glui32 ix, val, addr2;
+
+  if (arr) {
+    for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
+      if ((*aptr)->array == arr)
+        break;
+    }
+    arref = *aptr;
+    if (!arref)
+      fatal_error("Unable to re-find array argument in Glk call.");
+    if (arref->addr != addr || arref->len != len)
+      fatal_error("Mismatched array argument in Glk call.");
+
+    if (arref->retained) {
+      return;
+    }
+
+    *aptr = arref->next;
+    arref->next = NULL;
+
+    if (passout) {
+      for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
+        val = arr[ix];
+        MemW4(addr2, val);
+      }
+    }
+    glulx_free(arr);
+    glulx_free(arref);
+  }
+}
+
+gidispatch_rock_t glulxe_retained_register(void *array,
+  glui32 len, char *typecode)
+{
+  gidispatch_rock_t rock;
+  arrayref_t *arref = NULL;
+  arrayref_t **aptr;
+
+  if (typecode[4] != 'I' || array == NULL) {
+    /* We only retain integer arrays. */
+    rock.ptr = NULL;
+    return rock;
+  }
+
+  for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
+    if ((*aptr)->array == array)
+      break;
+  }
+  arref = *aptr;
+  if (!arref)
+    fatal_error("Unable to re-find array argument in Glk call.");
+  if (arref->elemsize != 4 || arref->len != len)
+    fatal_error("Mismatched array argument in Glk call.");
+
+  arref->retained = TRUE;
+
+  rock.ptr = arref;
+  return rock;
+}
+
+void glulxe_retained_unregister(void *array, glui32 len, 
+  char *typecode, gidispatch_rock_t objrock)
+{
+  arrayref_t *arref = NULL;
+  arrayref_t **aptr;
+  glui32 ix, addr2, val;
+
+  if (typecode[4] != 'I' || array == NULL) {
+    /* We only retain integer arrays. */
+    return;
+  }
+
+  for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
+    if ((*aptr)->array == array)
+      break;
+  }
+  arref = *aptr;
+  if (!arref)
+    fatal_error("Unable to re-find array argument in Glk call.");
+  if (arref != objrock.ptr)
+    fatal_error("Mismatched array reference in Glk call.");
+  if (!arref->retained)
+    fatal_error("Unretained array reference in Glk call.");
+  if (arref->elemsize != 4 || arref->len != len)
+    fatal_error("Mismatched array argument in Glk call.");
+
+  *aptr = arref->next;
+  arref->next = NULL;
+
+  for (ix=0, addr2=arref->addr; ix<arref->len; ix++, addr2+=4) {
+    val = ((glui32 *)array)[ix];
+    MemW4(addr2, val);
+  }
+  glulx_free(array);
+  glulx_free(arref);
+}
+
diff --git a/interpreters/glulxe/glulxe.h b/interpreters/glulxe/glulxe.h
new file mode 100644 (file)
index 0000000..093ac6a
--- /dev/null
@@ -0,0 +1,271 @@
+/* glulxe.h: Glulxe header file.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#ifndef _GLULXE_H
+#define _GLULXE_H
+
+/* We define our own TRUE and FALSE and NULL, because ANSI
+   is a strange world. */
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* You may have to edit the definition of glui16 to make sure it's really a
+   16-bit unsigned integer type, and glsi16 to make sure it's really a
+   16-bit signed integer type. If they're not, horrible things will happen. */
+typedef unsigned short glui16; 
+typedef signed short glsi16; 
+
+/* Uncomment this definition to turn on memory-address checking. In
+   this mode, all reads and writes to main memory will be checked to
+   ensure they're in range. This is slower, but prevents malformed
+   game files from crashing the interpreter. */
+/* #define VERIFY_MEMORY_ACCESS (1) */
+
+/* Uncomment this definition to turn on Glulx VM profiling. In this
+   mode, all function calls are timed, and the timing information is
+   written to a data file called "profile-raw". */
+/* #define VM_PROFILING (1) */
+
+/* Some macros to read and write integers to memory, always in big-endian
+   format. */
+#define Read4(ptr)    \
+  ( (glui32)(((unsigned char *)(ptr))[0] << 24)  \
+  | (glui32)(((unsigned char *)(ptr))[1] << 16)  \
+  | (glui32)(((unsigned char *)(ptr))[2] << 8)   \
+  | (glui32)(((unsigned char *)(ptr))[3]))
+#define Read2(ptr)    \
+  ( (glui16)(((unsigned char *)(ptr))[0] << 8)  \
+  | (glui16)(((unsigned char *)(ptr))[1]))
+#define Read1(ptr)    \
+  ((unsigned char)(((unsigned char *)(ptr))[0]))
+
+#define Write4(ptr, vl)   \
+  (((ptr)[0] = (unsigned char)(((glui32)(vl)) >> 24)),   \
+   ((ptr)[1] = (unsigned char)(((glui32)(vl)) >> 16)),   \
+   ((ptr)[2] = (unsigned char)(((glui32)(vl)) >> 8)),    \
+   ((ptr)[3] = (unsigned char)(((glui32)(vl)))))
+#define Write2(ptr, vl)   \
+  (((ptr)[0] = (unsigned char)(((glui32)(vl)) >> 8)),   \
+   ((ptr)[1] = (unsigned char)(((glui32)(vl)))))
+#define Write1(ptr, vl)   \
+  (((unsigned char *)(ptr))[0] = (vl))
+
+#if VERIFY_MEMORY_ACCESS
+#define Verify(adr, ln) verify_address(adr, ln)
+#else
+#define Verify(adr, ln) (0)
+#endif /* VERIFY_MEMORY_ACCESS */
+
+#define Mem1(adr)  (Verify(adr, 1), Read1(memmap+(adr)))
+#define Mem2(adr)  (Verify(adr, 2), Read2(memmap+(adr)))
+#define Mem4(adr)  (Verify(adr, 4), Read4(memmap+(adr)))
+#define MemW1(adr, vl)  (Verify(adr, 1), Write1(memmap+(adr), (vl)))
+#define MemW2(adr, vl)  (Verify(adr, 2), Write2(memmap+(adr), (vl)))
+#define MemW4(adr, vl)  (Verify(adr, 4), Write4(memmap+(adr), (vl)))
+
+/* Macros to access values on the stack. These *must* be used 
+   with proper alignment! (That is, Stk4 and StkW4 must take 
+   addresses which are multiples of four, etc.) If the alignment
+   rules are not followed, the program will see performance
+   degradation or even crashes, depending on the machine CPU. */
+
+#define Stk1(adr)   \
+  (*((unsigned char *)(stack+(adr))))
+#define Stk2(adr)   \
+  (*((glui16 *)(stack+(adr))))
+#define Stk4(adr)   \
+  (*((glui32 *)(stack+(adr))))
+
+#define StkW1(adr, vl)   \
+  (*((unsigned char *)(stack+(adr))) = (unsigned char)(vl))
+#define StkW2(adr, vl)   \
+  (*((glui16 *)(stack+(adr))) = (glui16)(vl))
+#define StkW4(adr, vl)   \
+  (*((glui32 *)(stack+(adr))) = (glui32)(vl))
+
+/* Some useful structures. */
+
+/* instruction_t:
+   Represents the list of operands to an instruction being executed.
+   (Yes, it's somewhat misnamed. Sorry.) We assume, for the indefinite
+   moment, that no opcode has more than 8 operands, and no opcode
+   has two "store" operands.
+*/
+typedef struct instruction_struct {
+  glui32 desttype;
+  glui32 value[8];
+} instruction_t;
+
+/* operandlist_t:
+   Represents the operand structure of an opcode.
+*/
+typedef struct operandlist_struct {
+  int num_ops; /* Number of operands for this opcode */
+  int arg_size; /* Usually 4, but can be 1 or 2 */
+  int *formlist; /* Array of values, either modeform_Load or modeform_Store */
+} operandlist_t;
+#define modeform_Load (1)
+#define modeform_Store (2)
+
+/* Some useful globals */
+
+extern strid_t gamefile;
+extern glui32 gamefile_start, gamefile_len;
+extern char *init_err, *init_err2;
+
+extern unsigned char *memmap;
+extern unsigned char *stack;
+
+extern glui32 ramstart;
+extern glui32 endgamefile;
+extern glui32 origendmem;
+extern glui32 stacksize;
+extern glui32 startfuncaddr;
+extern glui32 checksum;
+extern glui32 stackptr;
+extern glui32 frameptr;
+extern glui32 pc;
+extern glui32 origstringtable;
+extern glui32 stringtable;
+extern glui32 valstackbase;
+extern glui32 localsbase;
+extern glui32 endmem;
+extern glui32 protectstart, protectend;
+
+extern void (*stream_char_handler)(unsigned char ch);
+extern void (*stream_unichar_handler)(glui32 ch);
+
+/* main.c */
+extern void fatal_error_handler(char *str, char *arg, int useval, glsi32 val);
+extern void nonfatal_warning_handler(char *str, char *arg, int useval, glsi32 val);
+#define fatal_error(s)  (fatal_error_handler((s), NULL, FALSE, 0))
+#define fatal_error_2(s1, s2)  (fatal_error_handler((s1), (s2), FALSE, 0))
+#define fatal_error_i(s, v)  (fatal_error_handler((s), NULL, TRUE, (v)))
+#define nonfatal_warning(s) (nonfatal_warning_handler((s), NULL, FALSE, 0))
+#define nonfatal_warning_2(s1, s2) (nonfatal_warning_handler((s1), (s2), FALSE, 0))
+#define nonfatal_warning_i(s, v) (nonfatal_warning_handler((s), NULL, TRUE, (v)))
+
+/* files.c */
+extern int is_gamefile_valid(void);
+extern int locate_gamefile(int isblorb);
+
+/* vm.c */
+extern void setup_vm(void);
+extern void finalize_vm(void);
+extern void vm_restart(void);
+extern glui32 change_memsize(glui32 newlen, int internal);
+extern glui32 *pop_arguments(glui32 count, glui32 addr);
+extern void verify_address(glui32 addr, glui32 count);
+
+/* exec.c */
+extern void execute_loop(void);
+
+/* operand.c */
+extern operandlist_t *fast_operandlist[0x80];
+extern void init_operands(void);
+extern operandlist_t *lookup_operandlist(glui32 opcode);
+extern void parse_operands(instruction_t *inst, operandlist_t *oplist);
+extern void store_operand(glui32 desttype, glui32 destaddr, glui32 storeval);
+extern void store_operand_s(glui32 desttype, glui32 destaddr, glui32 storeval);
+extern void store_operand_b(glui32 desttype, glui32 destaddr, glui32 storeval);
+
+/* funcs.c */
+extern void enter_function(glui32 addr, glui32 argc, glui32 *argv);
+extern void leave_function(void);
+extern void push_callstub(glui32 desttype, glui32 destaddr);
+extern void pop_callstub(glui32 returnvalue);
+extern glui32 pop_callstub_string(int *bitnum);
+
+/* string.c */
+extern void stream_num(glsi32 val, int inmiddle, int charnum);
+extern void stream_string(glui32 addr, int inmiddle, int bitnum);
+extern glui32 stream_get_table(void);
+extern void stream_set_table(glui32 addr);
+extern void stream_get_iosys(glui32 *mode, glui32 *rock);
+extern void stream_set_iosys(glui32 mode, glui32 rock);
+extern char *make_temp_string(glui32 addr);
+extern glui32 *make_temp_ustring(glui32 addr);
+extern void free_temp_string(char *str);
+extern void free_temp_ustring(glui32 *str);
+
+/* heap.c */
+extern void heap_clear(void);
+extern int heap_is_active(void);
+extern glui32 heap_get_start(void);
+extern glui32 heap_alloc(glui32 len);
+extern void heap_free(glui32 addr);
+extern int heap_get_summary(glui32 *valcount, glui32 **summary);
+extern int heap_apply_summary(glui32 valcount, glui32 *summary);
+extern void heap_sanity_check(void);
+
+/* serial.c */
+extern int init_serial(void);
+extern glui32 perform_save(strid_t str);
+extern glui32 perform_restore(strid_t str);
+extern glui32 perform_saveundo(void);
+extern glui32 perform_restoreundo(void);
+extern glui32 perform_verify(void);
+
+/* search.c */
+extern glui32 linear_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options);
+extern glui32 binary_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options);
+extern glui32 linked_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 keyoffset, glui32 nextoffset,
+  glui32 options);
+
+/* osdepend.c */
+extern void *glulx_malloc(glui32 len);
+extern void *glulx_realloc(void *ptr, glui32 len);
+extern void glulx_free(void *ptr);
+extern void glulx_setrandom(glui32 seed);
+extern glui32 glulx_random(void);
+extern void glulx_sort(void *addr, int count, int size, 
+  int (*comparefunc)(void *p1, void *p2));
+
+/* gestalt.c */
+extern glui32 do_gestalt(glui32 val, glui32 val2);
+
+/* glkop.c */
+extern int init_dispatch(void);
+extern glui32 perform_glk(glui32 funcnum, glui32 numargs, glui32 *arglist);
+extern strid_t find_stream_by_id(glui32 objid);
+
+/* profile.c */
+extern int init_profile(void);
+#if VM_PROFILING
+extern glui32 profile_opcount;
+#define profile_tick() (profile_opcount++)
+extern void profile_in(glui32 addr, int accel);
+extern void profile_out(void);
+extern void profile_fail(char *reason);
+extern void profile_quit(void);
+#else /* VM_PROFILING */
+#define profile_tick()       (0)
+#define profile_in(addr, accel)  (0)
+#define profile_out()        (0)
+#define profile_fail(reason) (0)
+#define profile_quit()       (0)
+#endif /* VM_PROFILING */
+
+/* accel.c */
+typedef glui32 (*acceleration_func)(glui32 argc, glui32 *argv);
+extern void init_accel(void);
+extern acceleration_func accel_find_func(glui32 index);
+extern acceleration_func accel_get_func(glui32 addr);
+extern void accel_set_func(glui32 index, glui32 addr);
+extern void accel_set_param(glui32 index, glui32 val);
+
+#endif /* _GLULXE_H */
diff --git a/interpreters/glulxe/heap.c b/interpreters/glulxe/heap.c
new file mode 100644 (file)
index 0000000..ea5bf24
--- /dev/null
@@ -0,0 +1,481 @@
+/* heap.c: Glulxe code related to the dynamic allocation heap.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+
+typedef struct heapblock_struct {
+  glui32 addr;
+  glui32 len;
+  int isfree;
+  struct heapblock_struct *next;
+  struct heapblock_struct *prev;
+} heapblock_t;
+
+static glui32 heap_start = 0; /* zero for inactive heap */
+static int alloc_count = 0;
+
+/* The heap_head/heap_tail is a doubly-linked list of blocks, both
+   free and allocated. It is kept in address order. It should be
+   complete -- that is, the first block starts at heap_start, and each
+   block ends at the beginning of the next block, until the last one,
+   which ends at endmem.
+
+   (Heap_start is never the same as end_mem; if there is no heap space,
+   then the heap is inactive and heap_start is zero.)
+
+   Adjacent free blocks may be merged at heap_alloc() time.
+
+   ### To make alloc more efficient, we could keep a separate
+   free-list. To make free more efficient, we could keep a hash
+   table of allocations.
+ */
+static heapblock_t *heap_head = NULL;
+static heapblock_t *heap_tail = NULL;
+
+/* heap_clear():
+   Set the heap state to inactive, and free the block lists. This is
+   called when the game starts or restarts.
+*/
+void heap_clear()
+{
+  while (heap_head) {
+    heapblock_t *blo = heap_head;
+    heap_head = blo->next;
+    blo->next = NULL;
+    blo->prev = NULL;
+    glulx_free(blo);
+  }
+  heap_tail = NULL;
+
+  if (heap_start) {
+    glui32 res = change_memsize(heap_start, TRUE);
+    if (res)
+      fatal_error_i("Unable to revert memory size when deactivating heap.",
+        heap_start);
+  }
+
+  heap_start = 0;
+  alloc_count = 0;
+  /* heap_sanity_check(); */
+}
+
+/* heap_is_active():
+   Returns whether the heap is active.
+*/
+int heap_is_active() {
+  return (heap_start != 0);
+}
+
+/* heap_get_start():
+   Returns the start address of the heap, or 0 if the heap is not active.
+ */
+glui32 heap_get_start() {
+  return heap_start;
+}
+
+/* heap_alloc(): 
+   Allocate a block. If necessary, activate the heap and/or extend memory.
+   This may not be available at all; #define FIXED_MEMSIZE if you want
+   the interpreter to unconditionally refuse.
+   Returns the memory address of the block, or 0 if the operation failed.
+*/
+glui32 heap_alloc(glui32 len)
+{
+  heapblock_t *blo, *newblo;
+
+#ifdef FIXED_MEMSIZE
+  return 0;
+#else /* FIXED_MEMSIZE */
+
+  if (len <= 0)
+    fatal_error("Heap allocation length must be positive.");
+
+  blo = heap_head;
+  while (blo) {
+    if (blo->isfree && blo->len >= len)
+      break;
+
+    if (!blo->isfree) {
+      blo = blo->next;
+      continue;
+    }
+
+    if (!blo->next || !blo->next->isfree) {
+      blo = blo->next;
+      continue;
+    }
+
+    /* This is a free block, but the next block in the list is also
+       free, so we "advance" by merging rather than by going to
+       blo->next. */
+    newblo = blo->next;
+    blo->len += newblo->len;
+    if (newblo->next) {
+      blo->next = newblo->next;
+      newblo->next->prev = blo;
+    }
+    else {
+      blo->next = NULL;
+      heap_tail = blo;
+    }
+    newblo->next = NULL;
+    newblo->prev = NULL;
+    glulx_free(newblo);
+    newblo = NULL;
+    continue;
+  }
+
+  if (!blo) {
+    /* No free area is visible on the list. Try extending memory. How
+       much? Double the heap size, or by 256 bytes, or by the memory
+       length requested -- whichever is greatest. */
+    glui32 res;
+    glui32 extension;
+    glui32 oldendmem = endmem;
+
+    extension = 0;
+    if (heap_start)
+      extension = endmem - heap_start;
+    if (extension < len)
+      extension = len;
+    if (extension < 256)
+      extension = 256;
+    /* And it must be rounded up to a multiple of 256. */
+    extension = (extension + 0xFF) & (~(glui32)0xFF);
+
+    res = change_memsize(endmem+extension, TRUE);
+    if (res)
+      return 0;
+
+    /* If we just started the heap, note that. */
+    if (heap_start == 0)
+      heap_start = oldendmem;
+
+    if (heap_tail && heap_tail->isfree) {
+      /* Append the new space to the last block. */
+      blo = heap_tail;
+      blo->len += extension;
+    }
+    else {
+      /* Append the new space to the block list, as a new block. */
+      newblo = glulx_malloc(sizeof(heapblock_t));
+      if (!newblo)
+        fatal_error("Unable to allocate record for heap block.");
+      newblo->addr = oldendmem;
+      newblo->len = extension;
+      newblo->isfree = TRUE;
+      newblo->next = NULL;
+      newblo->prev = NULL;
+
+      if (!heap_tail) {
+        heap_head = newblo;
+        heap_tail = newblo;
+      }
+      else {
+        blo = heap_tail;
+        heap_tail = newblo;
+        blo->next = newblo;
+        newblo->prev = blo;
+      }
+
+      blo = newblo;
+      newblo = NULL;
+    }
+
+    /* and continue forwards, using this new block (blo). */
+  }
+
+  /* Something strange happened. */
+  if (!blo || !blo->isfree || blo->len < len)
+    return 0;
+
+  /* We now have a free block of size len or longer. */
+
+  if (blo->len == len) {
+    blo->isfree = FALSE;
+  }
+  else {
+    newblo = glulx_malloc(sizeof(heapblock_t));
+    if (!newblo)
+      fatal_error("Unable to allocate record for heap block.");
+    newblo->isfree = TRUE;
+    newblo->addr = blo->addr + len;
+    newblo->len = blo->len - len;
+    blo->len = len;
+    blo->isfree = FALSE;
+    newblo->next = blo->next;
+    if (newblo->next)
+      newblo->next->prev = newblo;
+    newblo->prev = blo;
+    blo->next = newblo;
+    if (heap_tail == blo)
+      heap_tail = newblo;
+  }
+
+  alloc_count++;
+  /* heap_sanity_check(); */
+  return blo->addr;
+
+#endif /* FIXED_MEMSIZE */
+}
+
+/* heap_free():
+   Free a heap block. If necessary, deactivate the heap.
+*/
+void heap_free(glui32 addr)
+{
+  heapblock_t *blo;
+
+  for (blo = heap_head; blo; blo = blo->next) { 
+    if (blo->addr == addr)
+      break;
+  };
+  if (!blo || blo->isfree)
+    fatal_error_i("Attempt to free unallocated address from heap.", addr);
+
+  blo->isfree = TRUE;
+  alloc_count--;
+  if (alloc_count <= 0) {
+    heap_clear();
+  }
+
+  /* heap_sanity_check(); */
+}
+
+/* heap_get_summary():
+   Create an array of words, in the VM serialization format:
+
+     heap_start
+     alloc_count
+     addr of first block
+     len of first block
+     ...
+
+   (Note that these are glui32 values -- native byte ordering. Also,
+   the blocks will be in address order, which is a stricter guarantee
+   than the VM specifies; that'll help in heap_apply_summary().)
+
+   If the heap is inactive, store NULL. Return 0 for success;
+   otherwise, the operation failed.
+
+   The array returned in summary must be freed with glulx_free() after
+   the caller uses it.
+*/
+int heap_get_summary(glui32 *valcount, glui32 **summary)
+{
+  glui32 *arr, len, pos, lx;
+  heapblock_t *blo;
+
+  *valcount = 0;
+  *summary = NULL;
+
+  if (heap_start == 0)
+    return 0;
+
+  len = 2 + 2*alloc_count;
+  arr = glulx_malloc(len * sizeof(glui32));
+  if (!arr)
+    return 1;
+
+  pos = 0;
+  arr[pos++] = heap_start;
+  arr[pos++] = alloc_count;
+
+  for (blo = heap_head; blo; blo = blo->next) {
+    if (blo->isfree)
+      continue;
+    arr[pos++] = blo->addr;
+    arr[pos++] = blo->len;
+  }
+
+  if (pos != len)
+    fatal_error("Wrong number of active blocks in heap");
+
+  *valcount = len;
+  *summary = arr;
+  return 0;
+}
+
+/* heap_apply_summary():
+   Given an array of words in the above format, set up the heap to
+   contain it. As noted above, the caller must ensure that the blocks
+   are in address order. When this is called, the heap must be
+   inactive.
+
+   Return 0 for success. Otherwise the operation failed (and, most
+   likely, caused a fatal error).
+*/
+int heap_apply_summary(glui32 valcount, glui32 *summary)
+{
+  glui32 lx, jx, lastend;
+
+  if (heap_start)
+    fatal_error("Heap active when heap_apply_summary called");
+
+  if (valcount == 0 || summary == NULL)
+    return 0;
+  if (valcount == 2 && summary[0] == 0 && summary[1] == 0)
+    return 0;
+
+#ifdef FIXED_MEMSIZE
+  return 1;
+#else /* FIXED_MEMSIZE */
+
+  lx = 0;
+  heap_start = summary[lx++];
+  alloc_count = summary[lx++];
+
+  for (jx=lx; jx+2<valcount; jx+=2) {
+    if (summary[jx] >= summary[jx+2])
+      fatal_error("Heap block summary is out of order.");
+  }
+
+  lastend = heap_start;
+
+  while (lx < valcount || lastend < endmem) {
+    heapblock_t *blo;
+
+    blo = glulx_malloc(sizeof(heapblock_t));
+    if (!blo)
+      fatal_error("Unable to allocate record for heap block.");
+
+    if (lx >= valcount) {
+      blo->addr = lastend;
+      blo->len = endmem - lastend;
+      blo->isfree = TRUE;
+    }
+    else {
+      if (lastend < summary[lx]) {
+        blo->addr = lastend;
+        blo->len = summary[lx] - lastend;
+        blo->isfree = TRUE;
+      }
+      else {
+        blo->addr = summary[lx++];
+        blo->len = summary[lx++];
+        blo->isfree = FALSE;
+      }
+    }
+
+    blo->prev = NULL;
+    blo->next = NULL;
+
+    if (!heap_head) {
+      heap_head = blo;
+      heap_tail = blo;
+    }
+    else {
+      heap_tail->next = blo;
+      blo->prev = heap_tail;
+      heap_tail = blo;
+    }
+
+    lastend = blo->addr + blo->len;
+  }
+
+  /* heap_sanity_check(); */
+
+  return 0;
+#endif /* FIXED_MEMSIZE */
+}
+
+#if 0
+#include <stdio.h>
+
+static void heap_dump(void);
+
+/* heap_dump():
+   Print out the heap list (using printf). This exists for debugging,
+   which is why it's ifdeffed out.
+*/
+static void heap_dump()
+{
+  heapblock_t *blo;
+
+  if (heap_start == 0) {
+    printf("# Heap is inactive.\n");
+    return;    
+  }
+
+  printf("# Heap active: %d outstanding blocks\n", alloc_count);
+  printf("# Heap start: %ld\n", heap_start);
+
+  for (blo = heap_head; blo; blo = blo->next) {
+    printf("#  %s at %ld..%ld, len %ld\n", 
+      (blo->isfree ? " free" : "*used"),
+      blo->addr, blo->addr+blo->len, blo->len);
+  }
+
+  printf("# Heap end: %ld\n", endmem);
+}
+
+/* heap_sanity_check():
+   Check the validity of the heap. Throw a fatal error if anything is
+   wrong.
+*/
+void heap_sanity_check()
+{
+  heapblock_t *blo, *last;
+  int livecount;
+
+  heap_dump();
+
+  if (heap_start == 0) {
+    if (heap_head || heap_tail)
+      fatal_error("Heap sanity: nonempty list when heap is inactive.");
+    if (alloc_count)
+      fatal_error_i("Heap sanity: outstanding blocks when heap is inactive.",
+        alloc_count);
+    return;
+  }
+
+#ifdef FIXED_MEMSIZE
+  fatal_error("Heap sanity: heap is active, but interpreter is compiled with no allocation.");
+#endif /* FIXED_MEMSIZE */
+
+  /* When the heap is active there may, briefly, be no heapblocks on the
+     list. */
+
+  last = NULL;
+  livecount = 0;
+
+  for (blo = heap_head; blo; last = blo, blo = blo->next) {
+    glui32 lastend;
+
+    if (blo->prev != last)
+      fatal_error("Heap sanity: prev pointer mismatch.");
+    if (!last) 
+      lastend = heap_start;
+    else
+      lastend = last->addr + last->len;
+    if (lastend != blo->addr)
+      fatal_error("Heap sanity: addr+len mismatch.");
+
+    if (!blo->isfree)
+      livecount++;
+  }
+
+  if (!last) {
+    if (heap_start != endmem)
+      fatal_error_i("Heap sanity: empty list, but endmem is not heap start.",
+        heap_start);
+    if (heap_tail)
+      fatal_error("Heap sanity: empty list, but heap tail exists.");
+  }
+  else {
+    if (last->addr + last->len != endmem)
+      fatal_error_i("Heap sanity: last block does not end at endmem.",
+        last->addr + last->len);
+    if (last != heap_tail)
+      fatal_error("Heap sanity: heap tail points wrong.");
+  }
+
+  if (livecount != alloc_count)
+    fatal_error_i("Heap sanity: wrong number of live blocks.", livecount);
+}
+
+#endif /* 0 */
+
diff --git a/interpreters/glulxe/main.c b/interpreters/glulxe/main.c
new file mode 100644 (file)
index 0000000..63aba89
--- /dev/null
@@ -0,0 +1,163 @@
+/* main.c: Glulxe top-level code.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+
+strid_t gamefile = NULL; /* The stream containing the Glulx file. */
+glui32 gamefile_start = 0; /* The position within the stream. (This will not 
+    be zero if the Glulx file is a chunk inside a Blorb archive.) */
+glui32 gamefile_len = 0; /* The length within the stream. */
+char *init_err = NULL;
+char *init_err2 = NULL;
+
+static winid_t get_error_win(void);
+static void stream_hexnum(glsi32 val);
+
+/* glk_main():
+   The top-level routine. This does everything, and consequently is
+   very simple. 
+*/
+void glk_main()
+{
+  if (init_err) {
+    fatal_error_2(init_err, init_err2);
+    return;
+  }
+
+  if (!is_gamefile_valid()) {
+    /* The fatal error has already been displayed. */
+    return;
+  }
+
+  glulx_setrandom(0);
+  if (!init_dispatch()) {
+    return;
+  }
+  if (!init_profile()) {
+    return;
+  }
+
+  setup_vm();
+  execute_loop();
+  finalize_vm();
+
+  profile_quit();
+  glk_exit();
+}
+
+/* get_error_win():
+   Return a window in which to display errors. The first time this is called,
+   it creates a new window; after that it returns the window it first
+   created.
+*/
+static winid_t get_error_win()
+{
+  static winid_t errorwin = NULL;
+
+  if (!errorwin) {
+    winid_t rootwin = glk_window_get_root();
+    if (!rootwin) {
+      errorwin = glk_window_open(0, 0, 0, wintype_TextBuffer, 1);
+    }
+    else {
+      errorwin = glk_window_open(rootwin, winmethod_Below | winmethod_Fixed, 
+        3, wintype_TextBuffer, 0);
+    }
+    if (!errorwin)
+      errorwin = rootwin;
+  }
+
+  return errorwin;
+}
+
+/* fatal_error_handler():
+   Display an error in the error window, and then exit.
+*/
+void fatal_error_handler(char *str, char *arg, int useval, glsi32 val)
+{
+  winid_t win = get_error_win();
+  if (win) {
+    glk_set_window(win);
+    glk_put_string("Glulxe fatal error: ");
+    glk_put_string(str);
+    if (arg || useval) {
+      glk_put_string(" (");
+      if (arg)
+        glk_put_string(arg);
+      if (arg && useval)
+        glk_put_string(" ");
+      if (useval)
+        stream_hexnum(val);
+      glk_put_string(")");
+    }
+    glk_put_string("\n");
+  }
+  glk_exit();
+}
+
+/* nonfatal_warning_handler():
+   Display a warning in the error window, and then continue.
+*/
+void nonfatal_warning_handler(char *str, char *arg, int useval, glsi32 val)
+{
+  winid_t win = get_error_win();
+  if (win) {
+    strid_t oldstr = glk_stream_get_current();
+    glk_set_window(win);
+    glk_put_string("Glulxe warning: ");
+    glk_put_string(str);
+    if (arg || useval) {
+      glk_put_string(" (");
+      if (arg)
+        glk_put_string(arg);
+      if (arg && useval)
+        glk_put_string(" ");
+      if (useval)
+        stream_hexnum(val);
+      glk_put_string(")");
+    }
+    glk_put_string("\n");
+    glk_stream_set_current(oldstr);
+  }
+}
+
+/* stream_hexnum():
+   Write a signed integer to the current Glk output stream.
+*/
+static void stream_hexnum(glsi32 val)
+{
+  char buf[16];
+  glui32 ival;
+  int ix;
+
+  if (val == 0) {
+    glk_put_char('0');
+    return;
+  }
+
+  if (val < 0) {
+    glk_put_char('-');
+    ival = -val;
+  }
+  else {
+    ival = val;
+  }
+
+  ix = 0;
+  while (ival != 0) {
+    buf[ix] = (ival % 16) + '0';
+    if (buf[ix] > '9')
+      buf[ix] += ('A' - ('9' + 1));
+    ix++;
+    ival /= 16;
+  }
+
+  while (ix) {
+    ix--;
+    glk_put_char(buf[ix]);
+  }
+}
+
diff --git a/interpreters/glulxe/opcodes.h b/interpreters/glulxe/opcodes.h
new file mode 100644 (file)
index 0000000..8da99d2
--- /dev/null
@@ -0,0 +1,113 @@
+/* opcodes.h: The big list of opcode values for Glulxe.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#ifndef _OPCODES_H
+#define _OPCODES_H
+
+#define op_nop          (0x00)
+
+#define op_add          (0x10)
+#define op_sub          (0x11)
+#define op_mul          (0x12)
+#define op_div          (0x13)
+#define op_mod          (0x14)
+#define op_neg          (0x15)
+#define op_bitand       (0x18)
+#define op_bitor        (0x19)
+#define op_bitxor       (0x1A)
+#define op_bitnot       (0x1B)
+#define op_shiftl       (0x1C)
+#define op_sshiftr      (0x1D)
+#define op_ushiftr      (0x1E)
+
+#define op_jump         (0x20)
+#define op_jz           (0x22)
+#define op_jnz          (0x23)
+#define op_jeq          (0x24)
+#define op_jne          (0x25)
+#define op_jlt          (0x26)
+#define op_jge          (0x27)
+#define op_jgt          (0x28)
+#define op_jle          (0x29)
+#define op_jltu         (0x2A)
+#define op_jgeu         (0x2B)
+#define op_jgtu         (0x2C)
+#define op_jleu         (0x2D)
+
+#define op_call         (0x30)
+#define op_return       (0x31)
+#define op_catch        (0x32)
+#define op_throw        (0x33)
+#define op_tailcall     (0x34)
+
+#define op_copy         (0x40)
+#define op_copys        (0x41)
+#define op_copyb        (0x42)
+#define op_sexs         (0x44)
+#define op_sexb         (0x45)
+#define op_aload        (0x48)
+#define op_aloads       (0x49)
+#define op_aloadb       (0x4A)
+#define op_aloadbit     (0x4B)
+#define op_astore       (0x4C)
+#define op_astores      (0x4D)
+#define op_astoreb      (0x4E)
+#define op_astorebit    (0x4F)
+
+#define op_stkcount     (0x50)
+#define op_stkpeek      (0x51)
+#define op_stkswap      (0x52)
+#define op_stkroll      (0x53)
+#define op_stkcopy      (0x54)
+
+#define op_streamchar   (0x70)
+#define op_streamnum    (0x71)
+#define op_streamstr    (0x72)
+#define op_streamunichar (0x73)
+
+#define op_gestalt      (0x100)
+#define op_debugtrap    (0x101)
+#define op_getmemsize   (0x102)
+#define op_setmemsize   (0x103)
+#define op_jumpabs      (0x104)
+
+#define op_random       (0x110)
+#define op_setrandom    (0x111)
+
+#define op_quit         (0x120)
+#define op_verify       (0x121)
+#define op_restart      (0x122)
+#define op_save         (0x123)
+#define op_restore      (0x124)
+#define op_saveundo     (0x125)
+#define op_restoreundo  (0x126)
+#define op_protect      (0x127)
+
+#define op_glk          (0x130)
+
+#define op_getstringtbl (0x140)
+#define op_setstringtbl (0x141)
+#define op_getiosys     (0x148)
+#define op_setiosys     (0x149)
+
+#define op_linearsearch (0x150)
+#define op_binarysearch (0x151)
+#define op_linkedsearch (0x152)
+
+#define op_callf        (0x160)
+#define op_callfi       (0x161)
+#define op_callfii      (0x162)
+#define op_callfiii     (0x163)
+
+#define op_mzero        (0x170)
+#define op_mcopy        (0x171)
+#define op_malloc       (0x178)
+#define op_mfree        (0x179)
+
+#define op_accelfunc    (0x180)
+#define op_accelparam   (0x181)
+
+#endif /* _OPCODES_H */
+
diff --git a/interpreters/glulxe/operand.c b/interpreters/glulxe/operand.c
new file mode 100644 (file)
index 0000000..bb5a7a3
--- /dev/null
@@ -0,0 +1,580 @@
+/* operand.c: Glulxe code for instruction operands, reading and writing.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+#include "opcodes.h"
+
+/* ### We could save a few cycles per operand by generating a function for
+   each operandlist type. */
+
+/* fast_operandlist[]:
+   This is a handy array in which to look up operandlists quickly.
+   It stores the operandlists for the first 128 opcodes, which are
+   the ones used most frequently.
+*/
+operandlist_t *fast_operandlist[0x80];
+
+/* The actual immutable structures which lookup_operandlist()
+   returns. */
+static operandlist_t list_none = { 0, 4, NULL };
+
+static int array_S[1] = { modeform_Store };
+static operandlist_t list_S = { 1, 4, array_S };
+static int array_LS[2] = { modeform_Load, modeform_Store };
+static operandlist_t list_LS = { 2, 4, array_LS };
+static int array_LLS[3] = { modeform_Load, modeform_Load, modeform_Store };
+static operandlist_t list_LLS = { 3, 4, array_LLS };
+static int array_LLLS[4] = { modeform_Load, modeform_Load, modeform_Load, modeform_Store };
+static operandlist_t list_LLLS = { 4, 4, array_LLLS };
+static int array_LLLLS[5] = { modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Store };
+static operandlist_t list_LLLLS = { 5, 4, array_LLLLS };
+static int array_LLLLLS[6] = { modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Store };
+static operandlist_t list_LLLLLS = { 6, 4, array_LLLLLS };
+static int array_LLLLLLS[7] = { modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Store };
+static operandlist_t list_LLLLLLS = { 7, 4, array_LLLLLLS };
+static int array_LLLLLLLS[8] = { modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Load, modeform_Store };
+static operandlist_t list_LLLLLLLS = { 8, 4, array_LLLLLLLS };
+
+static int array_L[1] = { modeform_Load };
+static operandlist_t list_L = { 1, 4, array_L };
+static int array_LL[2] = { modeform_Load, modeform_Load };
+static operandlist_t list_LL = { 2, 4, array_LL };
+static int array_LLL[3] = { modeform_Load, modeform_Load, modeform_Load };
+static operandlist_t list_LLL = { 3, 4, array_LLL };
+static operandlist_t list_2LS = { 2, 2, array_LS };
+static operandlist_t list_1LS = { 2, 1, array_LS };
+static int array_SL[2] = { modeform_Store, modeform_Load };
+static operandlist_t list_SL = { 2, 4, array_SL };
+static int array_SS[2] = { modeform_Store, modeform_Store };
+static operandlist_t list_SS = { 2, 4, array_SS };
+
+/* init_operands():
+   Set up the fast-lookup array of operandlists. This is called just
+   once, when the terp starts up. 
+*/
+void init_operands()
+{
+  int ix;
+  for (ix=0; ix<0x80; ix++)
+    fast_operandlist[ix] = lookup_operandlist(ix);
+}
+
+/* lookup_operandlist():
+   Return the operandlist for a given opcode. For opcodes in the range
+   00..7F, it's faster to use the array fast_operandlist[]. 
+*/
+operandlist_t *lookup_operandlist(glui32 opcode)
+{
+  switch (opcode) {
+  case op_nop: 
+    return &list_none;
+
+  case op_add:
+  case op_sub:
+  case op_mul:
+  case op_div:
+  case op_mod:
+  case op_bitand:
+  case op_bitor:
+  case op_bitxor:
+  case op_shiftl:
+  case op_sshiftr:
+  case op_ushiftr:
+    return &list_LLS;
+
+  case op_neg:
+  case op_bitnot:
+    return &list_LS;
+
+  case op_jump:
+  case op_jumpabs:
+    return &list_L;
+  case op_jz:
+  case op_jnz:
+    return &list_LL;
+  case op_jeq:
+  case op_jne:
+  case op_jlt:
+  case op_jge:
+  case op_jgt:
+  case op_jle:
+  case op_jltu:
+  case op_jgeu:
+  case op_jgtu:
+  case op_jleu:
+    return &list_LLL;
+
+  case op_call:
+    return &list_LLS;
+  case op_return:
+    return &list_L;
+  case op_catch:
+    return &list_SL;
+  case op_throw:
+    return &list_LL;
+  case op_tailcall:
+    return &list_LL;
+
+  case op_sexb:
+  case op_sexs:
+    return &list_LS;
+
+  case op_copy:
+    return &list_LS;
+  case op_copys:
+    return &list_2LS;
+  case op_copyb:
+    return &list_1LS;
+  case op_aload:
+  case op_aloads:
+  case op_aloadb:
+  case op_aloadbit:
+    return &list_LLS;
+  case op_astore:
+  case op_astores:
+  case op_astoreb:
+  case op_astorebit:
+    return &list_LLL;
+
+  case op_stkcount:
+    return &list_S;
+  case op_stkpeek:
+    return &list_LS;
+  case op_stkswap: 
+    return &list_none;
+  case op_stkroll:
+    return &list_LL;
+  case op_stkcopy:
+    return &list_L;
+
+  case op_streamchar:
+  case op_streamunichar:
+  case op_streamnum:
+  case op_streamstr:
+    return &list_L;
+  case op_getstringtbl:
+    return &list_S;
+  case op_setstringtbl:
+    return &list_L;
+  case op_getiosys:
+    return &list_SS;
+  case op_setiosys:
+    return &list_LL;
+
+  case op_random:
+    return &list_LS;
+  case op_setrandom:
+    return &list_L;
+
+  case op_verify:
+    return &list_S;
+  case op_restart:
+    return &list_none;
+  case op_save:
+  case op_restore:
+    return &list_LS;
+  case op_saveundo:
+  case op_restoreundo:
+    return &list_S;
+  case op_protect:
+    return &list_LL;
+
+  case op_quit:
+    return &list_none;
+
+  case op_gestalt:
+    return &list_LLS;
+
+  case op_debugtrap: 
+    return &list_L;
+
+  case op_getmemsize:
+    return &list_S;
+  case op_setmemsize:
+    return &list_LS;
+
+  case op_linearsearch:
+    return &list_LLLLLLLS;
+  case op_binarysearch:
+    return &list_LLLLLLLS;
+  case op_linkedsearch:
+    return &list_LLLLLLS;
+
+  case op_glk:
+    return &list_LLS;
+
+  case op_callf:
+    return &list_LS;
+  case op_callfi:
+    return &list_LLS;
+  case op_callfii:
+    return &list_LLLS;
+  case op_callfiii:
+    return &list_LLLLS;
+
+  case op_mzero:
+    return &list_LL;
+  case op_mcopy:
+    return &list_LLL;
+  case op_malloc:
+    return &list_LS;
+  case op_mfree:
+    return &list_L;
+
+  case op_accelfunc:
+  case op_accelparam:
+    return &list_LL;
+
+  default: 
+    return NULL;
+  }
+}
+
+/* parse_operands():
+   Read the list of operands of an instruction, and put the values
+   in inst. This assumes that the PC is at the beginning of the
+   operand mode list (right after an opcode number.) Upon return,
+   the PC will be at the beginning of the next instruction.
+*/
+void parse_operands(instruction_t *inst, operandlist_t *oplist)
+{
+  int ix;
+  int numops = oplist->num_ops;
+  int argsize = oplist->arg_size;
+  glui32 modeaddr = pc;
+  int modeval;
+
+  inst->desttype = 0;
+
+  pc += (numops+1) / 2;
+
+  for (ix=0; ix<numops; ix++) {
+    int mode;
+    glui32 value;
+    glui32 addr;
+
+    if ((ix & 1) == 0) {
+      modeval = Mem1(modeaddr);
+      mode = (modeval & 0x0F);
+    }
+    else {
+      mode = ((modeval >> 4) & 0x0F);
+      modeaddr++;
+    }
+
+    if (oplist->formlist[ix] == modeform_Load) {
+
+      switch (mode) {
+
+      case 8: /* pop off stack */
+        if (stackptr < valstackbase+4) {
+          fatal_error("Stack underflow in operand.");
+        }
+        stackptr -= 4;
+        value = Stk4(stackptr);
+        break;
+
+      case 0: /* constant zero */
+        value = 0;
+        break;
+
+      case 1: /* one-byte constant */
+        /* Sign-extend from 8 bits to 32 */
+        value = (glsi32)(signed char)(Mem1(pc));
+        pc++;
+        break;
+
+      case 2: /* two-byte constant */
+        /* Sign-extend the first byte from 8 bits to 32; the subsequent
+           byte must not be sign-extended. */
+        value = (glsi32)(signed char)(Mem1(pc));
+        pc++;
+        value = (value << 8) | (glui32)(Mem1(pc));
+        pc++;
+        break;
+
+      case 3: /* four-byte constant */
+        /* Bytes must not be sign-extended. */
+        value = Mem4(pc);
+        pc += 4;
+        break;
+
+      case 15: /* main memory RAM, four-byte address */
+        addr = Mem4(pc);
+        addr += ramstart;
+        pc += 4;
+        goto MainMemAddr; 
+
+      case 14: /* main memory RAM, two-byte address */
+        addr = (glui32)Mem2(pc);
+        addr += ramstart;
+        pc += 2;
+        goto MainMemAddr; 
+
+      case 13: /* main memory RAM, one-byte address */
+        addr = (glui32)(Mem1(pc));
+        addr += ramstart;
+        pc++;
+        goto MainMemAddr; 
+        
+      case 7: /* main memory, four-byte address */
+        addr = Mem4(pc);
+        pc += 4;
+        goto MainMemAddr;
+
+      case 6: /* main memory, two-byte address */
+        addr = (glui32)Mem2(pc);
+        pc += 2;
+        goto MainMemAddr;
+
+      case 5: /* main memory, one-byte address */
+        addr = (glui32)(Mem1(pc));
+        pc++;
+        /* fall through */
+
+      MainMemAddr:
+        /* cases 5, 6, 7, 13, 14, 15 all wind up here. */
+        if (argsize == 4) {
+          value = Mem4(addr);
+        }
+        else if (argsize == 2) {
+          value = Mem2(addr);
+        }
+        else {
+          value = Mem1(addr);
+        }
+        break;
+
+      case 11: /* locals, four-byte address */
+        addr = Mem4(pc);
+        pc += 4;
+        goto LocalsAddr;
+
+      case 10: /* locals, two-byte address */
+        addr = (glui32)Mem2(pc);
+        pc += 2;
+        goto LocalsAddr; 
+
+      case 9: /* locals, one-byte address */
+        addr = (glui32)(Mem1(pc));
+        pc++;
+        /* fall through */
+
+      LocalsAddr:
+        /* cases 9, 10, 11 all wind up here. It's illegal for addr to not
+           be four-byte aligned, but we don't check this explicitly. 
+           A "strict mode" interpreter probably should. It's also illegal
+           for addr to be less than zero or greater than the size of
+           the locals segment. */
+        addr += localsbase;
+        if (argsize == 4) {
+          value = Stk4(addr);
+        }
+        else if (argsize == 2) {
+          value = Stk2(addr);
+        }
+        else {
+          value = Stk1(addr);
+        }
+        break;
+
+      default:
+        fatal_error("Unknown addressing mode in load operand.");
+      }
+
+      inst->value[ix] = value;
+
+    }
+    else {  /* modeform_Store */
+      switch (mode) {
+
+      case 0: /* discard value */
+        inst->desttype = 0;
+        inst->value[ix] = 0;
+        break;
+
+      case 8: /* push on stack */
+        inst->desttype = 3;
+        inst->value[ix] = 0;
+        break;
+
+      case 15: /* main memory RAM, four-byte address */
+        addr = Mem4(pc);
+        addr += ramstart;
+        pc += 4;
+        goto WrMainMemAddr; 
+
+      case 14: /* main memory RAM, two-byte address */
+        addr = (glui32)Mem2(pc);
+        addr += ramstart;
+        pc += 2;
+        goto WrMainMemAddr; 
+
+      case 13: /* main memory RAM, one-byte address */
+        addr = (glui32)(Mem1(pc));
+        addr += ramstart;
+        pc++;
+        goto WrMainMemAddr; 
+
+      case 7: /* main memory, four-byte address */
+        addr = Mem4(pc);
+        pc += 4;
+        goto WrMainMemAddr;
+
+      case 6: /* main memory, two-byte address */
+        addr = (glui32)Mem2(pc);
+        pc += 2;
+        goto WrMainMemAddr;
+
+      case 5: /* main memory, one-byte address */
+        addr = (glui32)(Mem1(pc));
+        pc++;
+        /* fall through */
+
+      WrMainMemAddr:
+        /* cases 5, 6, 7 all wind up here. */
+        inst->desttype = 1;
+        inst->value[ix] = addr;
+        break;
+
+      case 11: /* locals, four-byte address */
+        addr = Mem4(pc);
+        pc += 4;
+        goto WrLocalsAddr;
+
+      case 10: /* locals, two-byte address */
+        addr = (glui32)Mem2(pc);
+        pc += 2;
+        goto WrLocalsAddr; 
+
+      case 9: /* locals, one-byte address */
+        addr = (glui32)(Mem1(pc));
+        pc++;
+        /* fall through */
+
+      WrLocalsAddr:
+        /* cases 9, 10, 11 all wind up here. It's illegal for addr to not
+           be four-byte aligned, but we don't check this explicitly. 
+           A "strict mode" interpreter probably should. It's also illegal
+           for addr to be less than zero or greater than the size of
+           the locals segment. */
+        inst->desttype = 2;
+        /* We don't add localsbase here; the store address for desttype 2
+           is relative to the current locals segment, not an absolute
+           stack position. */
+        inst->value[ix] = addr;
+        break;
+
+      case 1:
+      case 2:
+      case 3:
+        fatal_error("Constant addressing mode in store operand.");
+
+      default:
+        fatal_error("Unknown addressing mode in store operand.");
+      }
+    }
+  }
+}
+
+/* store_operand():
+   Store a result value, according to the desttype and destaddress given.
+   This is usually used to store the result of an opcode, but it's also
+   used by any code that pulls a call-stub off the stack.
+*/
+void store_operand(glui32 desttype, glui32 destaddr, glui32 storeval)
+{
+  switch (desttype) {
+
+  case 0: /* do nothing; discard the value. */
+    return;
+
+  case 1: /* main memory. */
+    MemW4(destaddr, storeval);
+    return;
+
+  case 2: /* locals. */
+    destaddr += localsbase;
+    StkW4(destaddr, storeval);
+    return;
+
+  case 3: /* push on stack. */
+    if (stackptr+4 > stacksize) {
+      fatal_error("Stack overflow in store operand.");
+    }
+    StkW4(stackptr, storeval);
+    stackptr += 4;
+    return;
+
+  default:
+    fatal_error("Unknown destination type in store operand.");
+
+  }
+}
+
+void store_operand_s(glui32 desttype, glui32 destaddr, glui32 storeval)
+{
+  storeval &= 0xFFFF;
+
+  switch (desttype) {
+
+  case 0: /* do nothing; discard the value. */
+    return;
+
+  case 1: /* main memory. */
+    MemW2(destaddr, storeval);
+    return;
+
+  case 2: /* locals. */
+    destaddr += localsbase;
+    StkW2(destaddr, storeval);
+    return;
+
+  case 3: /* push on stack. A four-byte value is actually pushed. */
+    if (stackptr+4 > stacksize) {
+      fatal_error("Stack overflow in store operand.");
+    }
+    StkW4(stackptr, storeval);
+    stackptr += 4;
+    return;
+
+  default:
+    fatal_error("Unknown destination type in store operand.");
+
+  }
+}
+
+void store_operand_b(glui32 desttype, glui32 destaddr, glui32 storeval)
+{
+  storeval &= 0xFF;
+
+  switch (desttype) {
+
+  case 0: /* do nothing; discard the value. */
+    return;
+
+  case 1: /* main memory. */
+    MemW1(destaddr, storeval);
+    return;
+
+  case 2: /* locals. */
+    destaddr += localsbase;
+    StkW1(destaddr, storeval);
+    return;
+
+  case 3: /* push on stack. A four-byte value is actually pushed. */
+    if (stackptr+4 > stacksize) {
+      fatal_error("Stack overflow in store operand.");
+    }
+    StkW4(stackptr, storeval);
+    stackptr += 4;
+    return;
+
+  default:
+    fatal_error("Unknown destination type in store operand.");
+
+  }
+}
diff --git a/interpreters/glulxe/osdepend.c b/interpreters/glulxe/osdepend.c
new file mode 100644 (file)
index 0000000..8c720dd
--- /dev/null
@@ -0,0 +1,195 @@
+/* osdepend.c: Glulxe platform-dependent code.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+
+/* This file contains definitions for platform-dependent code. Since
+   Glk takes care of I/O, this is a short list -- memory allocation
+   and random numbers.
+
+   The Makefile (or whatever) should define OS_UNIX, or some other
+   symbol. Code contributions welcome. 
+*/
+
+#ifdef OS_UNIX
+
+#include <time.h>
+#include <stdlib.h>
+
+/* Allocate a chunk of memory. */
+void *glulx_malloc(glui32 len)
+{
+  return malloc(len);
+}
+
+/* Resize a chunk of memory. This must follow ANSI rules: if the
+   size-change fails, this must return NULL, but the original chunk 
+   must remain unchanged. */
+void *glulx_realloc(void *ptr, glui32 len)
+{
+  return realloc(ptr, len);
+}
+
+/* Deallocate a chunk of memory. */
+void glulx_free(void *ptr)
+{
+  free(ptr);
+}
+
+/* Set the random-number seed; zero means use as random a source as
+   possible. */
+void glulx_setrandom(glui32 seed)
+{
+  if (seed == 0)
+    seed = time(NULL);
+  srandom(seed);
+}
+
+/* Return a random number in the range 0 to 2^32-1. */
+glui32 glulx_random()
+{
+  return random();
+}
+
+#endif /* OS_UNIX */
+
+#ifdef OS_MAC
+
+/* The Glk library uses malloc/free liberally, so we might as well also. */
+#include <stdlib.h>
+
+/* Allocate a chunk of memory. */
+void *glulx_malloc(glui32 len)
+{
+  return malloc(len);
+}
+
+/* Resize a chunk of memory. This must follow ANSI rules: if the
+   size-change fails, this must return NULL, but the original chunk 
+   must remain unchanged. */
+void *glulx_realloc(void *ptr, glui32 len)
+{
+  return realloc(ptr, len);
+}
+
+/* Deallocate a chunk of memory. */
+void glulx_free(void *ptr)
+{
+  free(ptr);
+}
+
+#define COMPILE_RANDOM_CODE
+static glui32 lo_random(void);
+static void lo_seed_random(glui32 seed);
+
+/* Return a random number in the range 0 to 2^32-1. */
+glui32 glulx_random()
+{
+  return lo_random();
+}
+
+/* Set the random-number seed; zero means use as random a source as
+   possible. */
+void glulx_setrandom(glui32 seed)
+{
+  if (seed == 0)
+    seed = TickCount() ^ Random();
+  lo_seed_random(seed);
+}
+
+#endif /* OS_MAC */
+
+#ifdef WIN32
+
+#include <time.h>
+#include <stdlib.h>
+
+/* Allocate a chunk of memory. */
+void *glulx_malloc(glui32 len)
+{
+  return malloc(len);
+}
+
+/* Resize a chunk of memory. This must follow ANSI rules: if the
+   size-change fails, this must return NULL, but the original chunk 
+   must remain unchanged. */
+void *glulx_realloc(void *ptr, glui32 len)
+{
+  return realloc(ptr, len);
+}
+
+/* Deallocate a chunk of memory. */
+void glulx_free(void *ptr)
+{
+  free(ptr);
+}
+
+/* Set the random-number seed; zero means use as random a source as
+   possible. */
+void glulx_setrandom(glui32 seed)
+{
+  if (seed == 0)
+    seed = time(NULL);
+  srand(seed);
+}
+
+/* Return a random number in the range 0 to 2^32-1. */
+glui32 glulx_random()
+{
+  return rand();
+}
+
+#endif /* WIN32 */
+
+#ifdef COMPILE_RANDOM_CODE
+
+/* Here is a pretty standard random-number generator and seed function. */
+static glui32 lo_random(void);
+static void lo_seed_random(glui32 seed);
+static glui32 rand_table[55]; /* State for the RNG. */
+static int rand_index1, rand_index2;
+
+static glui32 lo_random()
+{
+  rand_index1 = (rand_index1 + 1) % 55;
+  rand_index2 = (rand_index2 + 1) % 55;
+  rand_table[rand_index1] = rand_table[rand_index1] - rand_table[rand_index2];
+  return rand_table[rand_index1];
+}
+
+static void lo_seed_random(glui32 seed)
+{
+  glui32 k = 1;
+  int i, loop;
+
+  rand_table[54] = seed;
+  rand_index1 = 0;
+  rand_index2 = 31;
+  
+  for (i = 0; i < 55; i++) {
+    int ii = (21 * i) % 55;
+    rand_table[ii] = k;
+    k = seed - k;
+    seed = rand_table[ii];
+  }
+  for (loop = 0; loop < 4; loop++) {
+    for (i = 0; i < 55; i++)
+      rand_table[i] = rand_table[i] - rand_table[ (1 + i + 30) % 55];
+  }
+}
+
+#endif /* COMPILE_RANDOM_CODE */
+
+#include <stdlib.h>
+
+/* I'm putting a wrapper for qsort() here, in case I ever have to
+   worry about a platform without it. But I am not worrying at
+   present. */
+void glulx_sort(void *addr, int count, int size, 
+  int (*comparefunc)(void *p1, void *p2))
+{
+  qsort(addr, count, size, (int (*)(const void *, const void *))comparefunc);
+}
diff --git a/interpreters/glulxe/profile-analyze.py b/interpreters/glulxe/profile-analyze.py
new file mode 100644 (file)
index 0000000..c7f7345
--- /dev/null
@@ -0,0 +1,473 @@
+#!/usr/bin/python
+
+"""
+This script reads in the profile-raw file generated by Glulxe profiling,
+and lists the ten most costly functions. (In terms of how much total time
+was spent inside each function. If a function calls other functions, the
+time spent in them is not charged to the parent; that is, a function
+which does nothing but call other functions will be considered uncostly.)
+
+Optionally, this script can also read the debug output of the Inform 6
+compiler (or the assembly output), and use that to figure out the
+names of all the functions that were profiled.
+
+Using this script is currently a nuisance. The requirements:
+
+- You must compile Glulxe with profiling (the VM_PROFILING compile-time
+  option).
+- (If you want function names) you should compile your Inform 6 source
+  using the -k switch. This generates a "gameinfo.dbg" file.
+- Run Glulxe, play some of the game, and quit. This generates a data
+  file called "profile-raw".
+- Run this script, giving gameinfo.dbg and profile-raw as arguments.
+
+To sum up, in command-line form:
+
+% inform -G -k game.inf
+% glulxe game.ulx
+% python profile-analyze.py profile-raw gameinfo.dbg
+
+You can also use the assembly output of the Inform compiler, which you
+get with the -a switch. Save the output and use it instead of the debug
+file:
+
+% inform -G -a game.inf > game.asm
+% glulxe game.ulx
+% python profile-analyze.py profile-raw game.asm
+
+The limitations:
+
+The profiling code is not smart about VM operations that rearrange the
+call stack. In fact, it's downright stupid. @restart, @restore,
+@restoreundo, or @throw will kill the interpreter.
+
+Inform's -k switch does not work correctly with game files larger than
+16 megabytes.
+
+Inform's -a switch does not display code for veneer functions, so if
+you use that data, these will not be named; they will be listed as
+"<???>". This is a particular nuisance because veneer functions are
+often the most costly ones. (Therefore, you'll almost certainly want
+to use -k.)
+
+You can explore the profiling data in more detail by running the script
+interactively:
+
+% python -i profile-analyze.py profile-raw game.asm
+
+After it runs, you'll be left at a Python prompt. The environment
+will contain mappings called "functions" (mapping addresses to
+function objects), and "function_names" (names to function objects).
+
+>>> functions[0x3c]
+<Function $3c 'Main__'>
+>>> function_names['Main__']
+<Function $3c 'Main__'>
+>>> function_names['Main__'].dump()
+Main__:
+  at $00003c (line 0); called 1 times
+  0.000067 sec (1 ops) spent executing
+  6.273244 sec (117578 ops) including child calls
+
+A Function object has lots of attributes:
+  addr=INT:         The VM address of the function (in hex).
+  hexaddr=STRING:   The VM address of the function in hex (as a string).
+  name=STRING:      The function's name, or '<???>' if the function is
+    not known (veneer functions).
+  linenum=INT:      The line number of the function from the source code,
+    or 0 if it is not derived from source (Main__, etc).
+  call_count=INT:   The number of times the function was called.
+  accel_count=INT:  The number of times the function was called with
+    acceleration.
+  total_time=FLOAT: The amount of time spent during all calls to the
+    function (in seconds, as a floating-point value).
+  total_ops=INT:    The number of opcodes executed during all calls to
+    the function.
+  self_time=FLOAT:  The amount of time spent during all calls to the
+    function, excluding time spent in subcalls (functions called *by* the
+    function).
+  self_ops=INT:     The number of opcodes executed during all calls to
+    the function, excluding time spent in subcalls.
+
+(The self_time is the "cost" used for the original listing.)
+
+Note that if a function does not make any function calls, total_time
+will be the same as self_time (and total_ops the same as self_ops).
+
+Two special function entries may be included. The function with address
+"1" (which is not a legal Glulx function address) represents time spent
+in @glk opcode calls. This will typically have a large self_time, 
+because it includes all the time spent waiting for input.
+
+The function with address "2" represents the time spent printing string
+data (the @streamchar, @streamunichar, @streamnum, and @streamstr
+opcodes).
+
+(Both "1" and "2" represent time spent in the Glk library, but they
+get there by different code paths.)
+
+The function with the lowest address (ignoring "1" and "2") is the
+top-level Main__() function generated by the compiler. Its total_time
+is the running time of the entire program.
+
+"""
+
+import sys, os.path
+import xml.sax
+from struct import unpack
+
+if (len(sys.argv) < 2):
+    print "Usage: profile-analyze.py profile-raw [ gameinfo.dbg | game.asm ]"
+    sys.exit(1)
+
+profile_raw = sys.argv[1]
+if (not os.path.exists(profile_raw)):
+    print 'File not readable:', profile_raw
+    sys.exit(1)
+
+game_asm = None
+if (len(sys.argv) >= 3):
+    game_asm = sys.argv[2]
+    if (not os.path.exists(game_asm)):
+        print 'File not readable:', game_asm
+        sys.exit(1)
+
+special_functions = {
+    1: 'glk', 2: 'streamout'
+}
+max_special_functions = max(special_functions.keys())
+
+functions = None
+sourcemap = None
+
+class Function:
+    def __init__(self, addr, hexaddr, attrs):
+        self.addr = addr
+        self.hexaddr = hexaddr
+        val = special_functions.get(addr)
+        if (val is None):
+            self.name = '<???>'
+            self.special = False
+        else:
+            self.name = '<@' + val + '>'
+            self.special = True
+        self.linenum = 0
+        self.call_count =   int(attrs['call_count'])
+        self.accel_count = 0
+        if (attrs.has_key('accel_count')):
+            self.accel_count = int(attrs['accel_count'])
+        self.total_ops  =   int(attrs['total_ops'])
+        self.total_time = float(attrs['total_time'])
+        self.self_ops   =   int(attrs['self_ops'])
+        self.self_time  = float(attrs['self_time'])
+        
+    def __repr__(self):
+        return '<Function $' + self.hexaddr + ' ' + repr(self.name) + '>'
+
+    def dump(self):
+        print '%s:' % (self.name,)
+        val = ''
+        if (self.accel_count):
+            val = ' (%d accelerated)' % (self.accel_count,)
+        print '  at $%06x (line %d); called %d times%s' % (self.addr, self.linenum,self.call_count,val)
+        print '  %.6f sec (%d ops) spent executing' % (self.self_time, self.self_ops)
+        print '  %.6f sec (%d ops) including child calls' % (self.total_time, self.total_ops)
+
+class ProfileRawHandler(xml.sax.handler.ContentHandler):
+    def startElement(self, name, attrs):
+        global functions
+        
+        if (name == 'profile'):
+            functions = {}
+        if (name == 'function'):
+            hexaddr = attrs.get('addr')
+            addr = int(hexaddr, 16)
+            func = Function(addr, hexaddr, attrs)
+            functions[addr] = func
+
+def parse_asm(fl):
+    global sourcemap
+    sourcemap = {}
+    
+    lasttup = None
+    while True:
+        ln = fl.readline()
+        if (not ln):
+            break
+        ln = ln.strip()
+        ls = ln.split()
+        if (lasttup and not ls):
+            (linenum, funcname, addr) = lasttup
+            sourcemap[addr] = (linenum, funcname)
+        lasttup = None
+        try:
+            if (len(ls) >= 4 and ls[2] == '[' and ls[1].startswith('+')):
+                linenum = int(ls[0])
+                funcname = ls[3]
+                addr = int(ls[1][1:], 16)
+                lasttup = (linenum, funcname, addr)
+        except ValueError:
+            pass
+
+class InformFunc:
+    def __init__(self, funcnum):
+        self.funcnum = funcnum
+        self.name = '<???>'
+        self.addr = 0
+        self.linenum = None
+        self.endaddr = None
+        self.endlinenum = None
+        self.locals = None
+        self.seqpts = None
+    def __repr__(self):
+        return '<InformFunc $' + hex(self.addr)[2:] + ' ' + repr(self.name) + '>'
+            
+class DebugFile:
+    def __init__(self, fl):
+        self.files = {}
+        self.functions = {}
+        self.function_names = {}
+        self.classes = []
+        self.objects = {}
+        self.arrays = {}
+        self.globals = {}
+        self.properties = {}
+        self.attributes = {}
+        self.actions = {}
+        self.fake_actions = {}
+        self.map = {}
+        self.header = None
+        
+        dat = fl.read(2)
+        val = unpack('>H', dat)[0]
+        if (val != 0xDEBF):
+            raise ValueError('not an Inform debug file')
+            
+        dat = fl.read(2)
+        self.debugversion = unpack('>H', dat)[0]
+        dat = fl.read(2)
+        self.informversion = unpack('>H', dat)[0]
+
+        rectable = {
+            1:  self.read_file_rec,
+            2:  self.read_class_rec,
+            3:  self.read_object_rec,
+            4:  self.read_global_rec,
+            5:  self.read_attr_rec,
+            6:  self.read_prop_rec,
+            7:  self.read_fake_action_rec,
+            8:  self.read_action_rec,
+            9:  self.read_header_rec,
+            10: self.read_lineref_rec,
+            11: self.read_routine_rec,
+            12: self.read_array_rec,
+            13: self.read_map_rec,
+            14: self.read_routine_end_rec,
+        }
+
+        while True:
+            dat = fl.read(1)
+            rectype = unpack('>B', dat)[0]
+            if (rectype == 0):
+                break
+            recfunc = rectable.get(rectype)
+            if (not recfunc):
+                raise ValueError('unknown debug record type: %d' % (rectype,))
+            recfunc(fl)
+
+        for func in self.functions.values():
+            self.function_names[func.name] = func
+
+    def read_file_rec(self, fl):
+        dat = fl.read(1)
+        filenum = unpack('>B', dat)[0]
+        includename = self.read_string(fl)
+        realname = self.read_string(fl)
+        self.files[filenum] = ( includename, realname )
+        
+    def read_class_rec(self, fl):
+        name = self.read_string(fl)
+        start = self.read_linenum(fl)
+        end = self.read_linenum(fl)
+        self.classes.append( (name, start, end) )
+        
+    def read_object_rec(self, fl):
+        dat = fl.read(2)
+        num = unpack('>H', dat)[0]
+        name = self.read_string(fl)
+        start = self.read_linenum(fl)
+        end = self.read_linenum(fl)
+        self.objects[num] = (name, start, end)
+    
+    def read_global_rec(self, fl):
+        dat = fl.read(1)
+        num = unpack('>B', dat)[0]
+        name = self.read_string(fl)
+        self.arrays[num] = name
+    
+    def read_array_rec(self, fl):
+        dat = fl.read(2)
+        num = unpack('>H', dat)[0]
+        name = self.read_string(fl)
+        self.arrays[num] = name
+    
+    def read_attr_rec(self, fl):
+        dat = fl.read(2)
+        num = unpack('>H', dat)[0]
+        name = self.read_string(fl)
+        self.attributes[num] = name
+    
+    def read_prop_rec(self, fl):
+        dat = fl.read(2)
+        num = unpack('>H', dat)[0]
+        name = self.read_string(fl)
+        self.properties[num] = name
+    
+    def read_action_rec(self, fl):
+        dat = fl.read(2)
+        num = unpack('>H', dat)[0]
+        name = self.read_string(fl)
+        self.actions[num] = name
+    
+    def read_fake_action_rec(self, fl):
+        dat = fl.read(2)
+        num = unpack('>H', dat)[0]
+        name = self.read_string(fl)
+        self.fake_actions[num] = name
+    
+    def read_routine_rec(self, fl):
+        dat = fl.read(2)
+        funcnum = unpack('>H', dat)[0]
+        func = self.get_function(funcnum)
+        
+        func.linenum = self.read_linenum(fl)
+        dat = fl.read(3)
+        addr = unpack('>I', '\0'+dat)[0]
+        func.addr = int(addr)
+        func.name = self.read_string(fl)
+        locals = []
+        while True:
+            val = self.read_string(fl)
+            if (not val):
+                break
+            locals.append(val)
+        func.locals = locals
+
+    def read_lineref_rec(self, fl):
+        dat = fl.read(2)
+        funcnum = unpack('>H', dat)[0]
+        func = self.get_function(funcnum)
+
+        if (not func.seqpts):
+            func.seqpts = []
+        
+        dat = fl.read(2)
+        count = unpack('>H', dat)[0]
+        for ix in range(count):
+            linenum = self.read_linenum(fl)
+            dat = fl.read(2)
+            addr = unpack('>H', dat)[0]
+            func.seqpts.append( (linenum, addr) )
+        
+    def read_routine_end_rec(self, fl):
+        dat = fl.read(2)
+        funcnum = unpack('>H', dat)[0]
+        func = self.get_function(funcnum)
+
+        func.endlinenum = self.read_linenum(fl)
+        dat = fl.read(3)
+        addr = unpack('>I', '\0'+dat)[0]
+        func.endaddr = int(addr)
+
+    def read_header_rec(self, fl):
+        dat = fl.read(64)
+        self.header = dat
+    
+    def read_map_rec(self, fl):
+        while True:
+            name = self.read_string(fl)
+            if (not name):
+                break
+            dat = fl.read(3)
+            addr = unpack('>I', '\0'+dat)[0]
+            addr = int(addr)
+            self.map[name] = addr
+    
+    def read_linenum(self, fl):
+        dat = fl.read(4)
+        (funcnum, linenum, charnum) = unpack('>BHB', dat)
+        return (funcnum, linenum, charnum)
+
+    def read_string(self, fl):
+        val = ''
+        while True:
+            dat = fl.read(1)
+            if (dat == '\0'):
+                return val
+            val += dat
+
+    def get_function(self, funcnum):
+        func = self.functions.get(funcnum)
+        if (not func):
+            func = InformFunc(funcnum)
+            self.functions[funcnum] = func
+        return func
+                        
+# Begin the work
+            
+xml.sax.parse(profile_raw, ProfileRawHandler())
+
+source_start = min([ func.addr for func in functions.values()
+    if not func.special ])
+print 'Code segment begins at', hex(source_start)
+
+print len(functions), 'called functions found in', profile_raw
+
+if (game_asm):
+    fl = open(game_asm, 'rb')
+    val = fl.read(2)
+    fl.close()
+    if (val == '\xde\xbf'):
+        fl = open(game_asm, 'rb')
+        debugfile = DebugFile(fl)
+        fl.close()
+        sourcemap = {}
+        for func in debugfile.functions.values():
+            sourcemap[func.addr] = ( func.linenum[1], func.name)
+    else:
+        fl = open(game_asm, 'rU')
+        parse_asm(fl)
+        fl.close()
+
+if (sourcemap):
+    badls = []
+
+    for (addr, func) in functions.items():
+        if (func.special):
+            continue
+        tup = sourcemap.get(addr-source_start)
+        if (not tup):
+            badls.append(addr)
+            continue
+        (linenum, funcname) = tup
+        func.name = funcname
+        func.linenum = linenum
+    
+    if (badls):
+        print len(badls), 'functions from', profile_raw, 'did not appear in asm (veneer functions)'
+    
+    function_names = {}
+    for func in functions.values():
+        function_names[func.name] = func
+
+if (sourcemap):
+    uncalled_funcs = [ funcname for (addr, (linenum, funcname)) in sourcemap.items() if (addr+source_start) not in functions ]
+    print len(uncalled_funcs), 'functions found in', game_asm, 'were never called'
+
+print 'Functions that consumed the most time (excluding children):'
+ls = functions.values()
+ls.sort(lambda x1, x2: cmp(x2.self_time, x1.self_time))
+for func in ls[:10]:
+    func.dump()
+
diff --git a/interpreters/glulxe/profile.c b/interpreters/glulxe/profile.c
new file mode 100644 (file)
index 0000000..e7a0810
--- /dev/null
@@ -0,0 +1,309 @@
+/* profile.c: Glulxe profiling functions.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+/* 
+If compiled in, these functions maintain a collection of profiling
+information as the Glulx program executes.
+
+The profiling code is not smart about VM operations that rearrange the
+call stack. In fact, it's downright stupid. @restart, @restore,
+@restoreundo, or @throw will kill the interpreter.
+
+On a normal VM exit (end of top-level routine or @quit), the profiler
+writes out a data file called "profile-raw". This is an XML file of
+the form
+
+<profile>
+  <function ... />
+  <function ... />
+  ...
+</profile>
+
+The function list includes every function which was called during the
+program's run. Each function tag includes the following attributes:
+  addr=HEX:         The VM address of the function (in hex).
+  call_count=INT:   The number of times the function was called.
+  accel_count=INT:  The number of times the function was called with
+    acceleration.
+  total_time=FLOAT: The amount of time spent during all calls to the
+    function (in seconds, as a floating-point value).
+  total_ops=INT:    The number of opcodes executed during all calls to
+    the function.
+  self_time=FLOAT:  The amount of time spent during all calls to the
+    function, excluding time spent in subcalls (functions called *by* the
+    function).
+  self_ops=INT:     The number of opcodes executed during all calls to
+    the function, excluding time spent in subcalls.
+
+Note that if a function does not make any function calls, total_time
+will be the same as self_time (and total_ops the same as self_ops).
+
+Two special function entries may be included. The function with address
+"1" (which is not a legal Glulx function address) represents time spent
+in @glk opcode calls. This will typically have a large self_time, 
+because it includes all the time spent waiting for input.
+
+The function with address "2" represents the time spent printing string
+data (the @streamchar, @streamunichar, @streamnum, and @streamstr
+opcodes).
+
+(Both "1" and "2" represent time spent in the Glk library, but they
+get there by different code paths.)
+
+The function with the lowest address (ignoring "1" and "2") is the
+top-level Main__() function generated by the compiler. Its total_time
+is the running time of the entire program.
+
+ */
+
+#include "glk.h"
+#include "glulxe.h"
+
+#if VM_PROFILING
+
+#include <stdio.h>
+#include <string.h>
+#include <sys/time.h>
+
+typedef struct function_struct {
+  glui32 addr;
+
+  glui32 call_count;
+  glui32 accel_count;
+  glui32 entry_depth;
+  struct timeval entry_start_time;
+  glui32 entry_start_op;
+  struct timeval total_time;
+  glui32 total_ops;
+  struct timeval self_time;
+  glui32 self_ops;
+
+  struct function_struct *hash_next;
+} function_t;
+
+typedef struct frame_struct {
+  struct frame_struct *parent;
+  function_t *func;
+
+  struct timeval entry_time;
+  glui32 entry_op;
+
+  struct timeval children_time;
+  glui32 children_ops;
+} frame_t;
+
+#define FUNC_HASH_SIZE (511)
+
+static function_t **functions = NULL;
+static frame_t *current_frame = NULL;
+
+glui32 profile_opcount = 0;
+
+int init_profile()
+{
+  int bucknum;
+
+  functions = (function_t **)glulx_malloc(FUNC_HASH_SIZE
+    * sizeof(function_t *));
+  if (!functions) 
+    return FALSE;
+
+  for (bucknum=0; bucknum<FUNC_HASH_SIZE; bucknum++) 
+    functions[bucknum] = NULL;
+
+  return TRUE;
+}
+
+static function_t *get_function(glui32 addr)
+{
+  int bucknum = (addr % FUNC_HASH_SIZE);
+  function_t *func;
+
+  for (func = (functions[bucknum]); 
+       func && func->addr != addr;
+       func = func->hash_next) { }
+
+  if (!func) {
+    func = (function_t *)glulx_malloc(sizeof(function_t));
+    if (!func)
+      fatal_error("Profiler: cannot malloc function.");
+    memset(func, 0, sizeof(function_t));
+    func->hash_next = functions[bucknum];
+    functions[bucknum] = func;
+
+    func->addr = addr;
+    func->call_count = 0;
+    func->accel_count = 0;
+    timerclear(&func->entry_start_time);
+    func->entry_start_op = 0;
+    timerclear(&func->total_time);
+    func->total_ops = 0;
+    timerclear(&func->self_time);
+    func->self_ops = 0;
+  }
+
+  return func;
+}
+
+static char *timeprint(struct timeval *tv, char *buf)
+{
+  sprintf(buf, "%ld.%.6ld", (long)tv->tv_sec, (long)tv->tv_usec);
+  return buf;
+}
+
+void profile_in(glui32 addr, int accel)
+{
+  frame_t *fra;
+  function_t *func;
+  struct timeval now;
+
+  /* printf("### IN: %lx%s\n", addr, (accel?" accel":"")); */
+
+  gettimeofday(&now, NULL);
+
+  func = get_function(addr);
+  func->call_count += 1;
+  if (accel)
+    func->accel_count += 1;
+  if (!func->entry_depth) {
+    func->entry_start_time = now;
+    func->entry_start_op = profile_opcount;
+  }
+  func->entry_depth += 1;
+
+  fra = (frame_t *)glulx_malloc(sizeof(frame_t));
+  if (!fra)
+    fatal_error("Profiler: cannot malloc frame.");
+  memset(fra, 0, sizeof(frame_t));
+
+  fra->parent = current_frame;
+  current_frame = fra;
+
+  fra->func = func;
+  fra->entry_time = now;
+  fra->entry_op = profile_opcount;
+  timerclear(&fra->children_time);
+  fra->children_ops = 0;
+}
+
+void profile_out()
+{
+  frame_t *fra;
+  function_t *func;
+  struct timeval now, runtime;
+  glui32 runops;
+
+  /* printf("### OUT\n"); */
+
+  if (!current_frame) 
+    fatal_error("Profiler: stack underflow.");
+
+  gettimeofday(&now, NULL);
+
+  fra = current_frame;
+  func = fra->func;
+
+  timersub(&now, &fra->entry_time, &runtime);
+  runops = profile_opcount - fra->entry_op;
+
+  timeradd(&runtime, &func->self_time, &func->self_time);
+  timersub(&func->self_time, &fra->children_time, &func->self_time);
+  func->self_ops += runops;
+  func->self_ops -= fra->children_ops;
+
+  if (fra->parent) {
+    timeradd(&runtime, &fra->parent->children_time, &fra->parent->children_time);
+    fra->parent->children_ops += runops;
+  }
+
+  if (!func->entry_depth) 
+    fatal_error("Profiler: function entry underflow.");
+  
+  func->entry_depth -= 1;
+  if (!func->entry_depth) {
+    timersub(&now, &func->entry_start_time, &runtime);
+    timerclear(&func->entry_start_time);
+
+    runops = profile_opcount - func->entry_start_op;
+    func->entry_start_op = 0;
+
+    timeradd(&runtime, &func->total_time, &func->total_time);
+    func->total_ops += runops;
+  }
+
+  current_frame = fra->parent;
+  fra->parent = NULL;
+
+  glulx_free(fra);
+}
+
+/* ### throw/catch */
+/* ### restore/restore_undo/restart */
+
+void profile_fail(char *reason)
+{
+  fatal_error_2("Profiler: unable to handle operation", reason);
+}
+
+void profile_quit()
+{
+  int bucknum;
+  function_t *func;
+  char linebuf[512];
+  frefid_t profref;
+  strid_t profstr;
+
+  while (current_frame) {
+    profile_out();
+  }
+
+  profref = glk_fileref_create_by_name(fileusage_BinaryMode|fileusage_Data, "profile-raw", 0);
+  if (!profref)
+    fatal_error("Profiler: unable to create profile-raw file");
+
+  profstr = glk_stream_open_file(profref, filemode_Write, 0);
+
+  glk_put_string_stream(profstr, "<profile>\n");
+
+  for (bucknum=0; bucknum<FUNC_HASH_SIZE; bucknum++) {
+    char total_buf[20], self_buf[20];
+
+    for (func = functions[bucknum]; func; func=func->hash_next) {
+      /* ###
+      sprintf(linebuf, "function %lx called %ld times, total ops %ld, total time %s, self ops %ld,  self time %s\n",
+        func->addr, func->call_count,
+        func->total_ops,
+        timeprint(&func->total_time, total_buf),
+        func->self_ops,
+        timeprint(&func->self_time, self_buf));
+      ### */
+      sprintf(linebuf, "  <function addr=\"%lx\" call_count=\"%ld\" accel_count=\"%ld\" total_ops=\"%ld\" total_time=\"%s\" self_ops=\"%ld\" self_time=\"%s\" />\n",
+        func->addr, func->call_count, func->accel_count,
+        func->total_ops,
+        timeprint(&func->total_time, total_buf),
+        func->self_ops,
+        timeprint(&func->self_time, self_buf));
+      glk_put_string_stream(profstr, linebuf);
+    }
+  }
+
+  glk_put_string_stream(profstr, "</profile>\n");
+
+  glk_stream_close(profstr, NULL);
+
+  glulx_free(functions);
+  functions = NULL;
+}
+
+#else /* VM_PROFILING */
+
+int init_profile()
+{
+    /* Profiling is not compiled in. Do nothing. */
+    return TRUE;
+}
+
+#endif /* VM_PROFILING */
diff --git a/interpreters/glulxe/search.c b/interpreters/glulxe/search.c
new file mode 100644 (file)
index 0000000..26bf480
--- /dev/null
@@ -0,0 +1,267 @@
+/* search.c: Glulxe code for built-in search opcodes
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+#include "opcodes.h"
+
+#define serop_KeyIndirect (0x01)
+#define serop_ZeroKeyTerminates (0x02)
+#define serop_ReturnIndex (0x04)
+/* ### KeyZeroBounded? variants? */
+/* ### LowerBoundKey? */
+
+/* In general, these search functions look through a bunch of structures
+   in memory, searching for one whose key (a fixed-size sequence of bytes
+   within the structure) matches a given key. The result can indicate a
+   particular structure within the bunch, or it can be NULL ("not found".)
+
+   Any or all of these options can be applied:
+
+   KeyIndirect: If this is true, the key argument is taken to be the
+   start of an array of bytes in memory (whose length is keysize).
+   If it is false, the key argument contains the key itself. In
+   this case, keysize *must* be 1, 2, or 4. The key is stored in the
+   lower bytes of the key argument, big-endian. (The upper bytes are
+   ignored.)
+
+   ZeroKeyTerminates: If this is true, when the search reaches a struct
+   whose key is all zeroes, the search terminates (and returns NULL).
+   If the searched-for key happens to also be zeroes, the key-match
+   (returning the struct) takes precedence over the zero-match (returning
+   NULL.)
+
+   ReturnIndex: If this is false, the return value is the memory address
+   of the matching struct, or 0 to indicate NULL. If true, the return value
+   is the array index of the matching struct, or -1 to indicate NULL. 
+*/
+
+static void fetchkey(unsigned char *keybuf, glui32 key, glui32 keysize, 
+  glui32 options);
+
+/* linear_search():
+   An array of data structures is stored in memory, beginning at start,
+   each structure being structsize bytes. Within each struct, there is
+   a key value keysize bytes long, starting at position keyoffset (from
+   the start of the structure.) Search through these in order. If one
+   is found whose key matches, return it. If numstructs are searched
+   with no result, return NULL.
+   
+   numstructs may be -1 (0xFFFFFFFF) to indicate no upper limit to the
+   number of structures to search. The search will continue until a match
+   is found, or (if ZeroKeyTerminates is set) a zero key.
+
+   The KeyIndirect, ZeroKeyTerminates, and ReturnIndex options may be
+   used.
+*/
+glui32 linear_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options)
+{
+  unsigned char keybuf[4];
+  glui32 count;
+  int ix;
+  int retindex = ((options & serop_ReturnIndex) != 0);
+  int zeroterm = ((options & serop_ZeroKeyTerminates) != 0);
+
+  fetchkey(keybuf, key, keysize, options);
+
+  for (count=0; count<numstructs; count++, start+=structsize) {
+    int match = TRUE;
+    if (keysize <= 4) {
+      for (ix=0; match && ix<keysize; ix++) {
+        if (Mem1(start + keyoffset + ix) != keybuf[ix])
+          match = FALSE;
+      }
+    }
+    else {
+      for (ix=0; match && ix<keysize; ix++) {
+        if (Mem1(start + keyoffset + ix) != Mem1(key + ix))
+          match = FALSE;
+      }
+    }
+
+    if (match) {
+      if (retindex)
+        return count;
+      else
+        return start;
+    }
+
+    if (zeroterm) {
+      match = TRUE;
+      for (ix=0; match && ix<keysize; ix++) {
+        if (Mem1(start + keyoffset + ix) != 0)
+          match = FALSE;
+      }
+      if (match) {
+        break;
+      }
+    }
+  }
+  
+  if (retindex)
+    return -1;
+  else
+    return 0;
+}
+
+/* binary_search():
+   An array of data structures is in memory, as above. However, the
+   structs must be stored in forward order of their keys (taking each key
+   to be a multibyte unsigned integer.) There can be no duplicate keys. 
+   numstructs must indicate the exact length of the array; it cannot
+   be -1.
+
+   The KeyIndirect and ReturnIndex options may be used.
+*/
+glui32 binary_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 structsize, glui32 numstructs, 
+  glui32 keyoffset, glui32 options)
+{
+  unsigned char keybuf[4];
+  unsigned char byte, byte2;
+  glui32 top, bot, val, addr;
+  int ix;
+  int retindex = ((options & serop_ReturnIndex) != 0);
+
+  fetchkey(keybuf, key, keysize, options);
+  
+  bot = 0;
+  top = numstructs;
+  while (bot < top) {
+    int cmp = 0;
+    val = (top+bot) / 2;
+    addr = start + val * structsize;
+
+    if (keysize <= 4) {
+      for (ix=0; (!cmp) && ix<keysize; ix++) {
+        byte = Mem1(addr + keyoffset + ix);
+        byte2 = keybuf[ix];
+        if (byte < byte2)
+          cmp = -1;
+        else if (byte > byte2)
+          cmp = 1;
+      }
+    }
+    else {
+      for (ix=0; (!cmp) && ix<keysize; ix++) {
+        byte = Mem1(addr + keyoffset + ix);
+        byte2 = Mem1(key + ix);
+        if (byte < byte2)
+          cmp = -1;
+        else if (byte > byte2)
+          cmp = 1;
+      }
+    }
+
+    if (!cmp) {
+      if (retindex)
+        return val;
+      else
+        return addr;
+    }
+
+    if (cmp < 0) {
+      bot = val+1;
+    }
+    else {
+      top = val;
+    }
+  }
+
+  if (retindex)
+    return -1;
+  else
+    return 0;
+}
+
+/* linked_search():
+   The structures may be anywhere in memory, in any order. They are
+   linked by a four-byte address field, which is found in each struct
+   at position nextoffset. If this field contains zero, it indicates
+   the end of the linked list.
+
+   The KeyIndirect and ZeroKeyTerminates options may be used.
+*/
+glui32 linked_search(glui32 key, glui32 keysize, 
+  glui32 start, glui32 keyoffset, glui32 nextoffset, glui32 options)
+{
+  unsigned char keybuf[4];
+  int ix;
+  glui32 val;
+  int zeroterm = ((options & serop_ZeroKeyTerminates) != 0);
+
+  fetchkey(keybuf, key, keysize, options);
+
+  while (start != 0) {
+    int match = TRUE;
+    if (keysize <= 4) {
+      for (ix=0; match && ix<keysize; ix++) {
+        if (Mem1(start + keyoffset + ix) != keybuf[ix])
+          match = FALSE;
+      }
+    }
+    else {
+      for (ix=0; match && ix<keysize; ix++) {
+        if (Mem1(start + keyoffset + ix) != Mem1(key + ix))
+          match = FALSE;
+      }
+    }
+
+    if (match) {
+      return start;
+    }
+
+    if (zeroterm) {
+      match = TRUE;
+      for (ix=0; match && ix<keysize; ix++) {
+        if (Mem1(start + keyoffset + ix) != 0)
+          match = FALSE;
+      }
+      if (match) {
+        break;
+      }
+    }
+    
+    val = start + nextoffset;
+    start = Mem4(val);
+  }
+
+  return 0;
+}
+
+/* fetchkey():
+   This massages the key into a form that's easier to handle. When it
+   returns, the key will be stored in keybuf if keysize <= 4; otherwise,
+   it will be in memory.
+*/
+static void fetchkey(unsigned char *keybuf, glui32 key, glui32 keysize, 
+  glui32 options)
+{
+  int ix;
+
+  if (options & serop_KeyIndirect) {
+    if (keysize <= 4) {
+      for (ix=0; ix<keysize; ix++)
+        keybuf[ix] = Mem1(key+ix);
+    }
+  }
+  else {
+    switch (keysize) {
+    case 4:
+      Write4(keybuf, key);
+      break;
+    case 2:
+      Write2(keybuf, key);
+      break;
+    case 1:
+      Write1(keybuf, key);
+      break;
+    default:
+      fatal_error("Direct search key must hold one, two, or four bytes.");
+    }
+  }
+}
diff --git a/interpreters/glulxe/serial.c b/interpreters/glulxe/serial.c
new file mode 100644 (file)
index 0000000..f7da9ec
--- /dev/null
@@ -0,0 +1,1147 @@
+/* serial.c: Glulxe code for saving and restoring the VM state.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include <string.h>
+#include "glk.h"
+#include "glulxe.h"
+
+/* This structure allows us to write either to a Glk stream or to
+   a dynamically-allocated memory chunk. */
+typedef struct dest_struct {
+  int ismem;
+  
+  /* If it's a Glk stream: */
+  strid_t str;
+
+  /* If it's a block of memory: */
+  unsigned char *ptr;
+  glui32 pos;
+  glui32 size;
+} dest_t;
+
+#define IFFID(c1, c2, c3, c4)  \
+  ( (((glui32)c1) << 24)    \
+  | (((glui32)c2) << 16)    \
+  | (((glui32)c3) << 8)     \
+  | (((glui32)c4)) )
+
+/* This can be adjusted before startup by platform-specific startup
+   code -- that is, preference code. */
+int max_undo_level = 8;
+
+static int undo_chain_size = 0;
+static int undo_chain_num = 0;
+unsigned char **undo_chain = NULL;
+
+static glui32 protect_pos = 0;
+static glui32 protect_len = 0;
+
+static glui32 write_memstate(dest_t *dest);
+static glui32 write_heapstate(dest_t *dest, int portable);
+static glui32 write_stackstate(dest_t *dest, int portable);
+static glui32 read_memstate(dest_t *dest, glui32 chunklen);
+static glui32 read_heapstate(dest_t *dest, glui32 chunklen, int portable,
+  glui32 *sumlen, glui32 **summary);
+static glui32 read_stackstate(dest_t *dest, glui32 chunklen, int portable);
+static glui32 write_heapstate_sub(glui32 sumlen, glui32 *sumarray,
+  dest_t *dest, int portable);
+static int sort_heap_summary(void *p1, void *p2);
+static int write_long(dest_t *dest, glui32 val);
+static int read_long(dest_t *dest, glui32 *val);
+static int write_byte(dest_t *dest, unsigned char val);
+static int read_byte(dest_t *dest, unsigned char *val);
+static int reposition_write(dest_t *dest, glui32 pos);
+
+/* init_serial():
+   Set up the undo chain and anything else that needs to be set up.
+*/
+int init_serial()
+{
+  undo_chain_num = 0;
+  undo_chain_size = max_undo_level;
+  undo_chain = (unsigned char **)glulx_malloc(sizeof(unsigned char *) * undo_chain_size);
+  if (!undo_chain)
+    return FALSE;
+
+  return TRUE;
+}
+
+/* perform_saveundo():
+   Add a state pointer to the undo chain. This returns 0 on success,
+   1 on failure.
+*/
+glui32 perform_saveundo()
+{
+  dest_t dest;
+  glui32 res;
+  glui32 memstart, memlen, heapstart, heaplen, stackstart, stacklen;
+
+  /* The format for undo-saves is simpler than for saves on disk. We
+     just have a memory chunk, a heap chunk, and a stack chunk, in
+     that order. We skip the IFF chunk headers (although the size
+     fields are still there.) We also don't bother with IFF's 16-bit
+     alignment. */
+
+  if (undo_chain_size == 0)
+    return 1;
+
+  dest.ismem = TRUE;
+  dest.size = 0;
+  dest.pos = 0;
+  dest.ptr = NULL;
+  dest.str = NULL;
+
+  res = 0;
+  if (res == 0) {
+    res = write_long(&dest, 0); /* space for chunk length */
+  }
+  if (res == 0) {
+    memstart = dest.pos;
+    res = write_memstate(&dest);
+    memlen = dest.pos - memstart;
+  }
+  if (res == 0) {
+    res = write_long(&dest, 0); /* space for chunk length */
+  }
+  if (res == 0) {
+    heapstart = dest.pos;
+    res = write_heapstate(&dest, FALSE);
+    heaplen = dest.pos - heapstart;
+  }
+  if (res == 0) {
+    res = write_long(&dest, 0); /* space for chunk length */
+  }
+  if (res == 0) {
+    stackstart = dest.pos;
+    res = write_stackstate(&dest, FALSE);
+    stacklen = dest.pos - stackstart;
+  }
+
+  if (res == 0) {
+    /* Trim it down to the perfect size. */
+    dest.ptr = glulx_realloc(dest.ptr, dest.pos);
+    if (!dest.ptr)
+      res = 1;
+  }
+  if (res == 0) {
+    res = reposition_write(&dest, memstart-4);
+  }
+  if (res == 0) {
+    res = write_long(&dest, memlen);
+  }
+  if (res == 0) {
+    res = reposition_write(&dest, heapstart-4);
+  }
+  if (res == 0) {
+    res = write_long(&dest, heaplen);
+  }
+  if (res == 0) {
+    res = reposition_write(&dest, stackstart-4);
+  }
+  if (res == 0) {
+    res = write_long(&dest, stacklen);
+  }
+
+  if (res == 0) {
+    /* It worked. */
+    if (undo_chain_num >= undo_chain_size) {
+      glulx_free(undo_chain[undo_chain_num-1]);
+      undo_chain[undo_chain_num-1] = NULL;
+    }
+    if (undo_chain_size > 1)
+      memmove(undo_chain+1, undo_chain, 
+        (undo_chain_size-1) * sizeof(unsigned char *));
+    undo_chain[0] = dest.ptr;
+    if (undo_chain_num < undo_chain_size)
+      undo_chain_num += 1;
+    dest.ptr = NULL;
+  }
+  else {
+    /* It didn't work. */
+    if (dest.ptr) {
+      glulx_free(dest.ptr);
+      dest.ptr = NULL;
+    }
+  }
+    
+  return res;
+}
+
+/* perform_restoreundo():
+   Pull a state pointer from the undo chain. This returns 0 on success,
+   1 on failure. Note that if it succeeds, the frameptr, localsbase,
+   and valstackbase registers are invalid; they must be rebuilt from
+   the stack.
+*/
+glui32 perform_restoreundo()
+{
+  dest_t dest;
+  glui32 res, val;
+  glui32 heapsumlen = 0;
+  glui32 *heapsumarr = NULL;
+
+  if (undo_chain_size == 0 || undo_chain_num == 0)
+    return 1;
+
+  dest.ismem = TRUE;
+  dest.size = 0;
+  dest.pos = 0;
+  dest.ptr = undo_chain[0];
+  dest.str = NULL;
+
+  res = 0;
+  if (res == 0) {
+    res = read_long(&dest, &val);
+  }
+  if (res == 0) {
+    res = read_memstate(&dest, val);
+  }
+  if (res == 0) {
+    res = read_long(&dest, &val);
+  }
+  if (res == 0) {
+    res = read_heapstate(&dest, val, FALSE, &heapsumlen, &heapsumarr);
+  }
+  if (res == 0) {
+    res = read_long(&dest, &val);
+  }
+  if (res == 0) {
+    res = read_stackstate(&dest, val, FALSE);
+  }
+  /* ### really, many of the failure modes of those calls ought to
+     cause fatal errors. The stack or main memory may be damaged now. */
+
+  if (res == 0) {
+    if (heapsumarr)
+      res = heap_apply_summary(heapsumlen, heapsumarr);
+  }
+
+  if (res == 0) {
+    /* It worked. */
+    if (undo_chain_size > 1)
+      memmove(undo_chain, undo_chain+1,
+        (undo_chain_size-1) * sizeof(unsigned char *));
+    undo_chain_num -= 1;
+    glulx_free(dest.ptr);
+    dest.ptr = NULL;
+  }
+  else {
+    /* It didn't work. */
+    dest.ptr = NULL;
+  }
+
+  return res;
+}
+
+/* perform_save():
+   Write the state to the output stream. This returns 0 on success,
+   1 on failure.
+*/
+glui32 perform_save(strid_t str)
+{
+  dest_t dest;
+  int ix;
+  glui32 res, lx, val;
+  glui32 memstart, memlen, stackstart, stacklen, heapstart, heaplen;
+  glui32 filestart, filelen;
+
+  stream_get_iosys(&val, &lx);
+  if (val != 2) {
+    /* Not using the Glk I/O system, so bail. This function only
+       knows how to write to a Glk stream. */
+    fatal_error("Streams are only available in Glk I/O system.");
+  }
+
+  if (str == 0)
+    return 1;
+
+  dest.ismem = FALSE;
+  dest.size = 0;
+  dest.pos = 0;
+  dest.ptr = NULL;
+  dest.str = str;
+
+  res = 0;
+
+  /* Quetzal header. */
+  if (res == 0) {
+    res = write_long(&dest, IFFID('F', 'O', 'R', 'M'));
+  }
+  if (res == 0) {
+    res = write_long(&dest, 0); /* space for file length */
+    filestart = dest.pos;
+  }
+
+  if (res == 0) {
+    res = write_long(&dest, IFFID('I', 'F', 'Z', 'S')); /* ### ? */
+  }
+
+  /* Header chunk. This is the first 128 bytes of memory. */
+  if (res == 0) {
+    res = write_long(&dest, IFFID('I', 'F', 'h', 'd'));
+  }
+  if (res == 0) {
+    res = write_long(&dest, 128);
+  }
+  for (ix=0; res==0 && ix<128; ix++) {
+    res = write_byte(&dest, Mem1(ix));
+  }
+  /* Always even, so no padding necessary. */
+  
+  /* Memory chunk. */
+  if (res == 0) {
+    res = write_long(&dest, IFFID('C', 'M', 'e', 'm'));
+  }
+  if (res == 0) {
+    res = write_long(&dest, 0); /* space for chunk length */
+  }
+  if (res == 0) {
+    memstart = dest.pos;
+    res = write_memstate(&dest);
+    memlen = dest.pos - memstart;
+  }
+  if (res == 0 && (memlen & 1) != 0) {
+    res = write_byte(&dest, 0);
+  }
+
+  /* Heap chunk. */
+  if (res == 0) {
+    res = write_long(&dest, IFFID('M', 'A', 'l', 'l'));
+  }
+  if (res == 0) {
+    res = write_long(&dest, 0); /* space for chunk length */
+  }
+  if (res == 0) {
+    heapstart = dest.pos;
+    res = write_heapstate(&dest, TRUE);
+    heaplen = dest.pos - heapstart;
+  }
+  /* Always even, so no padding necessary. */
+
+  /* Stack chunk. */
+  if (res == 0) {
+    res = write_long(&dest, IFFID('S', 't', 'k', 's'));
+  }
+  if (res == 0) {
+    res = write_long(&dest, 0); /* space for chunk length */
+  }
+  if (res == 0) {
+    stackstart = dest.pos;
+    res = write_stackstate(&dest, TRUE);
+    stacklen = dest.pos - stackstart;
+  }
+  if (res == 0 && (stacklen & 1) != 0) {
+    res = write_byte(&dest, 0);
+  }
+
+  filelen = dest.pos - filestart;
+
+  /* Okay, fill in all the lengths. */
+  if (res == 0) {
+    res = reposition_write(&dest, memstart-4);
+  }
+  if (res == 0) {
+    res = write_long(&dest, memlen);
+  }
+  if (res == 0) {
+    res = reposition_write(&dest, heapstart-4);
+  }
+  if (res == 0) {
+    res = write_long(&dest, heaplen);
+  }
+  if (res == 0) {
+    res = reposition_write(&dest, stackstart-4);
+  }
+  if (res == 0) {
+    res = write_long(&dest, stacklen);
+  }
+  if (res == 0) {
+    res = reposition_write(&dest, filestart-4);
+  }
+  if (res == 0) {
+    res = write_long(&dest, filelen);
+  }
+
+  /* All done. */
+    
+  return res;
+}
+
+/* perform_restore():
+   Pull a state pointer from a stream. This returns 0 on success,
+   1 on failure. Note that if it succeeds, the frameptr, localsbase,
+   and valstackbase registers are invalid; they must be rebuilt from
+   the stack.
+*/
+glui32 perform_restore(strid_t str)
+{
+  dest_t dest;
+  int ix;
+  glui32 lx, res, val;
+  glui32 filestart, filelen;
+  glui32 heapsumlen = 0;
+  glui32 *heapsumarr = NULL;
+
+  stream_get_iosys(&val, &lx);
+  if (val != 2) {
+    /* Not using the Glk I/O system, so bail. This function only
+       knows how to read from a Glk stream. */
+    fatal_error("Streams are only available in Glk I/O system.");
+  }
+
+  if (str == 0)
+    return 1;
+
+  dest.ismem = FALSE;
+  dest.size = 0;
+  dest.pos = 0;
+  dest.ptr = NULL;
+  dest.str = str;
+
+  res = 0;
+
+  /* ### the format errors checked below should send error messages to
+     the current stream. */
+
+  if (res == 0) {
+    res = read_long(&dest, &val);
+  }
+  if (res == 0 && val != IFFID('F', 'O', 'R', 'M')) {
+    /* ### bad header */
+    return 1;
+  }
+  if (res == 0) {
+    res = read_long(&dest, &filelen);
+  }
+  filestart = dest.pos;
+
+  if (res == 0) {
+    res = read_long(&dest, &val);
+  }
+  if (res == 0 && val != IFFID('I', 'F', 'Z', 'S')) { /* ### ? */
+    /* ### bad header */
+    return 1;
+  }
+
+  while (res == 0 && dest.pos < filestart+filelen) {
+    /* Read a chunk and deal with it. */
+    glui32 chunktype, chunkstart, chunklen;
+    unsigned char dummy;
+
+    if (res == 0) {
+      res = read_long(&dest, &chunktype);
+    }
+    if (res == 0) {
+      res = read_long(&dest, &chunklen);
+    }
+    chunkstart = dest.pos;
+
+    if (chunktype == IFFID('I', 'F', 'h', 'd')) {
+      for (ix=0; res==0 && ix<128; ix++) {
+        res = read_byte(&dest, &dummy);
+        if (res == 0 && Mem1(ix) != dummy) {
+          /* ### non-matching header */
+          return 1;
+        }
+      }
+    }
+    else if (chunktype == IFFID('C', 'M', 'e', 'm')) {
+      res = read_memstate(&dest, chunklen);
+    }
+    else if (chunktype == IFFID('M', 'A', 'l', 'l')) {
+      res = read_heapstate(&dest, chunklen, TRUE, &heapsumlen, &heapsumarr);
+    }
+    else if (chunktype == IFFID('S', 't', 'k', 's')) {
+      res = read_stackstate(&dest, chunklen, TRUE);
+    }
+    else {
+      /* Unknown chunk type. Skip it. */
+      for (lx=0; res==0 && lx<chunklen; lx++) {
+        res = read_byte(&dest, &dummy);
+      }
+    }
+
+    if (chunkstart+chunklen != dest.pos) {
+      /* ### funny chunk length */
+      return 1;
+    }
+
+    if ((chunklen & 1) != 0) {
+      if (res == 0) {
+        res = read_byte(&dest, &dummy);
+      }
+    }
+  }
+
+  if (res == 0) {
+    if (heapsumarr) {
+      /* The summary might have come from any interpreter, so it could
+         be out of order. We'll sort it. */
+      glulx_sort(heapsumarr+2, (heapsumlen-2)/2, 2*sizeof(glui32),
+        &sort_heap_summary);
+      res = heap_apply_summary(heapsumlen, heapsumarr);
+    }
+  }
+
+  if (res)
+    return 1;
+
+  return 0;
+}
+
+static int reposition_write(dest_t *dest, glui32 pos)
+{
+  if (dest->ismem) {
+    dest->pos = pos;
+  }
+  else {
+    glk_stream_set_position(dest->str, pos, seekmode_Start);
+    dest->pos = pos;
+  }
+
+  return 0;
+}
+
+static int write_buffer(dest_t *dest, unsigned char *ptr, glui32 len)
+{
+  if (dest->ismem) {
+    if (dest->pos+len > dest->size) {
+      dest->size = dest->pos+len+1024;
+      if (!dest->ptr) {
+        dest->ptr = glulx_malloc(dest->size);
+      }
+      else {
+        dest->ptr = glulx_realloc(dest->ptr, dest->size);
+      }
+      if (!dest->ptr)
+        return 1;
+    }
+    memcpy(dest->ptr+dest->pos, ptr, len);
+  }
+  else {
+    glk_put_buffer_stream(dest->str, (char *)ptr, len);
+  }
+
+  dest->pos += len;
+
+  return 0;
+}
+
+static int read_buffer(dest_t *dest, unsigned char *ptr, glui32 len)
+{
+  glui32 newlen;
+
+  if (dest->ismem) {
+    memcpy(ptr, dest->ptr+dest->pos, len);
+  }
+  else {
+    newlen = glk_get_buffer_stream(dest->str, (char *)ptr, len);
+    if (newlen != len)
+      return 1;
+  }
+
+  dest->pos += len;
+
+  return 0;
+}
+
+static int write_long(dest_t *dest, glui32 val)
+{
+  unsigned char buf[4];
+  Write4(buf, val);
+  return write_buffer(dest, buf, 4);
+}
+
+static int write_short(dest_t *dest, glui16 val)
+{
+  unsigned char buf[2];
+  Write2(buf, val);
+  return write_buffer(dest, buf, 2);
+}
+
+static int write_byte(dest_t *dest, unsigned char val)
+{
+  return write_buffer(dest, &val, 1);
+}
+
+static int read_long(dest_t *dest, glui32 *val)
+{
+  unsigned char buf[4];
+  int res = read_buffer(dest, buf, 4);
+  if (res)
+    return res;
+  *val = Read4(buf);
+  return 0;
+}
+
+static int read_short(dest_t *dest, glui16 *val)
+{
+  unsigned char buf[2];
+  int res = read_buffer(dest, buf, 2);
+  if (res)
+    return res;
+  *val = Read2(buf);
+  return 0;
+}
+
+static int read_byte(dest_t *dest, unsigned char *val)
+{
+  return read_buffer(dest, val, 1);
+}
+
+static glui32 write_memstate(dest_t *dest)
+{
+  glui32 res, pos;
+  int val;
+  int runlen;
+  unsigned char ch;
+
+  res = write_long(dest, endmem);
+  if (res)
+    return res;
+
+  runlen = 0;
+  glk_stream_set_position(gamefile, gamefile_start+ramstart, seekmode_Start);
+
+  for (pos=ramstart; pos<endmem; pos++) {
+    ch = Mem1(pos);
+    if (pos < endgamefile) {
+      val = glk_get_char_stream(gamefile);
+      if (val == -1) {
+        fatal_error("The game file ended unexpectedly while saving.");
+      }
+      ch ^= (unsigned char)val;
+    }
+    if (ch == 0) {
+      runlen++;
+    }
+    else {
+      /* Write any run we've got. */
+      while (runlen) {
+        if (runlen >= 0x100)
+          val = 0x100;
+        else
+          val = runlen;
+        res = write_byte(dest, 0);
+        if (res)
+          return res;
+        res = write_byte(dest, (val-1));
+        if (res)
+          return res;
+        runlen -= val;
+      }
+      /* Write the byte we got. */
+      res = write_byte(dest, ch);
+      if (res)
+        return res;
+    }
+  }
+  /* It's possible we've got a run left over, but we don't write it. */
+
+  return 0;
+}
+
+static glui32 read_memstate(dest_t *dest, glui32 chunklen)
+{
+  glui32 chunkend = dest->pos + chunklen;
+  glui32 newlen;
+  glui32 res, pos;
+  int val;
+  int runlen;
+  unsigned char ch, ch2;
+
+  heap_clear();
+
+  res = read_long(dest, &newlen);
+  if (res)
+    return res;
+
+  res = change_memsize(newlen, FALSE);
+  if (res)
+    return res;
+
+  runlen = 0;
+  glk_stream_set_position(gamefile, gamefile_start+ramstart, seekmode_Start);
+
+  for (pos=ramstart; pos<endmem; pos++) {
+    if (pos < endgamefile) {
+      val = glk_get_char_stream(gamefile);
+      if (val == -1) {
+        fatal_error("The game file ended unexpectedly while restoring.");
+      }
+      ch = (unsigned char)val;
+    }
+    else {
+      ch = 0;
+    }
+
+    if (dest->pos >= chunkend) {
+      /* we're into the final, unstored run. */
+    }
+    else if (runlen) {
+      runlen--;
+    }
+    else {
+      res = read_byte(dest, &ch2);
+      if (res)
+        return res;
+      if (ch2 == 0) {
+        res = read_byte(dest, &ch2);
+        if (res)
+          return res;
+        runlen = (glui32)ch2;
+      }
+      else {
+        ch ^= ch2;
+      }
+    }
+
+    if (pos >= protectstart && pos < protectend)
+      continue;
+
+    MemW1(pos, ch);
+  }
+
+  return 0;
+}
+
+static glui32 write_heapstate(dest_t *dest, int portable)
+{
+  glui32 res;
+  glui32 sumlen;
+  glui32 *sumarray;
+
+  res = heap_get_summary(&sumlen, &sumarray);
+  if (res)
+    return res;
+
+  if (!sumarray)
+    return 0; /* no heap */
+
+  res = write_heapstate_sub(sumlen, sumarray, dest, portable);
+
+  glulx_free(sumarray);
+  return res;
+}
+
+static glui32 write_heapstate_sub(glui32 sumlen, glui32 *sumarray,
+  dest_t *dest, int portable) 
+{
+  glui32 res, lx;
+
+  /* If we're storing for the purpose of undo, we don't need to do any
+     byte-swapping, because the result will only be used by this session. */
+  if (!portable) {
+    res = write_buffer(dest, (void *)sumarray, sumlen*sizeof(glui32));
+    if (res)
+      return res;
+    return 0;
+  }
+
+  for (lx=0; lx<sumlen; lx++) {
+    res = write_long(dest, sumarray[lx]);
+    if (res)
+      return res;
+  }
+
+  return 0;
+}
+
+static int sort_heap_summary(void *p1, void *p2)
+{
+  glui32 *v1 = (glui32 *)p1;
+  glui32 *v2 = (glui32 *)p2;
+
+  if (v1 < v2)
+    return -1;
+  if (v1 > v2)
+    return 1;
+  return 0;
+}
+
+static glui32 read_heapstate(dest_t *dest, glui32 chunklen, int portable,
+  glui32 *sumlen, glui32 **summary)
+{
+  glui32 res, count, lx;
+  glui32 *arr;
+
+  *sumlen = 0;
+  *summary = NULL;
+
+  if (chunklen == 0)
+    return 0; /* no heap */
+
+  if (!portable) {
+    count = chunklen / sizeof(glui32);
+
+    arr = glulx_malloc(chunklen);
+    if (!arr)
+      return 1;
+
+    res = read_buffer(dest, (void *)arr, chunklen);
+    if (res)
+      return res;
+
+    *sumlen = count;
+    *summary = arr;
+
+    return 0;
+  }
+
+  count = chunklen / 4;
+
+  arr = glulx_malloc(count * sizeof(glui32));
+  if (!arr)
+    return 1;
+  
+  for (lx=0; lx<count; lx++) {
+    res = read_long(dest, arr+lx);
+    if (res)
+      return res;
+  }
+
+  *sumlen = count;
+  *summary = arr;
+
+  return 0;
+}
+
+static glui32 write_stackstate(dest_t *dest, int portable)
+{
+  glui32 res, pos;
+  glui32 val, lx;
+  unsigned char ch;
+  glui32 lastframe;
+
+  /* If we're storing for the purpose of undo, we don't need to do any
+     byte-swapping, because the result will only be used by this session. */
+  if (!portable) {
+    res = write_buffer(dest, stack, stackptr);
+    if (res)
+      return res;
+    return 0;
+  }
+
+  /* Write a portable stack image. To do this, we have to write stack
+     frames in order, bottom to top. Remember that the last word of
+     every stack frame is a pointer to the beginning of that stack frame.
+     (This includes the last frame, because the save opcode pushes on
+     a call stub before it calls perform_save().) */
+
+  lastframe = (glui32)(-1);
+  while (1) {
+    glui32 frameend, frm, frm2, frm3;
+    unsigned char loctype, loccount;
+    glui32 numlocals, frlen, locpos;
+
+    /* Find the next stack frame (after the one in lastframe). Sadly,
+       this requires searching the stack from the top down. We have to
+       do this for *every* frame, which takes N^2 time overall. But
+       save routines usually aren't nested very deep. 
+       If it becomes a practical problem, we can build a stack-frame 
+       array, which requires dynamic allocation. */
+    for (frm = stackptr, frameend = stackptr;
+         frm != 0 && (frm2 = Stk4(frm-4)) != lastframe;
+         frameend = frm, frm = frm2) { };
+
+    /* Write out the frame. */
+    frm2 = frm;
+
+    frlen = Stk4(frm2);
+    frm2 += 4;
+    res = write_long(dest, frlen);
+    if (res)
+      return res;
+    locpos = Stk4(frm2);
+    frm2 += 4;
+    res = write_long(dest, locpos);
+    if (res)
+      return res;
+
+    frm3 = frm2;
+
+    numlocals = 0;
+    while (1) {
+      loctype = Stk1(frm2);
+      frm2 += 1;
+      loccount = Stk1(frm2);
+      frm2 += 1;
+
+      res = write_byte(dest, loctype);
+      if (res)
+        return res;
+      res = write_byte(dest, loccount);
+      if (res)
+        return res;
+
+      if (loctype == 0 && loccount == 0)
+        break;
+
+      numlocals++;
+    }
+
+    if ((numlocals & 1) == 0) {
+      res = write_byte(dest, 0);
+      if (res)
+        return res;
+      res = write_byte(dest, 0);
+      if (res)
+        return res;
+      frm2 += 2;
+    }
+
+    if (frm2 != frm+locpos)
+      fatal_error("Inconsistent stack frame during save.");
+
+    /* Write out the locals. */
+    for (lx=0; lx<numlocals; lx++) {
+      loctype = Stk1(frm3);
+      frm3 += 1;
+      loccount = Stk1(frm3);
+      frm3 += 1;
+      
+      if (loctype == 0 && loccount == 0)
+        break;
+
+      /* Put in up to 0, 1, or 3 bytes of padding, depending on loctype. */
+      while (frm2 & (loctype-1)) {
+        res = write_byte(dest, 0);
+        if (res)
+          return res;
+        frm2 += 1;
+      }
+
+      /* Put in this set of locals. */
+      switch (loctype) {
+
+      case 1:
+        do {
+          res = write_byte(dest, Stk1(frm2));
+          if (res)
+            return res;
+          frm2 += 1;
+          loccount--;
+        } while (loccount);
+        break;
+
+      case 2:
+        do {
+          res = write_short(dest, Stk2(frm2));
+          if (res)
+            return res;
+          frm2 += 2;
+          loccount--;
+        } while (loccount);
+        break;
+
+      case 4:
+        do {
+          res = write_long(dest, Stk4(frm2));
+          if (res)
+            return res;
+          frm2 += 4;
+          loccount--;
+        } while (loccount);
+        break;
+
+      }
+    }
+
+    if (frm2 != frm+frlen)
+      fatal_error("Inconsistent stack frame during save.");
+
+    while (frm2 < frameend) {
+      res = write_long(dest, Stk4(frm2));
+      if (res)
+        return res;
+      frm2 += 4;
+    }
+
+    /* Go on to the next frame. */
+    if (frameend == stackptr)
+      break; /* All done. */
+    lastframe = frm;
+  }
+
+  return 0;
+}
+
+static glui32 read_stackstate(dest_t *dest, glui32 chunklen, int portable)
+{
+  glui32 res, pos;
+  unsigned char ch;
+  glui32 frameend, frm, frm2, frm3, locpos, frlen, numlocals;
+
+  if (chunklen > stacksize)
+    return 1;
+
+  stackptr = chunklen;
+  frameptr = 0;
+  valstackbase = 0;
+  localsbase = 0;
+
+  if (!portable) {
+    res = read_buffer(dest, stack, stackptr);
+    if (res)
+      return res;
+    return 0;
+  }
+
+  /* This isn't going to be pleasant; we're going to read the data in
+     as a block, and then convert it in-place. */
+  res = read_buffer(dest, stack, stackptr);
+  if (res)
+    return res;
+
+  frameend = stackptr;
+  while (frameend != 0) {
+    /* Read the beginning-of-frame pointer. Remember, right now, the
+       whole frame is stored big-endian. So we have to read with the
+       Read*() macros, and then write with the StkW*() macros. */
+    frm = Read4(stack+(frameend-4));
+
+    frm2 = frm;
+
+    frlen = Read4(stack+frm2);
+    StkW4(frm2, frlen);
+    frm2 += 4;
+    locpos = Read4(stack+frm2);
+    StkW4(frm2, locpos);
+    frm2 += 4;
+
+    /* The locals-format list is in bytes, so we don't have to convert it. */
+    frm3 = frm2;
+    frm2 = frm+locpos;
+
+    numlocals = 0;
+
+    while (1) {
+      unsigned char loctype, loccount;
+      loctype = Read1(stack+frm3);
+      frm3 += 1;
+      loccount = Read1(stack+frm3);
+      frm3 += 1;
+
+      if (loctype == 0 && loccount == 0)
+        break;
+
+      /* Skip up to 0, 1, or 3 bytes of padding, depending on loctype. */
+      while (frm2 & (loctype-1)) {
+        StkW1(frm2, 0);
+        frm2++;
+      }
+      
+      /* Convert this set of locals. */
+      switch (loctype) {
+        
+      case 1:
+        do {
+          /* Don't need to convert bytes. */
+          frm2 += 1;
+          loccount--;
+        } while (loccount);
+        break;
+
+      case 2:
+        do {
+          glui16 loc = Read2(stack+frm2);
+          StkW2(frm2, loc);
+          frm2 += 2;
+          loccount--;
+        } while (loccount);
+        break;
+
+      case 4:
+        do {
+          glui32 loc = Read4(stack+frm2);
+          StkW4(frm2, loc);
+          frm2 += 4;
+          loccount--;
+        } while (loccount);
+        break;
+
+      }
+
+      numlocals++;
+    }
+
+    if ((numlocals & 1) == 0) {
+      StkW1(frm3, 0);
+      frm3++;
+      StkW1(frm3, 0);
+      frm3++;
+    }
+
+    if (frm3 != frm+locpos) {
+      return 1;
+    }
+
+    while (frm2 & 3) {
+      StkW1(frm2, 0);
+      frm2++;
+    }
+
+    if (frm2 != frm+frlen) {
+      return 1;
+    }
+
+    /* Now, the values pushed on the stack after the call frame itself.
+       This includes the stub. */
+    while (frm2 < frameend) {
+      glui32 loc = Read4(stack+frm2);
+      StkW4(frm2, loc);
+      frm2 += 4;
+    }
+
+    frameend = frm;
+  }
+
+  return 0;
+}
+
+glui32 perform_verify()
+{
+  glui32 len, checksum, newlen;
+  unsigned char buf[4];
+  glui32 val, newsum, ix;
+
+  len = gamefile_len;
+
+  if (len < 256 || (len & 0xFF) != 0)
+    return 1;
+
+  glk_stream_set_position(gamefile, gamefile_start, seekmode_Start);
+  newsum = 0;
+
+  /* Read the header */
+  for (ix=0; ix<9; ix++) {
+    newlen = glk_get_buffer_stream(gamefile, (char *)buf, 4);
+    if (newlen != 4)
+      return 1;
+    val = Read4(buf);
+    if (ix == 4) {
+      if (len != val)
+        return 1;
+    }
+    if (ix == 8)
+      checksum = val;
+    else
+      newsum += val;
+  }
+
+  /* Read everything else */
+  for (; ix < len/4; ix++) {
+    newlen = glk_get_buffer_stream(gamefile, (char *)buf, 4);
+    if (newlen != 4)
+      return 1;
+    val = Read4(buf);
+    newsum += val;
+  }
+
+  if (newsum != checksum)
+    return 1;
+
+  return 0;  
+}
diff --git a/interpreters/glulxe/string.c b/interpreters/glulxe/string.c
new file mode 100644 (file)
index 0000000..1f3b6f0
--- /dev/null
@@ -0,0 +1,883 @@
+/* string.c: Glulxe string and text functions.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+
+static glui32 iosys_mode;
+static glui32 iosys_rock;
+/* These constants are defined in the Glulx spec. */
+#define iosys_None (0)
+#define iosys_Filter (1)
+#define iosys_Glk (2)
+
+#define CACHEBITS (4)
+#define CACHESIZE (1<<CACHEBITS) 
+#define CACHEMASK (15)
+
+typedef struct cacheblock_struct {
+  int depth; /* 1 to 4 */
+  int type;
+  union {
+    struct cacheblock_struct *branches;
+    unsigned char ch;
+    glui32 uch;
+    glui32 addr;
+  } u;
+} cacheblock_t;
+
+static int never_cache_stringtable = FALSE;
+
+/* The current string-decoding tables, broken out into a fast and
+   easy-to-use form. */
+static int tablecache_valid = FALSE;
+static cacheblock_t tablecache;
+
+static void stream_setup_unichar(void);
+
+static void nopio_char_han(unsigned char ch);
+static void filio_char_han(unsigned char ch);
+static void nopio_unichar_han(glui32 ch);
+static void filio_unichar_han(glui32 ch);
+static void glkio_unichar_nouni_han(glui32 val);
+static void (*glkio_unichar_han_ptr)(glui32 val) = NULL;
+
+static void dropcache(cacheblock_t *cablist);
+static void buildcache(cacheblock_t *cablist, glui32 nodeaddr, int depth,
+  int mask);
+static void dumpcache(cacheblock_t *cablist, int count, int indent);
+
+void stream_get_iosys(glui32 *mode, glui32 *rock)
+{
+  *mode = iosys_mode;
+  *rock = iosys_rock;
+}
+
+static void stream_setup_unichar()
+{
+#ifdef GLK_MODULE_UNICODE
+
+  if (glk_gestalt(gestalt_Unicode, 0))
+    glkio_unichar_han_ptr = glk_put_char_uni;
+  else
+    glkio_unichar_han_ptr = glkio_unichar_nouni_han;
+
+#else /* GLK_MODULE_UNICODE */
+
+  glkio_unichar_han_ptr = glkio_unichar_nouni_han;
+
+#endif /* GLK_MODULE_UNICODE */
+}
+
+void stream_set_iosys(glui32 mode, glui32 rock)
+{
+  switch (mode) {
+  default:
+    mode = 0;
+    /* ...and fall through to next case (no-op I/O). */
+  case iosys_None:
+    rock = 0;
+    stream_char_handler = nopio_char_han;
+    stream_unichar_handler = nopio_unichar_han;
+    break;
+  case iosys_Filter:
+    stream_char_handler = filio_char_han;
+    stream_unichar_handler = filio_unichar_han;
+    break;
+  case iosys_Glk:
+    if (!glkio_unichar_han_ptr)
+      stream_setup_unichar();
+    rock = 0;
+    stream_char_handler = glk_put_char;
+    stream_unichar_handler = glkio_unichar_han_ptr;
+    break;
+  }
+
+  iosys_mode = mode;
+  iosys_rock = rock;
+}
+
+static void nopio_char_han(unsigned char ch)
+{
+}
+
+static void nopio_unichar_han(glui32 ch)
+{
+}
+
+static void filio_char_han(unsigned char ch)
+{
+  glui32 val = ch;
+  push_callstub(0, 0);
+  enter_function(iosys_rock, 1, &val);
+}
+
+static void filio_unichar_han(glui32 val)
+{
+  push_callstub(0, 0);
+  enter_function(iosys_rock, 1, &val);
+}
+
+static void glkio_unichar_nouni_han(glui32 val)
+{
+  /* Only used if the Glk library has no Unicode functions */
+  if (val > 0xFF)
+    val = '?';
+  glk_put_char(val);
+}
+
+/* stream_num():
+   Write a signed integer to the current output stream.
+*/
+void stream_num(glsi32 val, int inmiddle, int charnum)
+{
+  int ix = 0;
+  int res, jx;
+  char buf[16];
+  glui32 ival;
+
+  if (val == 0) {
+    buf[ix] = '0';
+    ix++;
+  }
+  else {
+    if (val < 0) 
+      ival = -val;
+    else 
+      ival = val;
+
+    while (ival != 0) {
+      buf[ix] = (ival % 10) + '0';
+      ix++;
+      ival /= 10;
+    }
+
+    if (val < 0) {
+      buf[ix] = '-';
+      ix++;
+    }
+  }
+
+  switch (iosys_mode) {
+
+  case iosys_Glk:
+    while (ix) {
+      ix--;
+      glk_put_char(buf[ix]);
+    }
+    break;
+
+  case iosys_Filter:
+    if (!inmiddle) {
+      push_callstub(0x11, 0);
+    }
+    if (charnum >= ix) {
+      res = pop_callstub_string(&jx);
+      if (res) 
+        fatal_error("String-on-string call stub while printing number.");
+    }
+    else {
+      ival = buf[(ix-1)-charnum] & 0xFF;
+      pc = val;
+      push_callstub(0x12, charnum+1);
+      enter_function(iosys_rock, 1, &ival);
+    }
+    break;
+
+  default:
+    break;
+
+  }
+}
+
+/* stream_string():
+   Write a Glulx string object to the current output stream.
+   inmiddle is zero if we are beginning a new string, or
+   nonzero if restarting one (E0/E1/E2, as appropriate for
+   the string type).
+*/
+void stream_string(glui32 addr, int inmiddle, int bitnum)
+{
+  int ch;
+  int type;
+  int alldone = FALSE;
+  int substring = (inmiddle != 0);
+  glui32 ival;
+
+  if (!addr)
+    fatal_error("Called stream_string with null address.");
+  
+  while (!alldone) {
+
+    if (inmiddle == 0) {
+      type = Mem1(addr);
+      if (type == 0xE2)
+        addr+=4;
+      else
+        addr++;
+      bitnum = 0;
+    }
+    else {
+      type = inmiddle;
+    }
+
+    if (type == 0xE1) {
+      if (tablecache_valid) {
+        int bits, numbits;
+        int readahead;
+        glui32 tmpaddr;
+        cacheblock_t *cablist;
+        int done = 0;
+
+        /* bitnum is already set right */
+        bits = Mem1(addr); 
+        if (bitnum)
+          bits >>= bitnum;
+        numbits = (8 - bitnum);
+        readahead = FALSE;
+
+        if (tablecache.type != 0) {
+          /* This is a bit of a cheat. If the top-level block is not
+             a branch, then it must be a string-terminator -- otherwise
+             the string would be an infinite repetition of that block.
+             We check for this case and bail immediately. */
+          done = 1;
+        }
+
+        cablist = tablecache.u.branches;
+        while (!done) {
+          cacheblock_t *cab;
+
+          if (numbits < CACHEBITS) {
+            /* readahead is certainly false */
+            int newbyte = Mem1(addr+1);
+            bits |= (newbyte << numbits);
+            numbits += 8;
+            readahead = TRUE;
+          }
+
+          cab = &(cablist[bits & CACHEMASK]);
+          numbits -= cab->depth;
+          bits >>= cab->depth;
+          bitnum += cab->depth;
+          if (bitnum >= 8) {
+            addr += 1;
+            bitnum -= 8;
+            if (readahead) {
+              readahead = FALSE;
+            }
+            else {
+              int newbyte = Mem1(addr);
+              bits |= (newbyte << numbits);
+              numbits += 8;
+            }
+          }
+
+          switch (cab->type) {
+          case 0x00: /* non-leaf node */
+            cablist = cab->u.branches;
+            break;
+          case 0x01: /* string terminator */
+            done = 1;
+            break;
+          case 0x02: /* single character */
+            switch (iosys_mode) {
+            case iosys_Glk:
+              glk_put_char(cab->u.ch);
+              break;
+            case iosys_Filter: 
+              ival = cab->u.ch & 0xFF;
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              enter_function(iosys_rock, 1, &ival);
+              return;
+            }
+            cablist = tablecache.u.branches;
+            break;
+          case 0x04: /* single Unicode character */
+            switch (iosys_mode) {
+            case iosys_Glk:
+              glkio_unichar_han_ptr(cab->u.uch);
+              break;
+            case iosys_Filter: 
+              ival = cab->u.uch;
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              enter_function(iosys_rock, 1, &ival);
+              return;
+            }
+            cablist = tablecache.u.branches;
+            break;
+          case 0x03: /* C string */
+            switch (iosys_mode) {
+            case iosys_Glk:
+              for (tmpaddr=cab->u.addr; (ch=Mem1(tmpaddr)) != '\0'; tmpaddr++) 
+                glk_put_char(ch);
+              cablist = tablecache.u.branches; 
+              break;
+            case iosys_Filter:
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              inmiddle = 0xE0;
+              addr = cab->u.addr;
+              done = 2;
+              break;
+            default:
+              cablist = tablecache.u.branches; 
+              break;
+            }
+            break;
+          case 0x05: /* C Unicode string */
+            switch (iosys_mode) {
+            case iosys_Glk:
+              for (tmpaddr=cab->u.addr; (ival=Mem4(tmpaddr)) != 0; tmpaddr+=4) 
+                glkio_unichar_han_ptr(ival);
+              cablist = tablecache.u.branches; 
+              break;
+            case iosys_Filter:
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              inmiddle = 0xE2;
+              addr = cab->u.addr;
+              done = 2;
+              break;
+            default:
+              cablist = tablecache.u.branches; 
+              break;
+            }
+            break;
+          case 0x08:
+          case 0x09:
+          case 0x0A:
+          case 0x0B: 
+            {
+              glui32 oaddr;
+              int otype;
+              oaddr = cab->u.addr;
+              if (cab->type >= 0x09)
+                oaddr = Mem4(oaddr);
+              if (cab->type == 0x0B)
+                oaddr = Mem4(oaddr);
+              otype = Mem1(oaddr);
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              if (otype >= 0xE0 && otype <= 0xFF) {
+                pc = addr;
+                push_callstub(0x10, bitnum);
+                inmiddle = 0;
+                addr = oaddr;
+                done = 2;
+              }
+              else if (otype >= 0xC0 && otype <= 0xDF) {
+                glui32 argc;
+                glui32 *argv;
+                if (cab->type == 0x0A || cab->type == 0x0B) {
+                  argc = Mem4(cab->u.addr+4);
+                  argv = pop_arguments(argc, cab->u.addr+8);
+                }
+                else {
+                  argc = 0;
+                  argv = NULL;
+                }
+                pc = addr;
+                push_callstub(0x10, bitnum);
+                enter_function(oaddr, argc, argv);
+                return;
+              }
+              else {
+                fatal_error("Unknown object while decoding string indirect reference.");
+              }
+            }
+            break;
+          default:
+            fatal_error("Unknown entity in string decoding (cached).");
+            break;
+          }
+        }
+        if (done > 1) {
+          continue; /* restart the top-level loop */
+        }
+      }
+      else { /* tablecache not valid */
+        glui32 node;
+        int byte;
+        int nodetype;
+        int done = 0;
+
+        if (!stringtable)
+          fatal_error("Attempted to print a compressed string with no table set.");
+        /* bitnum is already set right */
+        byte = Mem1(addr); 
+        if (bitnum)
+          byte >>= bitnum;
+        node = Mem4(stringtable+8);
+        while (!done) {
+          nodetype = Mem1(node);
+          node++;
+          switch (nodetype) {
+          case 0x00: /* non-leaf node */
+            if (byte & 1) 
+              node = Mem4(node+4);
+            else
+              node = Mem4(node+0);
+            if (bitnum == 7) {
+              bitnum = 0;
+              addr++;
+              byte = Mem1(addr);
+            }
+            else {
+              bitnum++;
+              byte >>= 1;
+            }
+            break;
+          case 0x01: /* string terminator */
+            done = 1;
+            break;
+          case 0x02: /* single character */
+            ch = Mem1(node);
+            switch (iosys_mode) {
+            case iosys_Glk:
+              glk_put_char(ch);
+              break;
+            case iosys_Filter: 
+              ival = ch & 0xFF;
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              enter_function(iosys_rock, 1, &ival);
+              return;
+            }
+            node = Mem4(stringtable+8);
+            break;
+          case 0x04: /* single Unicode character */
+            ival = Mem4(node);
+            switch (iosys_mode) {
+            case iosys_Glk:
+              glkio_unichar_han_ptr(ival);
+              break;
+            case iosys_Filter: 
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              enter_function(iosys_rock, 1, &ival);
+              return;
+            }
+            node = Mem4(stringtable+8);
+            break;
+          case 0x03: /* C string */
+            switch (iosys_mode) {
+            case iosys_Glk:
+              for (; (ch=Mem1(node)) != '\0'; node++) 
+                glk_put_char(ch);
+              node = Mem4(stringtable+8);
+              break;
+            case iosys_Filter:
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              inmiddle = 0xE0;
+              addr = node;
+              done = 2;
+              break;
+            default:
+              node = Mem4(stringtable+8);
+              break;
+            }
+            break;
+          case 0x05: /* C Unicode string */
+            switch (iosys_mode) {
+            case iosys_Glk:
+              for (; (ival=Mem4(node)) != 0; node+=4) 
+                glkio_unichar_han_ptr(ival);
+              node = Mem4(stringtable+8);
+              break;
+            case iosys_Filter:
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              pc = addr;
+              push_callstub(0x10, bitnum);
+              inmiddle = 0xE2;
+              addr = node;
+              done = 2;
+              break;
+            default:
+              node = Mem4(stringtable+8);
+              break;
+            }
+            break;
+          case 0x08:
+          case 0x09:
+          case 0x0A:
+          case 0x0B: 
+            {
+              glui32 oaddr;
+              int otype;
+              oaddr = Mem4(node);
+              if (nodetype == 0x09 || nodetype == 0x0B)
+                oaddr = Mem4(oaddr);
+              otype = Mem1(oaddr);
+              if (!substring) {
+                push_callstub(0x11, 0);
+                substring = TRUE;
+              }
+              if (otype >= 0xE0 && otype <= 0xFF) {
+                pc = addr;
+                push_callstub(0x10, bitnum);
+                inmiddle = 0;
+                addr = oaddr;
+                done = 2;
+              }
+              else if (otype >= 0xC0 && otype <= 0xDF) {
+                glui32 argc;
+                glui32 *argv;
+                if (nodetype == 0x0A || nodetype == 0x0B) {
+                  argc = Mem4(node+4);
+                  argv = pop_arguments(argc, node+8);
+                }
+                else {
+                  argc = 0;
+                  argv = NULL;
+                }
+                pc = addr;
+                push_callstub(0x10, bitnum);
+                enter_function(oaddr, argc, argv);
+                return;
+              }
+              else {
+                fatal_error("Unknown object while decoding string indirect reference.");
+              }
+            }
+            break;
+          default:
+            fatal_error("Unknown entity in string decoding.");
+            break;
+          }
+        }
+        if (done > 1) {
+          continue; /* restart the top-level loop */
+        }
+      }
+    }
+    else if (type == 0xE0) {
+      switch (iosys_mode) {
+      case iosys_Glk:
+        while (1) {
+          ch = Mem1(addr);
+          addr++;
+          if (ch == '\0')
+            break;
+          glk_put_char(ch);
+        }
+        break;
+      case iosys_Filter:
+        if (!substring) {
+          push_callstub(0x11, 0);
+          substring = TRUE;
+        }
+        ch = Mem1(addr);
+        addr++;
+        if (ch != '\0') {
+          ival = ch & 0xFF;
+          pc = addr;
+          push_callstub(0x13, 0);
+          enter_function(iosys_rock, 1, &ival);
+          return;
+        }
+        break;
+      }
+    }
+    else if (type == 0xE2) {
+      switch (iosys_mode) {
+      case iosys_Glk:
+        while (1) {
+          ival = Mem4(addr);
+          addr+=4;
+          if (ival == 0)
+            break;
+          glkio_unichar_han_ptr(ival);
+        }
+        break;
+      case iosys_Filter:
+        if (!substring) {
+          push_callstub(0x11, 0);
+          substring = TRUE;
+        }
+        ival = Mem4(addr);
+        addr+=4;
+        if (ival != 0) {
+          pc = addr;
+          push_callstub(0x14, 0);
+          enter_function(iosys_rock, 1, &ival);
+          return;
+        }
+        break;
+      }
+    }
+    else if (type >= 0xE0 && type <= 0xFF) {
+      fatal_error("Attempt to print unknown type of string.");
+    }
+    else {
+      fatal_error("Attempt to print non-string.");
+    }
+
+    if (!substring) {
+      /* Just get straight out. */
+      alldone = TRUE;
+    }
+    else {
+      /* Pop a stub and see what's to be done. */
+      addr = pop_callstub_string(&bitnum);
+      if (addr == 0) {
+        alldone = TRUE;
+      }
+      else {
+        inmiddle = 0xE1;
+      }
+    }
+  }
+}
+
+/* stream_get_table():
+   Get the current table address. 
+*/
+glui32 stream_get_table()
+{
+  return stringtable;
+}
+
+/* stream_set_table():
+   Set the current table address, and rebuild decoding cache. 
+*/
+void stream_set_table(glui32 addr)
+{
+  if (stringtable == addr)
+    return;
+
+  /* Drop cache. */
+  if (tablecache_valid) {
+    if (tablecache.type == 0)
+      dropcache(tablecache.u.branches);
+    tablecache.u.branches = NULL;
+    tablecache_valid = FALSE;
+  }
+
+  stringtable = addr;
+
+  if (stringtable) {
+    /* Build cache. We can only do this if the table is entirely in ROM. */
+    glui32 tablelen = Mem4(stringtable);
+    glui32 rootaddr = Mem4(stringtable+8);
+    if (stringtable+tablelen <= ramstart && !never_cache_stringtable) {
+      buildcache(&tablecache, rootaddr, CACHEBITS, 0);
+      /* dumpcache(&tablecache, 1, 0); */
+      tablecache_valid = TRUE;
+    }
+  }
+}
+
+static void buildcache(cacheblock_t *cablist, glui32 nodeaddr, int depth,
+  int mask)
+{
+  int ix, type;
+
+  type = Mem1(nodeaddr);
+
+  if (type == 0 && depth == CACHEBITS) {
+    cacheblock_t *list, *cab;
+    list = (cacheblock_t *)glulx_malloc(sizeof(cacheblock_t) * CACHESIZE);
+    buildcache(list, nodeaddr, 0, 0);
+    cab = &(cablist[mask]);
+    cab->type = 0;
+    cab->depth = CACHEBITS;
+    cab->u.branches = list;
+    return;
+  }
+
+  if (type == 0) {
+    glui32 leftaddr  = Mem4(nodeaddr+1);
+    glui32 rightaddr = Mem4(nodeaddr+5);
+    buildcache(cablist, leftaddr, depth+1, mask);
+    buildcache(cablist, rightaddr, depth+1, (mask | (1 << depth)));
+    return;
+  }
+
+  /* Leaf node. */
+  nodeaddr++;
+  for (ix = mask; ix < CACHESIZE; ix += (1 << depth)) {
+    cacheblock_t *cab = &(cablist[ix]);
+    cab->type = type;
+    cab->depth = depth;
+    switch (type) {
+    case 0x02:
+      cab->u.ch = Mem1(nodeaddr);
+      break;
+    case 0x04:
+      cab->u.uch = Mem4(nodeaddr);
+      break;
+    case 0x03:
+    case 0x05:
+    case 0x0A:
+    case 0x0B:
+      cab->u.addr = nodeaddr;
+      break;
+    case 0x08:
+    case 0x09:
+      cab->u.addr = Mem4(nodeaddr);
+      break;
+    }
+  }
+}
+
+#if 0
+#include <stdio.h>
+static void dumpcache(cacheblock_t *cablist, int count, int indent)
+{
+  int ix, jx;
+
+  for (ix=0; ix<count; ix++) {
+    cacheblock_t *cab = &(cablist[ix]); 
+    for (jx=0; jx<indent; jx++)
+      printf("  ");
+    printf("%X: ", ix);
+    switch (cab->type) {
+    case 0:
+      printf("...\n");
+      dumpcache(cab->u.branches, CACHESIZE, indent+1);
+      break;
+    case 1:
+      printf("<EOS>\n");
+      break;
+    case 2:
+      printf("0x%02X", cab->u.ch);
+      if (cab->u.ch < 32)
+        printf(" ''\n");
+      else
+        printf(" '%c'\n", cab->u.ch);
+      break;
+    default:
+      printf("type %02X, address %06lX\n", cab->type, cab->u.addr);
+      break;
+    }
+  }
+}
+#endif /* 0 */
+
+static void dropcache(cacheblock_t *cablist)
+{
+  int ix;
+  for (ix=0; ix<CACHESIZE; ix++) {
+    cacheblock_t *cab = &(cablist[ix]);
+    if (cab->type == 0) {
+      dropcache(cab->u.branches);
+      cab->u.branches = NULL;
+    }
+  }
+  glulx_free(cablist);
+}
+
+/* This misbehaves if a Glk function has more than one S argument. */
+
+#define STATIC_TEMP_BUFSIZE (127)
+static char temp_buf[STATIC_TEMP_BUFSIZE+1];
+
+char *make_temp_string(glui32 addr)
+{
+  int ix, len;
+  glui32 addr2;
+  char *res, *cx;
+
+  if (Mem1(addr) != 0xE0)
+    fatal_error("String argument to a Glk call must be unencoded.");
+  addr++;
+
+  for (addr2=addr; Mem1(addr2); addr2++) { };
+  len = (addr2 - addr);
+  if (len < STATIC_TEMP_BUFSIZE) {
+    res = temp_buf;
+  }
+  else {
+    res = (char *)glulx_malloc(len+1);
+    if (!res) 
+      fatal_error("Unable to allocate space for string argument to Glk call.");
+  }
+  
+  for (ix=0, addr2=addr; ix<len; ix++, addr2++) {
+    res[ix] = Mem1(addr2);
+  }
+  res[len] = '\0';
+
+  return res;
+}
+
+glui32 *make_temp_ustring(glui32 addr)
+{
+  int ix, len;
+  glui32 addr2;
+  glui32 *res, *cx;
+
+  if (Mem1(addr) != 0xE2)
+    fatal_error("Ustring argument to a Glk call must be unencoded.");
+  addr+=4;
+
+  for (addr2=addr; Mem4(addr2); addr2+=4) { };
+  len = (addr2 - addr) / 4;
+  if ((len+1)*4 < STATIC_TEMP_BUFSIZE) {
+    res = (glui32 *)temp_buf;
+  }
+  else {
+    res = (glui32 *)glulx_malloc((len+1)*4);
+    if (!res) 
+      fatal_error("Unable to allocate space for ustring argument to Glk call.");
+  }
+  
+  for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
+    res[ix] = Mem4(addr2);
+  }
+  res[len] = 0;
+
+  return res;
+}
+
+void free_temp_string(char *str)
+{
+  if (str && str != temp_buf) 
+    glulx_free(str);
+}
+
+void free_temp_ustring(glui32 *str)
+{
+  if (str && str != (glui32 *)temp_buf) 
+    glulx_free(str);
+}
+
diff --git a/interpreters/glulxe/unixstrt.c b/interpreters/glulxe/unixstrt.c
new file mode 100644 (file)
index 0000000..4e62905
--- /dev/null
@@ -0,0 +1,61 @@
+/* unixstrt.c: Unix-specific code for Glulxe.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+#include "glkstart.h" /* This comes with the Glk library. */
+
+/* The only command-line argument is the filename. */
+glkunix_argumentlist_t glkunix_arguments[] = {
+  { "", glkunix_arg_ValueFollows, "filename: The game file to load." },
+  { NULL, glkunix_arg_End, NULL }
+};
+
+int glkunix_startup_code(glkunix_startup_t *data)
+{
+  /* It turns out to be more convenient if we return TRUE from here, even 
+     when an error occurs, and display an error in glk_main(). */
+  char *cx;
+  unsigned char buf[12];
+  int res;
+
+  if (data->argc <= 1) {
+    init_err = "You must supply the name of a game file.";
+    return FALSE;
+  }
+  cx = data->argv[1];
+    
+  gamefile = glkunix_stream_open_pathname(cx, FALSE, 1);
+  if (!gamefile) {
+    init_err = "The game file could not be opened.";
+    init_err2 = cx;
+    return TRUE;
+  }
+
+  /* Now we have to check to see if it's a Blorb file. */
+
+  glk_stream_set_position(gamefile, 0, seekmode_Start);
+  res = glk_get_buffer_stream(gamefile, (char *)buf, 12);
+  if (!res) {
+    init_err = "The data in this stand-alone game is too short to read.";
+    return TRUE;
+  }
+    
+  if (buf[0] == 'G' && buf[1] == 'l' && buf[2] == 'u' && buf[3] == 'l') {
+    locate_gamefile(FALSE);
+    return TRUE;
+  }
+  else if (buf[0] == 'F' && buf[1] == 'O' && buf[2] == 'R' && buf[3] == 'M'
+    && buf[8] == 'I' && buf[9] == 'F' && buf[10] == 'R' && buf[11] == 'S') {
+    locate_gamefile(TRUE);
+    return TRUE;
+  }
+  else {
+    init_err = "This is neither a Glulx game file nor a Blorb file "
+      "which contains one.";
+    return TRUE;
+  }
+}
+
diff --git a/interpreters/glulxe/vm.c b/interpreters/glulxe/vm.c
new file mode 100644 (file)
index 0000000..4a113f5
--- /dev/null
@@ -0,0 +1,303 @@
+/* vm.c: Glulxe code related to the VM overall. Also miscellaneous stuff.
+    Designed by Andrew Plotkin <erkyrath@eblong.com>
+    http://eblong.com/zarf/glulx/index.html
+*/
+
+#include "glk.h"
+#include "glulxe.h"
+
+/* The memory blocks which contain VM main memory and the stack. */
+unsigned char *memmap = NULL;
+unsigned char *stack = NULL;
+
+/* Various memory addresses which are useful. These are loaded in from
+   the game file header. */
+glui32 ramstart;
+glui32 endgamefile;
+glui32 origendmem;
+glui32 stacksize;
+glui32 startfuncaddr;
+glui32 origstringtable;
+glui32 checksum;
+
+/* The VM registers. */
+glui32 stackptr;
+glui32 frameptr;
+glui32 pc;
+glui32 stringtable;
+glui32 valstackbase;
+glui32 localsbase;
+glui32 endmem;
+glui32 protectstart, protectend;
+
+void (*stream_char_handler)(unsigned char ch);
+void (*stream_unichar_handler)(glui32 ch);
+
+/* setup_vm():
+   Read in the game file and build the machine, allocating all the memory
+   necessary.
+*/
+void setup_vm()
+{
+  unsigned char buf[4 * 7];
+  int res;
+
+  pc = 0; /* Clear this, so that error messages are cleaner. */
+
+  /* Read in all the size constants from the game file header. */
+
+  stream_char_handler = NULL;
+  stream_unichar_handler = NULL;
+
+  glk_stream_set_position(gamefile, gamefile_start+8, seekmode_Start);
+  res = glk_get_buffer_stream(gamefile, (char *)buf, 4 * 7);
+  
+  ramstart = Read4(buf+0);
+  endgamefile = Read4(buf+4);
+  origendmem = Read4(buf+8);
+  stacksize = Read4(buf+12);
+  startfuncaddr = Read4(buf+16);
+  origstringtable = Read4(buf+20);
+  checksum = Read4(buf+24);
+
+  /* Set the protection range to (0, 0), meaning "off". */
+  protectstart = 0;
+  protectend = 0;
+
+  /* Do a few sanity checks. */
+
+  if ((ramstart & 0xFF)
+    || (endgamefile & 0xFF) 
+    || (origendmem & 0xFF)
+    || (stacksize & 0xFF)) {
+    nonfatal_warning("One of the segment boundaries in the header is not "
+      "256-byte aligned.");
+  }
+
+  if (ramstart < 0x100 || endgamefile < ramstart || origendmem < endgamefile) {
+    fatal_error("The segment boundaries in the header are in an impossible "
+      "order.");
+  }
+  if (stacksize < 0x100) {
+    fatal_error("The stack size in the header is too small.");
+  }
+  
+  /* Allocate main memory and the stack. This is where memory allocation
+     errors are most likely to occur. */
+  endmem = origendmem;
+  memmap = (unsigned char *)glulx_malloc(origendmem);
+  if (!memmap) {
+    fatal_error("Unable to allocate Glulx memory space.");
+  }
+  stack = (unsigned char *)glulx_malloc(stacksize);
+  if (!stack) {
+    glulx_free(memmap);
+    memmap = NULL;
+    fatal_error("Unable to allocate Glulx stack space.");
+  }
+  stringtable = 0;
+
+  /* Initialize various other things in the terp. */
+  init_operands(); 
+  init_accel();
+  init_serial();
+
+  /* Set up the initial machine state. */
+  vm_restart();
+}
+
+/* finalize_vm():
+   Deallocate all the memory and shut down the machine.
+*/
+void finalize_vm()
+{
+  if (memmap) {
+    glulx_free(memmap);
+    memmap = NULL;
+  }
+  if (stack) {
+    glulx_free(stack);
+    stack = NULL;
+  }
+}
+
+/* vm_restart(): 
+   Put the VM into a state where it's ready to begin executing the
+   game. This is called both at startup time, and when the machine
+   performs a "restart" opcode. 
+*/
+void vm_restart()
+{
+  glui32 lx;
+  int res;
+
+  /* Deactivate the heap (if it was active). */
+  heap_clear();
+
+  /* Reset memory to the original size. */
+  lx = change_memsize(origendmem, FALSE);
+  if (lx)
+    fatal_error("Memory could not be reset to its original size.");
+
+  /* Load in all of main memory */
+  glk_stream_set_position(gamefile, gamefile_start, seekmode_Start);
+  for (lx=0; lx<endgamefile; lx++) {
+    res = glk_get_char_stream(gamefile);
+    if (res == -1) {
+      fatal_error("The game file ended unexpectedly.");
+    }
+    if (lx >= protectstart && lx < protectend)
+      continue;
+    memmap[lx] = res;
+  }
+  for (lx=endgamefile; lx<origendmem; lx++) {
+    memmap[lx] = 0;
+  }
+
+  /* Reset all the registers */
+  stackptr = 0;
+  frameptr = 0;
+  pc = 0;
+  stream_set_iosys(0, 0);
+  stream_set_table(origstringtable);
+  valstackbase = 0;
+  localsbase = 0;
+
+  /* Note that we do not reset the protection range. */
+
+  /* Push the first function call. (No arguments.) */
+  enter_function(startfuncaddr, 0, NULL);
+
+  /* We're now ready to execute. */
+}
+
+/* change_memsize():
+   Change the size of the memory map. This may not be available at
+   all; #define FIXED_MEMSIZE if you want the interpreter to
+   unconditionally refuse. The internal flag should be true only when
+   the heap-allocation system is calling.
+   Returns 0 for success; otherwise, the operation failed.
+*/
+glui32 change_memsize(glui32 newlen, int internal)
+{
+  long lx;
+  unsigned char *newmemmap;
+
+  if (newlen == endmem)
+    return 0;
+
+#ifdef FIXED_MEMSIZE
+  return 1;
+#else /* FIXED_MEMSIZE */
+
+  if ((!internal) && heap_is_active())
+    fatal_error("Cannot resize Glulx memory space while heap is active.");
+
+  if (newlen < origendmem)
+    fatal_error("Cannot resize Glulx memory space smaller than it started.");
+
+  if (newlen & 0xFF)
+    fatal_error("Can only resize Glulx memory space to a 256-byte boundary.");
+  
+  newmemmap = (unsigned char *)glulx_realloc(memmap, newlen);
+  if (!newmemmap) {
+    /* The old block is still in place, unchanged. */
+    return 1;
+  }
+  memmap = newmemmap;
+
+  if (newlen > endmem) {
+    for (lx=endmem; lx<newlen; lx++) {
+      memmap[lx] = 0;
+    }
+  }
+
+  endmem = newlen;
+
+  return 0;
+
+#endif /* FIXED_MEMSIZE */
+}
+
+/* pop_arguments():
+   If addr is 0, pop N arguments off the stack, and put them in an array. 
+   If non-0, take N arguments from that main memory address instead.
+   This has to dynamically allocate if there are more than 32 arguments,
+   but that shouldn't be a problem.
+*/
+glui32 *pop_arguments(glui32 count, glui32 addr)
+{
+  int ix;
+  glui32 argptr;
+  glui32 *array;
+
+  #define MAXARGS (32)
+  static glui32 statarray[MAXARGS];
+  static glui32 *dynarray = NULL;
+  static glui32 dynarray_size = 0;
+
+  if (count == 0)
+    return NULL;
+
+  if (count <= MAXARGS) {
+    /* Store in the static array. */
+    array = statarray;
+  }
+  else {
+    if (!dynarray) {
+      dynarray_size = count+8;
+      dynarray = glulx_malloc(sizeof(glui32) * dynarray_size);
+      if (!dynarray)
+        fatal_error("Unable to allocate function arguments.");
+      array = dynarray;
+    }
+    else {
+      if (dynarray_size >= count) {
+        /* It fits. */
+        array = dynarray;
+      }
+      else {
+        dynarray_size = count+8;
+        dynarray = glulx_realloc(dynarray, sizeof(glui32) * dynarray_size);
+        if (!dynarray)
+          fatal_error("Unable to reallocate function arguments.");
+        array = dynarray;
+      }
+    }
+  }
+
+  if (!addr) {
+    if (stackptr < valstackbase+4*count) 
+      fatal_error("Stack underflow in arguments.");
+    stackptr -= 4*count;
+    for (ix=0; ix<count; ix++) {
+      argptr = stackptr+4*((count-1)-ix);
+      array[ix] = Stk4(argptr);
+    }
+  }
+  else {
+    for (ix=0; ix<count; ix++) {
+      array[ix] = Mem4(addr);
+      addr += 4;
+    }
+  }
+
+  return array;
+}
+
+/* verify_address():
+   Make sure that count bytes beginning with addr all fall within the
+   current memory map. This is called at every memory access if
+   VERIFY_MEMORY_ACCESS is defined in the header file.
+*/
+void verify_address(glui32 addr, glui32 count)
+{
+  if (addr >= endmem)
+    fatal_error_i("Memory access out of range", addr);
+  if (count > 1) {
+    addr += (count-1);
+    if (addr >= endmem)
+      fatal_error_i("Memory access out of range", addr);
+  }
+}
+
index 913bb204321541a4280699eea25f5bdf370122d7..ba1e1d8d9fae46a8fb68ab1ed64723e0e9f1f44a 100644 (file)
@@ -39,7 +39,7 @@ libchimara_la_CFLAGS = @CHIMARA_CFLAGS@ $(AM_CFLAGS)
 libchimara_la_LIBADD = @CHIMARA_LIBS@
 libchimara_la_LDFLAGS = -version-info $(LT_VERSION_INFO) \
        -no-undefined \
-       -export-symbols-regex "^(glk_|chimara_glk_|glkunix_|giblorb_|garglk_)"
+       -export-symbols-regex "^(glk|chimara_glk|glkunix|giblorb|gidispatch|garglk)_"
 libchimara_includedir = $(includedir)/chimara/libchimara
 libchimara_include_HEADERS = \
        chimara-glk.h \
index 94755c8a6c2b0c33fbc74b270caa4cccd5e6a56c..4acd4ed4072d13e6e312462c0ee338eb6e91a415 100644 (file)
@@ -154,7 +154,7 @@ main(int argc, char *argv[])
        g_object_unref( G_OBJECT(builder) );
        g_object_unref( G_OBJECT(uimanager) );
 
-    if( !chimara_glk_run(CHIMARA_GLK(glk), "../interpreters/frotz/.libs/frotz.so", argc, argv, &error) ) {
+    if( !chimara_glk_run(CHIMARA_GLK(glk), "../interpreters/glulxe/.libs/glulxe.so", argc, argv, &error) ) {
                error_dialog(GTK_WINDOW(window), error, "Error starting Glk library: ");
                return 1;
        }
diff --git a/tests/photo201.blb b/tests/photo201.blb
new file mode 100644 (file)
index 0000000..fa6c0ff
Binary files /dev/null and b/tests/photo201.blb differ