aboutsummaryrefslogtreecommitdiff
path: root/engines/glk/tads/tads2
diff options
context:
space:
mode:
authorPaul Gilbert2019-05-17 14:48:01 -1000
committerPaul Gilbert2019-05-24 18:21:06 -0700
commitf607792fa4e1f024dd8265034ac84425bde4aee7 (patch)
tree19372287bea6cc0b4cbfdc717510cc9419fd9b04 /engines/glk/tads/tads2
parent105a1b94bd9d5a0f10752e135671f4e9a4b0d8da (diff)
downloadscummvm-rg350-f607792fa4e1f024dd8265034ac84425bde4aee7.tar.gz
scummvm-rg350-f607792fa4e1f024dd8265034ac84425bde4aee7.tar.bz2
scummvm-rg350-f607792fa4e1f024dd8265034ac84425bde4aee7.zip
GLK: TADS2: More code files implemented
Diffstat (limited to 'engines/glk/tads/tads2')
-rw-r--r--engines/glk/tads/tads2/file_io.cpp1742
-rw-r--r--engines/glk/tads/tads2/line_source_file.cpp1037
-rw-r--r--engines/glk/tads/tads2/memory_cache.cpp1156
-rw-r--r--engines/glk/tads/tads2/memory_cache_loader.cpp31
-rw-r--r--engines/glk/tads/tads2/memory_cache_swap.cpp300
-rw-r--r--engines/glk/tads/tads2/object.cpp1045
-rw-r--r--engines/glk/tads/tads2/opcode.h (renamed from engines/glk/tads/tads2/opcode_defs.h)4
-rw-r--r--engines/glk/tads/tads2/post_compilation.cpp466
-rw-r--r--engines/glk/tads/tads2/run.h2
9 files changed, 5747 insertions, 36 deletions
diff --git a/engines/glk/tads/tads2/file_io.cpp b/engines/glk/tads/tads2/file_io.cpp
index 581601fbf0..d82f67abea 100644
--- a/engines/glk/tads/tads2/file_io.cpp
+++ b/engines/glk/tads/tads2/file_io.cpp
@@ -21,12 +21,1754 @@
*/
#include "glk/tads/tads2/file_io.h"
+#include "glk/tads/tads2/appctx.h"
+#include "glk/tads/tads2/character_map.h"
+#include "glk/tads/tads2/error.h"
+#include "glk/tads/tads2/memory_cache_heap.h"
+#include "glk/tads/tads2/os.h"
+#include "glk/tads/tads2/run.h"
+#include "glk/tads/tads2/tokenizer.h"
+#include "glk/tads/tads2/vocabulary.h"
+#include "glk/tads/os_glk.h"
namespace Glk {
namespace TADS {
namespace TADS2 {
+/* compare a resource string */
+/* int fioisrsc(uchar *filbuf, char *refnam); */
+#define fioisrsc(filbuf, refnam) \
+ (((filbuf)[0] == strlen(refnam)) && \
+ !memcmp(filbuf+1, refnam, (size_t)((filbuf)[0])))
+
+/* callback to load an object on demand */
+void OS_LOADDS fioldobj(void *ctx0, mclhd handle, uchar *ptr, ushort siz)
+{
+ fiolcxdef *ctx = (fiolcxdef *)ctx0;
+ ulong seekpos = (ulong)handle;
+ osfildef *fp = ctx->fiolcxfp;
+ char buf[7];
+ errcxdef *ec = ctx->fiolcxerr;
+ uint rdsiz;
+
+ /* figure out what type of object is to be loaded */
+ osfseek(fp, seekpos + ctx->fiolcxst, OSFSK_SET);
+ if (osfrb(fp, buf, 7)) errsig(ec, ERR_LDGAM);
+ switch(buf[0])
+ {
+ case TOKSTFUNC:
+ rdsiz = osrp2(buf + 3);
+ break;
+
+ case TOKSTOBJ:
+ rdsiz = osrp2(buf + 5);
+ break;
+
+ case TOKSTFWDOBJ:
+ case TOKSTFWDFN:
+ default:
+ errsig(ec, ERR_UNKOTYP);
+ }
+
+ if (siz < rdsiz) errsig(ec, ERR_LDBIG);
+ if (osfrb(fp, ptr, rdsiz)) errsig(ec, ERR_LDGAM);
+ if (ctx->fiolcxflg & FIOFCRYPT)
+ fioxor(ptr, rdsiz, ctx->fiolcxseed, ctx->fiolcxinc);
+}
+
+/* shut down load-on-demand subsystem (close load file) */
+void fiorcls(fiolcxdef *ctx)
+{
+ if (ctx != 0 && ctx->fiolcxfp != 0)
+ {
+ /* close the file */
+ osfcls(ctx->fiolcxfp);
+
+ /* forget the file object */
+ ctx->fiolcxfp = 0;
+ }
+}
+
+/*
+ * Read an HTMLRES resource map
+ */
+static void fiordhtml(errcxdef *ec, osfildef *fp, appctxdef *appctx,
+ int resfileno, const char *resfilename)
+{
+ uchar buf[256];
+
+ /*
+ * resource map - if the host system is interested, tell it about it
+ */
+ if (appctx != 0)
+ {
+ ulong entry_cnt;
+ ulong i;
+
+ /* read the index table header */
+ if (osfrb(fp, buf, 8))
+ errsig1(ec, ERR_RDRSC, ERRTSTR,
+ errstr(ec, resfilename, strlen(resfilename)));
+
+ /* get the number of entries in the table */
+ entry_cnt = osrp4(buf);
+
+ /* read the index entries */
+ for (i = 0 ; i < entry_cnt ; ++i)
+ {
+ ulong res_ofs;
+ ulong res_siz;
+ ushort res_namsiz;
+
+ /* read this entry */
+ if (osfrb(fp, buf, 10))
+ errsig1(ec, ERR_RDRSC, ERRTSTR,
+ errstr(ec, resfilename, strlen(resfilename)));
+
+ /* get the entry header */
+ res_ofs = osrp4(buf);
+ res_siz = osrp4(buf + 4);
+ res_namsiz = osrp2(buf + 8);
+
+ /* read this entry's name */
+ if (osfrb(fp, buf, res_namsiz))
+ errsig1(ec, ERR_RDRSC, ERRTSTR,
+ errstr(ec, resfilename, strlen(resfilename)));
+
+ /* tell the host system about this entry */
+ if (appctx->add_resource)
+ (*appctx->add_resource)(appctx->add_resource_ctx,
+ res_ofs, res_siz,
+ (char *)buf,
+ (size_t)res_namsiz,
+ resfileno);
+ }
+
+ /* tell the host system where the resources start */
+ if (appctx->set_resmap_seek != 0)
+ {
+ long pos = osfpos(fp);
+ (*appctx->set_resmap_seek)(appctx->set_resmap_seek_ctx,
+ pos, resfileno);
+ }
+ }
+}
+
+/*
+ * Read an external resource file. This is a limited version of the
+ * general file reader that can only read resource files, not full game
+ * files.
+ */
+static void fiordrscext(errcxdef *ec, osfildef *fp, appctxdef *appctx,
+ int resfileno, char *resfilename)
+{
+ uchar buf[TOKNAMMAX + 50];
+ unsigned long endpos;
+ unsigned long startofs;
+
+ /* note the starting offset */
+ startofs = osfpos(fp);
+
+ /* check file and version headers, and get flags and timestamp */
+ if (osfrb(fp, buf, (int)(sizeof(FIOFILHDR) + sizeof(FIOVSNHDR) + 2)))
+ errsig1(ec, ERR_RDRSC, ERRTSTR,
+ errstr(ec, resfilename, strlen(resfilename)));
+ if (memcmp(buf, FIOFILHDRRSC, (size_t)sizeof(FIOFILHDRRSC)))
+ errsig1(ec, ERR_BADHDRRSC, ERRTSTR,
+ errstr(ec, resfilename, strlen(resfilename)));
+ if (memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR,
+ (size_t)sizeof(FIOVSNHDR))
+ && memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR2,
+ (size_t)sizeof(FIOVSNHDR2))
+ && memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR3,
+ (size_t)sizeof(FIOVSNHDR3)))
+ errsig(ec, ERR_BADVSN);
+ if (osfrb(fp, buf, (size_t)26))
+ errsig1(ec, ERR_RDRSC, ERRTSTR,
+ errstr(ec, resfilename, strlen(resfilename)));
+
+ /* now read resources from the file */
+ for (;;)
+ {
+ /* read resource type and next-resource pointer */
+ if (osfrb(fp, buf, 1)
+ || osfrb(fp, buf + 1, (int)(buf[0] + 4)))
+ errsig1(ec, ERR_RDRSC, ERRTSTR,
+ errstr(ec, resfilename, strlen(resfilename)));
+ endpos = osrp4(buf + 1 + buf[0]);
+
+ /* check the resource type */
+ if (fioisrsc(buf, "HTMLRES"))
+ {
+ /* read the HTML resource map */
+ fiordhtml(ec, fp, appctx, resfileno, resfilename);
+
+ /*
+ * skip the resources - they're entirely for the host
+ * application's use
+ */
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+ else if (fioisrsc(buf, "$EOF"))
+ {
+ /* we're done reading the file */
+ break;
+ }
+ else
+ errsig(ec, ERR_UNKRSC);
+ }
+}
+
+/*
+ * read a game from a binary file
+ *
+ * flags:
+ * &1 ==> run preinit
+ * &2 ==> preload objects
+ */
+static void fiord1(mcmcxdef *mctx, voccxdef *vctx, tokcxdef *tctx,
+ osfildef *fp, const char *fname,
+ fiolcxdef *setupctx, ulong startofs,
+ objnum *preinit, uint *flagp, tokpdef *path,
+ uchar **fmtsp, uint *fmtlp, uint *pcntptr, int flags,
+ appctxdef *appctx, char *argv0)
+{
+ int i;
+ int siz;
+ uchar buf[TOKNAMMAX + 50];
+ errcxdef *ec = vctx->voccxerr;
+ ulong endpos;
+ int obj;
+ ulong curpos;
+ runxdef *ex;
+ ulong eof_reset = 0; /* reset here at EOF if non-zero */
+#if 0 // XFCNs are obsolete
+ int xfcns_done = FALSE; /* already loaded XFCNs */
+#endif
+ ulong xfcn_pos = 0; /* location of XFCN's if preloadable */
+ uint xor_seed = 17; /* seed value for fioxor */
+ uint xor_inc = 29; /* increment value for fioxor */
+
+ /* set up loader callback context */
+ setupctx->fiolcxfp = fp;
+ setupctx->fiolcxerr = ec;
+ setupctx->fiolcxst = startofs;
+ setupctx->fiolcxseed = xor_seed;
+ setupctx->fiolcxinc = xor_inc;
+
+ /* check file and version headers, and get flags and timestamp */
+ if (osfrb(fp, buf, (int)(sizeof(FIOFILHDR) + sizeof(FIOVSNHDR) + 2)))
+ errsig(ec, ERR_RDGAM);
+ if (memcmp(buf, FIOFILHDR, (size_t)sizeof(FIOFILHDR)))
+ errsig(ec, ERR_BADHDR);
+ if (memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR,
+ (size_t)sizeof(FIOVSNHDR))
+ && memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR2,
+ (size_t)sizeof(FIOVSNHDR2))
+ && memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR3,
+ (size_t)sizeof(FIOVSNHDR3)))
+ errsig(ec, ERR_BADVSN);
+ if (osfrb(fp, vctx->voccxtim, (size_t)26)) errsig(ec, ERR_RDGAM);
+
+ /*
+ * if the game wasn't compiled with 2.2 or later, make a note,
+ * because we need to ignore certain property flags (due to a bug in
+ * the old compiler)
+ */
+ if (memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR2,
+ (size_t)sizeof(FIOVSNHDR2)) == 0
+ || memcmp(buf + sizeof(FIOFILHDR), FIOVSNHDR3,
+ (size_t)sizeof(FIOVSNHDR3)) == 0)
+ mctx->mcmcxflg |= MCMCXF_NO_PRP_DEL;
+
+ setupctx->fiolcxflg =
+ *flagp = osrp2(buf + sizeof(FIOFILHDR) + sizeof(FIOVSNHDR));
+
+ /* now read resources from the file */
+ for (;;)
+ {
+ /* read resource type and next-resource pointer */
+ if (osfrb(fp, buf, 1)
+ || osfrb(fp, buf + 1, (int)(buf[0] + 4)))
+ errsig(ec, ERR_RDGAM);
+ endpos = osrp4(buf + 1 + buf[0]);
+
+ if (fioisrsc(buf, "OBJ"))
+ {
+ /* skip regular objects if fast-load records are included */
+ if (*flagp & FIOFFAST)
+ {
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ continue;
+ }
+
+ curpos = osfpos(fp) - startofs;
+ while (curpos != endpos)
+ {
+ /* read type and object number */
+ if (osfrb(fp, buf, 3)) errsig(ec, ERR_RDGAM);
+ obj = osrp2(buf+1);
+
+ switch(buf[0])
+ {
+ case TOKSTFUNC:
+ case TOKSTOBJ:
+ if (osfrb(fp, buf + 3, 4)) errsig(ec, ERR_RDGAM);
+ mcmrsrv(mctx, (ushort)osrp2(buf + 3), (mcmon)obj,
+ (mclhd)curpos);
+ curpos += osrp2(buf + 5) + 7;
+
+ /* load object if preloading */
+ if (flags & 2)
+ {
+ (void)mcmlck(mctx, (mcmon)obj);
+ mcmunlck(mctx, (mcmon)obj);
+ }
+
+ /* seek past this object */
+ osfseek(fp, curpos + startofs, OSFSK_SET);
+ break;
+
+ case TOKSTFWDOBJ:
+ case TOKSTFWDFN:
+ {
+ ushort bsiz;
+ uchar *p;
+
+ if (osfrb(fp, buf+3, 2)) errsig(ec, ERR_RDGAM);
+ bsiz = osrp2(buf+3);
+ p = mcmalonum(mctx, bsiz, (mcmon)obj);
+ if (osfrb(fp, p, bsiz)) errsig(ec, ERR_RDGAM);
+ mcmunlck(mctx, (mcmon)obj);
+ curpos += 5 + bsiz;
+ break;
+ }
+
+ case TOKSTEXTERN:
+ if (!vctx->voccxrun->runcxext)
+ errsig(ec, ERR_UNXEXT);
+ ex = &vctx->voccxrun->runcxext[obj];
+
+ if (osfrb(fp, buf + 3, 1)
+ || osfrb(fp, ex->runxnam, (int)buf[3]))
+ errsig(ec, ERR_RDGAM);
+ ex->runxnam[buf[3]] = '\0';
+ curpos += buf[3] + 4;
+ break;
+
+ default:
+ errsig(ec, ERR_UNKOTYP);
+ }
+ }
+ }
+ else if (fioisrsc(buf, "FST"))
+ {
+ uchar *p;
+ uchar *bufp;
+ ulong bsiz;
+
+ if (!(*flagp & FIOFFAST))
+ {
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ continue;
+ }
+
+ curpos = osfpos(fp) - startofs;
+ bsiz = endpos - curpos;
+ if (bsiz && bsiz < OSMALMAX
+ && (bufp = p = (uchar *)osmalloc((size_t)bsiz)) != 0)
+ {
+ uchar *p1;
+ ulong siz2;
+ uint sizcur;
+
+ for (p1 = p, siz2 = bsiz ; siz2 ; siz2 -= sizcur, p1 += sizcur)
+ {
+ sizcur = (siz2 > (uint)0xffff ? (uint)0xffff : siz2);
+ if (osfrb(fp, p1, sizcur)) errsig(ec, ERR_RDGAM);
+ }
+
+ while (bsiz)
+ {
+ obj = osrp2(p + 1);
+ switch(*p)
+ {
+ case TOKSTFUNC:
+ case TOKSTOBJ:
+ mcmrsrv(mctx, (ushort)osrp2(p + 3), (mcmon)obj,
+ (mclhd)osrp4(p + 7));
+ p += 11;
+ bsiz -= 11;
+
+ /* preload object if desired */
+ if (flags & 2)
+ {
+ (void)mcmlck(mctx, (mcmon)obj);
+ mcmunlck(mctx, (mcmon)obj);
+ }
+ break;
+
+ case TOKSTEXTERN:
+ if (!vctx->voccxrun->runcxext)
+ errsig(ec, ERR_UNXEXT);
+ ex = &vctx->voccxrun->runcxext[obj];
+
+ memcpy(ex->runxnam, p + 4, (size_t)p[3]);
+ ex->runxnam[p[3]] = '\0';
+ bsiz -= p[3] + 4;
+ p += p[3] + 4;
+ break;
+
+ default:
+ errsig(ec, ERR_UNKOTYP);
+ }
+ }
+
+ /* done with temporary block; free it */
+ osfree(bufp);
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+ else
+ {
+ while (curpos != endpos)
+ {
+ if (osfrb(fp, buf, 3)) errsig(ec, ERR_RDGAM);
+ obj = osrp2(buf + 1);
+ switch(buf[0])
+ {
+ case TOKSTFUNC:
+ case TOKSTOBJ:
+ if (osfrb(fp, buf + 3, 8)) errsig(ec, ERR_RDGAM);
+ mcmrsrv(mctx, (ushort)osrp2(buf + 3), (mcmon)obj,
+ (mclhd)osrp4(buf + 7));
+ curpos += 11;
+
+ /* preload object if desired */
+ if (flags & 2)
+ {
+ (void)mcmlck(mctx, (mcmon)obj);
+ mcmunlck(mctx, (mcmon)obj);
+ osfseek(fp, curpos + startofs, OSFSK_SET);
+ }
+ break;
+
+ case TOKSTEXTERN:
+ if (!vctx->voccxrun->runcxext)
+ errsig(ec, ERR_UNXEXT);
+ ex = &vctx->voccxrun->runcxext[obj];
+
+ if (osfrb(fp, buf + 3, 1)
+ || osfrb(fp, ex->runxnam, (int)buf[3]))
+ errsig(ec, ERR_RDGAM);
+ ex->runxnam[buf[3]] = '\0';
+ curpos += buf[3] + 4;
+ break;
+
+ default:
+ errsig(ec, ERR_UNKOTYP);
+ }
+ }
+ }
+
+ /* if we can preload xfcn's, do so now */
+ if (xfcn_pos)
+ {
+ eof_reset = endpos; /* remember to return here when done */
+ osfseek(fp, xfcn_pos, OSFSK_SET); /* go to xfcn's */
+ }
+ }
+ else if (fioisrsc(buf, "XFCN"))
+ {
+ if (!vctx->voccxrun->runcxext) errsig(ec, ERR_UNXEXT);
+
+ /* read length and name of resource */
+ if (osfrb(fp, buf, 3) || osfrb(fp, buf + 3, (int)buf[2]))
+ errsig(ec, ERR_RDGAM);
+ siz = osrp2(buf);
+
+#if 0
+/*
+ * external functions are now obsolete - do not load
+ */
+
+ /* look for an external function with the same name */
+ for (i = vctx->voccxrun->runcxexc, ex = vctx->voccxrun->runcxext
+ ; i ; ++ex, --i)
+ {
+ j = strlen(ex->runxnam);
+ if (j == buf[2] && !memcmp(buf + 3, ex->runxnam, (size_t)j))
+ break;
+ }
+
+ /* if we found an external function of this name, load it */
+ if (i && !xfcns_done)
+ {
+ /* load the function */
+ ex->runxptr = os_exfld(fp, (unsigned)siz);
+ }
+ else
+ {
+ /* this XFCN isn't used; don't bother loading it */
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+#else
+ /* external functions are obsolete; simply skip the data */
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+#endif
+ }
+ else if (fioisrsc(buf, "HTMLRES"))
+ {
+ /* read the resources */
+ fiordhtml(ec, fp, appctx, 0, fname);
+
+ /*
+ * skip the resources - they're entirely for the host
+ * application's use
+ */
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+ else if (fioisrsc(buf, "INH"))
+ {
+ uchar *p;
+ uchar *bufp;
+ ulong bsiz;
+
+ /* do it in a single file read, if we can, for speed */
+ curpos = osfpos(fp) - startofs;
+ bsiz = endpos - curpos;
+ if (bsiz && bsiz < OSMALMAX
+ && (bufp = p = (uchar *)osmalloc((size_t)bsiz)) != 0)
+ {
+ uchar *p1;
+ ulong siz2;
+ uint sizcur;
+
+ for (p1 = p, siz2 = bsiz ; siz2 ; siz2 -= sizcur, p1 += sizcur)
+ {
+ sizcur = (siz2 > (uint)0xffff ? (uint)0xffff : siz2);
+ if (osfrb(fp, p1, sizcur)) errsig(ec, ERR_RDGAM);
+ }
+
+ while (bsiz)
+ {
+ i = osrp2(p + 7);
+ obj = osrp2(p + 1);
+
+ vociadd(vctx, (objnum)obj, (objnum)osrp2(p+3), i,
+ (objnum *)(p + 9), p[0] | VOCIFXLAT);
+ vocinh(vctx, obj)->vociilc = osrp2(p + 5);
+
+ p += 9 + (2 * i);
+ bsiz -= 9 + (2 * i);
+ }
+
+ /* done with temporary block; free it */
+ osfree(bufp);
+ }
+ else
+ {
+ while (curpos != endpos)
+ {
+ if (osfrb(fp, buf, 9)) errsig(ec, ERR_RDGAM);
+ i = osrp2(buf + 7); /* get number of superclasses */
+ obj = osrp2(buf + 1); /* get object number */
+ if (i && osfrb(fp, buf + 9, 2 * i)) errsig(ec, ERR_RDGAM);
+
+ vociadd(vctx, (objnum)obj, (objnum)osrp2(buf+3),
+ i, (objnum *)(buf + 9), buf[0] | VOCIFXLAT);
+ vocinh(vctx, obj)->vociilc = osrp2(buf + 5);
+
+ curpos += 9 + (2 * i);
+ }
+ }
+ }
+ else if (fioisrsc(buf, "REQ"))
+ {
+ curpos = osfpos(fp) - startofs;
+ siz = endpos - curpos;
+
+ if (osfrb(fp, buf, (uint)siz)) errsig(ec, ERR_RDGAM);
+ vctx->voccxme = vctx->voccxme_init = osrp2(buf);
+ vctx->voccxvtk = osrp2(buf+2);
+ vctx->voccxstr = osrp2(buf+4);
+ vctx->voccxnum = osrp2(buf+6);
+ vctx->voccxprd = osrp2(buf+8);
+ vctx->voccxvag = osrp2(buf+10);
+ vctx->voccxini = osrp2(buf+12);
+ vctx->voccxpre = osrp2(buf+14);
+ vctx->voccxper = osrp2(buf+16);
+
+ /* if we have a cmdPrompt function, read it */
+ if (siz >= 20)
+ vctx->voccxprom = osrp2(buf + 18);
+ else
+ vctx->voccxprom = MCMONINV;
+
+ /* if we have the NLS functions, read them */
+ if (siz >= 26)
+ {
+ vctx->voccxpdis = osrp2(buf + 20);
+ vctx->voccxper2 = osrp2(buf + 22);
+ vctx->voccxpdef = osrp2(buf + 24);
+ }
+ else
+ {
+ /* the new NLS functions aren't defined in this file */
+ vctx->voccxpdis = MCMONINV;
+ vctx->voccxper2 = MCMONINV;
+ vctx->voccxpdef = MCMONINV;
+ }
+
+ /* test for parseAskobj separately, as it was added later */
+ if (siz >= 28)
+ vctx->voccxpask = osrp2(buf + 26);
+ else
+ vctx->voccxpask = MCMONINV;
+
+ /* test for preparseCmd separately - it's another late comer */
+ if (siz >= 30)
+ vctx->voccxppc = osrp2(buf + 28);
+ else
+ vctx->voccxppc = MCMONINV;
+
+ /* check for parseAskobjActor separately - another late comer */
+ if (siz >= 32)
+ vctx->voccxpask2 = osrp2(buf + 30);
+ else
+ vctx->voccxpask2 = MCMONINV;
+
+ /* if we have parseErrorParam, read it as well */
+ if (siz >= 34)
+ {
+ vctx->voccxperp = osrp2(buf + 32);
+ }
+ else
+ {
+ /* parseErrorParam isn't defined in this file */
+ vctx->voccxperp = MCMONINV;
+ }
+
+ /*
+ * if we have commandAfterRead and initRestore, read them as
+ * well
+ */
+ if (siz >= 38)
+ {
+ vctx->voccxpostprom = osrp2(buf + 34);
+ vctx->voccxinitrestore = osrp2(buf + 36);
+ }
+ else
+ {
+ /* these new functions aren't defined in this game */
+ vctx->voccxpostprom = MCMONINV;
+ vctx->voccxinitrestore = MCMONINV;
+ }
+
+ /* check for and read parseUnknownVerb, parseNounPhrase */
+ if (siz >= 42)
+ {
+ vctx->voccxpuv = osrp2(buf + 38);
+ vctx->voccxpnp = osrp2(buf + 40);
+ }
+ else
+ {
+ vctx->voccxpuv = MCMONINV;
+ vctx->voccxpnp = MCMONINV;
+ }
+
+ /* check for postAction, endCommand */
+ if (siz >= 48)
+ {
+ vctx->voccxpostact = osrp2(buf + 42);
+ vctx->voccxendcmd = osrp2(buf + 44);
+ vctx->voccxprecmd = osrp2(buf + 46);
+ }
+ else
+ {
+ vctx->voccxpostact = MCMONINV;
+ vctx->voccxendcmd = MCMONINV;
+ vctx->voccxprecmd = MCMONINV;
+ }
+
+ /* check for parseAskobjIndirect */
+ if (siz >= 50)
+ vctx->voccxpask3 = osrp2(buf + 48);
+ else
+ vctx->voccxpask3 = MCMONINV;
+
+ /* check for preparseExt and parseDefaultExt */
+ if (siz >= 54)
+ {
+ vctx->voccxpre2 = osrp2(buf + 50);
+ vctx->voccxpdef2 = osrp2(buf + 52);
+ }
+ else
+ {
+ vctx->voccxpre2 = MCMONINV;
+ vctx->voccxpdef2 = MCMONINV;
+ }
+ }
+ else if (fioisrsc(buf, "VOC"))
+ {
+ uchar *p;
+ uchar *bufp;
+ ulong bsiz;
+ int len1;
+ int len2;
+
+ /* do it in a single file read, if we can, for speed */
+ curpos = osfpos(fp) - startofs;
+ bsiz = endpos - curpos;
+ if (bsiz && bsiz < OSMALMAX
+ && (bufp = p = (uchar *)osmalloc((size_t)bsiz)) != 0)
+ {
+ uchar *p1;
+ ulong siz2;
+ uint sizcur;
+
+ for (p1 = p, siz2 = bsiz ; siz2 ; siz2 -= sizcur, p1 += sizcur)
+ {
+ sizcur = (siz2 > (uint)0xffff ? (uint)0xffff : siz2);
+ if (osfrb(fp, p1, sizcur)) errsig(ec, ERR_RDGAM);
+ }
+
+ while (bsiz)
+ {
+ len1 = osrp2(p);
+ len2 = osrp2(p + 2);
+ if (*flagp & FIOFCRYPT)
+ fioxor(p + 10, (uint)(len1 + len2),
+ xor_seed, xor_inc);
+ vocadd2(vctx, (prpnum)osrp2(p+4), (objnum)osrp2(p+6),
+ osrp2(p+8), p + 10, len1,
+ (len2 ? p + 10 + len1 : (uchar*)0), len2);
+
+ p += 10 + len1 + len2;
+ bsiz -= 10 + len1 + len2;
+ }
+
+ /* done with the temporary block; free it up */
+ osfree(bufp);
+ }
+ else
+ {
+ /* can't do it in one file read; do it the slow way */
+ while (curpos != endpos)
+ {
+ if (osfrb(fp, buf, 10)
+ || osfrb(fp, buf + 10,
+ (len1 = osrp2(buf)) + (len2 = osrp2(buf + 2))))
+ errsig(ec, ERR_RDGAM);
+
+ if (*flagp & FIOFCRYPT)
+ fioxor(buf + 10, (uint)(len1 + len2),
+ xor_seed, xor_inc);
+ vocadd2(vctx, (prpnum)osrp2(buf+4), (objnum)osrp2(buf+6),
+ osrp2(buf+8), buf + 10, len1,
+ (len2 ? buf + 10 + len1 : (uchar*)0), len2);
+ curpos += 10 + len1 + len2;
+ }
+ }
+ }
+ else if (fioisrsc(buf, "FMTSTR"))
+ {
+ uchar *fmts;
+ uint fmtl;
+
+ if (osfrb(fp, buf, 2)) errsig(ec, ERR_RDGAM);
+ fmtl = osrp2(buf);
+ fmts = mchalo(vctx->voccxerr, fmtl, "fiord1");
+ if (osfrb(fp, fmts, fmtl)) errsig(ec, ERR_RDGAM);
+ if (*flagp & FIOFCRYPT) fioxor(fmts, fmtl, xor_seed, xor_inc);
+ tiosetfmt(vctx->voccxtio, vctx->voccxrun, fmts, fmtl);
+
+ if (fmtsp) *fmtsp = fmts;
+ if (fmtlp) *fmtlp = fmtl;
+ }
+ else if (fioisrsc(buf, "CMPD"))
+ {
+ if (osfrb(fp, buf, 2)) errsig(ec, ERR_RDGAM);
+ vctx->voccxcpl = osrp2(buf);
+ vctx->voccxcpp = (char *)mchalo(vctx->voccxerr,
+ vctx->voccxcpl, "fiord1");
+ if (osfrb(fp, vctx->voccxcpp, (uint)vctx->voccxcpl))
+ errsig(ec, ERR_RDGAM);
+ if (*flagp & FIOFCRYPT)
+ fioxor((uchar *)vctx->voccxcpp, (uint)vctx->voccxcpl,
+ xor_seed, xor_inc);
+ }
+ else if (fioisrsc(buf, "SPECWORD"))
+ {
+ if (osfrb(fp, buf, 2)) errsig(ec, ERR_RDGAM);
+ vctx->voccxspl = osrp2(buf);
+ vctx->voccxspp = (char *)mchalo(vctx->voccxerr,
+ vctx->voccxspl, "fiord1");
+ if (osfrb(fp, vctx->voccxspp, (uint)vctx->voccxspl))
+ errsig(ec, ERR_RDGAM);
+ if (*flagp & FIOFCRYPT)
+ fioxor((uchar *)vctx->voccxspp, (uint)vctx->voccxspl,
+ xor_seed, xor_inc);
+ }
+ else if (fioisrsc(buf, "SYMTAB"))
+ {
+ tokthdef *symtab;
+
+ /* if there's no debugger context, don't bother with this */
+ if (!vctx->voccxrun->runcxdbg)
+ {
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ continue;
+ }
+
+ if (!(symtab = vctx->voccxrun->runcxdbg->dbgcxtab))
+ {
+ symtab = (tokthdef *)mchalo(ec, sizeof(tokthdef),
+ "fiord:symtab");
+ tokthini(ec, mctx, (toktdef *)symtab);
+ vctx->voccxrun->runcxdbg->dbgcxtab = symtab;
+ }
+
+ /* read symbols until we find a zero-length symbol */
+ for (;;)
+ {
+ int hash;
+
+ if (osfrb(fp, buf, 4)) errsig(ec, ERR_RDGAM);
+ if (buf[0] == 0) break;
+ if (osfrb(fp, buf + 4, (int)buf[0])) errsig(ec, ERR_RDGAM);
+ buf[4 + buf[0]] = '\0';
+ hash = tokhsh((char *)buf + 4);
+
+ (*symtab->tokthsc.toktfadd)((toktdef *)symtab,
+ (char *)buf + 4,
+ (int)buf[0], (int)buf[1],
+ osrp2(buf + 2), hash);
+ }
+ }
+ else if (fioisrsc(buf, "SRC"))
+ {
+ /* skip source file id's if there's no debugger context */
+ if (vctx->voccxrun->runcxdbg == 0)
+ {
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ continue;
+ }
+
+ while ((osfpos(fp) - startofs) != endpos)
+ {
+ /* the only thing we know how to read is linfdef's */
+ if (linfload(fp, vctx->voccxrun->runcxdbg, ec, path))
+ errsig(ec, ERR_RDGAM);
+ }
+ }
+ else if (fioisrsc(buf, "SRC2"))
+ {
+ /*
+ * this is simply a marker indicating that we have new-style
+ * (line-number-based) source debugging information in the
+ * file -- set the new-style debug info flag
+ */
+ if (vctx->voccxrun->runcxdbg != 0)
+ vctx->voccxrun->runcxdbg->dbgcxflg |= DBGCXFLIN2;
+
+ /* the contents are empty - skip the block */
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+ else if (fioisrsc(buf, "PREINIT"))
+ {
+ if (osfrb(fp, buf, 2)) errsig(ec, ERR_RDGAM);
+ *preinit = osrp2(buf);
+ }
+ else if (fioisrsc(buf, "ERRMSG"))
+ {
+ errini(ec, fp);
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+ else if (fioisrsc(buf, "EXTCNT"))
+ {
+ uchar *p;
+ ushort len;
+ ulong bsiz;
+
+ curpos = osfpos(fp) - startofs;
+ bsiz = endpos - curpos;
+ if (osfrb(fp, buf, 2)) errsig(ec, ERR_RDGAM);
+ i = osrp2(buf);
+
+ len = i * sizeof(runxdef);
+ p = mchalo(ec, len, "fiord:runxdef");
+ memset(p, 0, (size_t)len);
+
+ vctx->voccxrun->runcxext = (runxdef *)p;
+ vctx->voccxrun->runcxexc = i;
+
+ /* see if start-of-XFCN information is present */
+ if (bsiz >= 6)
+ {
+ /* get location of first XFCN, and seek there */
+ if (osfrb(fp, buf, 4)) errsig(ec, ERR_RDGAM);
+ xfcn_pos = osrp4(buf);
+ }
+
+ /* seek past this resource */
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+ else if (fioisrsc(buf, "PRPCNT"))
+ {
+ if (osfrb(fp, buf, 2)) errsig(ec, ERR_RDGAM);
+ if (pcntptr) *pcntptr = osrp2(buf);
+ }
+ else if (fioisrsc(buf, "TADSPP") && tctx != 0)
+ {
+ tok_read_defines(tctx, fp, ec);
+ }
+ else if (fioisrsc(buf, "XSI"))
+ {
+ if (osfrb(fp, buf, 2)) errsig(ec, ERR_RDGAM);
+ setupctx->fiolcxseed = xor_seed = buf[0];
+ setupctx->fiolcxinc = xor_inc = buf[1];
+ osfseek(fp, endpos + startofs, OSFSK_SET);
+ }
+ else if (fioisrsc(buf, "CHRSET"))
+ {
+ size_t len;
+
+ /* read the character set ID and LDESC */
+ if (osfrb(fp, buf, 6)
+ || (len = osrp2(buf+4)) > CMAP_LDESC_MAX_LEN
+ || osfrb(fp, buf+6, len))
+ errsig(ec, ERR_RDGAM);
+
+ /* establish this character set mapping */
+ buf[4] = '\0';
+ cmap_set_game_charset(ec, (char *)buf, (char *)buf + 6, argv0);
+ }
+ else if (fioisrsc(buf, "$EOF"))
+ {
+ if (eof_reset)
+ {
+ osfseek(fp, eof_reset, OSFSK_SET); /* back after EXTCNT */
+ eof_reset = 0; /* really done at next EOF */
+#if 0 // XFCNs are obsolete
+ xfcns_done = TRUE; /* don't do XFCNs again */
+#endif
+ }
+ else
+ break;
+ }
+ else
+ errsig(ec, ERR_UNKRSC);
+ }
+}
+
+/* read binary file */
+void fiord(mcmcxdef *mctx, voccxdef *vctx, tokcxdef *tctx, char *fname,
+ char *exename, fiolcxdef *setupctx, objnum *preinit, uint *flagp,
+ tokpdef *path, uchar **fmtsp, uint *fmtlp, uint *pcntptr,
+ int flags, struct appctxdef *appctx, char *argv0)
+{
+ osfildef *fp;
+ ulong startofs;
+ char *display_fname;
+
+ /* presume there will be no need to run preinit */
+ *preinit = MCMONINV;
+
+ /*
+ * get the display filename - use the real filename if one is
+ * provided, otherwise use the name of the executable file itself
+ */
+ display_fname = (fname != 0 ? fname : exename);
+
+ /* save the filename in G_os_gamename */
+ if (display_fname != 0)
+ {
+ size_t copylen;
+
+ /* limit the copy to the buffer size */
+ if ((copylen = strlen(display_fname)) > sizeof(G_os_gamename) - 1)
+ copylen = sizeof(G_os_gamename) - 1;
+
+ /* save it */
+ memcpy(G_os_gamename, display_fname, copylen);
+ G_os_gamename[copylen] = '\0';
+ }
+ else
+ G_os_gamename[0] = '\0';
+
+ /* open the file and read and check file header */
+ fp = (fname != 0 ? osfoprb(fname, OSFTGAME)
+ : os_exeseek(exename, "TGAM"));
+ if (fp == 0)
+ errsig(vctx->voccxerr, ERR_OPRGAM);
+
+ /*
+ * we've identified the .GAM file source - tell the host system
+ * about it, if it's interested
+ */
+ if (appctx != 0 && appctx->set_game_name != 0)
+ (*appctx->set_game_name)(appctx->set_game_name_ctx, display_fname);
+
+ /* remember starting location in file */
+ startofs = osfpos(fp);
+
+ ERRBEGIN(vctx->voccxerr)
+
+ /*
+ * Read the game file. Note that the .GAM file always has resource
+ * file number zero.
+ */
+ fiord1(mctx, vctx, tctx, fp, display_fname,
+ setupctx, startofs, preinit, flagp, path,
+ fmtsp, fmtlp, pcntptr, flags, appctx, argv0);
+
+ /*
+ * If the host system accepts additional resource files, look for
+ * additional resource files. These are files in the same directory
+ * as the .GAM file, with the .GAM suffix replaced by suffixes from
+ *. RS0 to .RS9.
+ */
+ if (appctx != 0 && appctx->add_resfile != 0)
+ {
+ char suffix_lc[4];
+ char suffix_uc[4];
+ int i;
+ char *base_name;
+
+ /* use the game or executable filename, as appropriate */
+ base_name = display_fname;
+
+ /* build the initial suffixes - try both upper- and lower-case */
+ suffix_uc[0] = 'R';
+ suffix_uc[1] = 'S';
+ suffix_uc[3] = '\0';
+ suffix_lc[0] = 'r';
+ suffix_lc[1] = 's';
+ suffix_lc[3] = '\0';
+
+ /* loop through each possible suffix (.RS0 through .RS9) */
+ for (i = 0 ; i < 9 ; ++i)
+ {
+ char resname[OSFNMAX];
+ osfildef *fpres;
+ int resfileno;
+
+ /*
+ * Build the next resource filename. If there's an explicit
+ * resource path, use it, otherwise use the same directory
+ * that contains the .GAM file.
+ */
+ if (appctx->ext_res_path != 0)
+ {
+ /*
+ * There's an explicit resource path - append the root
+ * (filename-only, minus path) portion of the .GAM file
+ * name to the resource path.
+ */
+ os_build_full_path(resname, sizeof(resname),
+ appctx->ext_res_path,
+ os_get_root_name(base_name));
+ }
+ else
+ {
+ /*
+ * there's no resource path - use the entire .GAM
+ * filename, including directory, so that we look in the
+ * same directory that contains the .GAM file
+ */
+ if (base_name != 0)
+ strcpy(resname, base_name);
+ else
+ resname[0] = '\0';
+ }
+
+ /* add the current extension (replacing any current extension) */
+ os_remext(resname);
+ suffix_lc[2] = suffix_uc[2] = '0' + i;
+ os_addext(resname, suffix_lc);
+
+ /* try opening the file */
+ fpres = osfoprb(resname, OSFTGAME);
+
+ /* if that didn't work, try the upper-case name */
+ if (fpres == 0)
+ {
+ /* replace the suffix with the upper-case version */
+ os_remext(resname);
+ os_addext(resname, suffix_uc);
+
+ /* try again with the new name */
+ fpres = osfoprb(resname, OSFTGAME);
+ }
+
+ /* if we opened it successfully, read it */
+ if (fpres != 0)
+ {
+ /* tell the host system about it */
+ resfileno = (*appctx->add_resfile)
+ (appctx->add_resfile_ctx, resname);
+
+ /* read the file */
+ fiordrscext(vctx->voccxerr, fpres, appctx,
+ resfileno, resname);
+
+ /* we're done with the file, so close it */
+ osfcls(fpres);
+ }
+ }
+ }
+
+ ERRCLEAN(vctx->voccxerr)
+ /* if an error occurs during read, clean up by closing the file */
+ osfcls(fp);
+ ERRENDCLN(vctx->voccxerr);
+}
+
+/* save game header */
+#define FIOSAVHDR "TADS2 save\012\015\032"
+
+/* save game header prefix - .GAM file information */
+#define FIOSAVHDR_PREFIX "TADS2 save/g\012\015\032"
+
+/*
+ * Saved game format version string - note that the length of the
+ * version string must be fixed, so when this is updated, it must be
+ * updated to another string of the same length. This should be updated
+ * whenever a change is made to the format that can't be otherwise
+ * detected from the data stream in the saved game file.
+ */
+#define FIOSAVVSN "v2.2.1"
+
+/* old saved game format version strings */
+#define FIOSAVVSN1 "v2.2.0"
+
+/* read fuse/daemon/alarm record */
+static int fiorfda(osfildef *fp, vocddef *p, uint cnt)
+{
+ vocddef *q;
+ uint i;
+ uchar buf[14];
+
+ /* start by clearing out entire record */
+ for (i = 0, q = p ; i < cnt ; ++q, ++i)
+ q->vocdfn = MCMONINV;
+
+ /* now restore all the records from the file */
+ for (;;)
+ {
+ /* read a record, and quit if it's the last one */
+ if (osfrb(fp, buf, 13)) return(TRUE);
+ if ((i = osrp2(buf)) == 0xffff) return(FALSE);
+
+ /* restore this record */
+ q = p + i;
+ q->vocdfn = osrp2(buf+2);
+ q->vocdarg.runstyp = buf[4];
+ switch(buf[4])
+ {
+ case DAT_NUMBER:
+ q->vocdarg.runsv.runsvnum = osrp4s(buf+5);
+ break;
+ case DAT_OBJECT:
+ case DAT_FNADDR:
+ q->vocdarg.runsv.runsvobj = osrp2(buf+5);
+ break;
+ case DAT_PROPNUM:
+ q->vocdarg.runsv.runsvprp = osrp2(buf+5);
+ break;
+ }
+ q->vocdprp = osrp2(buf+9);
+ q->vocdtim = osrp2(buf+11);
+ }
+}
+
+/*
+ * Look in a saved game file to determine if it has information on which
+ * GAM file created it. If the GAM file information is available, this
+ * routine returns true and stores the game file name in the given
+ * buffer; if the information isn't available, we'll return false.
+ */
+int fiorso_getgame(char *saved_file, char *fnamebuf, size_t buflen)
+{
+ osfildef *fp;
+ uint namelen;
+ char buf[sizeof(FIOSAVHDR_PREFIX) + 2];
+
+ /* open the input file */
+ if (!(fp = osfoprb(saved_file, OSFTSAVE)))
+ return FALSE;
+
+ /* read the prefix header and check */
+ if (osfrb(fp, buf, (int)(sizeof(FIOSAVHDR_PREFIX) + 2))
+ || memcmp(buf, FIOSAVHDR_PREFIX, sizeof(FIOSAVHDR_PREFIX)) != 0)
+ {
+ /*
+ * there's no game file information - close the file and
+ * indicate that we have no information
+ */
+ osfcls(fp);
+ return FALSE;
+ }
+
+ /* get the length of the filename */
+ namelen = osrp2(buf + sizeof(FIOSAVHDR_PREFIX));
+ if (namelen > buflen - 1)
+ namelen = buflen - 1;
+
+ /* read the filename */
+ if (osfrb(fp, fnamebuf, namelen))
+ {
+ osfcls(fp);
+ return FALSE;
+ }
+
+ /* null-terminate the string */
+ fnamebuf[namelen] = '\0';
+
+ /* done with the file */
+ osfcls(fp);
+
+ /* indicate that we found the information */
+ return TRUE;
+}
+
+/* restore game: returns TRUE on failure */
+int fiorso(voccxdef *vctx, char *fname)
+{
+ osfildef *fp;
+ objnum obj;
+ uchar *p;
+ uchar *mut;
+ uint mutsiz;
+ uint oldmutsiz;
+ int propcnt;
+ mcmcxdef *mctx = vctx->voccxmem;
+ uchar buf[sizeof(FIOSAVHDR) + sizeof(FIOSAVVSN)];
+ ushort newsiz;
+ int err = FALSE;
+ char timestamp[26];
+ int version = 0; /* version ID - 0 = current version */
+ int result;
+
+ /* presume success */
+ result = FIORSO_SUCCESS;
+
+ /* open the input file */
+ if (!(fp = osfoprb(fname, OSFTSAVE)))
+ return FIORSO_FILE_NOT_FOUND;
+
+ /* check for a prefix header - if it's there, skip it */
+ if (!osfrb(fp, buf, (int)(sizeof(FIOSAVHDR_PREFIX) + 2))
+ && memcmp(buf, FIOSAVHDR_PREFIX, sizeof(FIOSAVHDR_PREFIX)) == 0)
+ {
+ ulong skip_len;
+
+ /*
+ * The prefix header is present - skip it. The 2-byte value
+ * following the header is the length of the prefix data block
+ * (not including the header), so simply skip the additional
+ * number of bytes specified.
+ */
+ skip_len = (ulong)osrp2(buf + sizeof(FIOSAVHDR_PREFIX));
+ osfseek(fp, skip_len, OSFSK_CUR);
+ }
+ else
+ {
+ /*
+ * there's no prefix header - seek back to the start of the file
+ * and read the standard header information
+ */
+ osfseek(fp, 0, OSFSK_SET);
+ }
+
+
+ /* read headers and check */
+ if (osfrb(fp, buf, (int)(sizeof(FIOSAVHDR) + sizeof(FIOSAVVSN)))
+ || memcmp(buf, FIOSAVHDR, (size_t)sizeof(FIOSAVHDR)))
+ {
+ /* it's not a saved game file */
+ result = FIORSO_NOT_SAVE_FILE;
+ goto ret_error;
+ }
+
+ /* check the version string */
+ if (memcmp(buf + sizeof(FIOSAVHDR), FIOSAVVSN,
+ (size_t)sizeof(FIOSAVVSN)) == 0)
+ {
+ /* it's the current version */
+ version = 0;
+ }
+ else if (memcmp(buf + sizeof(FIOSAVHDR), FIOSAVVSN1,
+ (size_t)sizeof(FIOSAVVSN1)) == 0)
+ {
+ /* it's old version #1 */
+ version = 1;
+ }
+ else
+ {
+ /*
+ * this isn't a recognized version - the file must have been
+ * saved by a newer version of the system, so we can't assume we
+ * will be able to parse the format
+ */
+ result = FIORSO_BAD_FMT_VSN;
+ goto ret_error;
+ }
+
+ /*
+ * Read timestamp and check - the game must have been saved by the
+ * same .GAM file that we are now running, because the .SAV file is
+ * written entirely in terms of the contents of the .GAM file; any
+ * change in the .GAM file invalidates the .SAV file.
+ */
+ if (osfrb(fp, timestamp, 26)
+ || memcmp(timestamp, vctx->voccxtim, (size_t)26))
+ {
+ result = FIORSO_BAD_GAME_VSN;
+ goto ret_error;
+ }
+
+ /* first revert every object to original (post-compilation) state */
+ vocrevert(vctx);
+
+ /*
+ * the most common error from here on is simply a file read error,
+ * so presume that this is what will happen; if we are successful or
+ * encounter a different error, we'll change the status at that
+ * point
+ */
+ result = FIORSO_READ_ERROR;
+
+ /* go through file and load changed objects */
+ for (;;)
+ {
+ /* get the header */
+ if (osfrb(fp, buf, 7))
+ goto ret_error;
+
+ /* get the object number from the header, and stop if we're done */
+ obj = osrp2(buf+1);
+ if (obj == MCMONINV)
+ break;
+
+ /* if the object was dynamically allocated, recreate it */
+ if (buf[0] == 1)
+ {
+ int sccnt;
+ objnum sc;
+
+ /* create the object */
+ mutsiz = osrp2(buf + 3);
+ p = mcmalonum(mctx, (ushort)mutsiz, (mcmon)obj);
+
+ /* read the object's contents */
+ if (osfrb(fp, p, mutsiz))
+ goto ret_error;
+
+ /* get the superclass data (at most one superclass) */
+ sccnt = objnsc(p);
+ if (sccnt) sc = osrp2(objsc(p));
+
+ /* create inheritance records for the object */
+ vociadd(vctx, obj, MCMONINV, sccnt, &sc, VOCIFNEW | VOCIFVOC);
+
+#if 0
+ {
+ int wrdcnt;
+
+ /* read the object's vocabulary and add it back */
+ if (osfrb(fp, buf, 2))
+ goto ret_error;
+ wrdcnt = osrp2(buf);
+ while (wrdcnt--)
+ {
+ int len1;
+ int len2;
+ char wrd[80];
+
+ /* read the header */
+ if (osfrb(fp, buf, 6))
+ goto ret_error;
+ len1 = osrp2(buf+2);
+ len2 = osrp2(buf+4);
+
+ /* read the word text */
+ if (osfrb(fp, wrd, len1 + len2))
+ goto ret_error;
+
+ /* add the word */
+ vocadd2(vctx, buf[0], obj, buf[1], wrd, len1,
+ wrd + len1, len2);
+ }
+ }
+#endif
+
+ }
+ else
+ {
+ /* get the remaining data from the header */
+ propcnt = osrp2(buf + 3);
+ mutsiz = osrp2(buf + 5);
+
+ /* expand object if it's not big enough for mutsiz */
+ p = mcmlck(mctx, (mcmon)obj);
+ oldmutsiz = mcmobjsiz(mctx, (mcmon)obj) - objrst(p);
+ if (oldmutsiz < mutsiz)
+ {
+ newsiz = mutsiz - oldmutsiz;
+ p = (uchar *)objexp(mctx, obj, &newsiz);
+ }
+
+ /* reset statistics, and read mutable part from file */
+ mut = p + objrst(p);
+ objsnp(p, propcnt);
+ objsfree(p, mutsiz + objrst(p));
+ if (osfrb(fp, mut, mutsiz))
+ err = TRUE;
+
+ /* reset ignore flags as needed */
+ objsetign(mctx, obj);
+ }
+
+ /* touch and unlock the object */
+ mcmtch(mctx, (mcmon)obj);
+ mcmunlck(mctx, (mcmon)obj);
+ if (err)
+ goto ret_error;
+ }
+
+ /* read fuses/daemons/alarms */
+ if (fiorfda(fp, vctx->voccxdmn, vctx->voccxdmc)
+ || fiorfda(fp, vctx->voccxfus, vctx->voccxfuc)
+ || fiorfda(fp, vctx->voccxalm, vctx->voccxalc))
+ goto ret_error;
+
+ /* read the dynamically added and deleted vocabulary */
+ for (;;)
+ {
+ int len1;
+ int len2;
+ char wrd[80];
+ int flags;
+ int typ;
+
+ /* read the header */
+ if (osfrb(fp, buf, 8))
+ goto ret_error;
+
+ typ = buf[0];
+ flags = buf[1];
+ len1 = osrp2(buf+2);
+ len2 = osrp2(buf+4);
+ obj = osrp2(buf+6);
+
+ /* check to see if this is the end marker */
+ if (obj == MCMONINV) break;
+
+ /* read the word text */
+ if (osfrb(fp, wrd+2, len1))
+ goto ret_error;
+ if (len2)
+ {
+ wrd[len1 + 2] = ' ';
+ if (osfrb(fp, &wrd[len1 + 3], len2))
+ goto ret_error;
+ oswp2(wrd, len1 + len2 + 3);
+ }
+ else
+ oswp2(wrd, len1 + 2);
+
+ /* add or delete the word as appropriate */
+ if (flags & VOCFDEL)
+ vocdel1(vctx, obj, (char *)wrd, (prpnum)typ, FALSE, FALSE, FALSE);
+ else
+ vocadd2(vctx, buf[0], obj, buf[1], (uchar *)wrd+2, len1,
+ (uchar *)wrd+len1, len2);
+ }
+
+ /*
+ * the following was added in save format version "v2.2.1", so skip
+ * it if the save version is older than that
+ */
+ if (version != 1)
+ {
+ /* read the current "Me" object */
+ if (osfrb(fp, buf, 2))
+ goto ret_error;
+ vctx->voccxme = osrp2(buf);
+ }
+
+ /* done - close file and return success indication */
+ osfcls(fp);
+ return FIORSO_SUCCESS;
+
+ /* come here on failure - close file and return error indication */
+ret_error:
+ osfcls(fp);
+ return result;
+}
+
+/* write fuse/daemon/alarm block */
+static int fiowfda(osfildef *fp, vocddef *p, uint cnt)
+{
+ uchar buf[14];
+ uint i;
+
+ for (i = 0 ; i < cnt ; ++i, ++p)
+ {
+ if (p->vocdfn == MCMONINV) continue; /* not set - ignore */
+
+ oswp2(buf, i); /* element in array to be set */
+ oswp2(buf+2, p->vocdfn); /* object number for function/target */
+ buf[4] = p->vocdarg.runstyp; /* type of argument */
+ switch(buf[4])
+ {
+ case DAT_NUMBER:
+ oswp4s(buf+5, p->vocdarg.runsv.runsvnum);
+ break;
+ case DAT_OBJECT:
+ case DAT_FNADDR:
+ oswp2(buf+5, p->vocdarg.runsv.runsvobj);
+ break;
+ case DAT_PROPNUM:
+ oswp2(buf+5, p->vocdarg.runsv.runsvprp);
+ break;
+ }
+ oswp2(buf+9, p->vocdprp);
+ oswp2(buf+11, p->vocdtim);
+
+ /* write this record to file */
+ if (osfwb(fp, buf, 13)) return(TRUE);
+ }
+
+ /* write end record - -1 for array element number */
+ oswp2(buf, 0xffff);
+ return(osfwb(fp, buf, 13));
+}
+
+/* context for vocabulary saver callback function */
+struct fiosav_cb_ctx
+{
+ int err;
+ osfildef *fp;
+};
+
+#ifdef NEVER
+/*
+ * callback for vocabulary saver - called by voc_iterate for each word
+ * defined for a particular object, allowing us to write all the words
+ * attached to a dynamically allocated object to the save file
+ */
+static void fiosav_cb(struct fiosav_cb_ctx *ctx,
+ vocdef *voc, vocwdef *vocw)
+{
+ char buf[10];
+
+ /* write the part of speech, flags, and word lengths */
+ buf[0] = vocw->vocwtyp;
+ buf[1] = vocw->vocwflg;
+ oswp2(buf+2, voc->voclen);
+ oswp2(buf+4, voc->vocln2);
+ if (osfwb(ctx->fp, buf, 6)) ctx->err = TRUE;
+
+ /* write the words */
+ if (osfwb(ctx->fp, voc->voctxt, voc->voclen + voc->vocln2))
+ ctx->err = TRUE;
+}
+#endif
+
+/*
+ * Callback for vocabulary saver - called by voc_iterate for every
+ * word. We'll write the word if it was dynamically added or deleted,
+ * so that we can restore that status when the game is restored.
+ */
+static void fiosav_voc_cb(void *ctx0, vocdef *voc, vocwdef *vocw)
+{
+ struct fiosav_cb_ctx *ctx = (struct fiosav_cb_ctx *)ctx0;
+ char buf[10];
+
+ /* if the word was dynamically allocated or deleted, save it */
+ if ((vocw->vocwflg & VOCFNEW) || (vocw->vocwflg & VOCFDEL))
+ {
+ /* write the header information */
+ buf[0] = vocw->vocwtyp;
+ buf[1] = vocw->vocwflg;
+ oswp2(buf+2, voc->voclen);
+ oswp2(buf+4, voc->vocln2);
+ oswp2(buf+6, vocw->vocwobj);
+ if (osfwb(ctx->fp, buf, 8)) ctx->err = TRUE;
+
+ /* write the words */
+ if (osfwb(ctx->fp, voc->voctxt, voc->voclen + voc->vocln2))
+ ctx->err = TRUE;
+ }
+}
+
+
+/* save game; returns TRUE on failure */
+int fiosav(voccxdef *vctx, char *fname, char *game_fname)
+{
+ osfildef *fp;
+ vocidef ***vpg;
+ vocidef **v;
+ int i;
+ int j;
+ objnum obj;
+ uchar *p;
+ uchar *mut;
+ uint mutsiz;
+ int propcnt;
+ mcmcxdef *mctx = vctx->voccxmem;
+ uchar buf[8];
+ int err = FALSE;
+ struct fiosav_cb_ctx fnctx;
+
+ /* open the output file */
+ if ((fp = osfopwb(fname, OSFTSAVE)) == 0)
+ return TRUE;
+
+ /*
+ * If we have game file information, save the game file information
+ * with the saved game file. This lets the player start the
+ * run-time and restore the game by specifying only the saved game
+ * file.
+ */
+ if (game_fname != 0)
+ {
+ size_t len;
+
+ /* write the prefix header */
+ len = strlen(game_fname);
+ oswp2(buf, len);
+ if (osfwb(fp, FIOSAVHDR_PREFIX, (int)sizeof(FIOSAVHDR_PREFIX))
+ || osfwb(fp, buf, 2)
+ || osfwb(fp, game_fname, (int)len))
+ goto ret_error;
+ }
+
+ /* write save game header and timestamp */
+ if (osfwb(fp, FIOSAVHDR, (int)sizeof(FIOSAVHDR))
+ || osfwb(fp, FIOSAVVSN, (int)sizeof(FIOSAVVSN))
+ || osfwb(fp, vctx->voccxtim, 26))
+ goto ret_error;
+
+ /* go through each object, and write if it's been changed */
+ for (vpg = vctx->voccxinh, i = 0 ; i < VOCINHMAX ; ++vpg, ++i)
+ {
+ if (!*vpg) continue;
+ for (v = *vpg, obj = (i << 8), j = 0 ; j < 256 ; ++v, ++obj, ++j)
+ {
+ if (*v != 0)
+ {
+ /* write object if it's dirty */
+ if (mcmobjdirty(mctx, (mcmon)obj))
+ {
+ p = mcmlck(mctx, (mcmon)obj);
+ mut = p + objrst(p);
+ propcnt = objnprop(p);
+ mutsiz = objfree(p) - objrst(p);
+ if ((objflg(p) & OBJFINDEX) != 0)
+ mutsiz += propcnt * 4;
+
+ /*
+ * If the object was dynamically allocated, write
+ * the whole object. Otherwise, write just the
+ * mutable part.
+ */
+ if ((*v)->vociflg & VOCIFNEW)
+ {
+ /* indicate that the object is dynamic */
+ buf[0] = 1;
+ oswp2(buf + 1, obj);
+
+ /* write the entire object */
+ mutsiz = objfree(p);
+ oswp2(buf + 3, mutsiz);
+ if (osfwb(fp, buf, 7)
+ || osfwb(fp, p, mutsiz))
+ err = TRUE;
+
+#ifdef NEVER
+ {
+ int wrdcnt;
+
+ /* count the words, and write the count */
+ voc_count(vctx, obj, 0, &wrdcnt, (int *)0);
+ oswp2(buf, wrdcnt);
+ if (osfwb(fp, buf, 2))
+ err = TRUE;
+
+ /* write the words */
+ fnctx.err = 0;
+ fnctx.fp = fp;
+ voc_iterate(vctx, obj, fiosav_cb, &fnctx);
+ if (fnctx.err != 0)
+ err = TRUE;
+ }
+#endif
+ }
+ else if (mutsiz)
+ {
+ /* write number of properties, size of mut, and mut */
+ buf[0] = 0; /* indicate that the object is static */
+ oswp2(buf + 1, obj);
+ oswp2(buf + 3, propcnt);
+ oswp2(buf + 5, mutsiz);
+ if (osfwb(fp, buf, 7)
+ || osfwb(fp, mut, mutsiz))
+ err = TRUE;
+ }
+
+ mcmunlck(mctx, (mcmon)obj);
+ if (err != 0)
+ goto ret_error;
+ }
+ }
+ }
+ }
+
+ /* write end-of-objects indication */
+ buf[0] = 0;
+ oswp2(buf + 1, MCMONINV);
+ oswp4(buf + 3, 0);
+ if (osfwb(fp, buf, 7))
+ goto ret_error;
+
+ /* write fuses/daemons/alarms */
+ if (fiowfda(fp, vctx->voccxdmn, vctx->voccxdmc)
+ || fiowfda(fp, vctx->voccxfus, vctx->voccxfuc)
+ || fiowfda(fp, vctx->voccxalm, vctx->voccxalc))
+ goto ret_error;
+
+ /* write run-time vocabulary additions and deletions */
+ fnctx.fp = fp;
+ fnctx.err = 0;
+ voc_iterate(vctx, MCMONINV, fiosav_voc_cb, &fnctx);
+ if (fnctx.err)
+ goto ret_error;
+
+ /* write end marker for vocabulary additions and deletions */
+ oswp2(buf+6, MCMONINV);
+ if (osfwb(fp, buf, 8))
+ goto ret_error;
+
+ /* write the current "Me" object */
+ oswp2(buf, vctx->voccxme);
+ if (osfwb(fp, buf, 2))
+ goto ret_error;
+
+ /* done - close file and return success indication */
+ osfcls(fp);
+ os_settype(fname, OSFTSAVE);
+ return FALSE;
+
+ /* come here on failure - close file and return error indication */
+ret_error:
+ osfcls(fp);
+ return TRUE;
+}
+
} // End of namespace TADS2
} // End of namespace TADS
} // End of namespace Glk
diff --git a/engines/glk/tads/tads2/line_source_file.cpp b/engines/glk/tads/tads2/line_source_file.cpp
index 26536c06a4..b5da3d1a3c 100644
--- a/engines/glk/tads/tads2/line_source_file.cpp
+++ b/engines/glk/tads/tads2/line_source_file.cpp
@@ -21,12 +21,1049 @@
*/
#include "glk/tads/tads2/line_source_file.h"
+#include "glk/tads/tads2/character_map.h"
+#include "glk/tads/tads2/error.h"
+#include "glk/tads/tads2/memory_cache_heap.h"
+#include "glk/tads/tads2/tokenizer.h"
+#include "glk/tads/os_glk.h"
namespace Glk {
namespace TADS {
namespace TADS2 {
+/* initialize a pre-allocated linfdef, skipping debugger page setup */
+void linfini2(mcmcxdef *mctx, linfdef *linf,
+ char *filename, int flen, osfildef *fp, int new_line_records)
+{
+ /* set up method pointers */
+ linf->linflin.lingetp = linfget;
+ linf->linflin.linclsp = linfcls;
+ linf->linflin.linppos = linfppos;
+ linf->linflin.linglop = (new_line_records ? linfglop2 : linfglop);
+ linf->linflin.linwrtp = linfwrt;
+ linf->linflin.lincmpp = linfcmp;
+ linf->linflin.linactp = linfact;
+ linf->linflin.lindisp = linfdis;
+ linf->linflin.lintellp = linftell;
+ linf->linflin.linseekp = linfseek;
+ linf->linflin.linreadp = linfread;
+ linf->linflin.linpaddp = linfpadd;
+ linf->linflin.linqtopp = linfqtop;
+ linf->linflin.lingetsp = linfgets;
+ linf->linflin.linnamp = linfnam;
+ linf->linflin.linlnump = linflnum;
+ linf->linflin.linfindp = linffind;
+ linf->linflin.lingotop = linfgoto;
+ linf->linflin.linofsp = linfofs;
+ linf->linflin.linrenp = linfren;
+ linf->linflin.lindelp = linfdelnum;
+
+ /* set up instance data */
+ linf->linflin.linbuf = linf->linfbuf;
+ linf->linflin.linflg = 0;
+ memcpy(linf->linfnam, filename, (size_t)flen);
+ linf->linfnam[flen] = '\0';
+ linf->linfbuf[0] = '\0';
+ linf->linfbufnxt = 0;
+ linf->linfnxtlen = 0;
+ linf->linffp = fp;
+ linf->linfnum = 0;
+ linf->linflin.linlln = 4; /* OPCLINE operand is seek offset in file */
+ linf->linfmem = mctx; /* save memory manager context */
+ linf->linfcrec = 0; /* no debugger records written yet */
+}
+
+/*
+ * Initialize a file line source object. If must_find_file is true,
+ * we'll fail if we can't find the file. Otherwise, we'll create the
+ * linfdef even if we can't find the file, reserving the maximum space
+ * for its path name to be filled in later.
+ */
+linfdef *linfini(mcmcxdef *mctx, errcxdef *ec, char *filename,
+ int flen, tokpdef *path, int must_find_file,
+ int new_line_records)
+{
+ int i;
+ objnum *objp;
+ linfdef *linf;
+ osfildef *fp;
+ char fbuf[OSFNMAX + 1];
+ tokpdef fakepath;
+ int len;
+
+ if (!path)
+ {
+ path = &fakepath;
+ fakepath.tokpnxt = (tokpdef *)0;
+ fakepath.tokplen = 0;
+ }
+
+ /* search through the path list */
+ for ( ; path ; path = path->tokpnxt)
+ {
+ char last;
+
+ /* prefix the current path */
+ if ((len = path->tokplen) != 0)
+ {
+ memcpy(fbuf, path->tokpdir, (size_t)len);
+ last = fbuf[len - 1];
+ if (last == OSPATHCHAR ||
+ (OSPATHALT && strchr(OSPATHALT, last)))
+ /* do nothing */ ;
+ else
+ {
+ /* append path separator character */
+ fbuf[len++] = OSPATHCHAR;
+ }
+ }
+
+ /* add the filename and null-terminate */
+ memcpy(fbuf + len, filename, (size_t)flen);
+ fbuf[len + flen] = '\0';
+
+ /* attempt to open this file */
+ if ((fp = osfoprs(fbuf, OSFTTEXT)) != 0)
+ break;
+ }
+
+ /*
+ * If no file opened yet, search tads path; if that doesn't work,
+ * let the debugger UI try to find the file. If nothing works, give
+ * up and return failure.
+ */
+ if (fp == 0
+ && (!os_locate(filename, flen, (char *)0, fbuf, sizeof(fbuf))
+ || (fp = osfoprs(fbuf, OSFTTEXT)) == 0))
+ {
+ /*
+ * Ask the debugger UI for advice. If the debugger isn't
+ * present, we'll get a failure code from this routine.
+ */
+ if (!dbgu_find_src(filename, flen, fbuf, sizeof(fbuf),
+ must_find_file))
+ return 0;
+
+ /* try opening the file */
+ if (fbuf[0] == '\0')
+ {
+ /*
+ * we didn't get a filename - the UI wants to defer finding
+ * the file until later
+ */
+ fp = 0;
+ }
+ else
+ {
+ /* we got a filename from the UI - try opening it */
+ fp = osfoprs(fbuf, OSFTTEXT);
+ }
+
+ /*
+ * if the file isn't present, and we're required to find it,
+ * return failure
+ */
+ if (fp == 0 && must_find_file)
+ return 0;
+ }
+
+ /* figure out how much space we need for the file's full name */
+ if (fp == 0)
+ {
+ /*
+ * we didn't find the file, so we don't yet know its name - use
+ * the maximum possible filename length for the buffer size, so
+ * that we can store the final filename if we should figure out
+ * where the file is later on
+ */
+ fbuf[0] = '\0';
+ len = sizeof(fbuf);
+ }
+ else
+ {
+ /*
+ * we found the file, so we have its final name - allocate space
+ * for the known name
+ */
+ len = (int)strlen(fbuf);
+ }
+
+ /* allocate the linfdef */
+ linf = (linfdef *)mchalo(ec, (ushort)(sizeof(linfdef) + flen
+ + len + 1), "linfini");
+
+ /* do the basic initialization */
+ linfini2(mctx, linf, filename, flen, fp, new_line_records);
+
+ memcpy(linf->linfnam + flen + 1, fbuf, (size_t)len);
+ linf->linfnam[flen + 1 + len] = '\0';
+
+ /* set all debugger pages to not-yet-allocated */
+ for (i = LINFPGMAX, objp = linf->linfpg ; i ; ++objp, --i)
+ *objp = MCMONINV;
+
+ /* return the new line source object */
+ return linf;
+}
+
+int linfget(lindef *lin)
+{
+# define linf ((linfdef *)lin)
+ char *p;
+ size_t rdlen;
+ int nl_len;
+
+ /* remember seek position of start of current line */
+ linf->linfseek = osfpos(linf->linffp);
+
+ /*
+ * if we have data left in the buffer after the end of this line,
+ * move it to the start of the buffer
+ */
+ if (linf->linfnxtlen != 0)
+ {
+ /* move the data down */
+ memmove(linf->linfbuf, linf->linfbuf + linf->linfbufnxt,
+ linf->linfnxtlen);
+
+ /*
+ * adjust the seek position to account for the fact that we've
+ * read ahead in the file
+ */
+ linf->linfseek -= linf->linfnxtlen;
+
+ /*
+ * Fill up the rest of the buffer. Leave one byte for a null
+ * terminator and one byte for a possible extra newline pair
+ * character (see below), hence fill to sizeof(buf)-2.
+ */
+ rdlen = osfrbc(linf->linffp, linf->linfbuf + linf->linfnxtlen,
+ sizeof(linf->linfbuf) - linf->linfnxtlen - 2);
+
+ /*
+ * the total space is the amount we had left over plus the
+ * amount we just read
+ */
+ rdlen += linf->linfnxtlen;
+ }
+ else
+ {
+ /*
+ * We have nothing in the buffer - fill it up. Fill to
+ * sizeof(buf)-2 to leave room for a null terminator plus a
+ * possible extra newline pair character (see below).
+ */
+ rdlen = osfrbc(linf->linffp, linf->linfbuf,
+ sizeof(linf->linfbuf) - 2);
+ }
+
+ /*
+ * if there's nothing in the buffer at this point, we've reached the
+ * end of the file
+ */
+ if (rdlen == 0)
+ return TRUE;
+
+ /*
+ * if the last line was not a continuation line, increment the line
+ * counter for the start of a new line
+ */
+ if (!(lin->linflg & LINFMORE))
+ ++(linf->linfnum);
+
+ /* null-terminate the buffer contents */
+ linf->linfbuf[rdlen] = '\0';
+
+ /* perform character mapping on th new part only */
+ for (p = linf->linfbuf + linf->linfnxtlen ; *p != '\0' ; ++p)
+ *p = cmap_n2i(*p);
+
+ /*
+ * scan the for the first newline in the buffer, allowing newline
+ * conventions that involve either CR or LF
+ */
+ for (p = linf->linfbuf ; *p != '\n' && *p != '\r' && *p != '\0' ; ++p) ;
+
+ /*
+ * Check to see if this character is followed by its newline pair
+ * complement, to allow for either CR-LF or LF-CR sequences, as well
+ * as plain single-byte newline (CR or LF) sequences.
+ *
+ * First, though, one weird special case: if this character is at
+ * the read limit in the buffer, the complementary character might
+ * be lurking in the next byte that we haven't read. In this case,
+ * use that one-byte reserve we have left (we filled the buffer only
+ * to length-2 so far) and read the next byte.
+ */
+ if (*p != '\0' && p + 1 == linf->linfbuf + sizeof(linf->linfbuf) - 2)
+ {
+ /*
+ * we've filled the buffer to but not including the reserve for
+ * just this case - fetch the extra character
+ */
+ if (osfrbc(linf->linffp, p + 1, 1) == 1)
+ {
+ /* increase the total read length for the extra byte */
+ ++rdlen;
+ *(p+2) = '\0';
+ }
+ }
+
+ /*
+ * now we can check for the newline type, since we have definitely
+ * read the full paired sequence
+ */
+ if (*p == '\0')
+ {
+ /* there's no newline in the buffer - we'll return a partial line */
+ nl_len = 0;
+
+ /* set the partial line flag */
+ lin->linflg |= LINFMORE;
+
+ /* return the entire buffer */
+ lin->linlen = rdlen;
+
+ /* there's nothing left for the next time through */
+ linf->linfnxtlen = 0;
+ }
+ else
+ {
+ /* check for a complementary pair */
+ if ((*p == '\n' && *(p+1) == '\r') || (*p == '\r' && *(p+1) == '\n'))
+ {
+ /* we have a paired newline */
+ nl_len = 2;
+ }
+ else
+ {
+ /* we have but a single-character newline sequence */
+ nl_len = 1;
+ }
+
+ /* this is the end of a line */
+ lin->linflg &= ~LINFMORE;
+
+ /*
+ * return only the part of the buffer up to, but not including,
+ * the newline
+ */
+ lin->linlen = (p - linf->linfbuf);
+
+ /* null-terminate the buffer at the newline */
+ *p = '\0';
+
+ /*
+ * anything remaining after the newline sequence is available
+ * for reading the next time through
+ */
+ linf->linfbufnxt = ((p + nl_len) - linf->linfbuf);
+ linf->linfnxtlen = rdlen - linf->linfbufnxt;
+ }
+
+ /* make sure buffer pointer is correct */
+ lin->linbuf = linf->linfbuf;
+
+ LINFDEBUG(printf("%s\n", linf->linfbuf));
+
+ /* success */
+ return FALSE;
+
+# undef linf
+}
+
+/* make printable string from position in file (for error reporting) */
+void linfppos(lindef *lin, char *buf, uint buflen)
+{
+ VARUSED(buflen);
+
+ sprintf(buf, "%s(%lu): ", ((linfdef *)lin)->linfnam,
+ ((linfdef *)lin)->linfnum);
+}
+
+/* close line source */
+void linfcls(lindef *lin)
+{
+ osfcls(((linfdef *)lin)->linffp);
+}
+
+/* generate operand of OPCLINE (source-line debug) instruction */
+void linfglop(lindef *lin, uchar *buf)
+{
+ oswp4(buf, ((linfdef *)lin)->linfseek); /* save seek position of line */
+}
+
+/* generate new-style operand of OPCLINE instruction */
+void linfglop2(lindef *lin, uchar *buf)
+{
+ oswp4(buf, ((linfdef *)lin)->linfnum); /* save seek position of line */
+}
+
+/* save line source information to binary (.gam) file; TRUE ==> error */
+int linfwrt(lindef *lin, osfildef *fp)
+{
+# define linf ((linfdef *)lin)
+ uchar buf[UCHAR_MAX + 6];
+ size_t len;
+ uint pgcnt;
+ uchar *objp;
+ mcmon *objn;
+
+ buf[0] = lin->linid;
+ len = strlen(linf->linfnam);
+ if (len > UCHAR_MAX)
+ return FALSE;
+ buf[1] = (uchar)len;
+ oswp4(buf + 2, linf->linfcrec);
+ memcpy(buf + 6, linf->linfnam, (size_t)buf[1]);
+ if (osfwb(fp, buf, (int)(buf[1] + 6))) return(TRUE);
+
+ /* write the debug source pages */
+ if (!linf->linfcrec) return(FALSE); /* no debug records at all */
+ pgcnt = 1 + ((linf->linfcrec - 1) >> 10); /* figure number of pages */
+
+ for (objn = linf->linfpg ; pgcnt ; ++objn, --pgcnt)
+ {
+ objp = mcmlck(linf->linfmem, *objn);
+ if (osfwb(fp, objp, (1024 * DBGLINFSIZ))) return(TRUE);
+ mcmunlck(linf->linfmem, *objn);
+ }
+
+ return(FALSE);
+
+# undef linf
+}
+
+/* load a file-line-source from binary (.gam) file */
+int linfload(osfildef *fp, dbgcxdef *dbgctx, errcxdef *ec, tokpdef *path)
+{
+ linfdef *linf;
+ uchar buf[UCHAR_MAX + 6];
+ uint pgcnt;
+ uchar *objp;
+ mcmon *objn;
+
+ /* read the source's description from the file */
+ if (osfrb(fp, buf, 6)
+ || osfrb(fp, buf + 6, (int)buf[1]))
+ return TRUE;
+
+ /* initialize the linfdef */
+ if (!(linf = linfini(dbgctx->dbgcxmem, ec, (char *)buf + 6,
+ (int)buf[1], path, FALSE, FALSE)))
+ {
+ errlog1(ec, ERR_NOSOURC, ERRTSTR,
+ errstr(ec, (char *)buf+6, (int)buf[1]));
+ return TRUE;
+ }
+
+ /* if we opened the file, close it - don't hold all files open */
+ if (linf->linffp != 0)
+ {
+ osfcls(linf->linffp);
+ linf->linffp = 0;
+ }
+
+ /* link into debug line source chain */
+ linf->linflin.linnxt = dbgctx->dbgcxlin;
+ dbgctx->dbgcxlin = &linf->linflin;
+ linf->linflin.linid = buf[0];
+ linf->linfcrec = osrp4(buf + 2);
+
+ /* make sure the max line id is set above current line */
+ if (buf[0] >= dbgctx->dbgcxfid)
+ dbgctx->dbgcxfid = buf[0] + 1;
+
+ /* make sure we have some debug records */
+ if (!linf->linfcrec)
+ return FALSE;
+
+ /* figure number of pages */
+ pgcnt = 1 + ((linf->linfcrec - 1) >> 10);
+
+ /* allocate and read the debug source pages */
+ for (objn = linf->linfpg ; pgcnt ; ++objn, --pgcnt)
+ {
+ objp = mcmalo(linf->linfmem, (ushort)(1024 * DBGLINFSIZ), objn);
+ if (osfrb(fp, objp, (1024 * DBGLINFSIZ))) return(TRUE);
+ mcmunlck(linf->linfmem, *objn);
+ }
+
+ /* success */
+ return FALSE;
+}
+
+/* add a debugger line record for the current line being compiled */
+void linfcmp(lindef *lin, uchar *buf)
+{
+ uint pg;
+ uchar *objptr;
+# define linf ((linfdef *)lin)
+
+ /* figure out which page to use, and lock it */
+ pg = linf->linfcrec >> 10; /* 2^10 records per page */
+ if (pg >= LINFPGMAX)
+ errsig(linf->linfmem->mcmcxgl->mcmcxerr, ERR_MANYDBG);
+ if (linf->linfpg[pg] == MCMONINV)
+ objptr = mcmalo(linf->linfmem, (ushort)(1024 * DBGLINFSIZ),
+ &linf->linfpg[pg]);
+ else
+ objptr = mcmlck(linf->linfmem, linf->linfpg[pg]);
+
+ /* write the record to the appropriate offset within the page */
+ memcpy(objptr + (linf->linfcrec & 1023) * DBGLINFSIZ, buf,
+ (size_t)DBGLINFSIZ);
+
+ /* increment counter of line records so far */
+ ++(linf->linfcrec);
+
+ /* done with page - touch it and unlock it */
+ mcmtch(linf->linfmem, linf->linfpg[pg]);
+ mcmunlck(linf->linfmem, linf->linfpg[pg]);
+
+# undef linf
+}
+
+/*
+ * Renumber an existing object. Searches through all line records for
+ * any with the given object number, and changes the number to the new
+ * number if found.
+ */
+void linfren(lindef *lin, objnum oldnum, objnum newnum)
+{
+# define linf ((linfdef *)lin)
+ uint pgcnt;
+ uchar *objp;
+ mcmon *pgobjn;
+ int i;
+ int pgtot;
+ int tot;
+
+ /* figure the number of pages - if no lines, stop now */
+ tot = linf->linfcrec;
+ if (tot == 0)
+ return;
+
+ /* calculate the number of pages to check */
+ pgcnt = 1 + ((tot - 1) >> 10);
+
+ /* scan each page */
+ for (pgobjn = linf->linfpg ; pgcnt ; ++pgobjn, --pgcnt, tot -= 1024)
+ {
+ /* lock the page */
+ objp = mcmlck(linf->linfmem, *pgobjn);
+
+ /* figure the number on this page */
+ pgtot = (tot > 1024 ? 1024 : tot);
+
+ /* scan each record on this page */
+ for (i = 0 ; i < pgtot ; ++i, objp += DBGLINFSIZ)
+ {
+ /* check this one */
+ if (osrp2(objp) == oldnum)
+ {
+ /* it matches - renumber it */
+ oswp2(objp, newnum);
+ }
+ }
+
+ /* done with the page - touch it and unlock it */
+ mcmtch(linf->linfmem, *pgobjn);
+ mcmunlck(linf->linfmem, *pgobjn);
+ }
+
+# undef linf
+}
+
+/*
+ * Delete an existing object. Searches through all line records for any
+ * with the given object number, and removes line records for the object
+ * number if found.
+ */
+void linfdelnum(lindef *lin, objnum objn)
+{
+# define linf ((linfdef *)lin)
+ uint pgcnt;
+ uchar *objp;
+ uchar *objp_orig;
+ mcmon *pgobjn;
+ int i;
+ int pgtot;
+ int tot;
+
+ /* figure the number of pages - if no lines, stop now */
+ tot = linf->linfcrec;
+ if (tot == 0)
+ return;
+
+ /* calculate the number of pages to check */
+ pgcnt = 1 + ((tot - 1) >> 10);
+
+ /* scan each page */
+ for (pgobjn = linf->linfpg ; pgcnt ; ++pgobjn, --pgcnt, tot -= 1024)
+ {
+ /* lock the page */
+ objp = objp_orig = mcmlck(linf->linfmem, *pgobjn);
+
+ /* figure the number on this page */
+ pgtot = (tot > 1024 ? 1024 : tot);
+
+ /* scan each record on this page */
+ for (i = 0 ; i < pgtot ; ++i, objp += DBGLINFSIZ)
+ {
+ int j;
+
+ /* check this one */
+ if (osrp2(objp) == objn)
+ {
+ uchar *nxtp;
+ uint pg;
+ int delcnt;
+ int totrem;
+
+ /*
+ * it matches - delete it, along with any subsequent
+ * contiguous entries that also match it
+ */
+ for (delcnt = 1, j = i + 1 ; j < pgtot ; ++j, ++delcnt)
+ {
+ /*
+ * if this one doesn't match, we've found the end of
+ * the contiguous records for this object
+ */
+ if (osrp2(objp + (j - i)*DBGLINFSIZ) != objn)
+ break;
+ }
+
+ /* close up the gap on this page */
+ if (j < pgtot)
+ memmove(objp, objp + delcnt*DBGLINFSIZ,
+ (pgtot - j)*DBGLINFSIZ);
+
+ /*
+ * if this isn't the last page, copy the bottom of the
+ * next page to the gap at the top of this page
+ */
+ if (pgcnt > 1)
+ {
+ /* lock the next page */
+ nxtp = mcmlck(linf->linfmem, *(pgobjn + 1));
+
+ /*
+ * copy from the beginning of the next page to the
+ * end of this page
+ */
+ memcpy(objp_orig + (pgtot - delcnt)*DBGLINFSIZ,
+ nxtp, delcnt*DBGLINFSIZ);
+
+ /* done with the page */
+ mcmunlck(linf->linfmem, *(pgobjn + 1));
+ }
+ else
+ {
+ /*
+ * this is the last page, so there's no next page to
+ * copy items from - reduce the count of items on
+ * this page accordingly
+ */
+ pgtot -= delcnt;
+ }
+
+ /*
+ * Now rearrange all subsequent pages to accommodate the
+ * gap we just created
+ */
+ for (totrem = tot, pg = 1 ; pg < pgcnt ;
+ totrem -= 1024, ++pg)
+ {
+ uchar *curp;
+ int curtot;
+
+ /* figure how many we have on this page */
+ curtot = (totrem > 1024 ? 1024 : totrem);
+
+ /* lock this page */
+ curp = mcmlck(linf->linfmem, *(pgobjn + pg));
+
+ /* delete from the start of this page */
+ memmove(curp, curp + delcnt*DBGLINFSIZ,
+ (curtot - delcnt)*DBGLINFSIZ);
+
+ /* if there's another page, copy from it */
+ if (pg + 1 < pgcnt)
+ {
+ /* lock the next page */
+ nxtp = mcmlck(linf->linfmem, *(pgobjn + pg + 1));
+
+ /*
+ * copy from the start of the next page to the
+ * end of this page
+ */
+ memcpy(curp + (curtot - delcnt)*DBGLINFSIZ,
+ nxtp, delcnt*DBGLINFSIZ);
+
+ /* unlock it */
+ mcmunlck(linf->linfmem, *(pgobjn + pg + 1));
+ }
+
+ /* done with the page - touch it and unlock it */
+ mcmtch(linf->linfmem, *(pgobjn + pg));
+ mcmunlck(linf->linfmem, *(pgobjn + pg));
+ }
+
+ /* deduct the removed records from the total */
+ linf->linfcrec -= delcnt;
+ }
+ }
+
+ /* done with the page - touch it and unlock it */
+ mcmtch(linf->linfmem, *pgobjn);
+ mcmunlck(linf->linfmem, *pgobjn);
+ }
+
+# undef linf
+}
+
+
+/* find the nearest line record to a file seek location */
+void linffind(lindef *lin, char *buf, objnum *objp, uint *ofsp)
+{
+# define linf ((linfdef *)lin)
+ uint pg;
+ uchar *objptr;
+ uchar *bufptr;
+ long first;
+ long last;
+ long cur;
+ ulong seekpos;
+ ulong curpos = 0;
+ objnum objn;
+ uint ofs;
+
+ /* get desired seek position out of buffer */
+ seekpos = osrp4(buf);
+
+ /* we haven't traversed any records yet */
+ objn = MCMONINV;
+ ofs = 0;
+
+ /* run a binary search for the indicated line record */
+ first = 0;
+ last = linf->linfcrec - 1;
+ for (;;)
+ {
+ /* make sure we're not out of records entirely */
+ if (first > last)
+ {
+ /* return the most recent record found - it's closest */
+ *objp = objn;
+ *ofsp = ofs;
+
+ /* set the position to that of the line we actually found */
+ oswp4(buf, curpos);
+ return;
+ }
+
+ /* split the difference */
+ cur = first + (last - first)/2;
+
+ /* calculate the page containing this item */
+ pg = cur >> 10;
+
+ /* get object + offset corresponding to current source line */
+ objptr = mcmlck(linf->linfmem, linf->linfpg[pg]);
+ bufptr = objptr + ((cur & 1023) * DBGLINFSIZ);
+ objn = osrp2(bufptr);
+ ofs = osrp2(bufptr + 2);
+ mcmunlck(linf->linfmem, linf->linfpg[pg]);
+
+ /* read user data out of the object's OPCLINE record */
+ objptr = mcmlck(linf->linfmem, (mcmon)objn);
+ bufptr = objptr + ofs + 5;
+ curpos = osrp4(bufptr);
+ mcmunlck(linf->linfmem, (mcmon)objn);
+
+ /* see what we have */
+ if (curpos == seekpos)
+ {
+ *objp = objn;
+ *ofsp = ofs;
+ return;
+ }
+ else if (curpos < seekpos)
+ first = (cur == first ? first + 1 : cur);
+ else
+ last = (cur == last ? last - 1 : cur);
+ }
+
+# undef linf
+}
+
+/*
+ * copy line records to an array of linfinfo structures
+ */
+void linf_copy_linerecs(linfdef *linf, struct linfinfo *info)
+{
+ uint pg;
+ uint prvpg;
+ uchar *objptr;
+ uchar *bufptr;
+ long last;
+ long cur;
+
+ /* note the last element */
+ last = linf->linfcrec;
+
+ /* if there are no records, there's nothing to do */
+ if (last == 0)
+ return;
+
+ /* load the first page of records */
+ prvpg = 0;
+ pg = 0;
+ objptr = mcmlck(linf->linfmem, linf->linfpg[0]);
+
+ /* scan the records */
+ for (cur = 0 ; cur < last ; ++cur, ++info)
+ {
+ uchar *codeptr;
+
+ /* calculate the page containing this item */
+ pg = cur >> 10;
+
+ /* if it's different than the last page, load the next page */
+ if (pg != prvpg)
+ {
+ /* unlock the previous page */
+ mcmunlck(linf->linfmem, linf->linfpg[prvpg]);
+
+ /* load the next page */
+ objptr = mcmlck(linf->linfmem, linf->linfpg[pg]);
+
+ /* this is now the previous page */
+ prvpg = pg;
+ }
+
+ /* get object + offset corresponding to current source line */
+ bufptr = objptr + ((cur & 1023) * DBGLINFSIZ);
+ info->objn = osrp2(bufptr);
+ info->ofs = osrp2(bufptr + 2);
+
+ /* read source location data out of the object's OPCLINE record */
+ codeptr = mcmlck(linf->linfmem, (mcmon)info->objn);
+ bufptr = codeptr + info->ofs + 5;
+ info->fpos = osrp4(bufptr);
+ mcmunlck(linf->linfmem, (mcmon)info->objn);
+ }
+
+ /* unlock the last page */
+ mcmunlck(linf->linfmem, linf->linfpg[prvpg]);
+}
+
+/* disactivate line source under debugger - close file */
+void linfdis(lindef *lin)
+{
+# define linf ((linfdef *)lin)
+
+ if (linf->linffp)
+ {
+ osfcls(linf->linffp);
+ linf->linffp = (osfildef *)0;
+ }
+
+# undef linf
+}
+
+/* activate line source under debugger - open file */
+void linfact(lindef *lin)
+{
+ char *fname;
+# define linf ((linfdef *)lin)
+
+ /* get the name buffer, and advance to the full path name portion */
+ fname = linf->linfnam;
+ fname += strlen(fname) + 1;
+
+ /*
+ * If the full path name is empty, it means that the UI told us to
+ * defer searching for the file until we actually need the file. At
+ * this point, we actually need the file. Ask the UI again to find
+ * the file.
+ */
+ if (fname[0] != '\0'
+ || dbgu_find_src(linf->linfnam, strlen(linf->linfnam),
+ fname, OSFNMAX, TRUE))
+ {
+ /* open the file */
+ linf->linffp = osfoprs(fname, OSFTTEXT);
+ }
+ else
+ {
+ /* there's no file to open */
+ linf->linffp = 0;
+ }
+
+# undef linf
+}
+
+/* get current seek position */
+void linftell(lindef *lin, uchar *pos)
+{
+# define linf ((linfdef *)lin)
+ long seekpos;
+
+ seekpos = osfpos(linf->linffp);
+ oswp4(pos, seekpos);
+
+# undef linf
+}
+
+/* seek to a new position */
+void linfseek(lindef *lin, uchar *pos)
+{
+# define linf ((linfdef *)lin)
+ long seekpos;
+
+ seekpos = osrp4(pos);
+ osfseek(linf->linffp, seekpos, OSFSK_SET);
+
+# undef linf
+}
+
+/* read bytes - fread-style interface */
+int linfread(lindef *lin, uchar *buf, uint siz)
+{
+# define linf ((linfdef *)lin)
+
+ return osfrbc(linf->linffp, buf, siz);
+
+# undef linf
+}
+
+/* add a signed delta to a seek position */
+void linfpadd(lindef *lin, uchar *pos, long delta)
+{
+# define linf ((linfdef *)lin)
+ long seekpos;
+
+ seekpos = osrp4(pos);
+ seekpos += delta;
+ if (seekpos < 0) seekpos = 0;
+ oswp4(pos, seekpos);
+
+# undef linf
+}
+
+/* query whether we're at top of file */
+int linfqtop(lindef *lin, uchar *pos)
+{
+# define linf ((linfdef *)lin)
+
+ return(osrp4(pos) == 0);
+
+# undef linf
+}
+
+/* read one line at current position - fgets-style interface */
+int linfgets(lindef *lin, uchar *buf, uint siz)
+{
+ int ret;
+ long startpos;
+ uchar *p;
+# define linf ((linfdef *)lin)
+
+ /* note the seek offset at the start of the line */
+ startpos = osfpos(linf->linffp);
+
+ /* read the next line */
+ ret = (osfgets((char *)buf, siz, linf->linffp) != 0);
+ if (!ret)
+ return ret;
+
+ /* scan for non-standard line endings */
+ for (p = buf ; *p != '\0' && *p != '\r' && *p != '\n' ; ++p) ;
+ if (*p != '\0')
+ {
+ uchar *nxt;
+
+ /*
+ * Scan for non-line-ending characters after this line-ending
+ * character. If we find any, we must have non-standard newline
+ * conventions in this file. To be tolerant of these, seek back
+ * to the start of the next line in these cases and read the
+ * next line from the new location.
+ */
+ for (nxt = p + 1 ; *nxt == '\r' || *nxt == '\n' ; ++nxt) ;
+ if (*nxt == '\0')
+ {
+ /*
+ * we had only line-ending characters after the first
+ * line-ending character -- simply end the line after the
+ * first line-ending character
+ */
+ *(p+1) = '\0';
+ }
+ else
+ {
+ /*
+ * We had a line-ending character in the middle of other
+ * text, so we must have a file that doesn't conform to
+ * local newline conventions. Seek back to the next
+ * character following the last line-ending character so
+ * that we start the next line here, and end the current
+ * line after the first line-ending character.
+ */
+ *(p+1) = '\0';
+ osfseek(linf->linffp, startpos + (nxt - buf), OSFSK_SET);
+ }
+ }
+
+ /* return the result */
+ return ret;
+
+# undef linf
+}
+
+/* get name of line source */
+void linfnam(lindef *lin, char *buf)
+{
+# define linf ((linfdef *)lin)
+
+ strcpy(buf, linf->linfnam);
+
+# undef linf
+}
+
+/* get the current line number */
+ulong linflnum(lindef *lin)
+{
+# define linf ((linfdef *)lin)
+
+ return linf->linfnum;
+
+# undef linf
+}
+
+/* go to top/bottom of line source */
+void linfgoto(lindef *lin, int where)
+{
+# define linf ((linfdef *)lin)
+
+ osfseek(linf->linffp, 0L, where);
+
+# undef linf
+}
+
+/* return current seek offset within source */
+long linfofs(lindef *lin)
+{
+# define linf ((linfdef *)lin)
+
+ return(osfpos(linf->linffp));
+
+# undef linf
+}
} // End of namespace TADS2
} // End of namespace TADS
diff --git a/engines/glk/tads/tads2/memory_cache.cpp b/engines/glk/tads/tads2/memory_cache.cpp
index 3bab3b034b..359f1b3a4c 100644
--- a/engines/glk/tads/tads2/memory_cache.cpp
+++ b/engines/glk/tads/tads2/memory_cache.cpp
@@ -21,11 +21,1167 @@
*/
#include "glk/tads/tads2/memory_cache.h"
+#include "glk/tads/tads2/memory_cache_heap.h"
+#include "glk/tads/tads2/error.h"
+#include "glk/tads/os_glk.h"
namespace Glk {
namespace TADS {
namespace TADS2 {
+/* get an unused object cache entry, allocating a new page if needed */
+static mcmodef *mcmoal(mcmcx1def *ctx, mcmon *objnum);
+
+/* split a (previously free) block into two pieces */
+static void mcmsplt(mcmcx1def *ctx, mcmon n, ushort siz);
+
+/* unlink an object from a doubly-linked list */
+static void mcmunl(mcmcx1def *ctx, mcmon n, mcmon *lst);
+
+/* initialize a cache, return cache context */
+/* find free block: find a block from the free pool to satisfy a request */
+static mcmodef *mcmffb(mcmcx1def *ctx, ushort siz, mcmon *nump);
+
+/* add page pagenum, initializing entries after firstunu to unused */
+static void mcmadpg(mcmcx1def *ctx, uint pagenum, mcmon firstunu);
+
+/* link an object into a doubly-linked list at the head of the list */
+static void mcmlnkhd(mcmcx1def *ctx, mcmon *lst, mcmon n);
+
+/* try to allocate a new chunk from the heap */
+static uchar *mcmhalo(mcmcx1def *ctx);
+
+/* relocate blocks in a heap */
+static uchar *mcmreloc(mcmcx1def *ctx, uchar *start, uchar *end);
+
+/* find next free heap block */
+static uchar *mcmffh(mcmcx1def *ctx, uchar *p);
+
+#ifdef NEVER
+/* update entry to account for a block relocation */
+static void mcmmove(mcmcx1def *ctx, mcmodef *obj, uchar *newaddr);
+#else /* NEVER */
+#define mcmmove(ctx, o, new) ((o)->mcmoptr = (new))
+#endif /* NEVER */
+
+/* consolidate two contiguous free blocks into a single block */
+static void mcmconsol(mcmcx1def *ctx, uchar *p);
+
+/* collect garbage in all heaps */
+static void mcmgarb(mcmcx1def *ctx);
+
+/* make some room by swapping or discarding objects */
+static int mcmswap(mcmcx1def *ctx, ushort siz);
+
+/* toss out an object; returns TRUE if successful */
+static int mcmtoss(mcmcx1def *ctx, mcmon objnum);
+
+/* next heap block, given a heap block (points to header) */
+/* uchar *mcmhnxt(mcmcx1def *ctx, uchar *p) */
+
+#define mcmnxh(ctx, p) \
+ ((p) + osrndsz(sizeof(mcmon)) + mcmgobje(ctx, *(mcmon*)(p))->mcmosiz)
+
+#ifdef DEBUG
+# define MCMCLICTX(ctx) assert(*(((ulong *)ctx) - 1) == 0x02020202)
+# define MCMGLBCTX(ctx) assert(*(((ulong *)ctx) - 1) == 0x01010101)
+#else /* DEBUG */
+# define MCMCLICTX(ctx)
+# define MCMGLBCTX(ctx)
+#endif /* DEBUG */
+
+/* initialize a new client context */
+mcmcxdef *mcmcini(mcmcx1def *globalctx, uint pages,
+ void (*loadfn)(void *, mclhd, uchar *, ushort),
+ void *loadctx,
+ void (*revertfn)(void *, mcmon), void *revertctx)
+{
+ mcmcxdef *ret;
+ ushort siz;
+
+ siz = sizeof(mcmcxdef) + sizeof(mcmon *) * (pages - 1);
+ IF_DEBUG(siz += sizeof(ulong));
+
+ ret = (mcmcxdef *)mchalo(globalctx->mcmcxerr, siz, "mcm client context");
+ IF_DEBUG((*(ulong *)ret = 0x02020202,
+ ret = (mcmcxdef *)((uchar *)ret + sizeof(ulong))));
+
+ ret->mcmcxmsz = pages;
+ ret->mcmcxgl = globalctx;
+ ret->mcmcxldf = loadfn;
+ ret->mcmcxldc = loadctx;
+ ret->mcmcxrvf = revertfn;
+ ret->mcmcxrvc = revertctx;
+ ret->mcmcxflg = 0;
+ memset(ret->mcmcxmtb, 0, (size_t)(pages * sizeof(mcmon *)));
+ return(ret);
+}
+
+/* uninitialize a client context */
+void mcmcterm(mcmcxdef *ctx)
+{
+ /* delete the context memory */
+ mchfre(ctx);
+}
+
+/* initialize a new global context */
+mcmcx1def *mcmini(ulong max, uint pages, ulong swapsize,
+ osfildef *swapfp, char *swapfilename, errcxdef *errctx)
+{
+ mcmcx1def *ctx; /* newly-allocated cache manager context */
+ uchar *noreg chunk;/* 1st chunk of memory managed by this cache mgr */
+ mcmodef *obj; /* pointer to a cache object entry */
+ ushort siz; /* size of current thing being allocated */
+ ushort rem; /* bytes remaining in chunk */
+ int err;
+
+ NOREG((&chunk))
+
+ /* make sure 'max' is big enough - must be at least one chunk */
+ if (max < (ulong)MCMCHUNK) max = (ulong)MCMCHUNK;
+
+ /* allocate space for control structures from low-level heap */
+ rem = MCMCHUNK;
+
+ IF_DEBUG(rem += sizeof(long));
+ chunk = mchalo(errctx, rem, "mcmini");
+ IF_DEBUG((*(ulong *)chunk = 0x01010101, chunk += sizeof(ulong),
+ rem -= sizeof(ulong)));
+
+ ctx = (mcmcx1def *)chunk; /* put context at start of chunk */
+
+ /* initialize swapper; clean up if it fails */
+ ERRBEGIN(errctx)
+ mcsini(&ctx->mcmcxswc, ctx, swapsize, swapfp, swapfilename, errctx);
+ ERRCATCH(errctx, err)
+ mcsclose(&ctx->mcmcxswc);
+ mchfre(chunk);
+ errsig(errctx, err);
+ ERREND(errctx)
+
+ chunk += sizeof(mcmcx1def); /* rest of chunk is after context */
+ rem -= sizeof(mcmcx1def); /* remove from remaining size counter */
+
+ /* allocate the page table (an array of pointers to pages) */
+ ctx->mcmcxtab = (mcmodef **)chunk; /* put at bottom of chunk */
+ siz = pages * sizeof(mcmodef *); /* calcuate size of table */
+
+ memset(ctx->mcmcxtab, 0, (size_t)siz); /* clear entire table */
+ chunk += siz; /* reflect size of table */
+ rem -= siz; /* take it out of the remaining count */
+
+ /* here we begin normal heap marking with object references */
+ ctx->mcmcxhpch = (mcmhdef *)chunk; /* set start of heap chain */
+ chunk += sizeof(mcmhdef);
+ rem -= sizeof(mcmhdef);
+ ctx->mcmcxhpch->mcmhnxt = (mcmhdef *)0; /* no next heap in chain yet */
+
+ /* allocate the first page */
+ *(mcmon *)chunk = 0; /* set object number header in chunk */
+ chunk += osrndsz(sizeof(mcmon));
+ rem -= osrndsz(sizeof(mcmon));
+
+ ctx->mcmcxtab[0] = (mcmodef *)chunk; /* put at bottom of chunk */
+ memset(ctx->mcmcxtab[0], 0, (size_t)MCMPAGESIZE);
+ chunk += MCMPAGESIZE; /* reflect size of page */
+ rem -= MCMPAGESIZE; /* take it out of the remainder */
+
+ /* set up the first page with an entry for itself */
+ obj = mcmgobje(ctx, (mcmon)0); /* point to first page entry */
+ obj->mcmoflg = MCMOFPRES | MCMOFNODISC | MCMOFPAGE | MCMOFNOSWAP;
+ obj->mcmoptr = (uchar *)ctx->mcmcxtab[0];
+ obj->mcmosiz = MCMPAGESIZE;
+
+ /* set up the rest of the context */
+ ctx->mcmcxlru = ctx->mcmcxmru = MCMONINV; /* no mru/lru list yet */
+ ctx->mcmcxmax = max - (ulong)MCMCHUNK;
+ ctx->mcmcxpage = 1; /* next page slot to be allocated will be #1 */
+ ctx->mcmcxpgmx = pages; /* max number of pages we can allocate */
+ ctx->mcmcxerr = errctx;
+ ctx->mcmcxcsw = mcmcswf;
+
+ /* set up the free list with the remainder of the chunk */
+ ctx->mcmcxfre = 1; /* we've allocated object 0; obj 1 is free space */
+ obj = mcmgobje(ctx, ctx->mcmcxfre); /* point to free object entry */
+ obj->mcmonxt = obj->mcmoprv = MCMONINV; /* end of free list */
+ obj->mcmoflg = MCMOFFREE; /* mark the free block as such */
+ *(mcmon *)chunk = ctx->mcmcxfre; /* set free list header */
+
+ chunk += osrndsz(sizeof(mcmon));
+ rem -= osrndsz(sizeof(mcmon));
+ obj->mcmoptr = chunk; /* rest of chunk */
+
+ obj->mcmosiz = rem - osrndsz(sizeof(mcmon)); /* remaining size in chunk */
+
+ /* set flag for end of chunk (invalid object header) */
+ *((mcmon *)(chunk + rem - osrndsz(sizeof(mcmon)))) = MCMONINV;
+
+ /* set up the unused entry list with the remaining headers in the page */
+ mcmadpg(ctx, 0, 2);
+
+ return(ctx);
+}
+
+/*
+ * Uninitialize the cache manager. Frees the memory allocated for the
+ * cache, including the context structure itself.
+ */
+void mcmterm(mcmcx1def *ctx)
+{
+ mcmhdef *cur, *nxt;
+
+ /*
+ * Free each chunk in the cache block list, *except* the last one. The
+ * last one is special: it's actually the first chunk allocated, since
+ * we build the list in reverse order, and the first chunk pointer
+ * points into the middle of the actual allocation block, since we
+ * sub-allocated the context structure itself and the page table out of
+ * that memory.
+ */
+ for (cur = ctx->mcmcxhpch ; cur != 0 && cur->mcmhnxt != 0 ; cur = nxt)
+ {
+ /* remember the next chunk, and delete this one */
+ nxt = cur->mcmhnxt;
+ mchfre(cur);
+ }
+
+ /*
+ * As described above, the last chunk in the list is the first
+ * allocated, and it points into the middle of the actual allocated
+ * memory block. Luckily, we do have a handy pointer to the start of
+ * the memory block, namely the context pointer - it's the first thing
+ * allocated out of the block, so it's the same as the block pointer.
+ * Freeing the context frees this last/first chunk.
+ */
+ mchfre(ctx);
+}
+
+/*
+ * Allocate a new object, returning a pointer to its memory. The new
+ * object is locked upon return. The object number for the new object
+ * is returned at *nump.
+ */
+static uchar *mcmalo1(mcmcx1def *ctx, ushort siz, mcmon *nump)
+{
+ mcmon n;
+ mcmodef *o;
+ uchar *chunk;
+
+ MCMGLBCTX(ctx);
+
+ /* round size to appropriate multiple */
+ siz = osrndsz(siz);
+
+ /* if it's bigger than the chunk size, we can't allocate it */
+ if (siz > MCMCHUNK)
+ errsig(ctx->mcmcxerr, ERR_BIGOBJ);
+
+startover:
+ /* look in the free block chain for a fit to the request */
+ o = mcmffb(ctx, siz, &n);
+ if (n != MCMONINV)
+ {
+ mcmsplt(ctx, n, siz); /* split the block if necessary */
+ mcmgobje(ctx, n)->mcmoflg = MCMOFNODISC | MCMOFLOCK | MCMOFPRES;
+ mcmgobje(ctx, n)->mcmolcnt = 1; /* one locker so far */
+ *nump = n;
+ return(o->mcmoptr);
+ }
+
+ /* nothing found; we must get space out of the heap if possible */
+ chunk = mcmhalo(ctx); /* get space from heap */
+ if (!chunk) goto error; /* can't get any more space from heap */
+ o = mcmoal(ctx, &n); /* set up cache entry for free space */
+ if (n == MCMONINV)
+ {
+ mcmhdef *chunk_hdr = ((mcmhdef *)chunk) - 1;
+ ctx->mcmcxhpch = chunk_hdr->mcmhnxt;
+ mchfre(chunk_hdr);
+ goto error; /* any error means we can't allocate the memory */
+ }
+
+ *(mcmon *)chunk = n; /* set object header */
+ chunk += osrndsz(sizeof(mcmon));
+ o->mcmoptr = chunk;
+ o->mcmosiz = MCMCHUNK - osrndsz(sizeof(mcmon));
+ o->mcmoflg = MCMOFFREE;
+ mcmlnkhd(ctx, &ctx->mcmcxfre, n);
+ goto startover; /* try again, now that we have some memory */
+
+error:
+ *nump = MCMONINV;
+ return((uchar *)0);
+}
+
+static void mcmcliexp(mcmcxdef *cctx, mcmon clinum)
+{
+ /* add global number to client mapping table at client number */
+ if (cctx->mcmcxmtb[clinum >> 8] == (mcmon *)0)
+ {
+ mcmcx1def *ctx = cctx->mcmcxgl;
+ int i;
+ mcmon *p;
+
+ /* this page is not allocated - allocate it */
+ p = (mcmon *)mchalo(ctx->mcmcxerr, (256 * sizeof(mcmon)),
+ "client mapping page");
+ cctx->mcmcxmtb[clinum >> 8] = p;
+ for (i = 0 ; i < 256 ; ++i) *p++ = MCMONINV;
+ }
+}
+
+/* high-level allocate: try, collect garbage, then try again */
+uchar *mcmalo0(mcmcxdef *cctx, ushort siz, mcmon *nump,
+ mcmon clinum, int noclitrans)
+{
+ uchar *ret;
+ mcmcx1def *ctx = cctx->mcmcxgl; /* global context */
+ mcmon glb; /* global object number allocated */
+
+ MCMCLICTX(cctx);
+ MCMGLBCTX(ctx);
+
+ /* try once */
+ if ((ret = mcmalo1(ctx, siz, &glb)) != 0)
+ goto done;
+
+ /* collect some garbage */
+ mcmgarb(ctx);
+
+ /* try swapping until we get the memory or have nothing left to swap */
+ for ( ;; )
+ {
+ /* try again */
+ if ((ret = mcmalo1(ctx, siz, &glb)) != 0)
+ goto done;
+
+ /* nothing left to swap? */
+ if (!mcmswap(ctx, siz))
+ break;
+
+ /* try yet again */
+ if ((ret = mcmalo1(ctx, siz, &glb)) != 0)
+ goto done;
+
+ /* collect garbage once again */
+ mcmgarb(ctx);
+ }
+
+ /* try again */
+ if ((ret = mcmalo1(ctx, siz, &glb)) != 0)
+ goto done;
+
+ /* we have no other way of getting more memory, so signal an error */
+ errsig(ctx->mcmcxerr, ERR_NOMEM1);
+ NOTREACHEDV(uchar *);
+
+done:
+ if (noclitrans)
+ {
+ *nump = glb;
+ return(ret);
+ }
+
+ /* we have an object - generate client number */
+ if (clinum == MCMONINV)
+ {
+ /* find a free number */
+ mcmon **p;
+ uint i;
+ mcmon j = 0;
+ mcmon *q;
+ int found = FALSE;
+ int unused = -1;
+
+ for (i = 0, p = cctx->mcmcxmtb ; i < cctx->mcmcxmsz ; ++i, ++p)
+ {
+ if (*p)
+ {
+ for (j = 0, q = *p ; j < 256 ; ++j, ++q)
+ {
+ if (*q == MCMONINV)
+ {
+ found = TRUE;
+ break;
+ }
+ }
+ }
+ else if (unused == -1)
+ unused = i; /* note an unused page mapping table */
+
+ if (found) break;
+ }
+
+ if (found)
+ clinum = (i << 8) + j;
+ else if (unused != -1)
+ clinum = (unused << 8);
+ else
+ errsig(ctx->mcmcxerr, ERR_CLIFULL);
+ }
+
+ /* expand client mapping table if necessary */
+ mcmcliexp(cctx, clinum);
+
+ /* make sure the entry isn't already in use */
+ if (mcmc2g(cctx, clinum) != MCMONINV)
+ errsig(ctx->mcmcxerr, ERR_CLIUSE);
+
+ cctx->mcmcxmtb[clinum >> 8][clinum & 255] = glb;
+ if (nump) *nump = clinum;
+ return(ret);
+}
+
+/* reserve space for an object at a client object number */
+void mcmrsrv(mcmcxdef *cctx, ushort siz, mcmon clinum, mclhd loadhd)
+{
+ mcmcx1def *ctx = cctx->mcmcxgl; /* global context */
+ mcmon glb; /* global object number allocated */
+ mcmodef *o;
+
+ MCMCLICTX(cctx);
+ MCMGLBCTX(ctx);
+
+ o = mcmoal(ctx, &glb); /* get a new object header */
+ if (!o) errsig(ctx->mcmcxerr, ERR_NOHDR); /* can't get a new header */
+
+ o->mcmoldh = loadhd;
+ o->mcmoflg = 0;
+ o->mcmosiz = siz;
+
+ mcmcliexp(cctx, clinum);
+ if (mcmc2g(cctx, clinum) != MCMONINV)
+ errsig(ctx->mcmcxerr, ERR_CLIUSE);
+
+ cctx->mcmcxmtb[clinum >> 8][clinum & 255] = glb;
+}
+
+/* resize an existing object */
+uchar *mcmrealo(mcmcxdef *cctx, mcmon cliobj, ushort newsize)
+{
+ mcmcx1def *ctx = cctx->mcmcxgl; /* global context */
+ mcmon obj = mcmc2g(cctx, cliobj);
+ mcmodef *o = mcmgobje(ctx, obj);
+ mcmon nxt;
+ mcmodef *nxto;
+ uchar *p;
+ int local_lock;
+
+ MCMCLICTX(cctx);
+ MCMGLBCTX(ctx);
+
+ newsize = osrndsz(newsize);
+
+ /* make sure the object is locked, and note if we locked it */
+ if ((local_lock = !(o->mcmoflg & MCMOFLOCK)) != 0)
+ (void)mcmlck(cctx, cliobj);
+
+ ERRBEGIN(ctx->mcmcxerr)
+
+ if (newsize < o->mcmosiz)
+ mcmsplt(ctx, obj, newsize); /* smaller; just split block */
+ else
+ {
+ /* see if there's a free block after this block */
+ p = o->mcmoptr;
+ nxt = *(mcmon *)(p + o->mcmosiz);
+ nxto = (nxt == MCMONINV) ? (mcmodef *)0 : mcmgobje(ctx, nxt);
+
+ if (nxto && ((nxto->mcmoflg & MCMOFFREE)
+ && nxto->mcmosiz >= newsize - o->mcmosiz))
+ {
+ /* sanity check - make sure heap and page table agree */
+ assert(nxto->mcmoptr == p + o->mcmosiz + osrndsz(sizeof(mcmon)));
+ /* annex the free block */
+ o->mcmosiz += nxto->mcmosiz + osrndsz(sizeof(mcmon));
+ /* move the free block to the unused list */
+ mcmunl(ctx, nxt, &ctx->mcmcxfre);
+ nxto->mcmonxt = ctx->mcmcxunu;
+ ctx->mcmcxunu = nxt;
+ nxto->mcmoflg = 0;
+
+ /* split the newly grown block if necessary */
+ mcmsplt(ctx, obj, newsize);
+ }
+ else
+ {
+ /* can't annex; allocate new memory and copy */
+
+ if (o->mcmolcnt != 1) /* if anyone else has a lock... */
+ errsig(ctx->mcmcxerr, ERR_REALCK); /* we can't move it */
+
+ p = mcmalo0(cctx, newsize, &nxt, MCMONINV, TRUE);
+ if (nxt == MCMONINV) errsig(ctx->mcmcxerr, ERR_NOMEM2);
+ memcpy(p, o->mcmoptr, (size_t)o->mcmosiz);
+
+ /* adjust the object entries */
+ nxto = mcmgobje(ctx, nxt); /* get pointer to new entry */
+ newsize = nxto->mcmosiz; /* get actual size of new block */
+ nxto->mcmoptr = o->mcmoptr; /* copy current block info to new */
+ nxto->mcmosiz = o->mcmosiz;
+ o->mcmoptr = p; /* copy new block info to original entry */
+ o->mcmosiz = newsize;
+
+ /* now fix up the heap pointers, and free the temp object */
+ *(mcmon *)(p - osrndsz(sizeof(mcmon))) = obj;
+ *(mcmon *)(nxto->mcmoptr - osrndsz(sizeof(mcmon))) = nxt;
+ mcmgunlck(ctx, nxt);
+ mcmgfre(ctx, nxt);
+ }
+ }
+
+ ERRCLEAN(ctx->mcmcxerr)
+ /* release our lock, if we had to obtain one */
+ if (local_lock) mcmunlck(cctx, cliobj);
+ ERRENDCLN(ctx->mcmcxerr)
+
+ /* return the address of the object */
+ return(o->mcmoptr);
+}
+
+/*
+ * Free an object by GLOBAL number: move object to free list.
+ */
+void mcmgfre(mcmcx1def *ctx, mcmon obj)
+{
+ mcmodef *o = mcmgobje(ctx, obj);
+
+ MCMGLBCTX(ctx);
+
+ /* signal an error if the object is locked */
+ if (o->mcmolcnt) errsig(ctx->mcmcxerr, ERR_LCKFRE);
+
+ /* take out of LRU chain if it's in the chain */
+ if (o->mcmoflg & MCMOFLRU) mcmunl(ctx, obj, &ctx->mcmcxlru);
+
+ /* put it in the free list */
+ mcmlnkhd(ctx, &ctx->mcmcxfre, obj);
+ o->mcmoflg = MCMOFFREE;
+}
+
+/*
+ * load and lock an object that has been swapped out or discarded
+ */
+uchar *mcmload(mcmcxdef *cctx, mcmon cnum)
+{
+ mcmcx1def *ctx = cctx->mcmcxgl;
+ mcmodef *o = mcmobje(cctx, cnum);
+ mcmodef *newdef;
+ mcmon newn;
+ mcmon num = mcmc2g(cctx, cnum);
+
+ MCMCLICTX(cctx);
+ MCMGLBCTX(ctx);
+
+ /* we first need to obtain some memory for this object */
+ (void)mcmalo0(cctx, o->mcmosiz, &newn, MCMONINV, TRUE);
+ newdef = mcmgobje(ctx, newn);
+
+ /* use memory block from our new object */
+ o->mcmoptr = newdef->mcmoptr;
+ o->mcmosiz = newdef->mcmosiz;
+
+ /* load or swap the object in */
+ ERRBEGIN(ctx->mcmcxerr)
+ if (o->mcmoflg & (MCMOFNODISC | MCMOFDIRTY))
+ mcsin(&ctx->mcmcxswc, o->mcmoswh, o->mcmoptr, o->mcmosiz);
+ else if (cctx->mcmcxldf)
+ (*cctx->mcmcxldf)(cctx->mcmcxldc, o->mcmoldh, o->mcmoptr,
+ o->mcmosiz);
+ else
+ errsig(ctx->mcmcxerr, ERR_NOLOAD);
+ ERRCLEAN(ctx->mcmcxerr)
+ mcmgunlck(ctx, newn); /* unlock the object */
+ mcmgfre(ctx, newn); /* don't need new memory after all */
+ ERRENDCLN(ctx->mcmcxerr)
+
+ /* unuse the new cache entry we obtained (we just wanted the memory) */
+/* @@@ */
+ *(mcmon *)(o->mcmoptr - osrndsz(sizeof(mcmon))) = num; /* set obj# */
+ newdef->mcmoflg = 0; /* mark new block as unused */
+ newdef->mcmonxt = ctx->mcmcxunu; /* link to unused chain */
+ ctx->mcmcxunu = newn;
+
+ /* set flags in the newly loaded object and return */
+ o->mcmoflg |= MCMOFPRES | MCMOFLOCK; /* object is now present in memory */
+ o->mcmoflg &= ~MCMOFDIRTY; /* not written since last swapped in */
+ o->mcmoflg |= MCMOFNODISC; /* don't discard once it's been to swap file */
+ o->mcmolcnt = 1; /* one locker so far */
+
+ /* if the object is to be reverted upon loading, revert it now */
+ if (o->mcmoflg & MCMOFREVRT)
+ {
+ (*cctx->mcmcxrvf)(cctx->mcmcxrvc, cnum);
+ o->mcmoflg &= ~MCMOFREVRT;
+ }
+
+ return(o->mcmoptr);
+}
+
+/*
+ * Allocate a new object header. This doesn't allocate an object, just
+ * the header for one.
+ */
+static mcmodef *mcmoal(mcmcx1def *ctx, mcmon *nump)
+{
+ mcmodef *ret;
+ uint pagenum;
+
+ MCMGLBCTX(ctx);
+
+ /* look first in list of unused headers */
+startover:
+ if (ctx->mcmcxunu != MCMONINV)
+ {
+ /* we have something in the unused list; return it */
+ *nump = ctx->mcmcxunu;
+ ret = mcmgobje(ctx, *nump);
+ ctx->mcmcxunu = ret->mcmonxt;
+ ret->mcmoswh = MCSSEGINV;
+ return(ret);
+ }
+
+ /*
+ * No unused entries: we must create a new page. To do so, we
+ * simply allocate memory for a new page. Allocate the memory
+ * ourselves, to avoid deadlocking with the allocator (which can
+ * try to get a new entry to satisfy our request for memory).
+ */
+ if (ctx->mcmcxpage == ctx->mcmcxpgmx) goto error; /* no more pages */
+ pagenum = ctx->mcmcxpage++; /* get a new page slot */
+
+ ctx->mcmcxtab[pagenum] =
+ (mcmodef *)mchalo(ctx->mcmcxerr, MCMPAGESIZE, "mcmoal");
+ mcmadpg(ctx, pagenum, MCMONINV);
+ goto startover;
+
+error:
+ *nump = MCMONINV;
+ return((mcmodef *)0);
+}
+
+/* find free block: find a block from the free pool to satisfy allocation */
+static mcmodef *mcmffb(mcmcx1def *ctx, ushort siz, mcmon *nump)
+{
+ mcmon n;
+ mcmodef *o;
+ mcmon minn;
+ mcmodef *mino;
+ ushort min = 0;
+
+ MCMGLBCTX(ctx);
+
+ for (minn = MCMONINV, mino = 0, n = ctx->mcmcxfre ; n != MCMONINV ;
+ n = o->mcmonxt)
+ {
+ o = mcmgobje(ctx, n);
+ if (o->mcmosiz == siz)
+ {
+ /* found exact match - use it immediately */
+ minn = n;
+ min = siz;
+ mino = o;
+ break;
+ }
+ else if (o->mcmosiz > siz)
+ {
+ /* found something at least as big; is it smallest yet? */
+ if (minn == MCMONINV || o->mcmosiz < min)
+ {
+ /* yes, best fit so far, use it; but keep looking */
+ minn = n;
+ mino = o;
+ min = o->mcmosiz;
+ }
+ }
+ }
+
+ /* if we found something, remove from the free list */
+ if (minn != MCMONINV)
+ {
+ mcmunl(ctx, minn, &ctx->mcmcxfre);
+ mino->mcmoflg &= ~MCMOFFREE;
+ mino->mcmoswh = MCSSEGINV;
+ }
+
+ *nump = minn;
+ return mino;
+}
+
+/*
+ * unlink an object header from one of the doubly-linked lists
+ */
+static void mcmunl(mcmcx1def *ctx, mcmon n, mcmon *lst)
+{
+ mcmodef *o = mcmgobje(ctx, n);
+ mcmodef *nxt;
+ mcmodef *prv;
+
+ MCMGLBCTX(ctx);
+
+ /* see if this is LRU chain - must deal with MRU pointer if so */
+ if (lst == &ctx->mcmcxlru)
+ {
+ /* if it's at MRU, set MRU pointer to previous object in list */
+ if (ctx->mcmcxmru == n)
+ {
+ ctx->mcmcxmru = o->mcmoprv; /* set MRU to previous in chain */
+ if (ctx->mcmcxmru != MCMONINV) /* set nxt for new MRU */
+ mcmgobje(ctx, ctx->mcmcxmru)->mcmonxt = MCMONINV;
+ else
+ ctx->mcmcxlru = MCMONINV; /* nothing in list; clear LRU */
+ }
+ o->mcmoflg &= ~MCMOFLRU;
+ }
+
+ nxt = o->mcmonxt == MCMONINV ? (mcmodef *)0 : mcmgobje(ctx, o->mcmonxt);
+ prv = o->mcmoprv == MCMONINV ? (mcmodef *)0 : mcmgobje(ctx, o->mcmoprv);
+
+ /* set back link for next object, if there is a next object */
+ if (nxt) nxt->mcmoprv = o->mcmoprv;
+
+ /* set forward link for previous object, or head if no previous object */
+ if (prv) prv->mcmonxt = o->mcmonxt;
+ else *lst = o->mcmonxt;
+
+ o->mcmonxt = o->mcmoprv = MCMONINV;
+}
+
+/* link an item to the head of a doubly-linked list */
+static void mcmlnkhd(mcmcx1def *ctx, mcmon *lst, mcmon n)
+{
+ MCMGLBCTX(ctx);
+
+ if (*lst != MCMONINV) mcmgobje(ctx, *lst)->mcmoprv = n;
+ mcmgobje(ctx, n)->mcmonxt = *lst; /* next is previous head of list */
+ *lst = n; /* make object new head of list */
+ mcmgobje(ctx, n)->mcmoprv = MCMONINV; /* there is no previous entry */
+}
+
+/* add page pagenum, initializing entries after firstunu to unused */
+static void mcmadpg(mcmcx1def *ctx, uint pagenum, mcmon firstunu)
+{
+ mcmon unu;
+ mcmodef *obj;
+ mcmon lastunu;
+
+ MCMGLBCTX(ctx);
+
+ unu = (firstunu == MCMONINV ? pagenum * MCMPAGECNT : firstunu);
+ ctx->mcmcxunu = unu;
+ lastunu = (pagenum * MCMPAGECNT) + MCMPAGECNT - 1;
+ for (obj = mcmgobje(ctx, unu) ; unu < lastunu ; ++obj)
+ obj->mcmonxt = ++unu;
+ obj->mcmonxt = MCMONINV;
+}
+
+/*
+ * split a previously-free block into two chunks, adding the remainder
+ * back into the free list, if there's enough left over
+ */
+static void mcmsplt(mcmcx1def *ctx, mcmon n, ushort siz)
+{
+ mcmodef *o = mcmgobje(ctx, n);
+ mcmon newn;
+ mcmodef *newp;
+
+ MCMGLBCTX(ctx);
+
+ if (o->mcmosiz < siz + MCMSPLIT) return; /* don't split; we're done */
+
+ newp = mcmoal(ctx, &newn);
+ if (newn == MCMONINV) return; /* ignore error - just skip split */
+
+ /* set up the new entry, and link into free list */
+ *(mcmon *)(o->mcmoptr + siz) = newn;
+ newp->mcmoptr = o->mcmoptr + siz + osrndsz(sizeof(mcmon));
+ newp->mcmosiz = o->mcmosiz - siz - osrndsz(sizeof(mcmon));
+ newp->mcmoflg = MCMOFFREE;
+ mcmlnkhd(ctx, &ctx->mcmcxfre, newn);
+
+ o->mcmosiz = siz; /* size of new object is now exactly as request */
+}
+
+/* allocate a new chunk from the heap if possible */
+static uchar *mcmhalo(mcmcx1def *ctx)
+{
+ uchar *chunk;
+ int err;
+# define size (MCMCHUNK + sizeof(mcmhdef) + 2*osrndsz(sizeof(mcmon)))
+
+ VARUSED(err);
+
+ MCMGLBCTX(ctx);
+
+ if (ctx->mcmcxmax < MCMCHUNK) return((uchar *)0);
+
+ ERRBEGIN(ctx->mcmcxerr)
+ chunk = mchalo(ctx->mcmcxerr, size, "mcmhalo");
+ ERRCATCH(ctx->mcmcxerr, err)
+ ctx->mcmcxmax = 0; /* remember we can't allocate anything more */
+ return((uchar *)0); /* return no memory */
+ ERREND(ctx->mcmcxerr)
+
+ ctx->mcmcxmax -= MCMCHUNK;
+
+ /* link into heap chain */
+ ((mcmhdef *)chunk)->mcmhnxt = ctx->mcmcxhpch;
+ ctx->mcmcxhpch = (mcmhdef *)chunk;
+/*@@@@*/
+ *(mcmon *)(chunk + osrndsz(sizeof(mcmhdef) + MCMCHUNK)) = MCMONINV;
+ return(chunk + sizeof(mcmhdef));
+
+# undef size
+}
+
+/* "use" an object - move to most-recent position in LRU chain */
+void mcmuse(mcmcx1def *ctx, mcmon obj)
+{
+ mcmodef *o = mcmgobje(ctx, obj);
+
+ MCMGLBCTX(ctx);
+
+ if (ctx->mcmcxmru == obj) return; /* already MRU; nothing to do */
+
+ /* remove from LRU chain if it's in it */
+ if (o->mcmoflg & MCMOFLRU) mcmunl(ctx, obj, &ctx->mcmcxlru);
+
+ /* set forward pointer of last block, if there is one */
+ if (ctx->mcmcxmru != MCMONINV)
+ mcmgobje(ctx, ctx->mcmcxmru)->mcmonxt = obj;
+
+ o->mcmoprv = ctx->mcmcxmru; /* point back to previous MRU */
+ o->mcmonxt = MCMONINV; /* nothing in list after this one */
+ ctx->mcmcxmru = obj; /* point MRU to new block */
+
+ /* if there's nothing in the chain at all, set LRU to this block, too */
+ if (ctx->mcmcxlru == MCMONINV) ctx->mcmcxlru = obj;
+
+ /* note that object is in LRU chain */
+ o->mcmoflg |= MCMOFLRU;
+}
+
+/* find next free block in a heap, starting with pointer */
+static uchar *mcmffh(mcmcx1def *ctx, uchar *p)
+{
+ mcmodef *o;
+
+ MCMGLBCTX(ctx);
+
+ while (*(mcmon *)p != MCMONINV)
+ {
+ o = mcmgobje(ctx, *(mcmon *)p);
+ assert(o->mcmoptr == p + osrndsz(sizeof(mcmon)));
+ if (o->mcmoflg & MCMOFFREE) return(p);
+ p += osrndsz(sizeof(mcmon)) + o->mcmosiz; /* move on to next chunk */
+ }
+ return((uchar *)0); /* no more free blocks in heap */
+}
+
+#ifdef NEVER
+static void mcmmove(mcmcx1def *ctx, mcmodef *o, uchar *newpage)
+{
+ mcmodef **page;
+
+ MCMGLBCTX(ctx);
+
+ /* see if we need to update page table (we do if moving a page) */
+ if (o->mcmoflg & MCMOFPAGE)
+ {
+ for (page = ctx->mcmcxtab ; *page ; ++page)
+ {
+ if (*page == (mcmodef *)(o->mcmoptr))
+ {
+ *page = (mcmodef *)newpag;
+ break;
+ }
+ }
+ if (!*page) printf("\n*** internal error - relocating page\n");
+ }
+ o->mcmoptr = newpage;
+}
+#endif /* NEVER */
+
+/* relocate blocks from p to (but not including) q */
+static uchar *mcmreloc(mcmcx1def *ctx, uchar *p, uchar *q)
+{
+ mcmodef *o;
+ ushort dist;
+ mcmon objnum;
+
+ MCMGLBCTX(ctx);
+
+ objnum = *(mcmon *)p; /* get number of free block being bubbled up */
+ o = mcmgobje(ctx, objnum); /* get pointer to free object */
+ assert(o->mcmoptr == p + osrndsz(sizeof(mcmon)));
+ dist = osrndsz(sizeof(mcmon)) + o->mcmosiz; /* compute distance to move */
+ mcmmove(ctx, o, q - dist + osrndsz(sizeof(mcmon))); /* move obj to top */
+
+ memmove(p, p+dist, (size_t)(q - p - o->mcmosiz)); /* move memory */
+
+ /* update cache entries for the blocks we moved */
+ while (p != q - dist)
+ {
+ mcmmove(ctx, mcmgobje(ctx, *(mcmon *)p), p + osrndsz(sizeof(mcmon)));
+ p = mcmnxh(ctx, p);
+ }
+
+ *(mcmon *)(q - dist) = objnum; /* set bubbled num */
+ return(q - dist); /* return new location of bubbled block */
+}
+
+/* consolidate the two (free) blocks starting at p into one block */
+static void mcmconsol(mcmcx1def *ctx, uchar *p)
+{
+ uchar *q;
+ mcmodef *obj1, *obj2;
+
+ MCMGLBCTX(ctx);
+
+ q = mcmnxh(ctx, p);
+ obj1 = mcmgobje(ctx, *(mcmon *)p);
+ obj2 = mcmgobje(ctx, *(mcmon *)q);
+
+ assert(obj1->mcmoptr == p + osrndsz(sizeof(mcmon)));
+ assert(obj2->mcmoptr == q + osrndsz(sizeof(mcmon)));
+
+ obj1->mcmosiz += osrndsz(sizeof(mcmon)) + obj2->mcmosiz;
+ mcmunl(ctx, *(mcmon *)q, &ctx->mcmcxfre);
+
+ /* add second object entry to unused list */
+ obj2->mcmonxt = ctx->mcmcxunu;
+ ctx->mcmcxunu = *(mcmon *)q;
+ obj2->mcmoflg = 0;
+}
+
+/* attempt to compact all heaps by consolidating free space */
+static void mcmgarb(mcmcx1def *ctx)
+{
+ mcmhdef *h;
+ uchar *p;
+ uchar *q;
+ uchar *nxt;
+ ushort flags;
+
+ MCMGLBCTX(ctx);
+
+ for (h = ctx->mcmcxhpch ; h ; h = h->mcmhnxt)
+ {
+ p = (uchar *)(h+1); /* get pointer to actual heap */
+ p = mcmffh(ctx, p); /* get first free block in heap */
+ if (!p) continue; /* can't do anything - no free blocks */
+ nxt = mcmnxh(ctx, p); /* remember immediate next block */
+
+ for (q=p ;; )
+ {
+ q = mcmnxh(ctx, q); /* find next chunk in heap */
+ if (*(mcmon *)q == MCMONINV) break; /* reached end of heap */
+ assert(mcmgobje(ctx, *(mcmon *)q)->mcmoptr
+ == q + osrndsz(sizeof(mcmon)));
+ flags = mcmgobje(ctx, *(mcmon *)q)->mcmoflg; /* get flags */
+
+ /* if the block is locked, p can't be relocated */
+ if (flags & MCMOFLOCK)
+ {
+ p = mcmffh(ctx, q); /* find next free block after p */
+ q = p;
+ if (p) continue; /* try again; start with next free block */
+ else break; /* no more free blocks - done with heap */
+ }
+
+ /* if the block is free, we can relocate between p and q */
+ if (flags & MCMOFFREE)
+ {
+ if (q != nxt) p = mcmreloc(ctx, p, q); /* relocate */
+ mcmconsol(ctx, p); /* consolidate two free blocks */
+
+ /* resume looking, starting with consolidated block */
+ nxt = mcmnxh(ctx, p);
+ q = p;
+ continue;
+ }
+ }
+ }
+}
+
+/* toss out a particular object */
+static int mcmtoss(mcmcx1def *ctx, mcmon n)
+{
+ mcmodef *o = mcmgobje(ctx, n);
+ mcmodef *newp;
+ mcmon newn;
+
+ MCMGLBCTX(ctx);
+
+ /* make a new block for the free space */
+ newp = mcmoal(ctx, &newn);
+ if (newn == MCMONINV)
+ return(FALSE); /* ignore the error, but can't toss it out */
+
+ /* write object to swap file if not discardable */
+ if (o->mcmoflg & (MCMOFNODISC | MCMOFDIRTY))
+ {
+ mcsseg old_swap_seg;
+
+ /*
+ * If this object was last loaded out of the load file, rather
+ * than the swap file, don't attempt to find it in the swap file
+ * -- so note by setting the old swap segment parameter to null.
+ */
+ if (!(o->mcmoflg & MCMOFNODISC))
+ old_swap_seg = o->mcmoswh;
+ else
+ old_swap_seg = MCSSEGINV;
+
+ o->mcmoswh = mcsout(&ctx->mcmcxswc, (uint)n, o->mcmoptr, o->mcmosiz,
+ old_swap_seg, o->mcmoflg & MCMOFDIRTY);
+ }
+
+ /* give the object's space to the newly created block */
+ newp->mcmoptr = o->mcmoptr;
+ newp->mcmosiz = o->mcmosiz;
+ newp->mcmoflg = MCMOFFREE;
+/*@@@*/
+ *(mcmon *)(o->mcmoptr - osrndsz(sizeof(mcmon))) = newn;
+ mcmlnkhd(ctx, &ctx->mcmcxfre, newn);
+
+ o->mcmoflg &= ~MCMOFPRES; /* object is no longer in memory */
+ mcmunl(ctx, n, &ctx->mcmcxlru); /* remove from LRU list */
+ return(TRUE); /* successful, so return TRUE */
+}
+
+/* swap or discard to make room for siz; return 0 if nothing swapped */
+static int mcmswap(mcmcx1def *ctx, ushort siz)
+{
+ mcmon n;
+ mcmodef *o;
+ mcmon nxt;
+ int pass; /* pass 1: swap one piece big enough */
+ /* pass 2: swap enough pieces to add up to right size */
+ ushort tot;
+
+ MCMGLBCTX(ctx);
+
+ for (pass = 1, tot = 0 ; pass < 3 && tot < siz ; ++pass)
+ {
+ for (n = ctx->mcmcxlru ; n != MCMONINV && tot < siz ; n = nxt)
+ {
+ o = mcmgobje(ctx, n);
+ nxt = o->mcmonxt; /* get next now, as we may unlink */
+ if (!(o->mcmoflg & (MCMOFLOCK | MCMOFNOSWAP | MCMOFPAGE))
+ && (pass == 2 || o->mcmosiz >= siz))
+ {
+ /* toss out, and add into size if successful */
+ if (mcmtoss(ctx, n)) tot += o->mcmosiz;
+ }
+ }
+ }
+
+ /* if we managed to remove anything, return TRUE, otherwise FALSE */
+ return(tot != 0);
+}
+
+/* compute size of cache */
+ulong mcmcsiz(mcmcxdef *cctx)
+{
+ mcmcx1def *ctx = cctx->mcmcxgl;
+ mcmhdef *p;
+ ulong tot;
+
+ MCMCLICTX(cctx);
+ MCMGLBCTX(ctx);
+
+ /* count number of heaps, adding in chunk size for each */
+ for (tot = 0, p = ctx->mcmcxhpch ; p ; p = p->mcmhnxt)
+ tot += MCMCHUNK;
+
+ return(tot);
+}
+
+#ifdef MCM_NO_MACRO
+/* routines that can be either macros or functions */
+
+uchar *mcmlck(mcmcxdef *ctx, mcmon objnum)
+{
+ mcmodef *o = mcmobje(ctx, objnum);
+
+ if ((o->mcmoflg & MCMOFFREE) != 0 || mcmc2g(ctx, objnum) == MCMONINV)
+ {
+ errsig(ctx->mcmcxgl->mcmcxerr, ERR_INVOBJ);
+ return 0;
+ }
+ else if (o->mcmoflg & MCMOFPRES)
+ {
+ o->mcmoflg |= MCMOFLOCK;
+ ++(o->mcmolcnt);
+ return(o->mcmoptr);
+ }
+ else
+ return(mcmload(ctx, objnum));
+}
+
+void mcmunlck(mcmcxdef *ctx, mcmon obj)
+{
+ mcmodef *o = mcmobje(ctx, obj);
+
+ if (o->mcmoflg & MCMOFLOCK)
+ {
+ if (!(--(o->mcmolcnt)))
+ {
+ o->mcmoflg &= ~MCMOFLOCK;
+ mcmuse(ctx->mcmcxgl, mcmc2g(ctx, obj));
+ }
+ }
+}
+
+void mcmgunlck(mcmcx1def *ctx, mcmon obj)
+{
+ mcmodef *o = mcmgobje(ctx, obj);
+
+ if (o->mcmoflg & MCMOFLOCK)
+ {
+ if (!(--(o->mcmolcnt)))
+ {
+ o->mcmoflg &= ~MCMOFLOCK;
+ mcmuse(ctx, obj);
+ }
+ }
+}
+
+#endif /* MCM_NO_MACRO */
+
+/*
+ * Change an object's swap file handle. This routine will only be
+ * called for an object that is either present or swapped out (i.e., an
+ * object with a valid mcsseg number in its swap state).
+ */
+void mcmcswf(mcmcx1def *ctx, mcmon objn, mcsseg swapn, mcsseg oldswapn)
+{
+ mcmodef *o = mcmgobje(ctx, objn);
+
+ MCMGLBCTX(ctx);
+
+ /*
+ * Reset the swap number only if the object is swapped out and its
+ * swap file number matches the old one, or the object is currently
+ * present (in which case the swap file number is irrelevant and can
+ * be replaced).
+ */
+ if (((o->mcmoflg & (MCMOFDIRTY | MCMOFNODISC)) && o->mcmoswh == oldswapn)
+ || (o->mcmoflg & MCMOFPRES))
+ o->mcmoswh = swapn;
+}
+
+
+void mcmfre(mcmcxdef *ctx, mcmon obj)
+{
+ /* free the actual object */
+ mcmgfre(ctx->mcmcxgl, mcmc2g(ctx, obj));
+
+ /* unmap the client object number */
+ mcmc2g(ctx, obj) = MCMONINV;
+}
+
} // End of namespace TADS2
} // End of namespace TADS
} // End of namespace Glk
diff --git a/engines/glk/tads/tads2/memory_cache_loader.cpp b/engines/glk/tads/tads2/memory_cache_loader.cpp
deleted file mode 100644
index f403299167..0000000000
--- a/engines/glk/tads/tads2/memory_cache_loader.cpp
+++ /dev/null
@@ -1,31 +0,0 @@
-/* ScummVM - Graphic Adventure Engine
- *
- * ScummVM is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- *
- */
-
-#include "glk/tads/tads2/memory_cache_loader.h"
-
-namespace Glk {
-namespace TADS {
-namespace TADS2 {
-
-} // End of namespace TADS2
-} // End of namespace TADS
-} // End of namespace Glk
diff --git a/engines/glk/tads/tads2/memory_cache_swap.cpp b/engines/glk/tads/tads2/memory_cache_swap.cpp
index 114a7258e9..8d78892963 100644
--- a/engines/glk/tads/tads2/memory_cache_swap.cpp
+++ b/engines/glk/tads/tads2/memory_cache_swap.cpp
@@ -21,11 +21,311 @@
*/
#include "glk/tads/tads2/memory_cache_swap.h"
+#include "glk/tads/tads2/memory_cache.h"
+#include "glk/tads/tads2/memory_cache_heap.h"
+#include "glk/tads/tads2/error.h"
namespace Glk {
namespace TADS {
namespace TADS2 {
+
+/* initialize swapper: allocate memory for swap page table */
+void mcsini(mcscxdef *ctx, mcmcx1def *gmemctx, ulong maxsiz,
+ osfildef *fp, char *swapfilename, errcxdef *errctx)
+{
+ uchar *p;
+
+ ctx->mcscxtab = (mcsdsdef **)0; /* anticipate failure */
+
+ /* allocate space from the low-level heap for page table and one page */
+ p = mchalo(errctx, ((MCSPAGETAB * sizeof(mcsdsdef *))
+ + (MCSPAGECNT * sizeof(mcsdsdef))), "mcsini");
+
+ /* set up the context with pointers to this chunk */
+ ctx->mcscxtab = (mcsdsdef **)p;
+ memset(p, 0, (size_t)(MCSPAGETAB * sizeof(mcsdsdef *)));
+ p += MCSPAGETAB * sizeof(mcsdsdef *);
+ ctx->mcscxtab[0] = (mcsdsdef *)p;
+
+ /* set up the rest of the context */
+ ctx->mcscxtop = (ulong)0;
+ ctx->mcscxmax = maxsiz;
+ ctx->mcscxmsg = 0;
+ ctx->mcscxfp = fp;
+ ctx->mcscxerr = errctx;
+ ctx->mcscxmem = gmemctx;
+
+ /*
+ * store the swap filename - make a copy so that the caller doesn't
+ * have to retain the original copy (in case it's on the stack)
+ */
+ if (swapfilename != 0)
+ {
+ ctx->mcscxfname = (char *)mchalo(errctx,
+ (strlen(swapfilename)+1),
+ "mcsini");
+ strcpy(ctx->mcscxfname, swapfilename);
+ }
+ else
+ ctx->mcscxfname = 0;
+}
+
+/* close the swapper */
+void mcsclose(mcscxdef *ctx)
+{
+ if (ctx->mcscxtab) mchfre(ctx->mcscxtab);
+}
+
+/*
+ * Attempt to compact the swap file when it grows too big. The segment
+ * descriptors are always allocated in increasing seek location within
+ * the swap file. To compress the file, make each descriptor's
+ * allocated size equal its used size for each in-use segment, and leave
+ * free segments at their allocated sizes.
+ */
+static void mcscompact(mcscxdef *ctx)
+{
+ char buf[512];
+ ulong max;
+ mcsseg cur_in;
+ mcsseg cur_out;
+ mcsdsdef *desc_in;
+ mcsdsdef *desc_out;
+ uint siz;
+ uint rdsiz;
+ ulong ptr_in;
+ ulong ptr_out;
+
+ max = 0; /* start at offset zero within file */
+ for (cur_in = cur_out = 0 ; cur_in < ctx->mcscxmsg ; ++cur_in)
+ {
+ desc_in = mcsdsc(ctx, cur_in);
+
+ /*
+ * If the present descriptor's address is wrong, and the swap
+ * segment is in use, move the swap segment. If it's not in
+ * use, we don't need to move it, because we're going to throw
+ * away the segment entirely.
+ */
+ if (desc_in->mcsdsptr != max
+ && (desc_in->mcsdsflg & MCSDSFINUSE))
+ {
+ /* ptr_in is the old location, ptr_out is the new location */
+ ptr_in = desc_in->mcsdsptr;
+ ptr_out = max;
+
+ /* copy through our buffer */
+ for (siz = desc_in->mcsdsosz ; siz ; siz -= rdsiz)
+ {
+ /* size is whole buffer, or last piece if smaller */
+ rdsiz = (siz > sizeof(buf) ? sizeof(buf) : siz);
+
+ /* seek to old location and get the piece */
+ osfseek(ctx->mcscxfp, ptr_in, OSFSK_SET);
+ (void)osfrb(ctx->mcscxfp, buf, (size_t)rdsiz);
+
+ /* seek to new location and write the piece */
+ osfseek(ctx->mcscxfp, ptr_out, OSFSK_SET);
+ (void)osfwb(ctx->mcscxfp, buf, (size_t)rdsiz);
+
+ /* adjust the pointers by the size copied */
+ ptr_in += rdsiz;
+ ptr_out += rdsiz;
+ }
+ }
+
+ /* adjust object descriptor to reflect new location */
+ desc_in->mcsdsptr = max;
+
+ /*
+ * Make current object's size exact if it's in use. If it's
+ * not in use, delete the segment altogether.
+ */
+ if (desc_in->mcsdsflg & MCSDSFINUSE)
+ {
+ desc_in->mcsdssiz = desc_in->mcsdsosz;
+ max += desc_in->mcsdssiz;
+
+ /* copy descriptor to correct position to close any holes */
+ if (cur_out != cur_in)
+ {
+ desc_out = mcsdsc(ctx, cur_out);
+ OSCPYSTRUCT(*desc_out, *desc_in);
+
+ /* we need to renumber the corresponding object as well */
+ mcmcsw(ctx->mcscxmem, (mcmon)desc_in->mcsdsobj,
+ cur_out, cur_in);
+ }
+
+ /* we actually wrote this one, so move output pointer */
+ ++cur_out;
+ }
+ else
+ {
+ /*
+ * We need to renumber the corresponding object so that it
+ * knows there is no swap segment for it any more.
+ */
+ mcmcsw(ctx->mcscxmem, (mcmon)desc_in->mcsdsobj,
+ MCSSEGINV, cur_in);
+ }
+ }
+
+ /*
+ * Adjust the top of the file for our new size, and add the savings
+ * into the available space counter. Also, adjust the total handle
+ * count to reflect any descriptors that we've deleted.
+ */
+ ctx->mcscxmax += (ctx->mcscxtop - max);
+ ctx->mcscxtop = max;
+ ctx->mcscxmsg = cur_out;
+}
+
+/* swap an object out to the swap file */
+mcsseg mcsout(mcscxdef *ctx, uint objid, uchar *ptr, ushort siz,
+ mcsseg oldseg, int dirty)
+{
+ mcsdsdef *desc;
+ mcsdsdef **pagep;
+ uint i;
+ uint j;
+ mcsseg min;
+ mcsseg cur;
+ ushort minsiz = 0;
+
+ IF_DEBUG(printf("<< mcsout: objid=%d, ptr=%lx, siz=%u, oldseg=%u >>\n",
+ objid, (unsigned long)ptr, siz, oldseg));
+
+ /* see if old segment can be reused */
+ if (oldseg != MCSSEGINV)
+ {
+ desc = mcsdsc(ctx, oldseg);
+ if (!(desc->mcsdsflg & MCSDSFINUSE) /* if old seg is not in use */
+ && desc->mcsdsobj == objid /* and it has same object */
+ && desc->mcsdssiz >= siz /* and it's still big enough */
+ && !dirty) /* and the object in memory hasn't been changed */
+ {
+ /* we can reuse the old segment without rewriting it */
+ desc->mcsdsflg |= MCSDSFINUSE; /* mark segment as in use */
+ return(oldseg);
+ }
+ }
+
+ /* look for the smallest unused segment big enough for this object */
+ for (cur = 0, min = MCSSEGINV, i = 0, pagep = ctx->mcscxtab
+ ; cur < ctx->mcscxmsg && i < MCSPAGETAB && *pagep ; ++pagep, ++i)
+ {
+ for (j = 0, desc = *pagep ; cur < ctx->mcscxmsg && j < MCSPAGECNT
+ ; ++desc, ++j, ++cur)
+ {
+ if (!(desc->mcsdsflg & MCSDSFINUSE)
+ && desc->mcsdssiz >= siz
+ && (min == MCSSEGINV || desc->mcsdssiz < minsiz))
+ {
+ min = cur;
+ minsiz = desc->mcsdssiz;
+ if (minsiz == siz) break; /* exact match - we're done */
+ }
+ }
+ /* quit if we found an exact match */
+ if (min != MCSSEGINV && minsiz == siz) break;
+ }
+
+ /* if we found nothing, allocate a new segment if possible */
+ if (min == MCSSEGINV)
+ {
+ if (siz > ctx->mcscxmax)
+ {
+ /* swap file is too big; compact it and try again */
+ mcscompact(ctx);
+ if (siz > ctx->mcscxmax)
+ errsig(ctx->mcscxerr, ERR_SWAPBIG);
+ }
+
+ min = ctx->mcscxmsg;
+ if ((min >> 8) >= MCSPAGETAB) /* exceeded pages in page table? */
+ errsig(ctx->mcscxerr, ERR_SWAPPG);
+
+ if (!ctx->mcscxtab[min >> 8]) /* haven't allocate page yet? */
+ {
+ ctx->mcscxtab[min >> 8] =
+ (mcsdsdef *)mchalo(ctx->mcscxerr,
+ (MCSPAGECNT * sizeof(mcsdsdef)),
+ "mcsout");
+ }
+
+ /* set up new descriptor */
+ desc = mcsdsc(ctx, min);
+ desc->mcsdsptr = ctx->mcscxtop;
+ desc->mcsdssiz = siz;
+ desc->mcsdsobj = objid;
+
+ /* write out the segment */
+ mcswrt(ctx, desc, ptr, siz);
+ desc->mcsdsflg = MCSDSFINUSE;
+
+ /* update context information to account for new segment */
+ ctx->mcscxtop += siz; /* add to top seek offset in file */
+ ctx->mcscxmax -= siz; /* take size out of quota */
+ ctx->mcscxmsg++; /* increment last segment allocated */
+
+ return(min);
+ }
+ else
+ {
+ desc = mcsdsc(ctx, min);
+ desc->mcsdsobj = objid;
+ mcswrt(ctx, desc, ptr, siz);
+ desc->mcsdsflg |= MCSDSFINUSE;
+
+ return(min);
+ }
+}
+
+void mcsin(mcscxdef *ctx, mcsseg seg, uchar *ptr, ushort siz)
+{
+ mcsdsdef *desc = mcsdsc(ctx, seg);
+
+ IF_DEBUG(printf("<< mcsin: seg=%u, ptr=%lx, siz=%d, objid=%u >>\n",
+ seg, (unsigned long)ptr, siz, desc->mcsdsobj));
+
+ assert(seg < ctx->mcscxmsg);
+
+ /* can only swap in as much as we wrote */
+ if (desc->mcsdsosz < siz) siz = desc->mcsdsosz;
+
+ /* seek to and read the segment */
+ if (osfseek(ctx->mcscxfp, desc->mcsdsptr, OSFSK_SET))
+ errsig(ctx->mcscxerr, ERR_FSEEK);
+ if (osfrb(ctx->mcscxfp, ptr, (size_t)siz))
+ errsig(ctx->mcscxerr, ERR_FREAD);
+
+ desc->mcsdsflg &= ~MCSDSFINUSE; /* segment no longer in use */
+}
+
+void mcswrt(mcscxdef *ctx, mcsdsdef *desc, uchar *buf, ushort bufl)
+{
+ int tries;
+
+ desc->mcsdsosz = bufl;
+
+ for (tries = 0 ; tries < 2 ; ++tries)
+ {
+ /* attempt to write the object to the swap file */
+ if (osfseek(ctx->mcscxfp, desc->mcsdsptr, OSFSK_SET))
+ errsig(ctx->mcscxerr, ERR_FSEEK);
+ if (!osfwb(ctx->mcscxfp, buf, (size_t)bufl))
+ return;
+
+ /* couldn't write it; compact the swap file */
+ mcscompact(ctx);
+ }
+
+ /* couldn't write to swap file, even after compacting it */
+ errsig(ctx->mcscxerr, ERR_FWRITE);
+}
+
} // End of namespace TADS2
} // End of namespace TADS
} // End of namespace Glk
diff --git a/engines/glk/tads/tads2/object.cpp b/engines/glk/tads/tads2/object.cpp
index 2ba1161d86..4360f5fea9 100644
--- a/engines/glk/tads/tads2/object.cpp
+++ b/engines/glk/tads/tads2/object.cpp
@@ -21,15 +21,1056 @@
*/
#include "glk/tads/tads2/object.h"
+#include "glk/tads/tads2/error.h"
+#include "glk/tads/tads2/memory_cache_heap.h"
+#include "glk/tads/os_glk.h"
namespace Glk {
namespace TADS {
namespace TADS2 {
+/*
+ * Get a property WITHOUT INHERITANCE. The offset of the property's
+ * prpdef is returned. An offset of zero means the property wasn't
+ * found.
+ */
+uint objgetp(mcmcxdef *mctx, objnum objn, prpnum prop, dattyp *typptr)
+{
+ objdef *objptr;
+ prpdef *p;
+ int cnt;
+ uint retval; /* property offset, if we find it */
+ uint ignprop; /* ignored property - use if real property isn't found */
+ uchar pbuf[2]; /* property number in portable format */
+ uchar *indp;
+ uchar *indbase;
+ int last;
+ int first;
+ int cur;
+
+ oswp2(pbuf, prop); /* get property number in portable foramt */
+ objptr = (objdef *)mcmlck(mctx, objn); /* get a lock on the object */
+ ignprop = 0; /* assume we won't find ignored property */
+ cnt = objnprop(objptr); /* get number of properties defined */
+ retval = 0; /* presume failure */
+
+ if (objflg(objptr) & OBJFINDEX)
+ {
+ /* there's an index -> do a binary search through the index */
+ indbase = (uchar *)objpfre(objptr); /* find index */
+ first = 0;
+ last = cnt - 1;
+ for (;;)
+ {
+ if (first > last) break; /* crossed over -> not found */
+ cur = first + (last - first)/2; /* split the difference */
+ indp = indbase + cur*4; /* get pointer to this entry */
+ if (indp[0] == pbuf[0] && indp[1] == pbuf[1])
+ {
+ retval = osrp2(indp + 2);
+ break;
+ }
+ else if (indp[0] < pbuf[0]
+ || (indp[0] == pbuf[0] && indp[1] < pbuf[1]))
+ first = (cur == first ? first + 1 : cur);
+ else
+ last = (cur == last ? last - 1 : cur);
+ }
+
+ /* ignore ignored and deleted properties if possible */
+ while (retval
+ && ((prpflg(objptr + retval) & PRPFIGN) != 0
+ || ((prpflg(objptr + retval) & PRPFDEL) != 0
+ && (mctx->mcmcxflg & MCMCXF_NO_PRP_DEL) == 0))
+ && cur < cnt && indp[0] == indp[4] && indp[1] == indp[5])
+ {
+ indp += 4;
+ retval = osrp2(indp + 2);
+ }
+ if (retval && osrp2(objptr + retval) != prop)
+ assert(FALSE);
+ }
+ else
+ {
+ /* there's no index -> do sequential search through properties */
+ for (p = objprp(objptr) ; cnt ; p = objpnxt(p), --cnt)
+ {
+ /* if this is the property, and it's not being ignored, use it */
+ if (*(uchar *)p == pbuf[0] && *(((uchar *)p) + 1) == pbuf[1])
+ {
+ if (prpflg(p) & PRPFIGN) /* this is ignored */
+ ignprop = objpofs(objptr, p); /* ... make a note of it */
+ else if ((prpflg(p) & PRPFDEL) != 0 /* it's deleted */
+ && (mctx->mcmcxflg & MCMCXF_NO_PRP_DEL) == 0)
+ /* simply skip it */ ;
+ else
+ {
+ retval = objpofs(objptr, p); /* this is the one */
+ break; /* we're done */
+ }
+ }
+ }
+ }
+
+ if (!retval) retval = ignprop; /* use ignored value if nothing else */
+ if (retval && typptr) *typptr = prptype(objofsp(objptr, retval));
+
+ mcmunlck(mctx, objn); /* done with object, so unlock it */
+ return(retval);
+}
+
+/* get the offset of the end of a property in an object */
+uint objgetp_end(mcmcxdef *ctx, objnum objn, prpnum prop)
+{
+ objdef *objp;
+ prpdef *propptr;
+ uint ofs;
+ uint valsiz;
+
+ /* get the start of the object */
+ ofs = objgetp(ctx, objn, prop, 0);
+ if (ofs == 0)
+ return 0;
+
+ /* get the object */
+ objp = mcmlck(ctx, (mcmon)objn);
+
+ /* get the property */
+ propptr = objofsp(objp, ofs);
+
+ /* get the data size */
+ valsiz = prpsize(propptr);
+
+ /* done with the object */
+ mcmunlck(ctx, (mcmon)objn);
+
+ /*
+ * return the ending offset - it's the starting offset plus the
+ * property header size plus the size of the property data
+ */
+ return ofs + PRPHDRSIZ + valsiz;
+}
+
+/* determine whether an object is a descendant of another object */
+static int objisd(mcmcxdef *ctx, objdef *objptr, objnum parentnum)
+{
+ uchar *sc;
+ int cnt;
+
+ for (sc = objsc(objptr), cnt = objnsc(objptr) ; cnt ;
+ sc += 2, --cnt)
+ {
+ int cursc = osrp2(sc);
+ int ret;
+ objdef *curptr;
+
+ if (cursc == parentnum) return(TRUE);
+
+ curptr = (objdef *)mcmlck(ctx, (mcmon)cursc);
+ ret = objisd(ctx, curptr, parentnum);
+ mcmunlck(ctx, (mcmon)cursc);
+ if (ret) return(TRUE);
+ }
+ return(FALSE);
+}
+
+/*
+ * Get a property of an object, either from the object or from a
+ * superclass (inherited). If the inh flag is TRUE, we do not look at
+ * all in the object itself, but restrict our search to inherited
+ * properties only. We return the byte offset of the prpdef within the
+ * object in which the prpdef is found; the superclass object itself is
+ * NOT locked upon return, but we will NOT unlock the object passed in
+ * (in other words, all object locking status is the same as it was on
+ * entry). If the offset is zero, the property was not found.
+ *
+ * This is an internal helper routine - it's not meant to be called
+ * except by objgetap().
+ */
+static uint objgetap0(mcmcxdef *ctx, noreg objnum obj, prpnum prop,
+ objnum *orn, int inh, dattyp *ortyp)
+{
+ uchar *sc;
+ ushort sccnt;
+ ushort psav;
+ dattyp typsav = DAT_NIL;
+ objnum osavn = MCMONINV;
+ uchar *o1;
+ objnum o1n;
+ ushort poff;
+ int found;
+ uint retval;
+ dattyp typ;
+ uchar sclist[100]; /* up to 50 superclasses */
+ objdef *objptr;
+
+ NOREG((&obj))
+
+ /* see if the property is in the current object first */
+ if (!inh && (retval = objgetp(ctx, obj, prop, &typ)) != 0)
+ {
+ /*
+ * tell the caller which object this came from, if the caller
+ * wants to know
+ */
+ if (orn != 0)
+ *orn = obj;
+
+ /* if the caller wants to know the type, return it */
+ if (ortyp != 0)
+ *ortyp = typ;
+
+ /* return the property offset */
+ return retval;
+ }
+
+ /* lock the object, cache its superclass list, and unlock it */
+ objptr = (objdef *)mcmlck(ctx, (mcmon)obj);
+ sccnt = objnsc(objptr);
+ memcpy(sclist, objsc(objptr), (size_t)(sccnt << 1));
+ sc = sclist;
+ mcmunlck(ctx, (mcmon)obj);
+
+ /* try to inherit the property */
+ for (found = FALSE ; sccnt != 0 ; sc += 2, --sccnt)
+ {
+ /* recursively look up the property in this superclass */
+ poff = objgetap0(ctx, (objnum)osrp2(sc), prop, &o1n, FALSE, &typ);
+
+ /* if we found the property, remember it */
+ if (poff != 0)
+ {
+ int isdesc;
+
+ /* if we have a previous object, determine lineage */
+ if (found)
+ {
+ o1 = mcmlck(ctx, o1n);
+ isdesc = objisd(ctx, o1, osavn);
+ mcmunlck(ctx, o1n);
+ }
+
+ /*
+ * if we don't already have a property, or the new object
+ * is a descendant of the previously found object (meaning
+ * that the new object's property should override the
+ * previously found object's property), use this new
+ * property
+ */
+ if (!found || isdesc)
+ {
+ psav = poff;
+ osavn = o1n;
+ typsav = typ;
+ found = TRUE;
+ }
+ }
+ }
+
+ /* set return pointer and return the offset of what we found */
+ if (orn != 0)
+ *orn = osavn;
+
+ /* return the object type if the caller wanted it */
+ if (ortyp != 0)
+ *ortyp = typsav;
+
+ /* return the offset of the property if we found one, or zero if not */
+ return (found ? psav : 0);
+}
+
+/*
+ * Get a property of an object, either from the object or from a
+ * superclass (inherited). If the inh flag is TRUE, we do not look at
+ * all in the object itself, but restrict our search to inherited
+ * properties only. We return the byte offset of the prpdef within the
+ * object in which the prpdef is found; the superclass object itself is
+ * NOT locked upon return, but we will NOT unlock the object passed in
+ * (in other words, all object locking status is the same as it was on
+ * entry). If the offset is zero, the property was not found.
+ */
+uint objgetap(mcmcxdef *ctx, noreg objnum obj, prpnum prop,
+ objnum *ornp, int inh)
+{
+ uint retval;
+ dattyp typ;
+ objnum orn;
+
+ /*
+ * even if the caller doesn't care about the original object number,
+ * we do, so provide our own location to store it if necessary
+ */
+ if (ornp == 0)
+ ornp = &orn;
+
+ /* keep going until we've finished translating synonyms */
+ for (;;)
+ {
+ /* look up the property */
+ retval = objgetap0(ctx, obj, prop, ornp, inh, &typ);
+
+ /*
+ * If we found something (i.e., retval != 0), check to see if we
+ * have a synonym; if so, synonym translation is required
+ */
+ if (retval != 0 && typ == DAT_SYN)
+ {
+ prpnum prvprop;
+ objdef *objptr;
+ prpdef *p;
+
+ /*
+ * Translation is required - get new property and try again.
+ * First, remember the original property, so we can make
+ * sure we're not going to loop (at least, not in this one
+ * synonym definition).
+ */
+ prvprop = prop;
+
+ objptr = (objdef *)mcmlck(ctx, (mcmon)*ornp);
+ p = objofsp(objptr, retval);
+ prop = osrp2(prpvalp(p));
+ mcmunlck(ctx, (mcmon)*ornp);
+
+ /* check for direct circularity */
+ if (prop == prvprop)
+ errsig(ctx->mcmcxgl->mcmcxerr, ERR_CIRCSYN);
+
+ /* go back for another try with the new property */
+ continue;
+ }
+
+ /* we don't have to perform a translation; return the result */
+ return retval;
+ }
+}
+
+
+/*
+ * Expand an object by a requested size, and return a pointer to the
+ * object's location. The object will be unlocked and relocked by this
+ * call. The new size is written to the *siz argument.
+ */
+objdef *objexp(mcmcxdef *ctx, objnum obj, ushort *siz)
+{
+ ushort oldsiz;
+ uchar *p;
+
+ oldsiz = mcmobjsiz(ctx, (mcmon)obj);
+ p = mcmrealo(ctx, (mcmon)obj, (ushort)(oldsiz + *siz));
+ *siz = mcmobjsiz(ctx, (mcmon)obj) - oldsiz;
+ return((objdef *)p);
+}
+
+/*
+ * Delete a property in an object. Note that we never actually remove
+ * anything marked as an original property, but just mark it 'ignore'.
+ * This way, it's easy to restore the entire original state of the
+ * objects, simply by deleting everything not marked original and
+ * clearing the 'ignore' flag on the remaining properties. If
+ * 'mark_only' is true, we'll only mark the property as deleted without
+ * actually reclaiming the space; this is necessary when deleting a
+ * method when other methods may follow, since p-code is not entirely
+ * self-relative and thus can't always be relocated within an object.
+ */
+void objdelp(mcmcxdef *mctx, objnum objn, prpnum prop, int mark_only)
+{
+ objdef *objptr;
+ uint pofs;
+ prpdef *p;
+ prpdef *nxt;
+ size_t movsiz;
+
+ pofs = objgetp(mctx, objn, prop, (dattyp *)0); /* try to find property */
+ if (!pofs) return; /* not defined - nothing to delete */
+
+ objptr = (objdef *)mcmlck(mctx, objn); /* get lock on object */
+ p = objofsp(objptr, pofs); /* get actual prpdef pointer */
+ nxt = objpnxt(p); /* find next prpdef after this one */
+
+ /* if this is original, just mark 'ignore' */
+ if (prpflg(p) & PRPFORG)
+ {
+ prpflg(p) |= PRPFIGN; /* mark this as overridden */
+ }
+ else if (mark_only)
+ {
+ prpflg(p) |= PRPFDEL; /* mark as deleted without removing space */
+ }
+ else
+ {
+ /* move prpdef's after current one down over current one */
+ movsiz = (uchar *)objptr + objfree(objptr) - (uchar *)nxt;
+ memmove(p, nxt, movsiz);
+
+ objsnp(objptr, objnprop(objptr)-1);
+ objsfree(objptr, objfree(objptr) - (((uchar *)nxt) - ((uchar *)p)));
+ }
+
+ /* tell cache manager this object has been changed, and unlock it */
+ mcmtch(mctx, objn);
+ mcmunlck(mctx, objn);
+}
+
+/*
+ * Set a property of an object to a new value, overwriting the original
+ * value (if any); the object must be unlocked coming in. If an undo
+ * context is provided, an undo record is written; if the undo context
+ * pointer is null, no undo information is kept.
+ */
+void objsetp(mcmcxdef *ctx, objnum objn, prpnum prop, dattyp typ,
+ void *val, objucxdef *undoctx)
+{
+ objdef *objptr;
+ prpdef *p;
+ uint pofs;
+ uint siz;
+ ushort newsiz;
+ int indexed;
+ int prop_was_set;
+
+ /* get a lock on the object */
+ objptr = (objdef *)mcmlck(ctx, objn);
+ indexed = objflg(objptr) & OBJFINDEX;
+
+ /* catch any errors so we can unlock the object */
+ ERRBEGIN(ctx->mcmcxgl->mcmcxerr)
+ {
+ /* get the previous value of the property, if any */
+ pofs = objgetp(ctx, objn, prop, (dattyp *)0);
+ p = objofsp(objptr, pofs);
+ prop_was_set = (p != 0);
+
+ /* start the undo record if we are keeping undo information */
+ if (undoctx && objuok(undoctx))
+ {
+ uchar *up;
+ uchar cmd;
+
+ if (p)
+ {
+ if (prpflg(p) & PRPFORG)
+ {
+ cmd = OBJUOVR; /* override original */
+ p = (prpdef *)0; /* pretend it doesn't even exist */
+ }
+ else cmd = OBJUCHG; /* change property */
+ }
+ else cmd = OBJUADD; /* prop didn't exist - adding it */
+
+ /* write header, reserve space, and get a pointer to the space */
+ up = objures(undoctx, cmd,
+ (ushort)(sizeof(mcmon) + sizeof(prpnum)
+ + (p ? PRPHDRSIZ + prpsize(p) : 0)));
+
+ /* write the object and property numbers */
+ memcpy(up, &objn, (size_t)sizeof(objn));
+ up += sizeof(mcmon);
+ memcpy(up, &prop, (size_t)sizeof(prop));
+ up += sizeof(prop);
+
+ /* if there's existing data, write it */
+ if (p)
+ {
+ memcpy(up, p, (size_t)(PRPHDRSIZ + prpsize(p)));
+ up += PRPHDRSIZ + prpsize(p);
+ }
+
+ /* update the undo context's head offset for the new value */
+ undoctx->objucxhead = up - undoctx->objucxbuf;
+ }
+
+ /* get the size of the data */
+ siz = datsiz(typ, val);
+
+ /*
+ * If the property is already set, and the new data fits, use the
+ * existing slot. However, do not use existing slot if it's
+ * in the non-mutable portion of the object.
+ */
+ if (!p || (uint)prpsize(p) < siz || pofs < (uint)objrst(objptr))
+ {
+ uint avail;
+
+ /* delete any existing value */
+ if (prop_was_set)
+ objdelp(ctx, objn, prop, FALSE);
+
+ /* get the top of the property area */
+ p = objpfre(objptr);
+ /* make sure there's room at the top */
+ avail = mcmobjsiz(ctx, (mcmon)objn) - objfree(objptr);
+ if (avail < siz + PRPHDRSIZ)
+ {
+ newsiz = 64 + ((objfree(objptr) + siz + PRPHDRSIZ) -
+ mcmobjsiz(ctx, (mcmon)objn));
+ objptr = objexp(ctx, objn, &newsiz);
+ p = objpfre(objptr); /* reset pointer if object moved */
+ /* NOTE! Index (if present) is now invalid! */
+ }
+
+ prpsetsize(p, siz); /* set the new property size */
+ prpsetprop(p, prop); /* ... and property id */
+ prpflg(p) = 0; /* no property flags yet */
+ objsnp(objptr, objnprop(objptr) + 1); /* one more prop */
+ objsfree(objptr, objfree(objptr) + siz + PRPHDRSIZ);
+ }
+
+ /* copy the new data to top of object's free space */
+ prptype(p) = typ;
+ if (siz != 0) memcpy(prpvalp(p), val, (size_t)siz);
+ }
+ ERRCLEAN(ctx->mcmcxgl->mcmcxerr)
+ {
+ mcmunlck(ctx, objn); /* unlock the object */
+ }
+ ERRENDCLN(ctx->mcmcxgl->mcmcxerr)
+
+ /* dirty the object, and release lock on object before return */
+ mcmtch(ctx, objn); /* mark the object as changed */
+ mcmunlck(ctx, objn); /* unlock it */
+
+ /* if necessary, rebuild the property index */
+ if (indexed) objindx(ctx, objn);
+}
+
+/* set an undo savepoint */
+void objusav(objucxdef *undoctx)
+{
+ /* the only thing in this record is the OBJUSAV header */
+ objures(undoctx, OBJUSAV, (ushort)0);
+}
+
+/* reserve space in an undo buffer, and write header */
+uchar *objures(objucxdef *undoctx, uchar cmd, ushort siz)
+{
+ ushort prv;
+ uchar *p;
+
+ /* adjust size to include header information */
+ siz += 1 + sizeof(ushort);
+
+ /* make sure there's enough room overall for the record */
+ if (siz > undoctx->objucxsiz) errsig(undoctx->objucxerr, ERR_UNDOVF);
+
+ /* if there's no information, reset buffers */
+ if (undoctx->objucxhead == undoctx->objucxprv)
+ {
+ undoctx->objucxhead = undoctx->objucxprv = undoctx->objucxtail = 0;
+ undoctx->objucxtop = 0;
+ goto done;
+ }
+
+ /* if tail is below head, we can use to top of entire buffer */
+ if (undoctx->objucxtail < undoctx->objucxhead)
+ {
+ /* if there's enough space left after head, we're done */
+ if (undoctx->objucxsiz - undoctx->objucxhead >= siz)
+ goto done;
+
+ /* insufficient space: wrap head down to bottom of buffer */
+ undoctx->objucxtop = undoctx->objucxprv; /* last was top */
+ undoctx->objucxhead = 0;
+ }
+
+ /* head is below tail: delete records until we have enough room */
+ while (undoctx->objucxtail - undoctx->objucxhead < siz)
+ {
+ objutadv(undoctx);
+
+ /* if the tail wrapped, advancing won't do any more good */
+ if (undoctx->objucxtail <= undoctx->objucxhead)
+ {
+ /* if there's enough room at the top, we're done */
+ if (undoctx->objucxsiz - undoctx->objucxhead >= siz)
+ goto done;
+
+ /* still not enough room; wrap the head this time */
+ undoctx->objucxtop = undoctx->objucxprv; /* last was top */
+ undoctx->objucxhead = 0;
+ }
+ }
+
+done:
+ /* save back-link, and set objucxprv pointer to the new record */
+ prv = undoctx->objucxprv;
+ undoctx->objucxprv = undoctx->objucxhead;
+
+ /* write the header: command byte, back-link to previous record */
+ p = &undoctx->objucxbuf[undoctx->objucxhead];
+ *p++ = cmd;
+ memcpy(p, &prv, sizeof(prv));
+
+ /* advance the head pointer past the header */
+ undoctx->objucxhead += 1 + sizeof(prv);
+
+ /* set the high-water mark if we've exceeded the old one */
+ if (undoctx->objucxprv > undoctx->objucxtop)
+ undoctx->objucxtop = undoctx->objucxprv;
+
+ /* return the reserved space */
+ return &undoctx->objucxbuf[undoctx->objucxhead];
+}
+
+/* advance the undo tail pointer over the record it points to */
+void objutadv(objucxdef *undoctx)
+{
+ uchar *p;
+ ushort siz;
+ uchar pr[PRPHDRSIZ]; /* space for a property header */
+ uchar cmd;
+
+ /* if we're at the most recently written record, flush buffer */
+ if (undoctx->objucxtail == undoctx->objucxprv)
+ {
+ undoctx->objucxtail = 0;
+ undoctx->objucxprv = 0;
+ undoctx->objucxhead = 0;
+ undoctx->objucxtop = 0;
+ }
+
+ /* if we've reached high water mark, wrap back to bottom */
+ if (undoctx->objucxtail == undoctx->objucxtop)
+ {
+ undoctx->objucxtail = 0;
+ return;
+ }
+
+ /* determine size by inspecting current record */
+ p = undoctx->objucxbuf + undoctx->objucxtail;
+ siz = 1 + sizeof(ushort); /* basic header size */
+
+ cmd = *p++;
+ p += sizeof(ushort); /* skip the previous pointer */
+
+ switch(cmd)
+ {
+ case OBJUCHG:
+ /* change: property header (added below) plus data value */
+ memcpy(pr, p + sizeof(mcmon) + sizeof(prpnum), (size_t)PRPHDRSIZ);
+ siz += PRPHDRSIZ + prpsize(pr);
+ /* FALLTHROUGH */
+
+ case OBJUADD:
+ case OBJUOVR:
+ /* add/override: property header only */
+ siz += sizeof(mcmon) + sizeof(prpnum);
+ break;
+
+ case OBJUCLI:
+ siz += (*undoctx->objucxcsz)(undoctx->objucxccx, p);
+ break;
+
+ case OBJUSAV:
+ break;
+ }
+
+ undoctx->objucxtail += siz;
+}
+
+/* undo one undo record, and remove it from the undo list */
+void obj1undo(mcmcxdef *mctx, objucxdef *undoctx)
+{
+ uchar *p;
+ prpnum prop = 0;
+ objnum objn = 0;
+ uchar cmd;
+ uchar pr[PRPHDRSIZ]; /* space for property header */
+ ushort prv;
+ ushort pofs;
+ objdef *objptr;
+ int indexed = 0;
+
+ /* if there's no more undo, signal an error */
+ if (undoctx->objucxprv == undoctx->objucxhead)
+ errsig(undoctx->objucxerr, ERR_NOUNDO);
+
+ /* move back to previous record */
+ undoctx->objucxhead = undoctx->objucxprv;
+ p = &undoctx->objucxbuf[undoctx->objucxprv];
+
+ /* get command, and set undocxprv to previous record */
+ cmd = *p++;
+ memcpy(&prv, p, sizeof(prv));
+ p += sizeof(prv);
+
+ /* if we're at the tail, no more undo; otherwise, use back link */
+ if (undoctx->objucxprv == undoctx->objucxtail)
+ undoctx->objucxprv = undoctx->objucxhead;
+ else
+ undoctx->objucxprv = prv;
+
+ if (cmd == OBJUSAV) return; /* savepointer marker - nothing to do */
+
+ /* get object/property information for property-changing undo */
+ if (cmd != OBJUCLI)
+ {
+ memcpy(&objn, p, (size_t)sizeof(objn));
+ p += sizeof(objn);
+ memcpy(&prop, p, (size_t)sizeof(prop));
+ p += sizeof(prop);
+ objptr = mcmlck(mctx, objn);
+ indexed = (objflg(objptr) & OBJFINDEX);
+ mcmunlck(mctx, objn);
+ }
+
+ switch(cmd)
+ {
+ case OBJUADD:
+ objdelp(mctx, objn, prop, FALSE);
+ if (indexed) objindx(mctx, objn);
+ break;
+
+ case OBJUOVR:
+ objdelp(mctx, objn, prop, FALSE); /* delete the non-original value */
+ pofs = objgetp(mctx, objn, prop, (dattyp *)0); /* get ignored prop */
+ objptr = (objdef *)mcmlck(mctx, objn); /* lock the object */
+ prpflg(objofsp(objptr, pofs)) &= ~PRPFIGN; /* no longer ignored */
+ mcmunlck(mctx, objn); /* unlock the object */
+ break;
+
+ case OBJUCHG:
+ memcpy(pr, p, (size_t)PRPHDRSIZ);
+ p += PRPHDRSIZ;
+ objsetp(mctx, objn, prop, prptype(pr), (void *)p, (objucxdef *)0);
+ break;
+
+ case OBJUCLI:
+ (*undoctx->objucxcun)(undoctx->objucxccx, p);
+ break;
+ }
+}
+
+/*
+ * Determine if it's ok to add undo records - returns TRUE if a
+ * savepoint has been stored in the undo log, FALSE if not.
+ */
+int objuok(objucxdef *undoctx)
+{
+ ushort prv;
+
+ /* see if there's any more undo information */
+ if (undoctx->objucxprv == undoctx->objucxhead)
+ return(FALSE);
+
+ /* look for most recent savepoint marker */
+ for (prv = undoctx->objucxprv ;; )
+ {
+ if (undoctx->objucxbuf[prv] == OBJUSAV)
+ return(TRUE); /* found a savepoint - can add undo */
+
+ /* if we've reached the tail, there are no more undo records */
+ if (prv == undoctx->objucxtail)
+ return(FALSE); /* no savepoints - can't add undo */
+
+ /* get previous record */
+ memcpy(&prv, &undoctx->objucxbuf[prv+1], sizeof(prv));
+ }
+}
+
+/*
+ * Undo back to the most recent savepoint. If there is no savepoint in
+ * the undo list, NOTHING will be undone. This prevents reaching an
+ * inconsistent state in which some, but not all, of the operations
+ * between two savepoints are undone: either all operations between two
+ * savepoints will be undone, or none will.
+ */
+void objundo(mcmcxdef *mctx, objucxdef *undoctx)
+{
+ ushort prv;
+ ushort sav;
+
+ /* see if there's any more undo information */
+ if (undoctx->objucxprv == undoctx->objucxhead)
+ errsig(undoctx->objucxerr, ERR_NOUNDO);
+
+ /* look for most recent savepoint marker */
+ for (prv = undoctx->objucxprv ;; )
+ {
+ if (undoctx->objucxbuf[prv] == OBJUSAV)
+ {
+ sav = prv;
+ break;
+ }
+
+ /* if we've reached the tail, there are no more undo records */
+ if (prv == undoctx->objucxtail)
+ errsig(undoctx->objucxerr, ERR_ICUNDO);
+
+ /* get previous record */
+ memcpy(&prv, &undoctx->objucxbuf[prv+1], sizeof(prv));
+ }
+
+ /* now undo everything until we get to the savepoint */
+ do { obj1undo(mctx, undoctx); } while (undoctx->objucxhead != sav);
+}
+
+/* initialize undo context */
+objucxdef *objuini(mcmcxdef *ctx, ushort siz,
+ void (*undocb)(void *, uchar *),
+ ushort (*sizecb)(void *, uchar *),
+ void *callctx)
+{
+ objucxdef *ret;
+ long totsiz;
+
+ /* force size into valid range */
+ totsiz = (long)siz + sizeof(objucxdef) - 1;
+ if (totsiz > 0xff00)
+ siz = 0xff00 - sizeof(objucxdef) + 1;
+
+ ret = (objucxdef *)mchalo(ctx->mcmcxgl->mcmcxerr,
+ (sizeof(objucxdef) + siz - 1),
+ "objuini");
+
+ ret->objucxmem = ctx;
+ ret->objucxerr = ctx->mcmcxgl->mcmcxerr;
+ ret->objucxsiz = siz;
+ ret->objucxhead = ret->objucxprv = ret->objucxtail = ret->objucxtop = 0;
+
+ /* set client callback functions */
+ ret->objucxcun = undocb; /* callback to apply client undo */
+ ret->objucxcsz = sizecb; /* callback to get size of client undo */
+ ret->objucxccx = callctx; /* context for client callback functions */
+
+ return(ret);
+}
+
+/* discard all undo records */
+void objulose(objucxdef *ctx)
+{
+ if (ctx)
+ ctx->objucxhead =
+ ctx->objucxprv =
+ ctx->objucxtail =
+ ctx->objucxtop = 0;
+}
+
+/* uninitialize the undo context - release allocated memory */
+void objuterm(objucxdef *uctx)
+{
+ /* free the undo memory block */
+ mchfre(uctx);
+}
+
+/* revert object to original (post-compilation) values */
+void objrevert(void *ctx0, mcmon objn)
+{
+ mcmcxdef *mctx = (mcmcxdef *)ctx0;
+ uchar *p;
+ prpdef *pr;
+ int cnt;
+ int indexed;
+
+ p = mcmlck(mctx, objn);
+ pr = objprp(p);
+ indexed = objflg(p) & OBJFINDEX;
+
+ /* restore original settings */
+ objsfree(p, objrst(p));
+ objsnp(p, objstat(p));
+
+ /* go through original properties and remove 'ignore' flag if set */
+ for (cnt = objnprop(p) ; cnt ; pr = objpnxt(pr), --cnt)
+ prpflg(pr) &= ~PRPFIGN;
+
+ /* touch object and unlock it */
+ mcmtch(mctx, objn);
+ mcmunlck(mctx, objn);
+
+ /* if it's indexed, rebuild the index */
+ if (indexed) objindx(mctx, objn);
+}
+
+/* set 'ignore' flag for original properties set in mutable part */
+void objsetign(mcmcxdef *mctx, objnum objn)
+{
+ objdef *objptr;
+ prpdef *mut;
+ prpdef *p;
+ int statcnt;
+ int cnt;
+ int indexed;
+ prpdef *p1;
+
+ objptr = (objdef *)mcmlck(mctx, (mcmon)objn);
+ p1 = objprp(objptr);
+ indexed = objflg(objptr) & OBJFINDEX;
+
+ /* go through mutables, and set ignore on duplicates in non-mutables */
+ for (mut = (prpdef *)(objptr + objrst(objptr)),
+ cnt = objnprop(objptr) - objstat(objptr) ; cnt ;
+ mut = objpnxt(mut), --cnt)
+ {
+ for (p = p1, statcnt = objstat(objptr) ; statcnt ;
+ p = objpnxt(p), --statcnt)
+ {
+ /* if this static prop matches a mutable prop, ignore it */
+ if (prpprop(p) == prpprop(mut))
+ {
+ prpflg(p) |= PRPFIGN;
+ break;
+ }
+ }
+ }
+
+ mcmtch(mctx, (mcmon)objn);
+ mcmunlck(mctx, (mcmon)objn);
+ if (indexed) objindx(mctx, objn);
+}
+
+/*
+ * Build or rebuild a property index for an object.
+ */
+void objindx(mcmcxdef *mctx, objnum objn)
+{
+ uint newsiz;
+ uint avail;
+ objdef *objptr;
+ uint cnt;
+ prpdef *p;
+ uchar *indp = nullptr;
+ uchar *indbase;
+ uint icnt;
+ uint first;
+ uint last;
+ uint cur = 0;
+
+ objptr = (objdef *)mcmlck(mctx, objn); /* get object pointer */
+ cnt = objnprop(objptr); /* get number of properties */
+ p = objprp(objptr); /* get pointer to properties (or old index) */
+ newsiz = 2 + 4*cnt; /* figure size needed for the index */
+
+ avail = mcmobjsiz(mctx, objn) - objfree(objptr);
+
+ /* insert space for the index; expand the object if necessary */
+ if (avail < newsiz)
+ {
+ ushort need;
+
+ newsiz += 10*4; /* add some extra space for later */
+ need = newsiz - avail; /* compute amount of space needed */
+ objptr = objexp(mctx, objn, &need);
+ p = objprp(objptr);
+ }
+
+ /* now build the index */
+ indbase = objpfre(objptr);
+ for (icnt = 0 ; cnt ; p = objpnxt(p), --cnt, ++icnt)
+ {
+ uint ofs = (uchar *)p - (uchar *)objptr;
+
+ if (icnt)
+ {
+ /* figure out where to insert this property */
+ first = 0;
+ last = icnt - 1;
+ for (;;)
+ {
+ if (first > last) break;
+ cur = first + (last - first)/2;
+ indp = indbase + cur*4;
+ if (indp[0] == p[0] && indp[1] == p[1])
+ break;
+ else if (indp[0] < p[0]
+ || (indp[0] == p[0] && indp[1] < p[1]))
+ first = (cur == first ? first + 1 : cur);
+ else
+ last = (cur == last ? last - 1 : cur);
+ }
+
+ /* make sure we're positioned just before insertion point */
+ while (cur < icnt
+ && (indp[0] <= p[0]
+ || (indp[0] == p[0] && indp[1] <= p[1])))
+ {
+ indp += 4;
+ ++cur;
+ }
+
+ /* move elements above if any */
+ if (cur < icnt)
+ memmove(indp + 4, indp, (size_t)((icnt - cur) * 4));
+ }
+ else
+ indp = indbase;
+
+ /* insert property into index */
+ indp[0] = p[0];
+ indp[1] = p[1];
+ oswp2(indp+2, ofs);
+ }
+
+ /* set the index flag, and dirty and free the object */
+ objsflg(objptr, objflg(objptr) | OBJFINDEX);
+ mcmtch(mctx, (mcmon)objn);
+ mcmunlck(mctx, (mcmon)objn);
+}
+
+/* allocate and initialize an object */
+objdef *objnew(mcmcxdef *mctx, int sccnt, ushort propspace,
+ objnum *objnptr, int classflg)
+{
+ objdef *o;
+ mcmon objn;
+
+ /* allocate cache object */
+ o = (objdef *)mcmalo(mctx, (ushort)(OBJDEFSIZ + sccnt * 2 + propspace),
+ &objn);
+
+ /* set up object descriptor for the new object */
+ objini(mctx, sccnt, (objnum)objn, classflg);
+
+ *objnptr = (objnum)objn;
+ return(o);
+}
+
+/* initialize an already allocated object */
+void objini(mcmcxdef *mctx, int sccnt, objnum objn, int classflg)
+{
+ objdef *o;
+ uint flags = 0;
+
+ /* get a lock on the object */
+ o = (objdef *)mcmlck(mctx, objn);
+
+ memset(o, 0, (size_t)10);
+ objsnsc(o, sccnt);
+ objsfree(o, ((uchar *)objsc(o) + 2*sccnt) - (uchar *)o);
+
+ /* set up flags */
+ if (classflg) flags |= OBJFCLASS;
+ objsflg(o, flags);
+
+ /* tell cache manager that this object has been modified */
+ mcmtch(mctx, objn);
+ mcmunlck(mctx, objn);
+}
+
+/*
+ * Get the first superclass of an object. If it doesn't have any
+ * superclasses, return invalid.
+ */
+objnum objget1sc(mcmcxdef *ctx, objnum objn)
+{
+ objdef *p;
+ objnum retval;
+
+ /* lock the object */
+ p = mcmlck(ctx, (mcmon)objn);
+
+ /* get the first superclass if it has any */
+ if (objnsc(p) == 0)
+ retval = MCMONINV;
+ else
+ retval = osrp2(objsc(p));
+
+ /* unlock the object and return the superclass value */
+ mcmunlck(ctx, (mcmon)objn);
+ return retval;
+}
} // End of namespace TADS2
} // End of namespace TADS
} // End of namespace Glk
-
-#endif
diff --git a/engines/glk/tads/tads2/opcode_defs.h b/engines/glk/tads/tads2/opcode.h
index 32519ae8f7..4175db3c90 100644
--- a/engines/glk/tads/tads2/opcode_defs.h
+++ b/engines/glk/tads/tads2/opcode.h
@@ -20,8 +20,8 @@
*
*/
-#ifndef GLK_TADS_TADS2_OPCODE_DEFS
-#define GLK_TADS_TADS2_OPCODE_DEFS
+#ifndef GLK_TADS_TADS2_OPCODE
+#define GLK_TADS_TADS2_OPCODE
/*
* Opcode definitions
diff --git a/engines/glk/tads/tads2/post_compilation.cpp b/engines/glk/tads/tads2/post_compilation.cpp
new file mode 100644
index 0000000000..ca29601190
--- /dev/null
+++ b/engines/glk/tads/tads2/post_compilation.cpp
@@ -0,0 +1,466 @@
+/* ScummVM - Graphic Adventure Engine
+ *
+ * ScummVM is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ */
+
+#include "glk/tads/tads2/post_compilation.h"
+#include "glk/tads/tads2/error.h"
+#include "glk/tads/tads2/os.h"
+
+namespace Glk {
+namespace TADS {
+namespace TADS2 {
+
+/*
+ * Special character sequence description table for TADS language.
+ * Note that operators that start with common sequences must be grouped
+ * together, with the shorter sequences preceding the longer sequences.
+ * For example, ":" and ":=" must be adjacent, and ":" must precede
+ * ":=". Other than this restriction, the order of tokens doesn't
+ * matter.
+ */
+tokldef supsctab[] =
+{
+ { TOKTCOLON, ":" },
+ { TOKTASSIGN, ":=" },
+ { TOKTLT, "<" },
+ { TOKTLE, "<=" },
+ { TOKTSHL, "<<" },
+ { TOKTSHLEQ, "<<="},
+ { TOKTNE, "<>" },
+ { TOKTGT, ">" },
+ { TOKTSHR, ">>" },
+ { TOKTSHREQ, ">>="},
+ { TOKTGE, ">=" },
+ { TOKTLPAR, "(" },
+ { TOKTRPAR, ")" },
+ { TOKTPLUS, "+" },
+ { TOKTINC, "++" },
+ { TOKTPLEQ, "+=" },
+ { TOKTMINUS, "-" },
+ { TOKTPOINTER, "->" },
+ { TOKTDEC, "--" },
+ { TOKTMINEQ, "-=" },
+ { TOKTDIV, "/" },
+ { TOKTMOD, "%" },
+ { TOKTMODEQ, "%=" },
+ { TOKTDIVEQ, "/=" },
+ { TOKTTIMES, "*" },
+ { TOKTTIMEQ, "*=" },
+ { TOKTEQ, "=" },
+ { TOKTEQEQ, "==" },
+ { TOKTLBRACK, "[" },
+ { TOKTRBRACK, "]" },
+ { TOKTLBRACE, "{" },
+ { TOKTRBRACE, "}" },
+ { TOKTSEM, ";" },
+ { TOKTCOMMA, "," },
+ { TOKTDOT, "." },
+ { TOKTELLIPSIS,"..." },
+ { TOKTPOUND, "#" },
+ { TOKTBAND, "&" },
+ { TOKTBANDEQ, "&=" },
+ { TOKTAND, "&&" },
+ { TOKTBOR, "|" },
+ { TOKTBOREQ, "|=" },
+ { TOKTOR, "||" },
+ { TOKTQUESTION,"?" },
+ { TOKTDSTRING, "\"" },
+ { TOKTSSTRING, "'" },
+ { TOKTNOT, "!" },
+ { TOKTNE, "!=" },
+ { TOKTXOR, "^" },
+ { TOKTXOREQ, "^=" },
+ { TOKTTILDE, "~" },
+ { 0, "" }
+};
+
+typedef struct supkwdef supkwdef;
+struct supkwdef
+{
+ char *supkwnam;
+ int supkwtok;
+};
+
+static supkwdef supkwtab[] =
+{
+ { "not", TOKTNOT },
+ { "if", TOKTIF },
+ { "else", TOKTELSE },
+ { "while", TOKTWHILE },
+ { "break", TOKTBREAK },
+ { "continue", TOKTCONTINUE },
+ { "exit", TOKTEXIT },
+ { "abort", TOKTABORT },
+ { "and", TOKTAND },
+ { "or", TOKTOR },
+ { "function", TOKTFUNCTION },
+ { "return", TOKTRETURN },
+ { "local", TOKTLOCAL },
+ { "object", TOKTOBJECT },
+ { "nil", TOKTNIL },
+ { "true", TOKTTRUE },
+ { "pass", TOKTPASS },
+ { "askdo", TOKTASKDO },
+ { "askio", TOKTASKIO },
+ { "ioSynonym", TOKTIOSYN },
+ { "doSynonym", TOKTDOSYN },
+ { "external", TOKTEXTERN },
+ { "formatstring", TOKTFORMAT },
+ { "compoundWord", TOKTCOMPOUND },
+ { "specialWords", TOKTSPECIAL },
+ { "class", TOKTCLASS },
+
+ /* new keywords for V2 */
+ { "\002", 0 }, /* special flag for start of v2 section */
+ { "for", TOKTFOR },
+ { "\001", 0 }, /* special flag that "do" is next keyword */
+ { "do", TOKTDO },
+ { "switch", TOKTSWITCH },
+ { "case", TOKTCASE },
+ { "default", TOKTDEFAULT },
+ { "goto", TOKTGOTO },
+ { "replace", TOKTREPLACE },
+ { "modify", TOKTMODIFY },
+
+ { "new", TOKTNEW },
+ { "delete", TOKTDELETE },
+ { (char *)0, 0 }
+};
+
+typedef struct supprdef supprdef;
+struct supprdef
+{
+ char *supprnam;
+ prpnum supprval;
+};
+
+static supprdef supprtab[] =
+{
+ { "verb", PRP_VERB },
+ { "noun", PRP_NOUN },
+ { "adjective", PRP_ADJ },
+ { "preposition", PRP_PREP },
+ { "article", PRP_ARTICLE },
+ { "plural", PRP_PLURAL },
+
+ /* add some more built-in properties */
+ { "doAction", PRP_DOACTION },
+ { "ioAction", PRP_IOACTION },
+ { "sdesc", PRP_SDESC },
+ { "thedesc", PRP_THEDESC },
+ { "ioDefault", PRP_IODEFAULT },
+ { "doDefault", PRP_DODEFAULT },
+ { "location", PRP_LOCATION },
+ { "value", PRP_VALUE },
+ { "roomAction", PRP_ROOMACTION },
+ { "actorAction", PRP_ACTORACTION },
+ { "contents", PRP_CONTENTS },
+ { "prepDefault", PRP_PREPDEFAULT },
+ { "verActor", PRP_VERACTOR },
+ { "validDo", PRP_VALIDDO },
+ { "validIo", PRP_VALIDIO },
+ { "lookAround", PRP_LOOKAROUND },
+ { "roomCheck", PRP_ROOMCHECK },
+ { "statusLine", PRP_STATUSLINE },
+ { "locationOK", PRP_LOCOK },
+ { "isVisible", PRP_ISVIS },
+ { "cantReach", PRP_NOREACH },
+ { "isHim", PRP_ISHIM },
+ { "isHer", PRP_ISHER },
+ { "action", PRP_ACTION },
+ { "validDoList", PRP_VALDOLIST },
+ { "validIoList", PRP_VALIOLIST },
+ { "dobjGen", PRP_DOBJGEN },
+ { "iobjGen", PRP_IOBJGEN },
+ { "nilPrep", PRP_NILPREP },
+ { "rejectMultiDobj", PRP_REJECTMDO },
+ { "moveInto", PRP_MOVEINTO },
+ { "construct", PRP_CONSTRUCT },
+ { "destruct", PRP_DESTRUCT },
+ { "validActor", PRP_VALIDACTOR },
+ { "preferredActor", PRP_PREFACTOR },
+ { "isEquivalent", PRP_ISEQUIV },
+ { "adesc", PRP_ADESC },
+ { "multisdesc", PRP_MULTISDESC },
+ { "anyvalue", PRP_ANYVALUE },
+ { "newNumbered", PRP_NEWNUMOBJ },
+ { "parseUnknownDobj", PRP_PARSEUNKNOWNDOBJ },
+ { "parseUnknownIobj", PRP_PARSEUNKNOWNIOBJ },
+ { "dobjCheck", PRP_DOBJCHECK },
+ { "iobjCheck", PRP_IOBJCHECK },
+ { "verbAction", PRP_VERBACTION },
+ { "disambigDobj", PRP_DISAMBIGDO },
+ { "disambigIobj", PRP_DISAMBIGIO },
+ { "prefixdesc", PRP_PREFIXDESC },
+ { "isThem", PRP_ISTHEM },
+
+ /* still more - TADS/Graphic properties */
+ { "gp_picture", PRP_GP_PIC },
+ { "gp_name", PRP_GP_NAME },
+ { "gp_defverb", PRP_GP_DEFVERB },
+ { "gp_active", PRP_GP_ACTIVE },
+ { "gp_hotlist", PRP_GP_HOTLIST },
+ { "gp_icon", PRP_GP_ICON },
+ { "gp_defverb2", PRP_GP_DEFVERB2 },
+ { "gp_defprep", PRP_GP_DEFPREP },
+ { "gp_hotid", PRP_GP_HOTID },
+ { "gp_overlay", PRP_GP_OVERLAY },
+ { "gp_hotx", PRP_GP_HOTX },
+ { "gp_hoty", PRP_GP_HOTY },
+
+ /* flag end of list with null property name */
+ { (char *)0, 0 }
+};
+
+/* define a built-in symbol */
+static void supaddsym(toktdef *tab, char *txt, int styp, int sval,
+ int casefold)
+{
+ char buf[40];
+
+ if (casefold)
+ {
+ strcpy(buf, txt);
+ os_strlwr(buf);
+ txt = buf;
+ }
+ (*tab->toktfadd)(tab, txt, (int)strlen(txt), styp, sval, tokhsh(txt));
+}
+
+/* add a built-in function to a symbol table */
+static void supaddbi(void (*bif[])(bifcxdef *, int),
+ toktdef *tab, char *txt,
+ void (*fn)(bifcxdef *, int), int num, int casefold)
+{
+ supaddsym(tab, txt, TOKSTBIFN, num, casefold);
+ bif[num] = fn;
+}
+
+/* set up reserved words: built-in functions and properties, keywords, etc */
+void suprsrv(supcxdef *sup, void (*bif[])(bifcxdef *, int),
+ toktdef *tab, int max, int v1compat, char *new_do,
+ int casefold)
+{
+ supkwdef *kw;
+ supbidef *p;
+ int i;
+ supprdef *pr;
+ extern supbidef osfar_t supbitab[];
+ int do_kw = FALSE;
+ char *kwname;
+ char buf[40];
+
+ /* add built-in functions */
+ for (p = supbitab, i = 0 ; p->supbinam ; ++i, ++p)
+ {
+ if (i >= max) errsig(sup->supcxerr, ERR_MANYBIF);
+ supaddbi(bif, tab, p->supbinam, p->supbifn, i, casefold);
+ }
+
+ /* add keywords */
+ for (kw = supkwtab ; kw->supkwnam ; ++kw)
+ {
+ if (kw->supkwnam[0] == '\002')
+ {
+ if (v1compat) break; /* no v2 keywords - quit now */
+ else continue; /* keep going, but skip this flag entry */
+ }
+
+ /* if this is the "do" keyword, change to user-supplied value */
+ if (do_kw && new_do)
+ kwname = new_do;
+ else
+ kwname = kw->supkwnam;
+
+ if (kw->supkwnam[0] == '\001')
+ {
+ do_kw = TRUE;
+ continue;
+ }
+ else
+ do_kw = FALSE;
+
+ if (casefold)
+ {
+ strcpy(buf, kwname);
+ os_strlwr(buf);
+ kwname = buf;
+ }
+ (*tab->toktfadd)(tab, kwname, (int)strlen(kwname),
+ TOKSTKW, kw->supkwtok, tokhsh(kwname));
+ }
+
+ /* add pseudo-variables */
+ supaddsym(tab, "self", TOKSTSELF, 0, casefold);
+ supaddsym(tab, "inherited", TOKSTINHERIT, 0, casefold);
+ supaddsym(tab, "argcount", TOKSTARGC, 0, casefold);
+
+ /* add built-in properties */
+ for (pr = supprtab ; pr->supprnam ; ++pr)
+ supaddsym(tab, pr->supprnam, TOKSTPROP, pr->supprval, casefold);
+}
+
+/* get name of an object out of symbol table */
+void supgnam(char *buf, tokthdef *tab, objnum objn)
+{
+ toksdef sym;
+
+ if (!tab)
+ {
+ strcpy(buf, "<NO SYMBOL TABLE>");
+ return;
+ }
+
+ if (tokthfind((toktdef *)tab, TOKSTOBJ, (uint)objn, &sym)
+ || tokthfind((toktdef *)tab, TOKSTFWDOBJ, (uint)objn, &sym))
+ {
+ memcpy(buf, sym.toksnam, (size_t)sym.tokslen);
+ buf[sym.tokslen] = '\0';
+ return;
+ }
+
+ strcpy(buf, "<UNKNOWN>");
+}
+
+/* set up inherited vocabulary */
+void supivoc(supcxdef *ctx)
+{
+ vocidef ***vpg;
+ vocidef **v;
+ voccxdef *voc = ctx->supcxvoc;
+ int i;
+ int j;
+ objnum obj;
+
+ /* delete all existing inherited words */
+ vocdelinh(voc);
+
+ for (vpg = voc->voccxinh, i = 0 ; i < VOCINHMAX ; ++vpg, ++i)
+ {
+ if (!*vpg) continue; /* no entries on this page */
+ for (v = *vpg, obj = (i << 8), j = 0 ; j < 256 ; ++v, ++obj, ++j)
+ {
+ /* if it's not a class, inherit vocabulary for the object */
+ if (!*v) continue;
+ if (!((*v)->vociflg & VOCIFCLASS))
+ {
+ (*v)->vociilc = MCMONINV; /* no inherited location yet */
+ supivoc1(ctx, ctx->supcxvoc, *v, obj, FALSE, 0);
+ }
+ }
+ }
+}
+
+/* find a single required object, by name */
+static void supfind1(errcxdef *ec, toktdef *tab, char *nam, objnum *objp,
+ int required, int *errp, int warnlevel, int casefold)
+{
+ toksdef sym;
+ int namel = strlen(nam);
+ char buf[40];
+
+ if (casefold)
+ {
+ strcpy(buf, nam);
+ os_strlwr(buf);
+ nam = buf;
+ }
+ if ((*tab->toktfsea)(tab, nam, namel, tokhsh(nam), &sym))
+ {
+ *objp = (objnum)sym.toksval;
+ }
+ else
+ {
+ if (required || warnlevel > 1)
+ errlog1(ec, (required ? ERR_RQOBJNF : ERR_WRNONF),
+ ERRTSTR, errstr(ec, nam, namel));
+ *objp = MCMONINV;
+ if (required) *errp = 1;
+ }
+}
+
+/* find required objects/functions */
+void supfind(errcxdef *ec, tokthdef *htab, voccxdef *voc,
+ objnum *preinit, int warnlevel, int cf)
+{
+ int err = 0;
+ toktdef *tab = &htab->tokthsc;
+
+ /* look up the required and optional symbols */
+ supfind1(ec, tab, "Me", &voc->voccxme, TRUE, &err, warnlevel, cf);
+ supfind1(ec, tab, "takeVerb", &voc->voccxvtk, TRUE, &err, warnlevel, cf);
+ supfind1(ec, tab, "strObj", &voc->voccxstr, TRUE, &err, warnlevel, cf);
+ supfind1(ec, tab, "numObj", &voc->voccxnum, TRUE, &err, warnlevel, cf);
+ supfind1(ec, tab, "pardon", &voc->voccxprd, TRUE, &err, warnlevel, cf);
+ supfind1(ec, tab, "againVerb", &voc->voccxvag, TRUE, &err, warnlevel, cf);
+ supfind1(ec, tab, "init", &voc->voccxini, TRUE, &err, warnlevel, cf);
+ supfind1(ec, tab, "preinit", preinit, FALSE, &err, warnlevel, cf);
+ supfind1(ec, tab, "preparse", &voc->voccxpre, FALSE, &err, warnlevel, cf);
+ supfind1(ec, tab, "preparseExt", &voc->voccxpre2, FALSE, &err,
+ warnlevel, cf);
+ supfind1(ec, tab, "parseError", &voc->voccxper, FALSE, &err, warnlevel,
+ cf);
+ supfind1(ec, tab, "commandPrompt", &voc->voccxprom, FALSE, &err,
+ warnlevel, cf);
+ supfind1(ec, tab, "parseDisambig", &voc->voccxpdis, FALSE, &err,
+ warnlevel, cf);
+ supfind1(ec, tab, "parseError2", &voc->voccxper2, FALSE, &err, warnlevel,
+ cf);
+ supfind1(ec, tab, "parseDefault", &voc->voccxpdef, FALSE, &err, warnlevel,
+ cf);
+ supfind1(ec, tab, "parseDefaultExt", &voc->voccxpdef2, FALSE, &err,
+ warnlevel, cf);
+ supfind1(ec, tab, "parseAskobj", &voc->voccxpask, FALSE, &err, warnlevel,
+ cf);
+ supfind1(ec, tab, "preparseCmd", &voc->voccxppc, FALSE, &err, warnlevel,
+ cf);
+ supfind1(ec, tab, "parseAskobjActor", &voc->voccxpask2, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "parseAskobjIndirect", &voc->voccxpask3, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "parseErrorParam", &voc->voccxperp, FALSE, &err,
+ warnlevel, cf);
+ supfind1(ec, tab, "commandAfterRead", &voc->voccxpostprom, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "initRestore", &voc->voccxinitrestore, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "parseUnknownVerb", &voc->voccxpuv, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "parseNounPhrase", &voc->voccxpnp, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "postAction", &voc->voccxpostact, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "endCommand", &voc->voccxendcmd, FALSE,
+ &err, warnlevel, cf);
+ supfind1(ec, tab, "preCommand", &voc->voccxprecmd, FALSE,
+ &err, warnlevel, cf);
+
+ /* "Me" is always the initial Me object */
+ voc->voccxme_init = voc->voccxme;
+
+ /* if we encountered any errors, signal the problem */
+ if (err)
+ errsig(ec, ERR_UNDEF);
+}
+
+} // End of namespace TADS2
+} // End of namespace TADS
+} // End of namespace Glk
diff --git a/engines/glk/tads/tads2/run.h b/engines/glk/tads/tads2/run.h
index 71b8d78d66..732cfdf29b 100644
--- a/engines/glk/tads/tads2/run.h
+++ b/engines/glk/tads/tads2/run.h
@@ -37,7 +37,7 @@
#include "glk/tads/tads2/object.h"
#include "glk/tads/tads2/memory_cache.h"
#include "glk/tads/tads2/memory_cache_swap.h"
-#include "glk/tads/tads2/opcode_defs.h"
+#include "glk/tads/tads2/opcode.h"
#include "glk/tads/tads2/property.h"
#include "glk/tads/tads2/text_io.h"
#include "glk/tads/tads2/tokenizer.h"