/*
* Write preprocessor state to a file
*/
void tok_write_defines(tokcxdef *ctx, osfildef *fp, errcxdef *ec)
{
int i;
tokdfdef **dfp;
tokdfdef *df;
char buf[4];
/* write each element of the hash chains */
for (i = TOKDFHSHSIZ, dfp = ctx->tokcxdf ; i ; ++dfp, --i)
{
/* write each entry in this hash chain */
for (df = *dfp ; df ; df = df->nxt)
{
/* write this entry */
oswp2(buf, df->len);
oswp2(buf + 2, df->explen);
if (osfwb(fp, buf, 4)
|| osfwb(fp, df->nm, df->len)
|| (df->explen != 0 && osfwb(fp, df->expan, df->explen)))
errsig(ec, ERR_WRTGAM);
}
/* write a zero-length entry to indicate the end of this chain */
oswp2(buf, 0);
if (osfwb(fp, buf, 4)) errsig(ec, ERR_WRTGAM);
}
}
/* write a resource header; returns pointer to next-res field in file */
static ulong fiowhd(osfildef *fp, errcxdef *ec, char *resname)
{
ulong ret;
if (osfwb(fp, resname, (int)(resname[0] + 1))) errsig(ec, ERR_WRTGAM);
ret = osfpos(fp);
if (osfwb(fp, "\000\000\000\000", 4)) errsig(ec, ERR_WRTGAM);
return(ret);
}
/*
* Read preprocessor state from a file
*/
void tok_read_defines(tokcxdef *ctx, osfildef *fp, errcxdef *ec)
{
int i;
tokdfdef **dfp;
tokdfdef *df;
char buf[4];
/* write each element of the hash chains */
for (i = TOKDFHSHSIZ, dfp = ctx->tokcxdf ; i ; ++dfp, --i)
{
/* read this hash chain */
for (;;)
{
/* read the next entry's header, and stop if this is the end */
if (osfrb(fp, buf, 4)) errsig(ec, ERR_RDGAM);
if (osrp2(buf) == 0) break;
/* set up a new symbol of the appropriate size */
df = (tokdfdef *)mchalo(ec,
(sizeof(tokdfdef) + osrp2(buf)
+ osrp2(buf+2) - 1),
"tok_read_defines");
df->explen = osrp2(buf+2);
df->nm = df->expan + df->explen;
df->len = osrp2(buf);
/* read the rest of the symbol */
if (osfrb(fp, df->nm, df->len)
|| (df->explen != 0 && osfrb(fp, df->expan, df->explen)))
errsig(ec, ERR_RDGAM);
/*
* If a symbol with this name already exists in the table,
* discard the new one -- the symbols defined by -D and the
* current set of built-in symbols takes precedence over the
* set loaded from the file.
*/
if (tok_find_define(ctx, df->nm, df->len))
{
/* simply discard this symbol */
mchfre(df);
}
else
{
/* link it into this hash chain */
df->nxt = *dfp;
*dfp = df;
}
}
}
}
/* write a required object (just an object number) */
static void fiowrq(errcxdef *ec, osfildef *fp, objnum objn)
{
uchar buf[2];
oswp2(buf, objn);
if (osfwb(fp, buf, 2)) errsig(ec, ERR_WRTGAM);
}
struct runsdef *dbgfrfind(dbgcxdef *ctx, objnum frobj, uint frofs)
{
VARUSED(frobj);
VARUSED(frofs);
errsig(ctx->dbgcxerr, ERR_INACTFR);
return 0;
}
/* add a symbol to a linear symbol table */
void toktladd(toktdef *toktab1, char *name, int namel,
int typ, int val, int hash)
{
uint siz = sizeof(toks1def) + namel;
toksdef *sym;
toktldef *toktab = (toktldef *)toktab1;
VARUSED(hash);
if (toktab->toktlsiz < siz)
errsig(toktab->toktlsc.tokterr, ERR_NOLCLSY);
sym = (toksdef *)toktab->toktlnxt;
siz = osrndsz(siz);
toktab->toktlnxt += siz;
if (siz > toktab->toktlsiz) toktab->toktlsiz = 0;
else toktab->toktlsiz -= siz;
/* set up symbol */
sym->toksval = val;
sym->tokslen = namel;
sym->tokstyp = typ;
sym->toksfr = 0;
memcpy(sym->toksnam, name, (size_t)(namel + 1));
/* indicate there's one more symbol in the table */
++(toktab->toktlcnt);
}
/* release a temporary label */
void emtdlbl(emtcxdef *ctx, noreg uint *lblp)
{
/* if label has forward references, internal error: label never set */
if (ctx->emtcxlbl[*lblp].emtllnk != EMTLLNKEND)
errsig(ctx->emtcxerr, ERR_LBNOSET);
ctx->emtcxlbl[*lblp].emtllnk = ctx->emtcxlfre;
ctx->emtcxlfre = *lblp;
*lblp = EMTLLNKEND;
}
/* get a new temporary label */
uint emtglbl(emtcxdef *ctx)
{
uint ret = ctx->emtcxlfre;
if (ctx->emtcxlfre == EMTLLNKEND) errsig(ctx->emtcxerr, ERR_NOLBL);
ctx->emtcxlfre = ctx->emtcxlbl[ret].emtllnk;
ctx->emtcxlbl[ret].emtllnk = EMTLLNKEND; /* nothing in label's list */
ctx->emtcxlbl[ret].emtlflg = 0; /* label is not yet set */
return(ret);
}
/* set up built-in functions array without symbol table (for run-time) */
void supbif(supcxdef *sup, void (*bif[])(bifcxdef*, int), int bifsiz)
{
supbidef *p;
int i;
for (p = supbitab, i = 0 ; p->supbinam ; ++i, ++p)
{
if (i >= bifsiz) errsig(sup->supcxerr, ERR_MANYBIF);
bif[i] = p->supbifn;
}
}
/* close a resource by writing next-res pointer */
static void fiowcls(osfildef *fp, errcxdef *ec, ulong respos)
{
ulong endpos;
char buf[4];
endpos = osfpos(fp);
osfseek(fp, respos, OSFSK_SET);
oswp4(buf, endpos);
if (osfwb(fp, buf, 4)) errsig(ec, ERR_WRTGAM);
osfseek(fp, endpos, OSFSK_SET);
}
/* write out a symbol table entry */
static void fiowrtsym(void *ctx0, toksdef *t)
{
fiowcxdef *ctx = (fiowcxdef *)ctx0;
uchar buf[TOKNAMMAX + 50];
errcxdef *ec = ctx->fiowcxerr;
osfildef *fp = ctx->fiowcxfp;
buf[0] = t->tokslen;
buf[1] = t->tokstyp;
oswp2(buf + 2, t->toksval);
memcpy(buf + 4, t->toksnam, (size_t)buf[0]);
if (osfwb(fp, buf, 4 + t->tokslen)) errsig(ec, ERR_WRTGAM);
}
/* reserve space for code, expanding object if needed */
void emtres(emtcxdef *ctx, ushort bytes)
{
ushort oldsiz = mcmobjsiz(ctx->emtcxmem, ctx->emtcxobj);
ushort need;
need = ctx->emtcxofs + bytes + 1;
if (need > oldsiz)
{
ushort newsiz;
newsiz = need + EMTINC;
if (newsiz < oldsiz) errsig(ctx->emtcxerr, ERR_OBJOVF);
ctx->emtcxptr = mcmrealo(ctx->emtcxmem, ctx->emtcxobj, newsiz);
assert(mcmobjsiz(ctx->emtcxmem, ctx->emtcxobj) >= need);
}
}
/* write game to binary file */
void fiowrt(mcmcxdef *mctx, voccxdef *vctx, tokcxdef *tokctx, tokthdef *tab,
uchar *fmts, uint fmtl, char *fname, uint flags, objnum preinit,
int extc, uint prpcnt, char *filever)
{
osfildef *fp;
/* open the file */
if (!(fp = osfoprwtb(fname, OSFTGAME)))
errsig(vctx->voccxerr, ERR_OPWGAM);
ERRBEGIN(vctx->voccxerr)
/* write the file */
fiowrt1(mctx, vctx, tokctx, tab, fmts, fmtl, fp, flags, preinit,
extc, prpcnt, filever);
os_settype(fname, OSFTGAME);
ERRCLEAN(vctx->voccxerr)
/* clean up by closing the file */
osfcls(fp);
ERRENDCLN(vctx->voccxerr)
}
void emtval(emtcxdef *ctx, tokdef *tok, uchar *base)
{
ushort oplen;
switch(tok->toktyp)
{
case TOKTSYMBOL:
switch(tok->toksym.tokstyp)
{
case TOKSTARGC:
emtop(ctx, OPCARGC);
return;
case TOKSTSELF:
emtop(ctx, OPCPUSHSELF);
return;
case TOKSTOBJ:
case TOKSTFWDOBJ:
emtop(ctx, OPCPUSHOBJ);
break;
case TOKSTLOCAL:
if (tok->toksym.toksfr)
{
emtop(ctx, OPCGETDBLCL); /* debug local - specifies frame */
emtint2(ctx, ctx->emtcxfrob); /* emit frame object */
emtint2(ctx, tok->toksym.toksfr); /* emit frame offset */
}
else
emtop(ctx, OPCGETLCL);
break;
case TOKSTBIFN:
emtop(ctx, OPCBUILTIN);
emtbyte(ctx, 0);
break;
case TOKSTFUNC:
case TOKSTFWDFN:
emtop(ctx, OPCPUSHFN);
break;
case TOKSTPROP:
emtop(ctx, OPCGETPSELF);
emtbyte(ctx, 0);
break;
case TOKSTPROPSPEC:
emtop(ctx, OPCGETPSELFDATA);
break;
default:
errsig(ctx->emtcxerr, ERR_REQOBJ);
/* NOTREACHED */
}
emtint2(ctx, tok->toksym.toksval);
return;
case TOKTNUMBER:
emtop(ctx, OPCPUSHNUM);
emtint4(ctx, tok->tokval);
return;
case TOKTNIL:
emtop(ctx, OPCPUSHNIL);
return;
case TOKTTRUE:
emtop(ctx, OPCPUSHTRUE);
return;
case TOKTPOUND:
emtop(ctx, OPCPUSHPN);
emtint2(ctx, tok->tokofs);
return;
case TOKTSSTRING:
emtop(ctx, OPCPUSHSTR);
break;
case TOKTDSTRING:
emtop(ctx, OPCSAY);
break;
case TOKTLIST:
emtop(ctx, OPCPUSHLST);
emtlst(ctx, (uint)tok->tokofs, base);
return;
}
/* if we haven't returned already, we have a large operand */
oplen = osrp2(base + tok->tokofs);
emtmem(ctx, base + tok->tokofs, oplen);
}
/* dummy file read functions */
void tok_read_defines(tokcxdef *tctx, osfildef *fp, errcxdef *ec)
{
errsig(ec, ERR_UNKRSC);
}
/* get a new line from line source, processing '#' directives */
static int tokgetlin(tokcxdef *ctx, int dopound)
{
for (;;)
{
if (linget(ctx->tokcxlin))
{
/* at eof in current source; resume parent if there is one */
if (ctx->tokcxlin->linpar)
{
lindef *parent;
parent = ctx->tokcxlin->linpar; /* remember parent */
lincls(ctx->tokcxlin); /* close included file */
if (!ctx->tokcxdbg) /* if no debug context... */
mchfre(ctx->tokcxlin); /* free line source */
ctx->tokcxlin = parent; /* reset to parent line source */
if (parent->linflg & LINFCMODE)
ctx->tokcxflg |= TOKCXFCMODE;
else
ctx->tokcxflg &= ~TOKCXFCMODE;
continue; /* back for another attempt */
}
else
{
/* check for outstanding #if/#ifdef */
if (ctx->tokcxifcnt)
errlog(ctx->tokcxerr, ERR_NOENDIF);
/* return end-of-file indication */
return TRUE;
}
}
/* if this is a multi-segment line, copy it into our own buffer */
if (ctx->tokcxlin->linflg & LINFMORE)
{
char *p;
uint rem;
int done;
if (!ctx->tokcxbuf)
{
/* allocate 1k as a default buffer */
ctx->tokcxbuf = (char *)mchalo(ctx->tokcxerr, 1024,
"tok");
ctx->tokcxbsz = 1024;
}
ctx->tokcxlen = 0;
for (done = FALSE, p = ctx->tokcxbuf, rem = ctx->tokcxbsz ;
!done ; )
{
size_t len = ctx->tokcxlin->linlen;
/* add the current segment's length into line length */
ctx->tokcxlen += len;
/* we're done after this piece if the last fetch was all */
done = !(ctx->tokcxlin->linflg & LINFMORE);
if (len + 1 > rem)
{
char *newp;
/* increase the size of the buffer */
if (ctx->tokcxbsz > (unsigned)0x8000)
errsig(ctx->tokcxerr, ERR_LONGLIN);
rem += 4096;
ctx->tokcxbsz += 4096;
/* allocate a new buffer and copy line into it */
newp = (char *)mchalo(ctx->tokcxerr, ctx->tokcxbsz, "tok");
memcpy(newp, ctx->tokcxbuf, (size_t)(p - ctx->tokcxbuf));
/* free the original buffer, and use the new one */
p = (p - ctx->tokcxbuf) + newp;
mchfre(ctx->tokcxbuf);
ctx->tokcxbuf = newp;
}
/* add the line to the buffer */
memcpy(p, ctx->tokcxlin->linbuf, len);
p += len;
rem -= len;
/* get the next piece of the line if there is one */
if (!done)
{
if (linget(ctx->tokcxlin)) break;
}
}
/* null-terminate the buffer, and use it for input */
*p = '\0';
ctx->tokcxptr = ctx->tokcxbuf;
}
else
{
ctx->tokcxptr = ctx->tokcxlin->linbuf;
ctx->tokcxlen = ctx->tokcxlin->linlen;
}
/* check for preprocessor directives */
if (dopound && ctx->tokcxlen != 0 && ctx->tokcxptr[0] == '#'
&& !(ctx->tokcxlin->linflg & LINFNOINC))
{
char *p;
int len;
static struct
{
char *nm;
int len;
int ok_in_if;
void (*fn)(tokcxdef *, char *, int);
}
*dirp, dir[] =
{
{ "include", 7, FALSE, tokinclude },
{ "pragma", 6, FALSE, tokpragma },
{ "define", 6, FALSE, tokdefine },
{ "ifdef", 5, TRUE, tokifdef },
{ "ifndef", 6, TRUE, tokifndef },
{ "if", 2, TRUE, tokif },
{ "else", 4, TRUE, tokelse },
{ "elif", 4, TRUE, tokelif },
{ "endif", 5, TRUE, tokendif },
{ "undef", 5, FALSE, tokundef },
{ "error", 5, FALSE, tok_p_error }
};
int i;
/* scan off spaces between '#' and directive */
for (len = ctx->tokcxlen - 1, p = &ctx->tokcxptr[1] ;
len && t_isspace(*p) ; --len, ++p) ;
/* find and process the directive */
for (dirp = dir, i = sizeof(dir)/sizeof(dir[0]) ; i ; --i, ++dirp)
{
/* compare this directive; if it wins, call its function */
if (len >= dirp->len && !memcmp(p, dirp->nm, (size_t)dirp->len)
&& (len == dirp->len || t_isspace(*(p + dirp->len))))
{
int cnt;
int stat;
/*
* if we're not in a #if's false part, or if the
* directive is processed even in #if false parts,
* process the line, otherwise skip it
*/
cnt = ctx->tokcxifcnt;
if (dirp->ok_in_if || cnt == 0
|| ((stat = ctx->tokcxifcur) == TOKIF_IF_YES
|| stat == TOKIF_ELSE_YES))
{
/* skip whitespace following the directive */
for (p += dirp->len, len -= dirp->len ;
len && t_isspace(*p) ;
--len, ++p) ;
/* invoke the function to process this directive */
(*dirp->fn)(ctx, p, len);
}
/* there's no need to look at more directives */
break;
}
}
/* if we didn't find anything, flag the error */
if (i == 0)
errlog(ctx->tokcxerr, ERR_PRPDIR);
/* ignore this line */
continue;
}
else
{
/*
* Check the #if level. If we're in an #if, and we're to
* ignore lines (because of a false condition or an #else
* part for a true condition), skip this line.
*/
if (ctx->tokcxifcnt != 0)
{
switch(ctx->tokcxifcur)
{
case TOKIF_IF_NO:
case TOKIF_ELSE_NO:
/* ignore this line */
continue;
default:
/* we're in a true part - keep the line */
break;
}
}
ctx->tokcxlin->linflg &= ~LINFDBG; /* no debug record yet */
return(FALSE); /* return the line we found */
}
}
}
/* find a #define symbol */
static tokdfdef *tok_find_define(tokcxdef *ctx, char *sym, int len)
{
int hsh;
tokdfdef *df;
/* find the appropriate chain the hash table */
hsh = tokdfhsh(sym, len);
/* search the chain for this symbol */
for (df = ctx->tokcxdf[hsh] ; df ; df = df->nxt)
{
/* if this one matches, return it */
if (df->len == len && !memcmp(df->nm, sym, (size_t)len))
{
/* fix it up if it's the special __FILE__ or __LINE__ symbol */
if (len == 8)
{
if (!memcmp(sym, "__FILE__", (size_t)8))
{
size_t len;
/*
* put in the opening single quote, since we want
* the expanded result to be a string
*/
df->expan[0] = '\'';
/* get the name */
linnam(ctx->tokcxlin, df->expan+1);
/* get the length, and add the closing quote */
len = strlen(df->expan);
df->expan[len] = '\'';
/*
* set the length of the expansion, including the
* quotes (the first quote was measured in the
* length originally, but the second quote hasn't
* been counted yet, so add one to our original
* length)
*/
df->explen = (int)len + 1;
/* if the expansion is too long, it's an error */
if (df->explen >= OSFNMAX)
errsig(ctx->tokcxerr, ERR_LONG_FILE_MACRO);
}
else if (!memcmp(sym, "__LINE__", (size_t)8))
{
ulong l;
/* get the line number */
l = linlnum(ctx->tokcxlin);
/* convert it to a textual format for the expansion */
sprintf(df->expan, "%lu", l);
/* set the expanded value's length */
df->explen = strlen(df->expan);
/* make sure the expansion isn't too long */
if (df->explen >= 40)
errsig(ctx->tokcxerr, ERR_LONG_LINE_MACRO);
}
}
/* return it */
return df;
}
}
/* didn't find anything */
return 0;
}
/* write game to binary file */
static void fiowrt1(mcmcxdef *mctx, voccxdef *vctx, tokcxdef *tokctx,
tokthdef *tab, uchar *fmts, uint fmtl, osfildef *fp,
uint flags, objnum preinit, int extc, uint prpcnt,
char *filever)
{
int i;
int j;
int k;
uchar buf[TOKNAMMAX + 50];
errcxdef *ec = vctx->voccxerr;
ulong fpos;
int obj;
vocidef ***vpg;
vocidef **v;
objnum *sc;
vocdef *voc;
vocwdef *vw;
vocdef **vhsh;
struct tm *tblock;
time_t timer;
fiowcxdef cbctx; /* callback context for toktheach */
uint xor_seed = 63;
uint xor_inc = 64;
char *vsnhdr;
uint vsnlen;
char fastnamebuf[OSFNMAX]; /* fast-load record temp file name */
long flag_seek;
/* generate appropriate file version */
switch(filever[0])
{
case 'a': /* generate .GAM compatible with pre-2.0.15 runtimes */
vsnhdr = FIOVSNHDR2;
vsnlen = sizeof(FIOVSNHDR2);
xor_seed = 17; /* use old xor values */
xor_inc = 29;
break;
case 'b': /* generate 2.0.15+ format */
vsnhdr = FIOVSNHDR3;
vsnlen = sizeof(FIOVSNHDR3);
break;
case 'c':
case '*': /* current version */
vsnhdr = FIOVSNHDR;
vsnlen = sizeof(FIOVSNHDR);
break;
default:
errsig(ec, ERR_WRTVSN);
}
/* write file header and version header */
if (osfwb(fp, FIOFILHDR, sizeof(FIOFILHDR))
|| osfwb(fp, vsnhdr, vsnlen))
errsig(ec, ERR_WRTGAM);
/*
* write the flags - remember where we wrote it in case we need to
* change the flags later
*/
flag_seek = osfpos(fp);
oswp2(buf, flags);
if (osfwb(fp, buf, 2))
errsig(ec, ERR_WRTGAM);
/* write the timestamp */
timer = time(NULL);
tblock = localtime(&timer);
strcpy(vctx->voccxtim, asctime(tblock));
if (osfwb(fp, vctx->voccxtim, (size_t)26))
errsig(ec, ERR_WRTGAM);
/* write xor parameters if generating post 2.0.15 .GAM file */
if (filever[0] != 'a')
{
fpos = fiowhd(fp, ec, "\003XSI");
buf[0] = xor_seed;
buf[1] = xor_inc;
if (osfwb(fp, buf, 2)) errsig(ec, ERR_WRTGAM);
fiowcls(fp, ec, fpos);
}
/* write count of external functions */
if (extc)
{
fpos = fiowhd(fp, ec, "\006EXTCNT");
oswp2(buf, extc); /* write the external function count */
if (osfwb(fp, buf, 2)) errsig(ec, ERR_WRTGAM);
/* write XFCN-seek-location header if post 2.0.15 file version */
if (filever[0] != 'a')
{
oswp4(buf, 0); /* placeholder - TADSRSC sets this up later */
if (osfwb(fp, buf, 4)) errsig(ec, ERR_WRTGAM);
}
/* close the resource */
fiowcls(fp, ec, fpos);
}
/*
* write the character set information, if a character set was
* specified
*/
if (G_cmap_id[0] != '\0')
{
size_t len;
/* this is not allowed with explicit file versions a, b, or c */
if (filever[0] == 'a' || filever[0] == 'b' || filever[0] == 'c')
errsig(ec, ERR_VNOCTAB);
/* write out the CHRSET resource header */
fpos = fiowhd(fp, ec, "\006CHRSET");
/* write out the ID and LDESC of the internal character set */
len = strlen(G_cmap_ldesc) + 1;
oswp2(buf, len);
if (osfwb(fp, G_cmap_id, 4)
|| osfwb(fp, buf, 2)
|| osfwb(fp, G_cmap_ldesc, len))
errsig(ec, ERR_WRTGAM);
/* close the resource */
fiowcls(fp, ec, fpos);
}
/* write OBJ resource header */
fpos = fiowhd(fp, ec, "\003OBJ");
/* set up the symbol table callback context for writing the objects */
cbctx.fiowcxmem = mctx;
cbctx.fiowcxerr = ec;
cbctx.fiowcxfp = fp;
cbctx.fiowcxund = 0;
cbctx.fiowcxseed = xor_seed;
cbctx.fiowcxinc = xor_inc;
cbctx.fiowcxdebug = (flags & FIOFSYM);
if (flags & FIOFFAST)
{
/* try creating the temp file */
cbctx.fiowcxffp = os_create_tempfile(0, fastnamebuf);
/* if that failed, we don't have a fast-load table after all */
if (cbctx.fiowcxffp == 0)
{
long curpos;
char flag_buf[2];
/* clear the fast-load flag */
flags &= ~FIOFFAST;
/*
* go back to the flags we wrote to the .gam file header, and
* re-write the new flags without the fast-load bit - since
* we're not going to write a fast-load table, we don't want
* readers thinking they're going to find one
*/
/* first, remember where we are right now */
curpos = osfpos(fp);
/* seek back to the flags and re-write the new flags */
osfseek(fp, flag_seek, OSFSK_SET);
oswp2(flag_buf, flags);
if (osfwb(fp, flag_buf, 2))
errsig(ec, ERR_WRTGAM);
/* seek back to where we started */
osfseek(fp, curpos, OSFSK_SET);
}
}
else
cbctx.fiowcxffp = (osfildef *)0;
cbctx.fiowcxflg = flags;
/* go through symbol table, and write each object */
toktheach((toktdef *)tab, fiowrtobj, &cbctx);
/* also write all objects created with 'new' */
for (vpg = vctx->voccxinh, i = 0 ; i < VOCINHMAX ; ++vpg, ++i)
{
objnum obj;
if (!*vpg) continue;
for (v = *vpg, obj = (i << 8), j = 0 ; j < 256 ; ++v, ++obj, ++j)
{
/* if the object was dynamically allocated, write it out */
if (*v && (*v)->vociflg & VOCIFNEW)
{
toksdef t;
/* clear the 'new' flag, as this is a static object now */
(*v)->vociflg &= ~VOCIFNEW;
/* set up a toksdef, and write it out */
t.tokstyp = TOKSTOBJ;
t.toksval = obj;
fiowrtobj(&cbctx, &t);
}
}
}
/* close the resource */
fiowcls(fp, ec, fpos);
/* copy fast-load records to output file if applicable */
if (cbctx.fiowcxffp)
{
osfildef *fp2 = cbctx.fiowcxffp;
char copybuf[1024];
ulong len;
ulong curlen;
/* start with resource header for fast-load records */
fpos = fiowhd(fp, ec, "\003FST");
/* get length of temp file, then rewind it */
len = osfpos(fp2);
osfseek(fp2, 0L, OSFSK_SET);
/* copy the whole thing to the output file */
while (len)
{
curlen = (len > sizeof(copybuf) ? sizeof(copybuf) : len);
if (osfrb(fp2, copybuf, (size_t)curlen)
|| osfwb(fp, copybuf, (size_t)curlen))
errsig(ec, ERR_WRTGAM);
len -= curlen;
}
/* close the fast-load resource */
fiowcls(fp, ec, fpos);
/* close and delete temp file */
osfcls(fp2);
osfdel_temp(fastnamebuf);
}
/* write vocabulary inheritance records - start with header */
fpos = fiowhd(fp, ec, "\003INH");
/* go through inheritance records and write to file */
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)
{
buf[0] = (*v)->vociflg;
oswp2(buf + 1, obj);
oswp2(buf + 3, (*v)->vociloc);
oswp2(buf + 5, (*v)->vociilc);
oswp2(buf + 7, (*v)->vocinsc);
for (k = 0, sc = (*v)->vocisc ; k < (*v)->vocinsc ; ++sc, ++k)
{
if (k + 9 >= sizeof(buf)) errsig(ec, ERR_FIOMSC);
oswp2(buf + 9 + (k << 1), (*sc));
}
if (osfwb(fp, buf, 9 + (2 * (*v)->vocinsc)))
errsig(ec, ERR_WRTGAM);
}
}
}
/* close resource */
fiowcls(fp, ec, fpos);
/* write format strings */
if (fmtl)
{
fpos = fiowhd(fp, ec, "\006FMTSTR");
oswp2(buf, fmtl);
if (flags & FIOFCRYPT) fioxor(fmts, fmtl, xor_seed, xor_inc);
if (osfwb(fp, buf, 2) || osfwb(fp, fmts, fmtl))
errsig(ec, ERR_WRTGAM);
fiowcls(fp, ec, fpos);
}
/* write preinit if preinit object was specified */
if (flags & FIOFPRE)
{
fpos = fiowhd(fp, ec, "\007PREINIT");
oswp2(buf, preinit);
if (osfwb(fp, buf, 2)) errsig(ec, ERR_WRTGAM);
fiowcls(fp, ec, fpos);
}
/* write required objects out of voccxdef */
fpos = fiowhd(fp, ec, "\003REQ");
fiowrq(ec, fp, vctx->voccxme);
fiowrq(ec, fp, vctx->voccxvtk);
fiowrq(ec, fp, vctx->voccxstr);
fiowrq(ec, fp, vctx->voccxnum);
fiowrq(ec, fp, vctx->voccxprd);
fiowrq(ec, fp, vctx->voccxvag);
fiowrq(ec, fp, vctx->voccxini);
fiowrq(ec, fp, vctx->voccxpre);
fiowrq(ec, fp, vctx->voccxper);
fiowrq(ec, fp, vctx->voccxprom);
fiowrq(ec, fp, vctx->voccxpdis);
fiowrq(ec, fp, vctx->voccxper2);
fiowrq(ec, fp, vctx->voccxpdef);
fiowrq(ec, fp, vctx->voccxpask);
fiowrq(ec, fp, vctx->voccxppc);
fiowrq(ec, fp, vctx->voccxpask2);
fiowrq(ec, fp, vctx->voccxperp);
fiowrq(ec, fp, vctx->voccxpostprom);
fiowrq(ec, fp, vctx->voccxinitrestore);
fiowrq(ec, fp, vctx->voccxpuv);
fiowrq(ec, fp, vctx->voccxpnp);
fiowrq(ec, fp, vctx->voccxpostact);
fiowrq(ec, fp, vctx->voccxendcmd);
fiowrq(ec, fp, vctx->voccxprecmd);
fiowrq(ec, fp, vctx->voccxpask3);
fiowrq(ec, fp, vctx->voccxpre2);
fiowrq(ec, fp, vctx->voccxpdef2);
fiowcls(fp, ec, fpos);
/* write compound words */
if (vctx->voccxcpl)
{
fpos = fiowhd(fp, ec, "\004CMPD");
oswp2(buf, vctx->voccxcpl);
if (flags & FIOFCRYPT)
fioxor((uchar *)vctx->voccxcpp, (uint)vctx->voccxcpl,
xor_seed, xor_inc);
if (osfwb(fp, buf, 2)
|| osfwb(fp, vctx->voccxcpp, (uint)vctx->voccxcpl))
errsig(ec, ERR_WRTGAM);
fiowcls(fp, ec, fpos);
}
/* write special words */
if (vctx->voccxspl)
{
fpos = fiowhd(fp, ec, "\010SPECWORD");
oswp2(buf, vctx->voccxspl);
if (flags & FIOFCRYPT)
fioxor((uchar *)vctx->voccxspp, (uint)vctx->voccxspl,
xor_seed, xor_inc);
if (osfwb(fp, buf, 2)
|| osfwb(fp, vctx->voccxspp, (uint)vctx->voccxspl))
errsig(ec, ERR_WRTGAM);
fiowcls(fp, ec, fpos);
}
/* write vocabulary */
fpos = fiowhd(fp, ec, "\003VOC");
/* go through each hash chain */
for (i = 0, vhsh = vctx->voccxhsh ; i < VOCHASHSIZ ; ++i, ++vhsh)
{
/* go through each word in this hash chain */
for (voc = *vhsh ; voc ; voc = voc->vocnxt)
{
/* encrypt the word if desired */
if (flags & FIOFCRYPT)
fioxor(voc->voctxt, (uint)(voc->voclen + voc->vocln2),
xor_seed, xor_inc);
/* go through each object relation attached to the word */
for (vw = vocwget(vctx, voc->vocwlst) ; vw ;
vw = vocwget(vctx, vw->vocwnxt))
{
/* clear the 'new' flag, as this is a static object now */
vw->vocwflg &= ~VOCFNEW;
/* write out this object relation */
oswp2(buf, voc->voclen);
oswp2(buf+2, voc->vocln2);
oswp2(buf+4, vw->vocwtyp);
oswp2(buf+6, vw->vocwobj);
oswp2(buf+8, vw->vocwflg);
if (osfwb(fp, buf, 10)
|| osfwb(fp, voc->voctxt, voc->voclen + voc->vocln2))
errsig(ec, ERR_WRTGAM);
}
}
}
fiowcls(fp, ec, fpos);
/* write the symbol table, if desired */
if (flags & FIOFSYM)
{
fpos = fiowhd(fp, ec, "\006SYMTAB");
toktheach((toktdef *)tab, fiowrtsym, &cbctx);
/* indicate last symbol with a length of zero */
buf[0] = 0;
if (osfwb(fp, buf, 4)) errsig(ec, ERR_WRTGAM);
fiowcls(fp, ec, fpos);
}
/* write line source chain, if desired */
if ((flags & (FIOFLIN | FIOFLIN2)) != 0 && vctx->voccxrun->runcxdbg != 0)
{
lindef *lin;
/* write the SRC header */
fpos = fiowhd(fp, ec, "\003SRC");
/* write the line records */
for (lin = vctx->voccxrun->runcxdbg->dbgcxlin ; lin ;
lin = lin->linnxt)
{
/* write this record */
if (linwrt(lin, fp))
errsig(ec, ERR_WRTGAM);
}
/* done with this section */
fiowcls(fp, ec, fpos);
/*
* if we have new-style line records, put a SRC2 header (with no
* block contents) in the file, so that the debugger realizes
* that it has new-style line records (with line numbers rather
* than seek offsets)
*/
if ((flags & FIOFLIN2) != 0)
{
fpos = fiowhd(fp, ec, "\004SRC2");
fiowcls(fp, ec, fpos);
}
}
/* if writing a precompiled header, write some more information */
if (flags & FIOFBIN)
{
/* write property count */
fpos = fiowhd(fp, ec, "\006PRPCNT");
oswp2(buf, prpcnt);
if (osfwb(fp, buf, 2)) errsig(ec, ERR_WRTGAM);
fiowcls(fp, ec, fpos);
/* write preprocessor symbol table */
fpos = fiowhd(fp, ec, "\006TADSPP");
tok_write_defines(tokctx, fp, ec);
fiowcls(fp, ec, fpos);
}
/* write end-of-file resource header */
(void)fiowhd(fp, ec, "\004$EOF");
osfcls(fp);
/* if there are undefined functions/objects, signal an error */
if (cbctx.fiowcxund) errsig(ec, ERR_UNDEF);
}
/* write an object given by a symbol table entry */
static void fiowrtobj(void *ctx0, toksdef *t)
{
fiowcxdef *ctx = (fiowcxdef *)ctx0;
uchar buf[TOKNAMMAX + 50];
mcmon obj;
mcmcxdef *mctx = ctx->fiowcxmem;
errcxdef *ec = ctx->fiowcxerr;
osfildef *fp = ctx->fiowcxfp;
uint flags = ctx->fiowcxflg;
uchar *p;
uint siz;
uint used;
int err = 0;
ulong startpos = osfpos(fp);
/* set up start of buffer to write */
buf[0] = t->tokstyp;
obj = t->toksval;
oswp2(buf + 1, obj);
switch(t->tokstyp)
{
case TOKSTOBJ:
/*
* Mark object as finished with compilation. Note that we must
* do this even though tcdmain() does this as well, because
* running preinit() might have updated properties since the
* last time we marked objects.
*/
objcomp(mctx, (objnum)obj, ctx->fiowcxdebug);
/* get the object's size information */
p = mcmlck(mctx, (mcmon)obj);
siz = mcmobjsiz(mctx, (mcmon)obj); /* size in cache */
used = objfree(p); /* size actually used in object */
if (objflg(p) & OBJFINDEX) used += objnprop(p) * 4;
goto write_func_or_obj;
case TOKSTFUNC:
/* size of function is entire object */
p = mcmlck(mctx, (mcmon)obj);
siz = used = mcmobjsiz(mctx, (mcmon)obj);
write_func_or_obj:
/* write type(OBJ) + objnum + size + sizeused */
oswp2(buf+3, siz);
oswp2(buf+5, used);
if (osfwb(fp, buf, 7)) err = ERR_WRTGAM;
/* write contents of object */
if (flags & FIOFCRYPT)
fioxor(p, used, ctx->fiowcxseed, ctx->fiowcxinc);
if (osfwb(fp, p, used)) err = ERR_WRTGAM;
/* write fast-load record if applicable */
if (ctx->fiowcxffp)
{
oswp4(buf + 7, startpos);
if (osfwb(ctx->fiowcxffp, buf, 11)) err = ERR_WRTGAM;
}
/*
* We're done with the object - delete it so that
* it doesn't have to be swapped out (which would
* be pointless, since we'll never need it again).
*/
mcmunlck(mctx, (mcmon)obj);
mcmfre(mctx, (mcmon)obj);
break;
case TOKSTEXTERN:
/* all we must write is the name & number of ext func */
buf[3] = t->tokslen;
memcpy(buf + 4, t->toksnam, (size_t)t->tokslen);
if (osfwb(fp, buf, t->tokslen + 4)) err = ERR_WRTGAM;
/* write fast-load record if applicable */
if (ctx->fiowcxffp
&& osfwb(ctx->fiowcxffp, buf, t->tokslen + 4)) err = ERR_WRTGAM;
break;
case TOKSTFWDOBJ:
case TOKSTFWDFN:
{
int e = (t->tokstyp == TOKSTFWDFN ? ERR_UNDEFF : ERR_UNDEFO);
if (flags & FIOFBIN)
{
/* write record for the forward reference */
p = mcmlck(mctx, (mcmon)obj);
siz = mcmobjsiz(mctx, (mcmon)obj);
oswp2(buf+3, siz);
if (osfwb(fp, buf, 5)
|| osfwb(fp, p, siz))
err = ERR_WRTGAM;
}
else
{
/* log the undefined-object error */
sup_log_undefobj(mctx, ec, e,
t->toksnam, (int)t->tokslen, obj);
/* count the undefined object */
++(ctx->fiowcxund);
/*
* we don't need this object any longer - delete it so
* that we don't have to bother swapping it in or out
*/
mcmfre(mctx, (mcmon)obj);
}
}
break;
}
/* if an error occurred, signal it */
if (err) errsig(ec, err);
}
/* get the next token, removing it from the input stream */
int toknext(tokcxdef *ctx)
{
char *p;
tokdef *tok = &ctx->tokcxcur;
int len;
/*
* Check for the special case that we pushed an open paren prior to
* a string containing an embedded expression. If this is the case,
* immediately return the string we previously parsed.
*/
if ((ctx->tokcxflg & TOKCXF_EMBED_PAREN_PRE) != 0)
{
/*
* convert the token to a string - note that the offset
* information for the string is already in the current token
* structure, since we set everything up for it on the previous
* call where we actually parsed the beginning of the string
*/
tok->toktyp = TOKTDSTRING;
/* clear the special flag - we've now consumed the pushed string */
ctx->tokcxflg &= ~TOKCXF_EMBED_PAREN_PRE;
/* immediately return the string */
return tok->toktyp;
}
/* set up at the current scanning position */
p = ctx->tokcxptr;
len = ctx->tokcxlen;
/* scan off whitespace and comments until we find something */
do
{
skipblanks:
/* if there's nothing on this line, get the next one */
if (len == 0)
{
/* if we're in a macro expansion, continue after it */
if (ctx->tokcxmlvl)
{
ctx->tokcxmlvl--;
p = ctx->tokcxmsav[ctx->tokcxmlvl];
len = ctx->tokcxmsvl[ctx->tokcxmlvl];
}
else
{
if (tokgetlin(ctx, TRUE))
{
tok->toktyp = TOKTEOF;
goto done;
}
p = ctx->tokcxptr;
len = ctx->tokcxlen;
}
}
while (len && t_isspace(*p)) ++p, --len; /* scan off whitespace */
/* check for comments, and remove if present */
if (len >= 2 && *p == '/' && *(p+1) == '/')
len = 0;
else if (len >= 2 && *p == '/' && *(p+1) == '*')
{
while (len < 2 || *p != '*' || *(p+1) != '/')
{
if (len != 0)
++p, --len;
if (len == 0)
{
if (ctx->tokcxmlvl != 0)
{
ctx->tokcxmlvl--;
p = ctx->tokcxmsav[ctx->tokcxmlvl];
len = ctx->tokcxmsvl[ctx->tokcxmlvl];
}
else
{
if (tokgetlin(ctx, FALSE))
{
ctx->tokcxptr = p;
tok->toktyp = TOKTEOF;
goto done;
}
p = ctx->tokcxptr;
len = ctx->tokcxlen;
}
}
}
p += 2;
len -= 2;
goto skipblanks;
}
} while (len == 0);
nexttoken:
if (isalpha((uchar)*p) || *p == '_' || *p == '$')
{
int l;
int hash;
char *q;
toktdef *tab;
int found = FALSE;
uchar thischar;
tokdfdef *df;
for (hash = 0, l = 0, q = tok->toknam ;
len != 0 && TOKISSYM(*p) && l < TOKNAMMAX ;
(thischar = ((isupper((uchar)*p)
&& (ctx->tokcxflg & TOKCXCASEFOLD))
? tolower((uchar)*p) : *p)),
(hash = ((hash + thischar) & (TOKHASHSIZE - 1))),
(*q++ = thischar), ++p, --len, ++l) ;
*q = '\0';
if (len != 0 && TOKISSYM(*p))
{
while (len != 0 && TOKISSYM(*p)) ++p, --len;
errlog1(ctx->tokcxerr, ERR_TRUNC, ERRTSTR,
errstr(ctx->tokcxerr, tok->toknam, tok->toklen));
}
tok->toklen = l;
tok->tokhash = hash;
/*
* check for the special defined() preprocessor operator
*/
if (l == 9 && !memcmp(tok->toknam,
((ctx->tokcxflg & TOKCXCASEFOLD)
? "__defined" : "__DEFINED"),
(size_t)9)
&& len > 2 && *p == '(' && TOKISSYM(*(p+1))
&& !isdigit((uchar)*(p+1)))
{
int symlen;
char mysym[TOKNAMMAX];
/* find the matching ')', allowing only symbolic characters */
++p, --len;
for (symlen = 0, q = p ; len && *p != ')' && TOKISSYM(*p) ;
++p, --len, ++symlen) ;
/* make sure we found the closing paren */
if (!len || *p != ')')
errsig(ctx->tokcxerr, ERR_BADISDEF);
++p, --len;
/* if we're folding case, convert the symbol to lower case */
q = tok_casefold_defsym(ctx, mysym, q, symlen);
/* check to see if it's defined */
tok->toktyp = TOKTNUMBER;
tok->tokval = (tok_find_define(ctx, q, symlen) != 0);
goto done;
}
/* substitute the preprocessor #define, if any */
if ((df = tok_find_define(ctx, tok->toknam, l)) != 0)
{
/* save the current parsing position */
if (ctx->tokcxmlvl >= TOKMACNEST)
errsig(ctx->tokcxerr, ERR_MACNEST);
ctx->tokcxmsav[ctx->tokcxmlvl] = p;
ctx->tokcxmsvl[ctx->tokcxmlvl] = len;
ctx->tokcxmlvl++;
/* point to the token's expansion and keep going */
p = df->expan;
len = df->explen;
goto nexttoken;
}
/* look up in symbol table(s), if any */
for (tab = ctx->tokcxstab ; tab ; tab = tab->toktnxt)
{
if ((found = (*tab->toktfsea)(tab, tok->toknam, l, hash,
&tok->toksym)) != 0)
break;
}
if (found && tok->toksym.tokstyp == TOKSTKW)
tok->toktyp = tok->toksym.toksval;
else
{
tok->toktyp = TOKTSYMBOL;
if (!found) tok->toksym.tokstyp = TOKSTUNK;
}
goto done;
}
else if (isdigit((uchar)*p))
{
long acc = 0;
/* check for octal/hex */
if (*p == '0')
{
++p, --len;
if (len && (*p == 'x' || *p == 'X'))
{
/* hex */
++p, --len;
while (len && TOKISHEX(*p))
{
acc = (acc << 4) + TOKHEX2INT(*p);
++p, --len;
}
}
else
{
/* octal */
while (len && TOKISOCT(*p))
{
acc = (acc << 3) + TOKOCT2INT(*p);
++p, --len;
}
}
}
else
{
/* decimal */
while (len && isdigit((uchar)*p))
{
acc = (acc << 1) + (acc << 3) + TOKDEC2INT(*p);
++p, --len;
}
}
tok->tokval = acc;
tok->toktyp = TOKTNUMBER;
goto done;
}
else if (*p == '"' || *p == '\'')
{
char delim; /* closing delimiter we're looking for */
char *strstart; /* pointer to start of string */
int warned;
delim = *p;
--len;
strstart = ++p;
if (delim == '"' && len >= 2 && *p == '<' && *(p+1) == '<')
{
/* save the current parsing position */
if (ctx->tokcxmlvl >= TOKMACNEST)
errsig(ctx->tokcxerr, ERR_MACNEST);
ctx->tokcxmsav[ctx->tokcxmlvl] = p + 2;
ctx->tokcxmsvl[ctx->tokcxmlvl] = len - 2;
ctx->tokcxmlvl++;
/*
* read from the special "<<" expansion string - use the
* version for a "<<" at the very beginning of the string
*/
p = tokmac1s;
len = strlen(p);
ctx->tokcxflg |= TOKCXFINMAC;
goto nexttoken;
}
tok->toktyp = (delim == '"' ? TOKTDSTRING : TOKTSSTRING);
tok->tokofs = (*ctx->tokcxsst)(ctx->tokcxscx); /* start the string */
for (warned = FALSE ;; )
{
if (len >= 2 && *p == '\\')
{
if (*(p+1) == '"' || *(p+1) == '\'')
{
(*ctx->tokcxsad)(ctx->tokcxscx, strstart,
(ushort)(p - strstart));
strstart = p + 1;
}
p += 2;
len -= 2;
}
else if (len == 0 || *p == delim ||
(delim == '"' && len >= 2 && *p == '<' && *(p+1) == '<'
&& !(ctx->tokcxflg & TOKCXFINMAC)))
{
(*ctx->tokcxsad)(ctx->tokcxscx, strstart,
(ushort)(p - strstart));
if (len == 0)
{
if (ctx->tokcxmlvl)
{
ctx->tokcxmlvl--;
p = ctx->tokcxmsav[ctx->tokcxmlvl];
len = ctx->tokcxmsvl[ctx->tokcxmlvl];
}
else
(*ctx->tokcxsad)(ctx->tokcxscx, " ", (ushort)1);
while (len == 0)
{
if (tokgetlin(ctx, FALSE))
errsig(ctx->tokcxerr, ERR_STREOF);
p = ctx->tokcxptr;
len = ctx->tokcxlen;
/* warn if it looks like the end of an object */
if (!warned && len && (*p == ';' || *p == '}'))
{
errlog(ctx->tokcxerr, ERR_STREND);
warned = TRUE; /* warn only once per string */
}
/* scan past whitespace at start of line */
while (len && t_isspace(*p)) ++p, --len;
}
strstart = p;
}
else break;
}
else
++p, --len;
}
/* end the string */
(*ctx->tokcxsend)(ctx->tokcxscx);
/* check to see how it ended */
if (len != 0 && *p == delim)
{
/*
* We ended with the matching delimiter. Move past the
* closing delimiter.
*/
++p;
--len;
/*
* If we have a pending close paren we need to put in
* because of an embedded expression that occurred earlier
* in the string, parse the macro to provide the paren.
*/
if ((ctx->tokcxflg & TOKCXF_EMBED_PAREN_AFT) != 0
&& !(ctx->tokcxflg & TOKCXFINMAC))
{
/* clear the flag */
ctx->tokcxflg &= ~TOKCXF_EMBED_PAREN_AFT;
/* push the current parsing position */
if (ctx->tokcxmlvl >= TOKMACNEST)
errsig(ctx->tokcxerr, ERR_MACNEST);
ctx->tokcxmsav[ctx->tokcxmlvl] = p;
ctx->tokcxmsvl[ctx->tokcxmlvl] = len;
ctx->tokcxmlvl++;
/* parse the macro */
p = tokmac4;
len = strlen(p);
}
}
else if (len != 0 && *p == '<')
{
/* save the current parsing position */
if (ctx->tokcxmlvl >= TOKMACNEST)
errsig(ctx->tokcxerr, ERR_MACNEST);
ctx->tokcxmsav[ctx->tokcxmlvl] = p + 2;
ctx->tokcxmsvl[ctx->tokcxmlvl] = len - 2;
ctx->tokcxmlvl++;
/* read from the "<<" expansion */
p = tokmac1;
len = strlen(p);
ctx->tokcxflg |= TOKCXFINMAC;
/*
* Set the special push-a-paren flag: we'll return an open
* paren now, so that we have an open paren before the
* string, and then on the next call to toknext() we'll
* immediately return the string we've already parsed here.
* This will ensure that everything in the string is
* properly grouped together as a single indivisible
* expression.
*
* Note that we only need to do this for the first embedded
* expression in a string. Once we have a close paren
* pending, we don't need more open parens.
*/
if (!(ctx->tokcxflg & TOKCXF_EMBED_PAREN_AFT))
{
ctx->tokcxflg |= TOKCXF_EMBED_PAREN_PRE;
tok->toktyp = TOKTLPAR;
}
}
goto done;
}
else if (len >= 2 && *p == '>' && *(p+1) == '>'
&& (ctx->tokcxflg & TOKCXFINMAC) != 0)
{
/* skip the ">>" */
ctx->tokcxflg &= ~TOKCXFINMAC;
p += 2;
len -= 2;
/* save the current parsing position */
if (ctx->tokcxmlvl >= TOKMACNEST)
errsig(ctx->tokcxerr, ERR_MACNEST);
ctx->tokcxmsav[ctx->tokcxmlvl] = p;
ctx->tokcxmsvl[ctx->tokcxmlvl] = len;
ctx->tokcxmlvl++;
if (*p == '"')
{
++(ctx->tokcxmsav[ctx->tokcxmlvl - 1]);
--(ctx->tokcxmsvl[ctx->tokcxmlvl - 1]);
p = tokmac3;
/*
* we won't need an extra closing paren now, since tokmac3
* provides it
*/
ctx->tokcxflg &= ~TOKCXF_EMBED_PAREN_AFT;
}
else
{
/*
* The string is continuing. Set a flag to note that we
* need to provide a close paren after the end of the
* string, and parse the glue (tokmac2) that goes between
* the expression and the resumption of the string.
*/
ctx->tokcxflg |= TOKCXF_EMBED_PAREN_AFT;
p = tokmac2;
}
len = strlen(p);
goto nexttoken;
}
else
{
tokscdef *sc;
for (sc = ctx->tokcxsc[ctx->tokcxinx[(uchar)*p]] ; sc ;
sc = sc->tokscnxt)
{
if (toksceq(sc->tokscstr, p, sc->toksclen, len))
{
tok->toktyp = sc->toksctyp;
p += sc->toksclen;
len -= sc->toksclen;
goto done;
}
}
errsig(ctx->tokcxerr, ERR_INVTOK);
}
done:
ctx->tokcxptr = p;
ctx->tokcxlen = len;
return(tok->toktyp);
}
/* set up contents property for load-on-demand */
void supcont(void *ctx0, objnum obj, prpnum prp)
{
supcxdef *ctx = (supcxdef *)ctx0;
vocidef ***vpg;
vocidef **v;
voccxdef *voc = ctx->supcxvoc;
int i;
int j;
int len = 2;
objnum chi;
objnum loc;
/* be sure the buffer is allocated */
if (!ctx->supcxbuf)
{
ctx->supcxlen = 512;
ctx->supcxbuf = mchalo(ctx->supcxerr, ctx->supcxlen,
"supcont");
}
assert(prp == PRP_CONTENTS); /* the only thing that makes sense */
for (vpg = voc->voccxinh, i = 0 ; i < VOCINHMAX ; ++vpg, ++i)
{
if (!*vpg) continue; /* no entries on this page */
for (v = *vpg, chi = (i << 8), j = 0 ; j < 256 ; ++v, ++chi, ++j)
{
/* if there's no record at this location, skip it */
if (!*v) continue;
/* inherit the location if it hasn't been set to any value */
if ((*v)->vociloc == MCMONINV
&& !((*v)->vociflg & VOCIFLOCNIL))
loc = (*v)->vociilc;
else
loc = (*v)->vociloc;
/* if this object is in the indicated location, add it */
if (loc == obj && !((*v)->vociflg & VOCIFCLASS))
{
/* see if we have room in list buffer; expand buffer if not */
if (len + 3 > ctx->supcxlen)
{
uchar *newbuf;
/* allocate a new buffer */
newbuf = mchalo(ctx->supcxerr,
(len + 512), "supcont");
/* copy the old buffer's contents into the new buffer */
memcpy(newbuf, ctx->supcxbuf, ctx->supcxlen);
/* remember the new buffer length */
ctx->supcxlen = len + 512;
/* free the old buffer */
mchfre(ctx->supcxbuf);
/* remember the new buffer */
ctx->supcxbuf = newbuf;
/* sanity check for integer overflow */
if (len + 3 > ctx->supcxlen)
errsig(ctx->supcxmem->mcmcxgl->mcmcxerr, ERR_SUPOVF);
}
ctx->supcxbuf[len] = DAT_OBJECT;
oswp2(ctx->supcxbuf + len + 1, chi);
len += 3;
}
}
}
oswp2(ctx->supcxbuf, len);
objsetp(ctx->supcxmem, obj, prp, DAT_LIST, ctx->supcxbuf,
ctx->supcxrun->runcxundo);
}
/* process a #elif */
static void tokelif(tokcxdef *ctx, char *p, int len)
{
errsig(ctx->tokcxerr, ERR_PELIF_NA);
}