From f607792fa4e1f024dd8265034ac84425bde4aee7 Mon Sep 17 00:00:00 2001 From: Paul Gilbert Date: Fri, 17 May 2019 14:48:01 -1000 Subject: GLK: TADS2: More code files implemented --- engines/glk/tads/tads2/file_io.cpp | 1742 ++++++++++++++++++++++++ engines/glk/tads/tads2/line_source_file.cpp | 1037 ++++++++++++++ engines/glk/tads/tads2/memory_cache.cpp | 1156 ++++++++++++++++ engines/glk/tads/tads2/memory_cache_loader.cpp | 31 - engines/glk/tads/tads2/memory_cache_swap.cpp | 300 ++++ engines/glk/tads/tads2/object.cpp | 1045 +++++++++++++- engines/glk/tads/tads2/opcode.h | 218 +++ engines/glk/tads/tads2/opcode_defs.h | 218 --- engines/glk/tads/tads2/post_compilation.cpp | 466 +++++++ engines/glk/tads/tads2/run.h | 2 +- 10 files changed, 5963 insertions(+), 252 deletions(-) delete mode 100644 engines/glk/tads/tads2/memory_cache_loader.cpp create mode 100644 engines/glk/tads/tads2/opcode.h delete mode 100644 engines/glk/tads/tads2/opcode_defs.h create mode 100644 engines/glk/tads/tads2/post_compilation.cpp (limited to 'engines/glk/tads/tads2') 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.h b/engines/glk/tads/tads2/opcode.h new file mode 100644 index 0000000000..4175db3c90 --- /dev/null +++ b/engines/glk/tads/tads2/opcode.h @@ -0,0 +1,218 @@ +/* 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. + * + */ + +#ifndef GLK_TADS_TADS2_OPCODE +#define GLK_TADS_TADS2_OPCODE + +/* + * Opcode definitions + * + * Lifted largely from the old TADS, since the basic run - time interpreter's + * operation is essentially the same. + */ + +#include "glk/tads/tads.h" +#include "glk/tads/tads2/data.h" + +namespace Glk { +namespace TADS { +namespace TADS2 { + +#define OPCPUSHNUM 1 /* push a constant numeric value */ +#define OPCPUSHOBJ 2 /* push an object */ +#define OPCNEG 3 /* unary negation */ +#define OPCNOT 4 /* logical negation */ +#define OPCADD 5 /* addition/list concatenation */ +#define OPCSUB 6 /* subtraction/list difference */ +#define OPCMUL 7 /* multiplication */ +#define OPCDIV 8 /* division */ +#define OPCAND 9 /* logical AND */ +#define OPCOR 10 /* logical OR */ +#define OPCEQ 11 /* equality */ +#define OPCNE 12 /* inequality */ +#define OPCGT 13 /* greater than */ +#define OPCGE 14 /* greater or equal */ +#define OPCLT 15 /* less than */ +#define OPCLE 16 /* less or equal */ +#define OPCCALL 17 /* call a function */ +#define OPCGETP 18 /* get property */ +#define OPCGETPDATA 19 /* get a property, allowing only data values */ +#define OPCGETLCL 20 /* get a local variable's value */ +#define OPCPTRGETPDATA 21 /* get property via pointer; only allow data */ +#define OPCRETURN 22 /* return without a value */ +#define OPCRETVAL 23 /* return a value */ +#define OPCENTER 24 /* enter a function */ +#define OPCDISCARD 25 /* discard top of stack */ +#define OPCJMP 26 /* unconditional jump */ +#define OPCJF 27 /* jump if false */ +#define OPCPUSHSELF 28 /* push current object */ +#define OPCSAY 29 /* implicit printout for doublequote strings */ +#define OPCBUILTIN 30 /* call a built-in function */ +#define OPCPUSHSTR 31 /* push a string */ +#define OPCPUSHLST 32 /* push a list */ +#define OPCPUSHNIL 33 /* push the NIL value */ +#define OPCPUSHTRUE 34 /* push the TRUE value */ +#define OPCPUSHFN 35 /* push the address of a function */ +#define OPCGETPSELFDATA 36 /* push property of self; only allow data */ + +#define OPCPTRCALL 38 /* call function pointed to by top of stack */ +#define OPCPTRINH 39 /* inherit pointer to property (stack=prop) */ +#define OPCPTRGETP 40 /* get property by pointer (stack=obj,prop) */ + +#define OPCPASS 41 /* pass to inherited handler */ +#define OPCEXIT 42 /* exit turn, but continue with fuses/daemons */ +#define OPCABORT 43 /* abort turn, skipping fuses/daemons */ +#define OPCASKDO 44 /* ask for a direct object */ +#define OPCASKIO 45 /* ask for indirect object and set preposition */ + +/* explicit superclass inheritance opcodes */ +#define OPCEXPINH 46 /* "inherited ." */ +#define OPCEXPINHPTR 47 /* "inherited ." */ + +/* + * Special opcodes for peephole optimization. These are essentially + * pairs of operations that occur frequently so have been collapsed into + * a single instruction. + */ +#define OPCCALLD 48 /* call function and discard value */ +#define OPCGETPD 49 /* evaluate property and discard any value */ +#define OPCBUILTIND 50 /* call built-in function and discard value */ + +#define OPCJE 51 /* jump if equal */ +#define OPCJNE 52 /* jump if not equal */ +#define OPCJGT 53 /* jump if greater than */ +#define OPCJGE 54 /* jump if greater or equal */ +#define OPCJLT 55 /* jump if less than */ +#define OPCJLE 56 /* jump if less or equal */ +#define OPCJNAND 57 /* jump if not AND */ +#define OPCJNOR 58 /* jump if not OR */ +#define OPCJT 59 /* jump if true */ + +#define OPCGETPSELF 60 /* get property of the 'self' object */ +#define OPCGETPSLFD 61 /* get property of 'self' and discard result */ +#define OPCGETPOBJ 62 /* get property of a given object */ + /* note: differs from GETP in that object is */ + /* encoded into the instruction */ +#define OPCGETPOBJD 63 /* get property of an object and discard result */ +#define OPCINDEX 64 /* get an indexed entry from a list */ + +#define OPCPUSHPN 67 /* push a property number */ + +#define OPCJST 68 /* jump and save top-of-stack if true */ +#define OPCJSF 69 /* jump and save top-of-stack if false */ +#define OPCJMPD 70 /* discard stack and then jump unconditionally */ + +#define OPCINHERIT 71 /* inherit a property from superclass */ +#define OPCCALLEXT 72 /* call external function */ +#define OPCDBGRET 73 /* return to debugger (no stack frame leaving) */ + +#define OPCCONS 74 /* construct list from top two stack elements */ +#define OPCSWITCH 75 /* switch statement */ + +#define OPCARGC 76 /* get argument count */ +#define OPCCHKARGC 77 /* check actual arguments against formal count */ + +#define OPCLINE 78 /* line record */ +#define OPCFRAME 79 /* local variable frame record */ +#define OPCBP 80 /* breakpoint - replaces an OPCLINE instruction */ +#define OPCGETDBLCL 81 /* get debugger local */ +#define OPCGETPPTRSELF 82 /* get property pointer from self */ +#define OPCMOD 83 /* modulo */ +#define OPCBAND 84 /* binary AND */ +#define OPCBOR 85 /* binary OR */ +#define OPCXOR 86 /* binary XOR */ +#define OPCBNOT 87 /* binary negation */ +#define OPCSHL 88 /* bit shift left */ +#define OPCSHR 89 /* bit shift right */ + +#define OPCNEW 90 /* create new object */ +#define OPCDELETE 91 /* delete object */ + + +/* ----- opcodes 192 and above are reserved for assignment operations ----- */ + +/* +ASSIGNMENT OPERATIONS + When (opcode & 0xc0 == 0xc0), we have an assignment operation. + (Note that this means that opcodes from 0xc0 up are all reserved + for assignment operations.) The low six bits of the opcode + specify exactly what kind of operation is to be performed: + + bits 0-1: specifies destination type: + 00 2-byte operand is local number + 01 2-byte operand is property to set in obj at tos + 10 tos is index, [sp-1] is list to be indexed and set + 11 tos is property pointer, [sp-1] is object + + bits 2-4: specifies assignment operation: + 000 := (direct assignment) + 001 += (add tos to destination) + 010 -= (subtract tos from destination) + 011 *= (multiply destination by tos) + 100 /= (divide destination by tos) + 101 ++ (increment tos) + 110 -- (decrement tos) + 111 *reserved* + + bit 5: specifies what to do with value computed by assignment + 0 leave on stack (implies pre increment/decrement) + 1 discard (implies post increment/decrement) +*/ +#define OPCASI_MASK 0xc0 /* assignment instruction */ + +#define OPCASIDEST_MASK 0x03 /* mask to get destination field */ +#define OPCASILCL 0x00 /* assign to a local */ +#define OPCASIPRP 0x01 /* assign to an object.property */ +#define OPCASIIND 0x02 /* assign to an element of a list */ +#define OPCASIPRPPTR 0x03 /* assign property via pointer */ + +#define OPCASITYP_MASK 0x1c /* mask to get assignment type field */ +#define OPCASIDIR 0x00 /* direct assignment */ +#define OPCASIADD 0x04 /* assign and add */ +#define OPCASISUB 0x08 /* assign and subtract */ +#define OPCASIMUL 0x0c /* assign and multiply */ +#define OPCASIDIV 0x10 /* assign and divide */ +#define OPCASIINC 0x14 /* increment */ +#define OPCASIDEC 0x18 /* decrement */ +#define OPCASIEXT 0x1c /* other - extension flag */ + +/* extended assignment flags - next byte when OPCASIEXT is used */ +#define OPCASIMOD 1 /* modulo and assign */ +#define OPCASIBAND 2 /* binary AND and assign */ +#define OPCASIBOR 3 /* binary OR and assign */ +#define OPCASIXOR 4 /* binary XOR and assign */ +#define OPCASISHL 5 /* shift left and assign */ +#define OPCASISHR 6 /* shift right and assign */ + + +#define OPCASIPRE_MASK 0x20 /* mask for pre/post field */ +#define OPCASIPOST 0x00 /* increment after push */ +#define OPCASIPRE 0x20 /* increment before push */ + +/* some composite opcodes for convenience */ +#define OPCSETLCL (OPCASI_MASK | OPCASILCL | OPCASIDIR) + +} // 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_defs.h deleted file mode 100644 index 32519ae8f7..0000000000 --- a/engines/glk/tads/tads2/opcode_defs.h +++ /dev/null @@ -1,218 +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. - * - */ - -#ifndef GLK_TADS_TADS2_OPCODE_DEFS -#define GLK_TADS_TADS2_OPCODE_DEFS - -/* - * Opcode definitions - * - * Lifted largely from the old TADS, since the basic run - time interpreter's - * operation is essentially the same. - */ - -#include "glk/tads/tads.h" -#include "glk/tads/tads2/data.h" - -namespace Glk { -namespace TADS { -namespace TADS2 { - -#define OPCPUSHNUM 1 /* push a constant numeric value */ -#define OPCPUSHOBJ 2 /* push an object */ -#define OPCNEG 3 /* unary negation */ -#define OPCNOT 4 /* logical negation */ -#define OPCADD 5 /* addition/list concatenation */ -#define OPCSUB 6 /* subtraction/list difference */ -#define OPCMUL 7 /* multiplication */ -#define OPCDIV 8 /* division */ -#define OPCAND 9 /* logical AND */ -#define OPCOR 10 /* logical OR */ -#define OPCEQ 11 /* equality */ -#define OPCNE 12 /* inequality */ -#define OPCGT 13 /* greater than */ -#define OPCGE 14 /* greater or equal */ -#define OPCLT 15 /* less than */ -#define OPCLE 16 /* less or equal */ -#define OPCCALL 17 /* call a function */ -#define OPCGETP 18 /* get property */ -#define OPCGETPDATA 19 /* get a property, allowing only data values */ -#define OPCGETLCL 20 /* get a local variable's value */ -#define OPCPTRGETPDATA 21 /* get property via pointer; only allow data */ -#define OPCRETURN 22 /* return without a value */ -#define OPCRETVAL 23 /* return a value */ -#define OPCENTER 24 /* enter a function */ -#define OPCDISCARD 25 /* discard top of stack */ -#define OPCJMP 26 /* unconditional jump */ -#define OPCJF 27 /* jump if false */ -#define OPCPUSHSELF 28 /* push current object */ -#define OPCSAY 29 /* implicit printout for doublequote strings */ -#define OPCBUILTIN 30 /* call a built-in function */ -#define OPCPUSHSTR 31 /* push a string */ -#define OPCPUSHLST 32 /* push a list */ -#define OPCPUSHNIL 33 /* push the NIL value */ -#define OPCPUSHTRUE 34 /* push the TRUE value */ -#define OPCPUSHFN 35 /* push the address of a function */ -#define OPCGETPSELFDATA 36 /* push property of self; only allow data */ - -#define OPCPTRCALL 38 /* call function pointed to by top of stack */ -#define OPCPTRINH 39 /* inherit pointer to property (stack=prop) */ -#define OPCPTRGETP 40 /* get property by pointer (stack=obj,prop) */ - -#define OPCPASS 41 /* pass to inherited handler */ -#define OPCEXIT 42 /* exit turn, but continue with fuses/daemons */ -#define OPCABORT 43 /* abort turn, skipping fuses/daemons */ -#define OPCASKDO 44 /* ask for a direct object */ -#define OPCASKIO 45 /* ask for indirect object and set preposition */ - -/* explicit superclass inheritance opcodes */ -#define OPCEXPINH 46 /* "inherited ." */ -#define OPCEXPINHPTR 47 /* "inherited ." */ - -/* - * Special opcodes for peephole optimization. These are essentially - * pairs of operations that occur frequently so have been collapsed into - * a single instruction. - */ -#define OPCCALLD 48 /* call function and discard value */ -#define OPCGETPD 49 /* evaluate property and discard any value */ -#define OPCBUILTIND 50 /* call built-in function and discard value */ - -#define OPCJE 51 /* jump if equal */ -#define OPCJNE 52 /* jump if not equal */ -#define OPCJGT 53 /* jump if greater than */ -#define OPCJGE 54 /* jump if greater or equal */ -#define OPCJLT 55 /* jump if less than */ -#define OPCJLE 56 /* jump if less or equal */ -#define OPCJNAND 57 /* jump if not AND */ -#define OPCJNOR 58 /* jump if not OR */ -#define OPCJT 59 /* jump if true */ - -#define OPCGETPSELF 60 /* get property of the 'self' object */ -#define OPCGETPSLFD 61 /* get property of 'self' and discard result */ -#define OPCGETPOBJ 62 /* get property of a given object */ - /* note: differs from GETP in that object is */ - /* encoded into the instruction */ -#define OPCGETPOBJD 63 /* get property of an object and discard result */ -#define OPCINDEX 64 /* get an indexed entry from a list */ - -#define OPCPUSHPN 67 /* push a property number */ - -#define OPCJST 68 /* jump and save top-of-stack if true */ -#define OPCJSF 69 /* jump and save top-of-stack if false */ -#define OPCJMPD 70 /* discard stack and then jump unconditionally */ - -#define OPCINHERIT 71 /* inherit a property from superclass */ -#define OPCCALLEXT 72 /* call external function */ -#define OPCDBGRET 73 /* return to debugger (no stack frame leaving) */ - -#define OPCCONS 74 /* construct list from top two stack elements */ -#define OPCSWITCH 75 /* switch statement */ - -#define OPCARGC 76 /* get argument count */ -#define OPCCHKARGC 77 /* check actual arguments against formal count */ - -#define OPCLINE 78 /* line record */ -#define OPCFRAME 79 /* local variable frame record */ -#define OPCBP 80 /* breakpoint - replaces an OPCLINE instruction */ -#define OPCGETDBLCL 81 /* get debugger local */ -#define OPCGETPPTRSELF 82 /* get property pointer from self */ -#define OPCMOD 83 /* modulo */ -#define OPCBAND 84 /* binary AND */ -#define OPCBOR 85 /* binary OR */ -#define OPCXOR 86 /* binary XOR */ -#define OPCBNOT 87 /* binary negation */ -#define OPCSHL 88 /* bit shift left */ -#define OPCSHR 89 /* bit shift right */ - -#define OPCNEW 90 /* create new object */ -#define OPCDELETE 91 /* delete object */ - - -/* ----- opcodes 192 and above are reserved for assignment operations ----- */ - -/* -ASSIGNMENT OPERATIONS - When (opcode & 0xc0 == 0xc0), we have an assignment operation. - (Note that this means that opcodes from 0xc0 up are all reserved - for assignment operations.) The low six bits of the opcode - specify exactly what kind of operation is to be performed: - - bits 0-1: specifies destination type: - 00 2-byte operand is local number - 01 2-byte operand is property to set in obj at tos - 10 tos is index, [sp-1] is list to be indexed and set - 11 tos is property pointer, [sp-1] is object - - bits 2-4: specifies assignment operation: - 000 := (direct assignment) - 001 += (add tos to destination) - 010 -= (subtract tos from destination) - 011 *= (multiply destination by tos) - 100 /= (divide destination by tos) - 101 ++ (increment tos) - 110 -- (decrement tos) - 111 *reserved* - - bit 5: specifies what to do with value computed by assignment - 0 leave on stack (implies pre increment/decrement) - 1 discard (implies post increment/decrement) -*/ -#define OPCASI_MASK 0xc0 /* assignment instruction */ - -#define OPCASIDEST_MASK 0x03 /* mask to get destination field */ -#define OPCASILCL 0x00 /* assign to a local */ -#define OPCASIPRP 0x01 /* assign to an object.property */ -#define OPCASIIND 0x02 /* assign to an element of a list */ -#define OPCASIPRPPTR 0x03 /* assign property via pointer */ - -#define OPCASITYP_MASK 0x1c /* mask to get assignment type field */ -#define OPCASIDIR 0x00 /* direct assignment */ -#define OPCASIADD 0x04 /* assign and add */ -#define OPCASISUB 0x08 /* assign and subtract */ -#define OPCASIMUL 0x0c /* assign and multiply */ -#define OPCASIDIV 0x10 /* assign and divide */ -#define OPCASIINC 0x14 /* increment */ -#define OPCASIDEC 0x18 /* decrement */ -#define OPCASIEXT 0x1c /* other - extension flag */ - -/* extended assignment flags - next byte when OPCASIEXT is used */ -#define OPCASIMOD 1 /* modulo and assign */ -#define OPCASIBAND 2 /* binary AND and assign */ -#define OPCASIBOR 3 /* binary OR and assign */ -#define OPCASIXOR 4 /* binary XOR and assign */ -#define OPCASISHL 5 /* shift left and assign */ -#define OPCASISHR 6 /* shift right and assign */ - - -#define OPCASIPRE_MASK 0x20 /* mask for pre/post field */ -#define OPCASIPOST 0x00 /* increment after push */ -#define OPCASIPRE 0x20 /* increment before push */ - -/* some composite opcodes for convenience */ -#define OPCSETLCL (OPCASI_MASK | OPCASILCL | OPCASIDIR) - -} // End of namespace TADS2 -} // End of namespace TADS -} // End of namespace Glk - -#endif 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, ""); + 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, ""); +} + +/* 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" -- cgit v1.2.3