Logo Search packages:      
Sourcecode: qtads version File versions

bif.c

#ifdef RCSID
static char RCSid[] =
"$Header: d:/cvsroot/tads/TADS2/BIF.C,v 1.4 1999/07/11 00:46:29 MJRoberts Exp $";
#endif

/* 
 *   Copyright (c) 1991, 2002 Michael J. Roberts.  All Rights Reserved.
 *   
 *   Please see the accompanying license file, LICENSE.TXT, for information
 *   on using and copying this software.  
 */
/*
Name
  bif.c - built-in function implementation
Function
  Implements built-in functions for TADS
Notes
  None
Modified
  04/11/99 CNebel        - fix signed/unsigned mismatches
  12/16/92 MJRoberts     - add TADS/Graphic functions
  12/26/91 MJRoberts     - creation
*/

#include <ctype.h>
#include <string.h>
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <time.h>
#include "os.h"
#include "std.h"
#include "bif.h"
#include "tio.h"
#include "run.h"
#include "voc.h"
#include "fio.h"
#include "dbg.h"
#include "prp.h"
#include "lst.h"
#include "trd.h"
#include "regex.h"
#include "res.h"


/* yorn - yes or no */
void bifyon(bifcxdef *ctx, int argc)
{
    char     rsp[128];
    char    *p;
    runsdef  val;
    char     yesbuf[64];
    char     nobuf[64];
    re_context  rectx;
    int      match_yes;
    int      match_no;

    bifcntargs(ctx, 0, argc);            /* check for proper argument count */

    /* load the "yes" and "no" reply patterns */
    if (os_get_str_rsc(RESID_YORN_YES, yesbuf, sizeof(yesbuf)))
        strcpy(yesbuf, "[Yy].*");
    if (os_get_str_rsc(RESID_YORN_NO, nobuf, sizeof(nobuf)))
        strcpy(nobuf, "[Nn].*");
    
    /* if we're in HTML mode, switch to input font */
    if (tio_is_html_mode())
        tioputs(ctx->bifcxtio, "<font face='TADS-Input'>");

    /* ensure the prompt is displayed */
    tioflushn(ctx->bifcxtio, 0);

    /* reset count of lines since the last keyboard input */
    tioreset(ctx->bifcxtio);

    /* read a line of text */
    if (tiogets(ctx->bifcxtio, (char *)0, rsp, (int)sizeof(rsp)))
        runsig(ctx->bifcxrun, ERR_RUNQUIT);

    /* if we're in HTML mode, close the input font tag */
    if (tio_is_html_mode())
        tioputs(ctx->bifcxtio, "</font>");

    /* scan off leading spaces */
    for (p = rsp ; t_isspace(*p) ; ++p) ;

    /* set up our regex context */
    re_init(&rectx, ctx->bifcxerr);

    /* check for a "yes" response */
    match_yes = re_compile_and_match(&rectx, yesbuf, strlen(yesbuf),
                                     p, strlen(p));

    /* check for a "no" response */
    match_no = re_compile_and_match(&rectx, nobuf, strlen(nobuf),
                                    p, strlen(p));

    /* check the result */
    if (match_yes == (int)strlen(p))
        val.runsv.runsvnum = 1;
    else if (match_no == (int)strlen(p))
        val.runsv.runsvnum = 0;
    else
        val.runsv.runsvnum = -1;

    /* delete our regex context */
    re_delete(&rectx);

    /* push the result */
    runpush(ctx->bifcxrun, DAT_NUMBER, &val);
}

/* setfuse */
void bifsfs(bifcxdef *ctx, int argc)
{
    objnum    func;
    uint      tm;
    runsdef   val;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 3, argc);            /* check for proper argument count */
    func = runpopfn(ctx->bifcxrun);
    tm = runpopnum(ctx->bifcxrun);
    runpop(ctx->bifcxrun, &val);
    
    /* limitation:  don't allow string or list for value */
    if (val.runstyp == DAT_LIST || val.runstyp == DAT_SSTRING)
        runsig(ctx->bifcxrun, ERR_FUSEVAL);
    
    vocsetfd(voc, voc->voccxfus, func, (prpnum)0,
             tm, &val, ERR_MANYFUS);
}

/* remfuse */
void bifrfs(bifcxdef *ctx, int argc)
{
    objnum    func;
    runsdef   val;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 2, argc);
    func = runpopfn(ctx->bifcxrun);
    runpop(ctx->bifcxrun, &val);
    vocremfd(voc, voc->voccxfus, func, (prpnum)0,
             &val, ERR_NOFUSE);
}

/* setdaemon */
void bifsdm(bifcxdef *ctx, int argc)
{
    objnum    func;
    runsdef   val;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 2, argc);            /* check for proper argument count */
    func = runpopfn(ctx->bifcxrun);
    runpop(ctx->bifcxrun, &val);
    
    /* limitation:  don't allow string or list for value */
    if (val.runstyp == DAT_LIST || val.runstyp == DAT_SSTRING)
        runsig(ctx->bifcxrun, ERR_FUSEVAL);
    
    vocsetfd(voc, voc->voccxdmn, func, (prpnum)0, 0,
             &val, ERR_MANYDMN);
}

/* remdaemon */
void bifrdm(bifcxdef *ctx, int argc)
{
    objnum    func;
    runsdef   val;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 2, argc);
    func = runpopfn(ctx->bifcxrun);
    runpop(ctx->bifcxrun, &val);
    vocremfd(voc, voc->voccxdmn, func, (prpnum)0,
             &val, ERR_NODMN);
}

/* incturn */
void bifinc(bifcxdef *ctx, int argc)
{
    int turncnt;
    
    if (argc == 1)
    {
        /* get the number of turns to skip */
        turncnt = runpopnum(ctx->bifcxrun);
        if (turncnt < 1)
            runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "incturn");
    }
    else
    {
        /* no arguments -> increment by one turn */
        bifcntargs(ctx, 0, argc);
        turncnt = 1;
    }

    /* skip the given number of turns */
    vocturn(ctx->bifcxrun->runcxvoc, turncnt, TRUE);
}

/* skipturn */
void bifskt(bifcxdef *ctx, int argc)
{
    int turncnt;

    bifcntargs(ctx, 1, argc);
    turncnt = runpopnum(ctx->bifcxrun);
    if (turncnt < 1)
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "skipturn");
    vocturn(ctx->bifcxrun->runcxvoc, turncnt, FALSE);
}

/* quit */
void bifqui(bifcxdef *ctx, int argc)
{
    /* check for proper argument count */
    bifcntargs(ctx, 0, argc);

    /* flush output buffer, and signal the end of the game */
    tioflush(ctx->bifcxtio);
    errsig(ctx->bifcxerr, ERR_RUNQUIT);
}

/* internal function to convert a TADS string into a C-string */
static void bifcstr(bifcxdef *ctx, char *buf, size_t bufsiz, uchar *str)
{
    size_t  srcrem;
    size_t  dstrem;
    uchar  *src;
    char   *dst;

    /* get the length and text portion of the string */
    srcrem = osrp2(str) - 2;
    str += 2;

    /* scan the string, and convert escapes */
    for (src = str, dst = buf, dstrem = bufsiz ;
         srcrem != 0 && dstrem != 0 ; ++src, --srcrem)
    {
        /* if we have an escape sequence, convert it */
        if (*src == '\\')
        {
            /* skip the backslash in the input */
            ++src;
            --srcrem;

            /* if there's nothing left, store the backslash */
            if (srcrem == 0)
            {
                /* store the backslash */
                *dst++ = '\\';
                --dstrem;

                /* there's nothing left to scan */
                break;
            }

            /* see what the second half of the escape sequence is */
            switch(*src)
            {
            case 'n':
                /* store a C-style newline character */
                *dst++ = '\n';
                --dstrem;
                break;

            case 't':
                /* store a C-style tab */
                *dst++ = '\t';
                --dstrem;
                break;

            case '(':
            case ')':
                /* entirely omit the highlighting sequences */
                break;

            default:
                /* store everything else unchanged */
                *dst++ = *src;
                --dstrem;
                break;
            }
        }
        else
        {
            /* copy this character unchanged */
            *dst++ = *src;
            --dstrem;
        }
    }

    /* if the buffer wasn't big enough, signal an error */
    if (dstrem == 0)
        runsig(ctx->bifcxrun, ERR_BIFCSTR);

    /* null-terminate the result string */
    *dst = '\0';
}

/* save */
void bifsav(bifcxdef *ctx, int argc)
{
    uchar   *fn;
    char     buf[OSFNMAX];
    int      err;
    runsdef  val;
    
    bifcntargs(ctx, 1, argc);
    fn = runpopstr(ctx->bifcxrun);
    bifcstr(ctx, buf, (size_t)sizeof(buf), fn);
    os_defext(buf, ctx->bifcxsavext != 0 ? ctx->bifcxsavext : "sav");
    err = fiosav(ctx->bifcxrun->runcxvoc, buf, ctx->bifcxrun->runcxgamename);
    runpush(ctx->bifcxrun, runclog(err), &val);
}

/* restore */
void bifrso(bifcxdef *ctx, int argc)
{
    uchar    *fn;
    char      buf[OSFNMAX];
    int       err;
    voccxdef *vctx = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 1, argc);
    
    /* check for special restore(nil) - restore game given as parameter */
    if (runtostyp(ctx->bifcxrun) == DAT_NIL)
    {
        /* get filename from startup parameter, if any */
        if (!os_paramfile(buf))
        {
            /* no startup parameter */
            runpnum(ctx->bifcxrun, FIORSO_NO_PARAM_FILE);
            return;
        }
    }
    else
    {
        /* get string parameter - it's the filename */
        fn = runpopstr(ctx->bifcxrun);
        bifcstr(ctx, buf, (size_t)sizeof(buf), fn);
        os_defext(buf, ctx->bifcxsavext != 0 ? ctx->bifcxsavext : "sav");
    }

    /* try restoring the file */
    err = fiorso(vctx, buf);

    /* blow away all undo records */
    objulose(vctx->voccxundo);

    /* return the result code from fiorso */
    runpnum(ctx->bifcxrun, err);

    /* note that the rest of the command line is to be ignored */
    vctx->voccxflg |= VOCCXFCLEAR;
}

/* logging */
void biflog(bifcxdef *ctx, int argc)
{
    char   buf[OSFNMAX];
    uchar *str;
    
    bifcntargs(ctx, 1, argc);
    if (runtostyp(ctx->bifcxrun) == DAT_NIL)
    {
        rundisc(ctx->bifcxrun);
        tiologcls(ctx->bifcxtio);
    }
    else
    {
        str = runpopstr(ctx->bifcxrun);
        bifcstr(ctx, buf, (size_t)sizeof(buf), str);
        tiologopn(ctx->bifcxtio, buf);
    }
}

/* restart */
void bifres(bifcxdef *ctx, int argc)
{
    voccxdef *vctx = ctx->bifcxrun->runcxvoc;
    objnum    fn;

    if (argc == 2)
        fn = runpopfn(ctx->bifcxrun);            /* get function if present */
    else
    {
        bifcntargs(ctx, 0, argc);        /* check for proper argument count */
        fn = MCMONINV;                         /* no function was specified */
    }

    objulose(vctx->voccxundo);                /* blow away all undo records */
    vocrevert(vctx);                /* revert all objects to original state */
    vocdmnclr(vctx);                   /* clear out fuses/deamons/notifiers */

    /* restore the original "Me" object */
    vctx->voccxme = vctx->voccxme_init;

    /* call preinit if necessary (call it before invoking the user callback) */
    if (vctx->voccxpreinit != MCMONINV)
        runfn(ctx->bifcxrun, vctx->voccxpreinit, 0);

    /*
     *   If a restart function was provided, call it.  Note that we left
     *   the argument for the function on the stack, so there's no need to
     *   re-push it!  
     */
    if (fn != MCMONINV) runfn(ctx->bifcxrun, fn, 1);

    /* restart the game */
    errsig(ctx->bifcxerr, ERR_RUNRESTART);
}

/* input - get a line of input from the keyboard */
void bifinp(bifcxdef *ctx, int argc)
{
    char inbuf[128];

    /* check for proper argument count */
    bifcntargs(ctx, 0, argc);

    /* make sure the prompt is displayed */
    tioflushn(ctx->bifcxtio, 0);

     /* reset count of lines since the last keyboard input */
    tioreset(ctx->bifcxtio);

    /* read a line of text */
    if (tiogets(ctx->bifcxtio, (char *)0, inbuf, (int)sizeof(inbuf)))
        runsig(ctx->bifcxrun, ERR_RUNQUIT);

    /* push the string, converting escapes */
    runpushcstr(ctx->bifcxrun, inbuf, strlen(inbuf), 0);
}

/* notify */
void bifnfy(bifcxdef *ctx, int argc)
{
    objnum    objn;
    prpnum    prp;
    uint      tm;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 3, argc);            /* check for proper argument count */
    objn = runpopobj(ctx->bifcxrun);
    prp = runpopprp(ctx->bifcxrun);
    tm = runpopnum(ctx->bifcxrun);

    /* a time of zero means every turn */
    if (tm == 0)
        tm = VOCDTIM_EACH_TURN;
    
    vocsetfd(voc, voc->voccxalm, objn, prp, tm,
             (runsdef *)0, ERR_MANYNFY);
}


/* unnotify */
void bifunn(bifcxdef *ctx, int argc)
{
    objnum    objn;
    prpnum    prop;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 2, argc);
    objn = runpopobj(ctx->bifcxrun);
    prop = runpopprp(ctx->bifcxrun);
    vocremfd(voc, voc->voccxalm, objn, prop,
             (runsdef *)0, ERR_NONFY);
}

/* trace on/off */
void biftrc(bifcxdef *ctx, int argc)
{
    runsdef val;
    int     n;
    int     flag;

    if (argc == 2)
    {
        /* get the type indicator and the on/off status */
        n = runpopnum(ctx->bifcxrun);
        flag = runpoplog(ctx->bifcxrun);

        /* see what type of debugging they want to turn on or off */
        switch(n)
        {
        case 1:
            /* turn on parser tracing */
            if (flag)
                ctx->bifcxrun->runcxvoc->voccxflg |= VOCCXFDBG;
            else
                ctx->bifcxrun->runcxvoc->voccxflg &= ~VOCCXFDBG;
            break;

        default:
            /* ignore other requests */
            runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "debugTrace");
        }
    }
    else
    {
        /* break into debugger; return whether debugger is present */
        bifcntargs(ctx, 0, argc);
        runpush(ctx->bifcxrun, runclog(dbgstart(ctx->bifcxrun->runcxdbg)),
                &val);
    }
}

/* say */
void bifsay(bifcxdef *ctx, int argc)
{
    uchar *str;
    long   num;
    char   numbuf[30];

    if (argc != 2) bifcntargs(ctx, 1, argc);
    
    switch(runtostyp(ctx->bifcxrun))
    {
    case DAT_NUMBER:
        num = runpopnum(ctx->bifcxrun);
        sprintf(numbuf, "%ld", num);
        tioputs(ctx->bifcxtio, numbuf);
        break;
        
    case DAT_SSTRING:
        str = runpopstr(ctx->bifcxrun);
        outfmt(ctx->bifcxtio, str);
        break;
        
    case DAT_NIL:
        (void)runpoplog(ctx->bifcxrun);
        break;
        
    default:
        runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "say");
    }
}

/* car */
void bifcar(bifcxdef *ctx, int argc)
{
    uchar   *lstp;
    uint     lstsiz;
    runsdef  val;
    
    bifcntargs(ctx, 1, argc);
    bifchkarg(ctx, DAT_LIST);
    
    lstp = runpoplst(ctx->bifcxrun);
    
    /* get list's size, and point to its data string */
    lstsiz = osrp2(lstp) - 2;
    lstp += 2;
    
    /* push first element if one is present, otherwise push nil */
    if (lstsiz)
        runpbuf(ctx->bifcxrun, *lstp, lstp+1);
    else
        runpush(ctx->bifcxrun, DAT_NIL, &val);
}

/* cdr */
void bifcdr(bifcxdef *ctx, int argc)
{
    uchar   *lstp;
    uint     siz;
    uint     lstsiz;
    runsdef  val;
    runsdef  stkval;
    
    bifcntargs(ctx, 1, argc);
    bifchkarg(ctx, DAT_LIST);
    
    lstp = runpoplst(ctx->bifcxrun);
    stkval.runstyp = DAT_LIST;
    stkval.runsv.runsvstr = lstp;
    
    /* get list's size, and point to its data string */
    lstsiz = osrp2(lstp) - 2;
    lstp += 2;
    
    if (lstsiz != 0)
    {
        /* deduct size of first element from size of list */
        siz = datsiz(*lstp, lstp+1) + 1;
        lstsiz -= siz;

        /* add in the size prefix for our new list size */
        lstsiz += 2;

        /* allocate space for new list containing rest of list */
        runhres1(ctx->bifcxrun, lstsiz, 1, &stkval);
        lstp = stkval.runsv.runsvstr + siz + 2;

        /* write out size followed by list value string */
        oswp2(ctx->bifcxrun->runcxhp, lstsiz);
        memcpy(ctx->bifcxrun->runcxhp+2, lstp, (size_t)(lstsiz-2));
        
        val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
        val.runstyp = DAT_LIST;
        ctx->bifcxrun->runcxhp += lstsiz;
        runrepush(ctx->bifcxrun, &val);
    }
    else
        runpush(ctx->bifcxrun, DAT_NIL, &val);   /* empty list - cdr is nil */
}

/* caps */
void bifcap(bifcxdef *ctx, int argc)
{
    bifcntargs(ctx, 0, argc);
    tiocaps(ctx->bifxtio);  /* set output driver next-char-capitalized flag */
}

/* nocaps */
void bifnoc(bifcxdef *ctx, int argc)
{
    bifcntargs(ctx, 0, argc);
    tionocaps(ctx->bifxtio);               /* set next-not-capitalized flag */
}

/* length */
void biflen(bifcxdef *ctx, int argc)
{
    uchar   *p;
    runsdef  val;
    long     len;
    int      l;
    
    bifcntargs(ctx, 1, argc);
    switch(runtostyp(ctx->bifcxrun))
    {
    case DAT_SSTRING:
        p = (uchar *)runpopstr(ctx->bifcxrun);
        len = osrp2(p) - 2;
        break;

    case DAT_LIST:
        p = runpoplst(ctx->bifcxrun);
        l = osrp2(p) - 2;
        p += 2;
        
        /* count all elements in list */
        for (len = 0 ; l ; ++len)
        {
            int cursiz;
            
            /* get size of this element, and move past it */
            cursiz = datsiz(*p, p+1) + 1;
            l -= cursiz;
            p += cursiz;
        }
        break;

    default:
        runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "length");
    }
    
    val.runsv.runsvnum = len;
    runpush(ctx->bifcxrun, DAT_NUMBER, &val);
}

/* find */
void biffnd(bifcxdef *ctx, int argc)
{
    uchar   *p1, *p2;
    int      len1, len2;
    int      outv;
    runsdef  val;
    int      typ;
    int      siz;
    
    bifcntargs(ctx, 2, argc);
    switch(runtostyp(ctx->bifcxrun))
    {
    case DAT_SSTRING:
        p1 = runpopstr(ctx->bifcxrun);
        len1 = osrp2(p1) - 2;
        p1 += 2;
        
        p2 = runpopstr(ctx->bifcxrun);
        len2 = osrp2(p2) - 2;
        p2 += 2;

        /* look for p2 within p1 */
        for (typ = DAT_NIL, outv = 1 ; len1 >= len2 ; ++p1, --len1, ++outv)
        {
            if (!memcmp(p1, p2, (size_t)len2))
            {
                typ = DAT_NUMBER;           /* use number in outv after all */
                break;                        /* that's it - we've found it */
            }
        }
        break;
        
    case DAT_LIST:
        p1 = runpoplst(ctx->bifcxrun);
        len1 = osrp2(p1) - 2;
        p1 += 2;

        /* get second item:  any old datatype */
        runpop(ctx->bifcxrun, &val);
        
        for (typ = DAT_NIL, outv = 1 ; len1 ; ++outv, p1 += siz, len1 -= siz)
        {
            siz = datsiz(*p1, p1 + 1) + 1;      /* get size of this element */
            if (val.runstyp != *p1) continue;          /* types don't match */
            
            switch(val.runstyp)
            {
            case DAT_NUMBER:
                if (val.runsv.runsvnum != osrp4(p1 + 1)) continue;
                break;
                
            case DAT_SSTRING:
            case DAT_LIST:
                if (osrp2(p1 + 1) != osrp2(val.runsv.runsvstr) ||
                    memcmp(p1 + 3, val.runsv.runsvstr + 2,
                           (size_t)(osrp2(p1 + 1) - 2)))
                    continue;
                break;
                
            case DAT_PROPNUM:
                if (osrp2(p1 + 1) != val.runsv.runsvprp) continue;
                break;
                
            case DAT_OBJECT:
            case DAT_FNADDR:
                if (osrp2(p1 + 1) != val.runsv.runsvobj) continue;
                break;
                
            default:
                break;
            }
            
            /* if we got here, it means we found a match */
            typ = DAT_NUMBER;                      /* use the value in outv */
            break;                            /* that's it - we've found it */
        }
        break;
        
    default:
        runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "find");
    }
    
    /* push the value given by typ and outv */
    val.runsv.runsvnum = outv;
    runpush(ctx->bifcxrun, typ, &val);
}

/* setit - set current 'it' */
void bifsit(bifcxdef *ctx, int argc)
{
    objnum    obj;
    int       typ;
    voccxdef *vcx = ctx->bifcxrun->runcxvoc;
    
    /* check for extended version that allows setting him/her */
    if (argc == 2)
    {
        if (runtostyp(ctx->bifcxrun) == DAT_NIL)
        {
            rundisc(ctx->bifcxrun);                      /* discard the nil */
            obj = MCMONINV;                           /* use invalid object */
        }
        else
            obj = runpopobj(ctx->bifcxrun);               /* get the object */

        typ = runpopnum(ctx->bifcxrun);                     /* get the code */
        vcx->voccxthc = 0;                         /* clear the 'them' list */

        switch(typ)
        {
        case 0:                                                 /* set "it" */
            vcx->voccxit = obj;
            break;

        case 1:                                                /* set "him" */
            vcx->voccxhim = obj;
            break;

        case 2:                                                /* set "her" */
            vcx->voccxher = obj;
            break;
        }
        return;
    }

    /* "setit classic" has one argument only */
    bifcntargs(ctx, 1, argc);

    /* check to see if we're setting 'it' or 'them' */
    if (runtostyp(ctx->bifcxrun) == DAT_LIST)
    {
        uchar *lst;
        uint   siz;
        int    cnt;

        lst = runpoplst(ctx->bifcxrun);
        siz = osrp2(lst);
        lst += 2;
        siz -= 2;

        for (cnt = 0 ; siz ; )
        {
            /* if this is an object, add to 'them' list (otherwise ignore) */
            if (*lst == DAT_OBJECT)
                vcx->voccxthm[cnt++] = osrp2(lst+1);

            lstadv(&lst, &siz);
        }
        vcx->voccxthc = cnt;
        vcx->voccxit = MCMONINV;
    }
    else
    {
        /* set 'it', and delete 'them' list */
        if (runtostyp(ctx->bifcxrun) == DAT_NIL)
        {
            vcx->voccxit = MCMONINV;
            rundisc(ctx->bifcxrun);
        }
        else
            vcx->voccxit = runpopobj(ctx->bifcxrun);
        vcx->voccxthc = 0;
    }
}

/* randomize - seed random number generator */
void bifsrn(bifcxdef *ctx, int argc)
{
    bifcntargs(ctx, 0, argc);
    os_rand(&ctx->bifcxrnd);
    ctx->bifcxrndset = TRUE;
}

/* rand - get a random number */
void bifrnd(bifcxdef *ctx, int argc)
{
    unsigned long result, max, randseed;
    int      tmp;
    runsdef  val;

    /* get argument - number giving upper bound of generated number */
    bifcntargs(ctx, 1, argc);
    bifchkarg(ctx, DAT_NUMBER);
    max = runpopnum(ctx->bifcxrun);

    /* if the max is zero, just return zero */
    if (max == 0)
    {
        runpnum(ctx->bifcxrun, 0);
        return;
    }

    /*
     *   If the random number generator has been seeded by a call to
     *   randomize(), use the new, improved random number generator.  If
     *   not, use the old random number generator to ensure that the same
     *   sequence of numbers is generated as always (to prevent breaking
     *   existing test scripts based on the old sequence). 
     */
    if (!ctx->bifcxrndset)
    {
        /* compute the next number in sequence, using old cheesy generator */
        randseed = ctx->bifcxrnd;
        randseed *= 1033;
        randseed += 5;
        tmp = randseed / 16384;
        randseed %= 16384;
        result = tmp / 7;

        /* adjust the result to be in the requested range */
        result = ( randseed % max ) + 1;
        
        /* save the new seed value, and return the value */
        ctx->bifcxrnd = randseed;
        val.runsv.runsvnum = result;
        runpush(ctx->bifcxrun, DAT_NUMBER, &val);
    }
    else
    {
#define BIF_RAND_M  ((ulong)2147483647)
#define BIF_RAND_Q  ((ulong)127773)
#define BIF_RAND_A  ((ulong)16807)
#define BIF_RAND_R  ((ulong)2836)

        long lo, hi, test;

        lo = ctx->bifcxrnd / BIF_RAND_Q;
        hi = ctx->bifcxrnd % BIF_RAND_Q;
        test = BIF_RAND_A*lo - BIF_RAND_R*hi;
        ctx->bifcxrnd = test;
        if (test > 0)
            ctx->bifcxrnd = test;
        else
            ctx->bifcxrnd = test + BIF_RAND_M;
        runpnum(ctx->bifcxrun, (((ulong)ctx->bifcxrnd) % max) + 1);
    }
}

/* 
 *   case-insensitive substring matching 
 */
static char *bif_stristr(const char *s1, const char *s2)
{
    size_t s1len;
    size_t s2len;

    /* scan for a match */
    for (s1len = strlen(s1), s2len = strlen(s2) ; s1len >= s2len ;
         ++s1, --s1len)
    {
        /* if this is a match, return this substring */
        if (memicmp(s1, s2, s2len) == 0)
            return (char *)s1;
    }

    return 0;
}

/*
 *   askfile flags 
 */
#define BIF_ASKF_EXT_RET  1                        /* extended return codes */

/* 
 *   askfile 
 */
void bifask(bifcxdef *ctx, int argc)
{
    uchar *prompt;
    char   buf[OSFNMAX + 2];
    char   pbuf[128];
    int    err;
    int    prompt_type;
    int    file_type;
    ulong  flags;

    /* make sure we have an acceptable number of arguments */
    if (argc != 1 && argc != 3 && argc != 4)
        runsig(ctx->bifcxrun, ERR_BIFARGC);

    /* get the first argument - the prompt string */
    prompt = runpopstr(ctx->bifcxrun);
    bifcstr(ctx, pbuf, (size_t)sizeof(pbuf), prompt);

    /* presume we will have no flags */
    flags = 0;

    /* if we have the prompt type and file type parameters, get them */
    if (argc >= 3)
    {
        /* get the prompt-type and the file-type arguments */
        prompt_type = (int)runpopnum(ctx->bifcxrun);
        file_type = (int)runpopnum(ctx->bifcxrun);

        /* if we have a fourth argument, it's the flags */
        if (argc == 4)
            flags = runpopnum(ctx->bifcxrun);
    }
    else
    {
        static const char *save_strs[] =
        {
            "save",
            "write",
            0
        };
        static const char *game_strs[] =
        {
            "restore",
            "game",
            0
        };
        const char **sp;

        /* 
         *   No prompt type or file type were specified.  Try to infer the
         *   dialog type and file type from the text of the prompt.  (This
         *   is mostly to support older games, in particular those based
         *   on older versions of adv.t, since newer games should always
         *   provide explicit values for the file type and dialog type.
         *   We are thus inferring the types based on the prompt strings
         *   that older adv.t's used when calling askfile.)
         *   
         *   If the prompt contains any substring such as "save" or
         *   "write", specify that we're saving; otherwise, assume that
         *   we're opening an existing file for reading.
         *   
         *   If the prompt contains the substrings "restore" AND "game",
         *   assume that we're opening a game file; otherwise, don't make
         *   any assumptions, and use the "unknown" file type.  
         */

        /* presume we're going to open a saved-game file */
        prompt_type = OS_AFP_OPEN;
        file_type = OSFTSAVE;

        /* look for any one of the "save" substrings */
        for (sp = save_strs ; *sp != 0 ; ++sp)
        {
            /* check to see if this substring matches */
            if (bif_stristr(pbuf, *sp))
            {
                /* found it - use the "save" prompt */
                prompt_type = OS_AFP_SAVE;

                /* no need to look any further */
                break;
            }
        }

        /* 
         *   look for *all* of the "restore game" strings - if we fail to
         *   find any of them, be conservative and make no assumptions
         *   about the file type 
         */
        for (sp = game_strs ; *sp != 0 ; ++sp)
        {
            if (bif_stristr(pbuf, *sp) == 0)
            {
                /* 
                 *   this one doesn't match - don't make assumptions about
                 *   the file type 
                 */
                file_type = OSFTUNK;

                /* no need to look any further */
                break;
            }
        }
    }

    /* ask for a file */
    err = tio_askfile(pbuf, buf, (int)sizeof(buf), prompt_type, file_type);

    /* 
     *   if the caller requested extended return codes, return a list
     *   containing the return code as the first element and, if
     *   successful, the string as the second element 
     */
    if ((flags & BIF_ASKF_EXT_RET) != 0)
    {
        ushort len;
        runsdef val;
        uchar *p;
        
        /* 
         *   Allocate space for the starter list - if we have a string to
         *   return, just allocate space for the number element for now;
         *   otherwise, allocate space for the number plus a nil second
         *   element (one byte).
         */
        len = 2 + (1 + 4);
        if (err != OS_AFE_SUCCESS)
            ++len;

        /* allocate the space */
        runhres(ctx->bifcxrun, len, 0);

        /* set up our list pointer */
        val.runstyp = DAT_LIST;
        val.runsv.runsvstr = p = ctx->bifcxrun->runcxhp;

        /* write the length prefix */
        oswp2(p, len);
        p += 2;

        /* write the return code as the first element */
        *p++ = DAT_NUMBER;
        oswp4(p, err);
        p += 4;

        /* write the 'nil' second element if there's an error */
        if (err != OS_AFE_SUCCESS)
            *p++ = DAT_NIL;

        /* commit the list's memory */
        ctx->bifcxrun->runcxhp = p;

        /* push the list */
        runrepush(ctx->bifcxrun, &val);

        /* if we were successful, add the string to the list */
        if (err == OS_AFE_SUCCESS)
        {
            runsdef val2;
            
            /* push the string value, converting to our string format */
            runpushcstr(ctx->bifcxrun, buf, strlen(buf), 1);

            /* add it to the list already on the stack */
            runpop(ctx->bifcxrun, &val2);
            runpop(ctx->bifcxrun, &val);
            runadd(ctx->bifcxrun, &val, &val2, 2);

            /* re-push the result */
            runrepush(ctx->bifcxrun, &val);
        }
    }
    else
    {
        /* 
         *   use the traditional return codes - if askfile failed, return
         *   nil; otherwise, return the filename 
         */
        if (err)
            runpnil(ctx->bifcxrun);
        else
            runpushcstr(ctx->bifcxrun, buf, strlen(buf), 0);
    }
}

/* setscore */
void bifssc(bifcxdef *ctx, int argc)
{
    int s1, s2;

    /* optional new way - string argument */
    if (argc == 1 && runtostyp(ctx->bifcxrun) == DAT_SSTRING)
    {
        char   buf[80];
        uchar *p;
        
        p = runpopstr(ctx->bifcxrun);
        bifcstr(ctx, buf, (size_t)sizeof(buf), p);
        tiostrsc(ctx->bifcxtio, buf);
    }
    else
    {
        /* old way - two numeric arguments (displays: x/y) */
        bifcntargs(ctx, 2, argc);
        s1 = runpopnum(ctx->bifcxrun);
        s2 = runpopnum(ctx->bifcxrun);
        tioscore(ctx->bifcxtio, s1, s2);
    }
}

/* substr */
void bifsub(bifcxdef *ctx, int argc)
{
    uchar   *p;
    int      ofs;
    int      asklen;
    int      outlen;
    int      len;

    bifcntargs(ctx, 3, argc);

    /* get the string argument */
    bifchkarg(ctx, DAT_SSTRING);
    p = runpopstr(ctx->bifcxrun);
    len = osrp2(p) - 2;
    p += 2;
    
    /* get the offset argument */
    bifchkarg(ctx, DAT_NUMBER);
    ofs = runpopnum(ctx->bifcxrun);
    if (ofs < 1) runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "substr");
    
    /* get the length argument */
    bifchkarg(ctx, DAT_NUMBER);
    asklen = runpopnum(ctx->bifcxrun);
    if (asklen < 0) runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "substr");

    --ofs;          /* convert offset to a zero bias (user provided 1-bias) */
    p += ofs;                           /* advance string pointer by offset */

    if (ofs >= len)
        outlen = 0;                         /* offset is past end of string */
    else if (asklen > len - ofs)
        outlen = len - ofs;                      /* just use rest of string */
    else
        outlen = asklen;                /* requested length can be provided */
    
    runpstr(ctx->bifcxrun, (char *)p, outlen, 3);
}

/* cvtstr - convert value to a string */
void bifcvs(bifcxdef *ctx, int argc)
{
    char *p;
    int   len;
    char  buf[30];
    
    bifcntargs(ctx, 1, argc);
    switch(runtostyp(ctx->bifcxrun))
    {
    case DAT_NIL:
        p = "nil";
        len = 3;
        (void)runpoplog(ctx->bifcxrun);
        break;
        
    case DAT_TRUE:
        p = "true";
        len = 4;
        (void)runpoplog(ctx->bifcxrun);
        break;
        
    case DAT_NUMBER:
        sprintf(buf, "%ld", runpopnum(ctx->bifcxrun));
        p = buf;
        len = strlen(buf);
        break;

    case DAT_SSTRING:
        /* leave the string value on the stack unchanged */
        return;

    default:
        /* throw the RUNEXITOBJ error */
        runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "cvtstr");
    }
    
    runpstr(ctx->bifcxrun, p, len, 0);
}

/* cvtnum  - convert a value to a number */
void bifcvn(bifcxdef *ctx, int argc)
{
    runsdef  val;
    uchar   *p;
    int      len;
    int      typ;
    long     acc;
    int      neg;
    
    bifcntargs(ctx, 1, argc);
    p = runpopstr(ctx->bifcxrun);
    len = osrp2(p) - 2;
    p += 2;
    
    if (len == 3 && !memcmp(p, "nil", (size_t)3))
        typ = DAT_NIL;
    else if (len == 4 && !memcmp(p, "true", (size_t)4))
        typ = DAT_TRUE;
    else
    {
        typ = DAT_NUMBER;
        while (*p && t_isspace(*p)) ++p;
        if (*p == '-')
        {
            neg = TRUE;
            for (++p ; *p && t_isspace(*p) ; ++p) ;
        }
        else neg = FALSE;

        /* accumulate the number digit by digit */
        for (acc = 0 ; len && isdigit(*p) ; ++p, --len)
            acc = (acc << 3) + (acc << 1) + ((*p) - '0');

        if (neg) acc = -acc;
        val.runsv.runsvnum = acc;
    }
    
    runpush(ctx->bifcxrun, typ, &val);
}

/* general string conversion function */
static void bifcvtstr(bifcxdef *ctx, void (*cvtfn)(uchar *, int), int argc)
{
    uchar   *p;
    int      len;
    runsdef  val;
    runsdef  stkval;
    
    bifcntargs(ctx, 1, argc);
    bifchkarg(ctx, DAT_SSTRING);
    
    p = runpopstr(ctx->bifcxrun);
    stkval.runstyp = DAT_SSTRING;
    stkval.runsv.runsvstr = p;
    len = osrp2(p);
    
    /* allocate space in heap for the string and convert */
    runhres1(ctx->bifcxrun, len, 1, &stkval);
    p = stkval.runsv.runsvstr;
    memcpy(ctx->bifcxrun->runcxhp, p, (size_t)len);
    (*cvtfn)(ctx->bifcxrun->runcxhp + 2, len - 2);
    
    val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
    val.runstyp = DAT_SSTRING;
    ctx->bifcxrun->runcxhp += len;
    runrepush(ctx->bifcxrun, &val);
}

/* routine to convert a counted-length string to uppercase */
static void bifstrupr(uchar *str, int len)
{
    for ( ; len ; --len, ++str)
    {
        if (*str == '\\' && len > 1)
            --len, ++str;
        else if (islower(*str))
            *str = toupper(*str);
    }
}

/* upper */
void bifupr(bifcxdef *ctx, int argc)
{
    bifcvtstr(ctx, bifstrupr, argc);
}

/* convert a counted-length string to lowercase */
static void bifstrlwr(uchar *str, int len)
{
    for ( ; len ; --len, ++str)
    {
        if (*str == '\\' && len > 1)
            --len, ++str;
        else if (isupper(*str))
            *str = tolower(*str);
    }
}

/* lower */
void biflwr(bifcxdef *ctx, int argc)
{
    bifcvtstr(ctx, bifstrlwr, argc);
}

/* internal check to determine if object is of a class */
int bifinh(voccxdef *voc, vocidef *v, objnum cls)
{
    int     i;
    objnum *sc;

    if (!v) return(FALSE);
    for (i = v->vocinsc, sc = v->vocisc ; i ; ++sc, --i)
    {
        if (*sc == cls
            || bifinh(voc, vocinh(voc, *sc), cls))
            return(TRUE);
    }
    return(FALSE);
}

/* isclass(obj, cls) */
void bifisc(bifcxdef *ctx, int argc)
{
    objnum    obj;
    objnum    cls;
    runsdef   val;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    bifcntargs(ctx, 2, argc);

    /* if checking for nil, return nil */
    if (runtostyp(ctx->bifcxrun) == DAT_NIL)
    {
        rundisc(ctx->bifcxrun);
        rundisc(ctx->bifcxrun);
        runpnil(ctx->bifcxrun);
        return;
    }

    /* get the arguments:  object, class */
    obj = runpopobj(ctx->bifcxrun);
    cls = runpopobj(ctx->bifcxrun);

    /* return the result from bifinh() */
    runpush(ctx->bifcxrun, runclog(bifinh(voc, vocinh(voc, obj), cls)), &val);
}

/* firstsc(obj) - get the first superclass of an object */
void bif1sc(bifcxdef *ctx, int argc)
{
    objnum obj;
    objnum sc;

    bifcntargs(ctx, 1, argc);
    obj = runpopobj(ctx->bifcxrun);
    sc = objget1sc(ctx->bifcxrun->runcxmem, obj);
    runpobj(ctx->bifcxrun, sc);
}

/* firstobj */
void biffob(bifcxdef *ctx, int argc)
{
    vocidef ***vpg;
    vocidef  **v;
    objnum     obj;
    int        i;
    int        j;
    objnum     cls;
    voccxdef  *voc = ctx->bifcxrun->runcxvoc;

    /* get class to search for, if one is specified */
    if (argc == 0)
        cls = MCMONINV;
    else if (argc == 1)
        cls = runpopobj(ctx->bifcxrun);
    else
        runsig(ctx->bifcxrun, ERR_BIFARGC);
    
    for (vpg = voc->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 || ((*v)->vociflg & VOCIFCLASS)
                || (cls != MCMONINV && !bifinh(voc, *v, cls)))
                continue;
            
            /* this is an object we can use - push it */
            runpobj(ctx->bifcxrun, obj);
            return;
        }
    }
    
    /* no objects found at all - return nil */
    runpnil(ctx->bifcxrun);
}

/* nextobj */
void bifnob(bifcxdef *ctx, int argc)
{
    objnum     prv;
    vocidef ***vpg;
    vocidef  **v;
    objnum     obj;
    int        i;
    int        j;
    objnum     cls;
    voccxdef  *voc = ctx->bifcxrun->runcxvoc;

    /* get last position in search */
    prv = runpopobj(ctx->bifcxrun);
    
    /* get class to search for, if one is specified */
    if (argc == 1)
        cls = MCMONINV;
    else if (argc == 2)
        cls = runpopobj(ctx->bifcxrun);
    else
        runsig(ctx->bifcxrun, ERR_BIFARGC);
    
    /* start at previous object plus 1 */
    i = (prv >> 8);
    vpg = voc->voccxinh + i;
    j = (prv & 255);
    obj = prv;
    v = (*vpg) + j;
    
    for (;;)
    {
        ++j;
        ++obj;
        ++v;
        if (j == 256)
        {
            j = 0;
            ++i;
            ++vpg;
            if (!*vpg)
            {
                obj += 255;
                j += 255;
                continue;
            }
            v = (*vpg);
        }
        if (i >= VOCINHMAX)
        {
            runpnil(ctx->bifcxrun);
            return;
        }
        
        if (!*v || ((*v)->vociflg & VOCIFCLASS)
            || (cls != MCMONINV && !bifinh(voc, *v, cls)))
            continue;
            
        /* this is an object we can use - push it */
        runpobj(ctx->bifcxrun, obj);
        return;
    }
}

/* setversion */
void bifsvn(bifcxdef *ctx, int argc)
{
    bifcntargs(ctx, 1, argc);
    (void)runpopstr(ctx->bifcxrun);
    /* note - setversion doesn't do anything in v2; uses timestamp instead */
}

/* getarg */
void bifarg(bifcxdef *ctx, int argc)
{
    int argnum;
    
    bifcntargs(ctx, 1, argc);
    bifchkarg(ctx, DAT_NUMBER);
    
    /* get and verify argument number */
    argnum = runpopnum(ctx->bifcxrun);
    if (argnum < 1) runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "getarg");

    runrepush(ctx->bifcxrun, ctx->bifcxrun->runcxbp - argnum - 1);
}

/* datatype */
void biftyp(bifcxdef *ctx, int argc)
{
    runsdef val;
    
    bifcntargs(ctx, 1, argc);
    
    /* get whatever it is, and push the type */
    runpop(ctx->bifcxrun, &val);
    val.runsv.runsvnum = val.runstyp;          /* new value is the datatype */
    runpush(ctx->bifcxrun, DAT_NUMBER, &val);
}

/* undo */
void bifund(bifcxdef *ctx, int argc)
{
    objucxdef *ucx = ctx->bifcxrun->runcxvoc->voccxundo;
    mcmcxdef  *mcx = ctx->bifcxrun->runcxmem;
    errcxdef  *ec  = ctx->bifcxerr;
    int        err;
    int        undone;
    runsdef    val;

    bifcntargs(ctx, 0, argc);                               /* no arguments */

    ERRBEGIN(ec)
        if (ucx)
        {
            objundo(mcx, ucx);         /* try to undo to previous savepoint */
            undone = TRUE;                       /* looks like we succeeded */
        }
        else
            undone = FALSE;                  /* no undo context; can't undo */
    ERRCATCH(ec, err)
        if (err == ERR_NOUNDO || err == ERR_ICUNDO)
            undone = FALSE;
        else
            errrse(ec);            /* don't know how to handle other errors */
    ERREND(ec)

    /* return a value indicating whether the undo operation succeeded */
    runpush(ctx->bifcxrun, runclog(undone), &val);

    /* note that the rest of the command line is to be ignored */
    ctx->bifcxrun->runcxvoc->voccxflg |= VOCCXFCLEAR;
}

/* flags for defined() function */
#define BIFDEF_DEFINED_ANY           1
#define BIFDEF_DEFINED_DIRECTLY      2
#define BIFDEF_DEFINED_INHERITS      3
#define BIFDEF_DEFINED_GET_CLASS     4

/* defined */
void bifdef(bifcxdef *ctx, int argc)
{
    prpnum  prpn;
    objnum  objn;
    uint    ofs;
    runsdef val;
    objnum  def_objn;
    int     flag;

    /* get object and property arguments */
    objn = runpopobj(ctx->bifcxrun);
    prpn = runpopprp(ctx->bifcxrun);

    /* if there's a flag argument, get it as well */
    if (argc == 3)
    {
        /* get the flag */
        flag = (int)runpopnum(ctx->bifcxrun);
    }
    else
    {
        /* check the argument count */
        bifcntargs(ctx, 2, argc);

        /* use the default flag value (DEFINES_OR_INHERITS) */
        flag = BIFDEF_DEFINED_ANY;
    }

    /* get the offset of the property and the defining object */
    ofs = objgetap(ctx->bifcxrun->runcxmem, objn, prpn, &def_objn, FALSE);

    /* determine the type of information they want */
    switch(flag)
    {
    case BIFDEF_DEFINED_ANY:
        /* if the property is defined, return true, else return nil */
        runpush(ctx->bifcxrun, runclog(ofs != 0), &val);
        break;

    case BIFDEF_DEFINED_DIRECTLY:
        /* if the property is defined directly by the object, return true */
        runpush(ctx->bifcxrun, runclog(ofs != 0 && def_objn == objn), &val);
        break;
        
    case BIFDEF_DEFINED_INHERITS:
        /* if the property is inherited, return true */
        runpush(ctx->bifcxrun, runclog(ofs != 0 && def_objn != objn), &val);
        break;

    case BIFDEF_DEFINED_GET_CLASS:
        /* if it's defined, return the defining object, otherwise nil */
        if (ofs == 0)
            runpnil(ctx->bifcxrun);
        else
            runpobj(ctx->bifcxrun, def_objn);
        break;

    default:
        /* invalid flag value */
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "defined");
    }
}

/* proptype */
void bifpty(bifcxdef *ctx, int argc)
{
    prpnum   prpn;
    objnum   objn;
    uint     ofs;
    runsdef  val;
    objnum   orn;
    objdef  *objptr;
    prpdef  *propptr;

    bifcntargs(ctx, 2, argc);
    
    /* get offset of obj.prop */
    objn = runpopobj(ctx->bifcxrun);
    prpn = runpopprp(ctx->bifcxrun);
    ofs = objgetap(ctx->bifcxrun->runcxmem, objn, prpn, &orn, FALSE);
    
    if (ofs)
    {
        /* lock the object, read the prpdef, and unlock it */
        objptr = (objdef *)mcmlck(ctx->bifcxrun->runcxmem, (mcmon)orn);
        propptr = objofsp(objptr, ofs);
        val.runsv.runsvnum = prptype(propptr);
        mcmunlck(ctx->bifcxrun->runcxmem, (mcmon)orn);
    }
    else
    {
        /* property is not defined by object - indicate that type is nil */
        val.runsv.runsvnum = DAT_NIL;
    }
    
    /* special case:  DAT_DEMAND -> DAT_LIST (for contents properties) */
    if (val.runsv.runsvnum == DAT_DEMAND)
        val.runsv.runsvnum = DAT_LIST;

    /* return the property type as a number */
    runpush(ctx->bifcxrun, DAT_NUMBER, &val);
}

/* outhide */
void bifoph(bifcxdef *ctx, int argc)
{
    runsdef val;
    int     hidden, output_occurred;

    bifcntargs(ctx, 1, argc);
    outstat(&hidden, &output_occurred);
    if (runtostyp(ctx->bifcxrun) == DAT_TRUE)
    {
        /* throw away the flag */
        rundisc(ctx->bifcxrun);
        
        /* figure out appropriate return value */
        if (!hidden)
            val.runsv.runsvnum = 0;
        else if (!output_occurred)
            val.runsv.runsvnum = 1;
        else
            val.runsv.runsvnum = 2;
        runpush(ctx->bifcxrun, DAT_NUMBER, &val);

        /* actually hide the output, resetting count flag */
        outhide();
    }
    else if (runtostyp(ctx->bifcxrun) == DAT_NIL)
    {
        /* throw away the flag */
        rundisc(ctx->bifcxrun);

        /* show output, returning status */
        runpush(ctx->bifcxrun, runclog(outshow()), &val);
    }
    else if (runtostyp(ctx->bifcxrun) == DAT_NUMBER)
    {
        int n = runpopnum(ctx->bifcxrun);

        if (n == 0)
        {
            /* output was not hidden - show output and return status */
            runpush(ctx->bifcxrun, runclog(outshow()), &val);
        }
        else if (n == 1)
        {
            /*
             *   Output was hidden, but no output had occurred yet.
             *   Leave output hidden and return whether any output has
             *   occurred.
             */
            runpush(ctx->bifcxrun, runclog(output_occurred), &val);
        }
        else if (n == 2)
        {
            /*
             *   Output was hidden, and output had already occurred.  If
             *   more output has occurred, return true, else return nil.
             *   In either case, set the output_occurred flag back to
             *   true, since it was true before the outhide(true).  
             */
            runpush(ctx->bifcxrun, runclog(output_occurred), &val);
            outsethidden();
        }
        else
            errsig1(ctx->bifcxerr, ERR_INVVBIF, ERRTSTR, "outhide");
    }
    else
        errsig(ctx->bifcxerr, ERR_REQNUM);
}

/* put a numeric value in a list */
static uchar *bifputnum(uchar *lstp, uint val)
{
    *lstp++ = DAT_NUMBER;
    oswp4(lstp, (long)val);
    return(lstp + 4);
}

/* gettime */
void biftim(bifcxdef *ctx, int argc)
{
    time_t     timer;
    struct tm *tblock;
    uchar      ret[80];
    uchar     *p;
    runsdef    val;
    int        typ;

    if (argc == 1)
    {
        /* get the time type */
        typ = (int)runpopnum(ctx->bifcxrun);
    }
    else
    {
        /* make sure no arguments are specified */
        bifcntargs(ctx, 0, argc);

        /* use the default time type */
        typ = 1;
    }

    switch(typ)
    {
    case 1:
        /* 
         *   default information format - list format with current system
         *   time and date 
         */

        /* make sure the time zone is set up properly */
        os_tzset();
        
        /* get the local time information */
        timer = time(NULL);
        tblock = localtime(&timer);
        
        /* adjust values for return format */
        tblock->tm_year += 1900;
        tblock->tm_mon++;
        tblock->tm_wday++;
        tblock->tm_yday++;
        
        /* build return list value */
        oswp2(ret, 47);
        p = ret + 2;
        p = bifputnum(p, tblock->tm_year);
        p = bifputnum(p, tblock->tm_mon);
        p = bifputnum(p, tblock->tm_mday);
        p = bifputnum(p, tblock->tm_wday);
        p = bifputnum(p, tblock->tm_yday);
        p = bifputnum(p, tblock->tm_hour);
        p = bifputnum(p, tblock->tm_min);
        p = bifputnum(p, tblock->tm_sec);
        *p++ = DAT_NUMBER;
        oswp4(p, (long)timer);
        
        val.runstyp = DAT_LIST;
        val.runsv.runsvstr = ret;
        runpush(ctx->bifcxrun, DAT_LIST, &val);
        break;

    case 2:
        /*
         *   High-precision system timer value - returns the system time
         *   in milliseconds, relative to an arbitrary zero point 
         */
        runpnum(ctx->bifcxrun, os_get_sys_clock_ms());
        break;

    default:
        /* other types are invalid */
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "gettime");
        break;
    }
}

/* getfuse */
void bifgfu(bifcxdef *ctx, int argc)
{
    vocddef  *daem;
    objnum    func;
    runsdef   val;
    runcxdef *rcx = ctx->bifcxrun;
    int       slots;
    prpnum    prop;
    voccxdef *vcx = ctx->bifcxrun->runcxvoc;

    bifcntargs(ctx, 2, argc);
 
    if (runtostyp(rcx) == DAT_FNADDR)
    {
        /* check on a setfuse()-style fuse: get fnaddr, parm */
        func = runpopfn(rcx);
        runpop(rcx, &val);

        for (slots = vcx->voccxfuc, daem = vcx->voccxfus ;
             slots ; ++daem, --slots)
        {
            if (daem->vocdfn == func
                && daem->vocdarg.runstyp == val.runstyp
                && !memcmp(&val.runsv, &daem->vocdarg.runsv,
                           (size_t)datsiz(val.runstyp, &val.runsv)))
                goto ret_num;
        }
    }
    else
    {
        /* check on a notify()-style fuse: get object, &message */
        func = runpopobj(rcx);
        prop = runpopprp(rcx);

        for (slots = vcx->voccxalc, daem = vcx->voccxalm ;
             slots ; ++daem, --slots)
        {
            if (daem->vocdfn == func && daem->vocdprp == prop)
                goto ret_num;
        }
    }
    
    /* didn't find anything - return nil */
    runpush(rcx, DAT_NIL, &val);
    return;
    
ret_num:
    /* return current daem->vocdtim */
    runpnum(rcx, (long)daem->vocdtim);
    return;
}

/* runfuses */
void bifruf(bifcxdef *ctx, int argc)
{
    int     ret;
    runsdef val;

    bifcntargs(ctx, 0, argc);
    ret = exefuse(ctx->bifcxrun->runcxvoc, TRUE);
    runpush(ctx->bifcxrun, runclog(ret), &val);
}

/* rundaemons */
void bifrud(bifcxdef *ctx, int argc)
{
    bifcntargs(ctx, 0, argc);
    exedaem(ctx->bifcxrun->runcxvoc);
}

/* intersect */
void bifsct(bifcxdef *bifctx, int argc)
{
    runcxdef *ctx = bifctx->bifcxrun;
    uchar    *l1;
    uchar    *l2;
    uchar    *l3;
    uint      siz1;
    uint      siz2;
    uint      siz3;
    uchar    *p;
    uint      l;
    uint      dsz1;
    uint      dsz2;
    runsdef   val;
    runsdef   stk1, stk2;
    
    bifcntargs(bifctx, 2, argc);
    l1 = runpoplst(ctx);
    siz1 = osrp2(l1);
    l2 = runpoplst(ctx);
    siz2 = osrp2(l2);

    /* make sure the first list is smaller - if not, switch them */
    if (siz1 > siz2)
        l3 = l1, l1 = l2, l2 = l3, siz3 = siz1, siz1 = siz2, siz2 = siz3;
    
    /* size of result is at most size of smaller list (which is now siz1) */
    stk1.runstyp = stk2.runstyp = DAT_LIST;
    stk1.runsv.runsvstr = l1;
    stk2.runsv.runsvstr = l2;
    runhres2(ctx, siz1, 2, &stk1, &stk2);
    l1 = stk1.runsv.runsvstr;
    l2 = stk2.runsv.runsvstr;
    l3 = ctx->runcxhp + 2;

    /* go through list1, and copy each element that is found in list2 */
    for (l1 += 2, l2 += 2, siz1 -= 2, siz2 -= 2 ; siz1 ; lstadv(&l1, &siz1))
    {
        dsz1 = datsiz(*l1, l1 + 1) + 1;
        for (l = siz2, p = l2 ; l ; lstadv(&p, &l))
        {
            dsz2 = datsiz(*p, p + 1) + 1;
#ifndef AMIGA
            if (dsz1 == dsz2 && !memcmp(l1, p, (size_t)dsz1))
#else /* AMIGA */
            if (!memcmp(l1, p, (size_t)dsz1) && (dsz1 == dsz2) )
#endif /* AMIGA */
            {
                memcpy(l3, p, (size_t)dsz1);
                l3 += dsz1;
                break;
            }
        }
    }
    
    /* set up return value, take it out of the heap, and push value */
    val.runsv.runsvstr = ctx->runcxhp;
    val.runstyp = DAT_LIST;
    oswp2(ctx->runcxhp, (uint)(l3 - ctx->runcxhp));
    ctx->runcxhp = l3;
    runrepush(ctx, &val);
}

/*
 *   Portable keystroke mappings.  We map the extended key codes to these
 *   strings, so that the TADS code can access arrow keys and the like.  
 */
static char *ext_key_names[] =
{
    "[up]",                                                   /* CMD_UP - 1 */
    "[down]",                                               /* CMD_DOWN - 2 */
    "[right]",                                             /* CMD_RIGHT - 3 */
    "[left]",                                               /* CMD_LEFT - 4 */
    "[end]",                                                 /* CMD_END - 5 */
    "[home]",                                               /* CMD_HOME - 6 */
    "[del-eol]",                                            /* CMD_DEOL - 7 */
    "[del-line]",                                           /* CMD_KILL - 8 */
    "[del]",                                                 /* CMD_DEL - 9 */
    "[scroll]",                                             /* CMD_SCR - 10 */
    "[page up]",                                           /* CMD_PGUP - 11 */
    "[page down]",                                         /* CMD_PGDN - 12 */
    "[top]",                                                /* CMD_TOP - 13 */
    "[bottom]",                                             /* CMD_BOT - 14 */
    "[f1]",                                                  /* CMD_F1 - 15 */
    "[f2]",                                                  /* CMD_F2 - 16 */
    "[f3]",                                                  /* CMD_F3 - 17 */
    "[f4]",                                                  /* CMD_F4 - 18 */
    "[f5]",                                                  /* CMD_F5 - 19 */
    "[f6]",                                                  /* CMD_F6 - 20 */
    "[f7]",                                                  /* CMD_F7 - 21 */
    "[f8]",                                                  /* CMD_F8 - 22 */
    "[f9]",                                                  /* CMD_F9 - 23 */
    "[f10]",                                                /* CMD_F10 - 24 */
    "[?]",                                  /* invalid key - CMD_CHOME - 25 */
    "[tab]",                                                /* CMD_TAB - 26 */
    "[?]",                                   /* invalid key - shift-F2 - 27 */
    "[?]",                                      /* not used (obsolete) - 28 */
    "[word-left]",                                    /* CMD_WORD_LEFT - 29 */
    "[word-right]",                                  /* CMD_WORD_RIGHT - 30 */
    "[del-word]",                                      /* CMD_WORDKILL - 31 */
    "[eof]",                                                /* CMD_EOF - 32 */
};

/*
 *   Get the name of a keystroke.  Pass in the one or two characters
 *   returned by os_getc(), and we'll fill in the buffer with the
 *   inputkey() name of the keystroke.  Returns true if the key was valid,
 *   false if not.  'c' is the first character returned by os_getc() for
 *   the keystroke; if 'c' is zero, then 'extc' is the character returned
 *   by the second call to os_getc() to get the CMD_xxx code for the
 *   keystroke.
 *   
 *   The name buffer should be 20 characters long - this will ensure that
 *   any name will fit.  
 *   
 *   For ordinary, printable characters, we'll simply return the
 *   character; the letter 'a', for example, is returned as the string "a".
 *   
 *   For extended keys, we'll look up the CMD_xxx code and return the name
 *   of the command, enclosed in square brackets; see the ext_key_names
 *   table for the mappings.  The left-arrow cursor key, for example,
 *   returns "[left]".
 *   
 *   For control characters, we'll generate a name like "[ctrl-a]", except
 *   for the following characters:
 *   
 *.  ascii 10 returns "\n"
 *.  ascii 13 returns "\n"
 *.  ascii 9 returns "\t"
 *.  ascii 8 returns "[bksp]" 
 */
static int get_ext_key_name(char *namebuf, int c, int extc)
{
    /* if it's a control character, translate it */
    if (c >= 1 && c <= 27)
    {
        switch(c)
        {
        case 10:
        case 13:
            /* return '\n' for LF and CR characters */
            strcpy(namebuf, "\\n");
            return TRUE;

        case 9:
            /* return '\t' for TAB characters */
            strcpy(namebuf, "\\t");
            return TRUE;

        case 8:
            /* return '[bksp]' for backspace characters */
            strcpy(namebuf, "[bksp]");
            return TRUE;

        case 27:
            /* return '[esc]' for the escape key */
            strcpy(namebuf, "[esc]");
            return TRUE;

        default:
            /* return '[ctrl-X]' for other control characters */
            strcpy(namebuf, "[ctrl-X]");
            namebuf[6] = (char)(c + 'a' - 1);
            return TRUE;
        }
    }

    /* if it's any other non-extended key, return it as-is */
    if (c != 0)
    {
        namebuf[0] = c;
        namebuf[1] = '\0';
        return TRUE;
    }
    
    /* if it's in the key name array, use the array entry */
    if (extc >= 1
        && extc <= (int)(sizeof(ext_key_names)/sizeof(ext_key_names[0])))
    {
        /* use the array name */
        strcpy(namebuf, ext_key_names[extc - 1]);
        return TRUE;
    }

    /* if it's in the ALT key range, generate an ALT key name */
    if (extc >= CMD_ALT && extc <= CMD_ALT + 25)
    {
        /* generate an ALT key name */
        strcpy(namebuf, "[alt-X]");
        namebuf[5] = (char)(extc - CMD_ALT + 'a');
        return TRUE;
    }

    /* it's not a valid key - use '[?]' as the name */
    strcpy(namebuf, "[?]");
    return FALSE;
}


/* inputkey */
void bifink(bifcxdef *ctx, int argc)
{
    int    c;
    int    extc;
    char   str[20];
    size_t len;
    
    bifcntargs(ctx, 0, argc);
    tioflushn(ctx->bifcxtio, 0);

    /* get a key */
    c = os_getc_raw();

    /* if it's extended, get the second part of the extended sequence */
    extc = (c == 0 ? os_getc_raw() : 0);

    /* map the extended key name */
    get_ext_key_name(str, c, extc);

    /* get the length of the name */
    len = strlen(str);

    /* reset the [more] counter */
    outreset();

    /* return the string, translating escapes */
    runpstr(ctx->bifcxrun, str, len, 0);
}

/* get direct/indirect object word list */
void bifwrd(bifcxdef *ctx, int argc)
{
    int       ob;
    vocoldef *v;
    uchar     buf[128];
    uchar    *dst;
    uchar    *src;
    uint      len;
    runsdef   val;
    
    bifcntargs(ctx, 1, argc);

    /* figure out what word list to get */
    ob = runpopnum(ctx->bifcxrun);
    switch(ob)
    {
    case 1:
        v = ctx->bifcxrun->runcxvoc->voccxdobj;
        break;

    case 2:
        v = ctx->bifcxrun->runcxvoc->voccxiobj;
        break;

    default:
        runpnil(ctx->bifcxrun);
        return;
    }

    /* now build a list of strings from the words, if there are any */
    if (v != 0 && voclistlen(v) != 0 && v->vocolfst != 0 && v->vocollst != 0)
    {
        for (dst = buf + 2, src = (uchar *)v->vocolfst ;
             src <= (uchar *)v->vocollst ; src += len + 1)
        {
            *dst++ = DAT_SSTRING;
            len = strlen((char *)src);
            oswp2(dst, len + 2);
            strcpy((char *)dst + 2, (char *)src);
            dst += len + 2;
        }
    }
    else
        dst = buf + 2;

    /* finish setting up the list length and return it */
    len = dst - buf;
    oswp2(buf, len);
    val.runsv.runsvstr = buf;
    val.runstyp = DAT_LIST;
    runpush(ctx->bifcxrun, DAT_LIST, &val);
}

/* add a vocabulary word to an object */
void bifadw(bifcxdef *ctx, int argc)
{
    uchar    *wrd;
    objnum    objn;
    prpnum    prpn;
    vocidef  *voci;
    int       classflg;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;

    bifcntargs(ctx, 3, argc);

    /* get the arguments */
    objn = runpopobj(ctx->bifcxrun);
    prpn = runpopprp(ctx->bifcxrun);
    wrd = runpopstr(ctx->bifcxrun);

    /* make sure the property is a valid part of speech property */
    if (!prpisvoc(prpn))
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "addword");

    /* get the vocidef for the object, and see if it's a class object */
    voci = vocinh(voc, objn);

    classflg = VOCFNEW;
    if (voci->vociflg & VOCIFCLASS) classflg |= VOCFCLASS;

    /* add the word */
    vocadd(voc, prpn, objn, classflg, (char *)wrd);

    /* generate undo for the operation */
    vocdusave_addwrd(voc, objn, prpn, classflg, (char *)wrd);
}

/* delete a vocabulary word from an object */
void bifdlw(bifcxdef *ctx, int argc)
{
    uchar    *wrd;
    objnum    objn;
    prpnum    prpn;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;

    bifcntargs(ctx, 3, argc);

    /* get the arguments */
    objn = runpopobj(ctx->bifcxrun);
    prpn = runpopprp(ctx->bifcxrun);
    wrd = runpopstr(ctx->bifcxrun);

    /* make sure the property is a valid part of speech property */
    if (!prpisvoc(prpn))
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "delword");

    /* delete the word */
    vocdel1(voc, objn, (char *)wrd, prpn, FALSE, FALSE, TRUE);
}

/* callback context for word list builder */
struct bifgtw_cb_ctx
{
    uchar *p;
    int    typ;
};

/* callback for word list builder */
static void bifgtw_cb(void *ctx0, vocdef *voc, vocwdef *vocw)
{
    struct bifgtw_cb_ctx *ctx = (struct bifgtw_cb_ctx *)ctx0;

    /* ignore deleted objects */
    if (vocw->vocwflg & VOCFDEL)
        return;

    /* ignore objects of the inappropriate type */
    if (vocw->vocwtyp != ctx->typ)
        return;
    
    /* the datatype is string */
    *ctx->p = DAT_SSTRING;

    /* copy the first word */
    memcpy(ctx->p + 3, voc->voctxt, (size_t)voc->voclen);

    /* if there are two words, add a space and the second word */
    if (voc->vocln2)
    {
        *(ctx->p + 3 + voc->voclen) = ' ';
        memcpy(ctx->p + 4 + voc->voclen, voc->voctxt + voc->voclen,
               (size_t)voc->vocln2);
        oswp2(ctx->p + 1, voc->voclen + voc->vocln2 + 3);
        ctx->p += voc->voclen + voc->vocln2 + 4;
    }
    else
    {
        oswp2(ctx->p + 1, voc->voclen+2);
        ctx->p += voc->voclen + 3;
    }
}

/* get the list of words for an object for a particular part of speech */
void bifgtw(bifcxdef *ctx, int argc)
{
    objnum    objn;
    prpnum    prpn;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    int       cnt;
    int       siz;
    runsdef   val;
    struct bifgtw_cb_ctx fnctx;

    bifcntargs(ctx, 2, argc);

    /* get the arguments */
    objn = runpopobj(ctx->bifcxrun);
    prpn = runpopprp(ctx->bifcxrun);
    
    /* make sure the property is a valid part of speech property */
    if (!prpisvoc(prpn))
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "delword");

    /* get the size of the list we'll need to build */
    voc_count(voc, objn, prpn, &cnt, &siz);

    /*
     *   calculate how much space it will take to make a list out of all
     *   these words: 2 bytes for the list length header; plus, for each
     *   entry, 1 byte for the type header, 2 bytes for the string size
     *   header, and possibly one extra byte for the two-word separator --
     *   a total of 4 bytes extra per word.  
     */
    siz += 2 + 4*cnt;

    /* reserve the space */
    runhres(ctx->bifcxrun, siz, 0);

    /* set up our callback context, and build the list */
    fnctx.p = ctx->bifcxrun->runcxhp + 2;
    fnctx.typ = prpn;
    voc_iterate(voc, objn, bifgtw_cb, &fnctx);

    /* set up the return value */
    val.runstyp = DAT_LIST;
    val.runsv.runsvstr = ctx->bifcxrun->runcxhp;

    /* write the list length, and advance past the space we used */
    oswp2(ctx->bifcxrun->runcxhp, fnctx.p - ctx->bifcxrun->runcxhp);
    ctx->bifcxrun->runcxhp = fnctx.p;

    /* return the list */
    runrepush(ctx->bifcxrun, &val);
}

/* verbinfo service routine - add an object to the output list */
static uchar *bifvin_putprpn(uchar *p, prpnum prpn)
{
    *p++ = DAT_PROPNUM;
    oswp2(p, prpn);
    return p + 2;
}

/* verbinfo */
void bifvin(bifcxdef *ctx, int argc)
{
    objnum  verb;
    objnum  prep;
    uchar   tplbuf[VOCTPL2SIZ];
    int     newstyle;

    /* get the verb */
    verb = runpopobj(ctx->bifcxrun);
    
    /* check for the presence of a preposition */
    if (argc == 1)
    {
        /* no preposition */
        prep = MCMONINV;
    }
    else
    {
        /* the second argument is the preposition */
        bifcntargs(ctx, 2, argc);
        prep = runpopobj(ctx->bifcxrun);
    }

    /* look up the template */
    if (voctplfnd(ctx->bifcxrun->runcxvoc, verb, prep, tplbuf, &newstyle))
    {
        prpnum   prp_do, prp_verdo, prp_io, prp_verio;
        int      flg_dis_do;
        ushort   siz;
        uchar   *p;
        runsdef  val;

        /* get the information from the template */
        prp_do     = voctpldo(tplbuf);
        prp_verdo  = voctplvd(tplbuf);
        prp_io     = voctplio(tplbuf);
        prp_verio  = voctplvi(tplbuf);
        flg_dis_do = (voctplflg(tplbuf) & VOCTPLFLG_DOBJ_FIRST) != 0;

        /*
         *   figure space for the return value: if there's a prep, three
         *   property pointers plus a boolean, otherwise just two property
         *   pointers 
         */
        siz = 2 + 2*(2+1);
        if (prep != MCMONINV)
            siz += (2+1) + 1;

        /* reserve the space */
        runhres(ctx->bifcxrun, siz, 0);

        /* build the output list */
        p = ctx->bifcxrun->runcxhp;
        oswp2(p, siz);
        p += 2;

        p = bifvin_putprpn(p, prp_verdo);
        if (prep == MCMONINV)
        {
            p = bifvin_putprpn(p, prp_do);
        }
        else
        {
            p = bifvin_putprpn(p, prp_verio);
            p = bifvin_putprpn(p, prp_io);
            *p++ = runclog(flg_dis_do);
        }

        /* build the return value */
        val.runstyp = DAT_LIST;
        val.runsv.runsvstr = ctx->bifcxrun->runcxhp;

        /* consume the space */
        ctx->bifcxrun->runcxhp += siz;

        /* return the list */
        runrepush(ctx->bifcxrun, &val);
    }
    else
    {
        /* no template for this verb - return nil */
        runpnil(ctx->bifcxrun);
    }
}


/* clearscreen */
void bifcls(bifcxdef *ctx, int argc)
{
    /* this takes no arguments */
    bifcntargs(ctx, 0, argc);

    /* flush any pending output */
    tioflushn(ctx->bifcxtio, 0);
    
    /* clear the screen */
    oscls();
}

/*
 *   File operations 
 */

/*
 *   fopen(file, mode).
 *   
 *   Operations are allowed only if they conform to the current I/O safety
 *   level.  The safety level can be set by the user on the command line
 *   when running the game, and some implementations may allow the setting
 *   to be saved as a preference.  The possible levels are:
 *   
 *.  0 - minimum safety - read and write in any directory
 *.  1 - read in any directory, write in current directory
 *.  2 - read-only access in any directory
 *.  3 - read-only access in current directory only
 *.  4 - maximum safety - no file I/O allowed
 *   
 *   When operations are allowed only in the current directory, the
 *   operations will fail if the filename contains any sort of path
 *   specifier (for example, on Unix, any file that contains a '/' is
 *   considered to have a path specifier, and will always fail if
 *   operations are only allowed in the current directory).  
 */
void biffopen(bifcxdef *ctx, int argc)
{
    char      fname[OSFNMAX];
    uchar    *p;
    uchar    *mode;
    int       modelen;
    int       fnum;
    osfildef *fp;
    int       bin_mode = TRUE;   /* flag: mode is binary (rather than text) */
    int       rw_mode = FALSE;     /* flag: both read and write are allowed */
    char      main_mode;                     /* 'r' for read, 'w' for write */
    int       in_same_dir;            /* flag: file is in current directory */
    appctxdef *appctx;
    
    bifcntargs(ctx, 2, argc);

    /* get the filename */
    p = runpopstr(ctx->bifcxrun);
    bifcstr(ctx, fname, (size_t)sizeof(fname), p);

    /* get the mode string */
    mode = runpopstr(ctx->bifcxrun);
    modelen = osrp2(mode) - 2;
    mode += 2;
    if (modelen < 1)
        goto bad_mode;

    /* allocate a filenum for the file */
    for (fnum = 0 ; fnum < BIFFILMAX ; ++fnum)
    {
        if (ctx->bifcxfile[fnum].fp == 0)
            break;
    }
    if (fnum == BIFFILMAX)
    {
        /* return nil to indicate failure */
        runpnil(ctx->bifcxrun);
        return;
    }

    /* parse the main mode */
    switch(*mode)
    {
    case 'w':
    case 'W':
        main_mode = 'w';
        break;

    case 'r':
    case 'R':
        main_mode = 'r';
        break;

    default:
        goto bad_mode;
    }

    /* skip the main mode, and check for a '+' flag */
    ++mode;
    --modelen;
    if (modelen > 0 && *mode == '+')
    {
        /* note the read/write mode */
        rw_mode = TRUE;

        /* skip the speciifer */
        ++mode;
        --modelen;
    }

    /* check for a binary/text specifier */
    if (modelen > 0)
    {
        switch(*mode)
        {
        case 'b':
        case 'B':
            bin_mode = TRUE;
            break;

        case 't':
        case 'T':
            bin_mode = FALSE;
            break;

        default:
            goto bad_mode;
        }

        /* skip the binary/text specifier */
        ++mode;
        --modelen;
    }

    /* it's an error if there's anything left unparsed */
    if (modelen > 0)
        goto bad_mode;

    /*
     *   If we have a host application context, and it provides a file
     *   safety level callback function, ask the host system for its
     *   current file safety level, which overrides our current setting.  
     */
    appctx = ctx->bifcxappctx;
    if (appctx != 0 && appctx->get_io_safety_level != 0)
    {
        /* 
         *   ask the host system for the current level, and override any
         *   setting we previously had 
         */
        ctx->bifcxsafety =
            (*appctx->get_io_safety_level)(appctx->io_safety_level_ctx);
    }

    /* 
     *   Check to see if the file is in the current directory - if not, we
     *   may have to disallow the operation based on safety level
     *   settings.  If the file has any sort of directory prefix, assume
     *   it's not in the same directory; if not, it must be.  This is
     *   actually overly conservative, since the path may be a relative
     *   path or even an absolute path that points to the current
     *   directory, but the important thing is whether we're allowing
     *   files to specify paths at all.  
     */
    in_same_dir = (os_get_root_name(fname) == fname);

    /* check file safety settings */
    switch(main_mode)
    {
    case 'w':
        /* 
         *   writing - we must be safety level 1 (read anywhere/write
         *   current directory) or lower to write at all, and we must be
         *   safety level 0 to write a file that's not in the current
         *   directory 
         */
        if (ctx->bifcxsafety > 1
            || (!in_same_dir && ctx->bifcxsafety > 0))
        {
            /* this operation is not allowed - return failure */
            runpnil(ctx->bifcxrun);
            return;
        }
        break;

    case 'r':
        /*
         *   reading - we must be at a safety level no higher than 3 (read
         *   current directory) to read at all, and we must be safety
         *   level 2 (read any directory) or lower to read a file that's
         *   not in the current directory 
         */
        if (ctx->bifcxsafety > 3
            || (!in_same_dir && ctx->bifcxsafety > 2))
        {
            /* this operation is not allowed - return failure */
            runpnil(ctx->bifcxrun);
            return;
        }
        break;

    default:
        /* 
         *   fail the operation, as a code maintenance measure to make
         *   sure that we add appropriate cases to this switch (even if
         *   merely to allow the operation unconditionally) in the event
         *   that more modes are added in the future 
         */
        goto bad_mode;
    }

    /* try opening the file */
    switch(main_mode)
    {
    case 'w':
        /* check for binary vs text mode */
        if (bin_mode)
        {
            /* 
             *   binary mode -- allow read/write or just writing, but in
             *   either case truncate the file if it already exists, and
             *   create a new file if it doesn't exist 
             */
            if (rw_mode)
                fp = osfoprwtb(fname, OSFTDATA);
            else
                fp = osfopwb(fname, OSFTDATA);
        }
        else
        {
            /* text mode - don't allow read/write on a text file */
            if (rw_mode)
                goto bad_mode;

            /* open the file */
            fp = osfopwt(fname, OSFTTEXT);
        }
        break;

    case 'r':
        /* check for binary vs text mode */
        if (bin_mode)
        {
            /*
             *   Binary mode -- allow read/write or just reading; leave
             *   any existing file intact.
             */
            if (rw_mode)
            {
                /* open for reading and writing, keeping existing data */
                fp = osfoprwb(fname, OSFTDATA);
            }
            else
            {
                /* open for read-only */
                fp = osfoprb(fname, OSFTDATA);
            }
        }
        else
        {
            /* text mode -- only allow reading */
            if (rw_mode)
                goto bad_mode;

            /* open the file */
            fp = osfoprt(fname, OSFTTEXT);
        }
        break;

    default:
        goto bad_mode;
    }

    /* if we couldn't open it, return nil */
    if (fp == 0)
    {
        runpnil(ctx->bifcxrun);
        return;
    }

    /* store the flags */
    ctx->bifcxfile[fnum].flags = 0;
    if (bin_mode)
        ctx->bifcxfile[fnum].flags |= BIFFIL_F_BINARY;

    /* remember the file handle */
    ctx->bifcxfile[fnum].fp = fp;

    /* return the file number (i.e., the slot number) */
    runpnum(ctx->bifcxrun, (long)fnum);
    return;


    /* come here on a mode error */
bad_mode:
    runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "fopen");
}
              
/* service routine for file routines - get and validate a file number */
static osfildef *bif_get_file(bifcxdef *ctx, int *fnump, int *bin_modep)
{
    long fnum;

    /* get the file number and make sure it's valid */
    fnum = runpopnum(ctx->bifcxrun);
    if (fnum < 0 || fnum >= BIFFILMAX || ctx->bifcxfile[fnum].fp == 0)
        runsig(ctx->bifcxrun, ERR_BADFILE);

    /* put the validated file number, if the caller wants it */
    if (fnump != 0)
        *fnump = (int)fnum;

    /* set the binary-mode flag, if the caller wants it */
    if (bin_modep != 0)
        *bin_modep = ((ctx->bifcxfile[fnum].flags & BIFFIL_F_BINARY) != 0);

    /* return the file array pointer */
    return ctx->bifcxfile[fnum].fp;
}

void biffclose(bifcxdef *ctx, int argc)
{
    int       fnum;
    osfildef *fp;

    /* get the file number */
    bifcntargs(ctx, 1, argc);
    fp = bif_get_file(ctx, &fnum, 0);

    /* close the file and release the slot */
    osfcls(fp);
    ctx->bifcxfile[fnum].fp = 0;
}
              
void bifftell(bifcxdef *ctx, int argc)
{
    osfildef *fp;

    /* get the file number */
    bifcntargs(ctx, 1, argc);
    fp = bif_get_file(ctx, (int *)0, 0);

    /* return the seek position */
    runpnum(ctx->bifcxrun, osfpos(fp));
}
              
void biffseek(bifcxdef *ctx, int argc)
{
    osfildef *fp;
    long      pos;

    /* get the file pointer */
    bifcntargs(ctx, 2, argc);
    fp = bif_get_file(ctx, (int *)0, 0);

    /* get the seek position, and seek there */
    pos = runpopnum(ctx->bifcxrun);
    osfseek(fp, pos, OSFSK_SET);
}
              
void biffseekeof(bifcxdef *ctx, int argc)
{
    osfildef *fp;

    /* get the file pointer */
    bifcntargs(ctx, 1, argc);
    fp = bif_get_file(ctx, (int *)0, 0);

    /* seek to the end */
    osfseek(fp, 0L, OSFSK_END);
}
              
void biffwrite(bifcxdef *ctx, int argc)
{
    osfildef *fp;
    char      typ;
    char      buf[32];
    runsdef   val;
    int       bin_mode;
    
    /* get the file */
    bifcntargs(ctx, 2, argc);
    fp = bif_get_file(ctx, (int *)0, &bin_mode);

    /* get the value to write */
    runpop(ctx->bifcxrun, &val);
    typ = val.runstyp;

    if (bin_mode)
    {
        /* put a byte indicating the type */
        if (osfwb(fp, &typ, 1))
            goto ret_error;
        
        /* see what type of data we want to put */
        switch(typ)
        {
        case DAT_NUMBER:
            oswp4(buf, val.runsv.runsvnum);
            if (osfwb(fp, buf, 4))
                goto ret_error;
            break;
            
        case DAT_SSTRING:
            /* write the string, including the length prefix */
            if (osfwb(fp, val.runsv.runsvstr, osrp2(val.runsv.runsvstr)))
                goto ret_error;
            break;
            
        case DAT_TRUE:
            /* all we need for this is the type prefix */
            break;
            
        default:
            /* other types are not acceptable */
            runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "fwrite");
        }
    }
    else
    {
        uint rem;
        uchar *p;
        
        switch(typ)
        {
        case DAT_SSTRING:
            /*
             *   Copy and translate the string to our buffer, in pieces if
             *   the size of the string exceeds that of our buffer.  If we
             *   encounter any escape codes, translate them.  
             */
            rem = osrp2(val.runsv.runsvstr) - 2;
            p = val.runsv.runsvstr + 2;
            while (rem > 0)
            {
                uchar *dst;
                uchar buf[256];

                /* fill up the buffer */
                for (dst = buf ;
                     rem != 0 && (size_t)(dst - buf) < sizeof(buf) - 1 ;
                     ++p, --rem)
                {
                    /* if we have an escape character, translate it */
                    if (*p == '\\' && rem > 1)
                    {
                        /* skip the opening slash */
                        ++p;
                        --rem;

                        /* translate it */
                        switch(*p)
                        {
                        case 'n':
                            *dst++ = '\n';
                            break;

                        case 't':
                            *dst++ = '\t';
                            break;

                        default:
                            *dst++ = *p;
                            break;
                        }
                    }
                    else
                    {
                        /* copy this character directly */
                        *dst++ = *p;
                    }
                }

                /* null-terminate the buffer */
                *dst = '\0';

                /* write it out */
                if (osfputs((char *)buf, fp) == EOF)
                    goto ret_error;
            }

            /* done */
            break;

        default:
            /* other types are not allowed */
            runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "fwrite");
        }
    }

    /* success */
    runpnil(ctx->bifcxrun);
    return;

ret_error:
    val.runstyp = DAT_TRUE;
    runpush(ctx->bifcxrun, DAT_TRUE, &val);
}
              
void biffread(bifcxdef *ctx, int argc)
{
    osfildef *fp;
    char      typ;
    char      buf[32];
    runsdef   val;
    ushort    len;
    int       bin_mode;

    /* get the file pointer */
    bifcntargs(ctx, 1, argc);
    fp = bif_get_file(ctx, (int *)0, &bin_mode);

    if (bin_mode)
    {
        /* binary file - read the type byte */
        if (osfrb(fp, &typ, 1))
            goto ret_error;
        
        /* read the data according to the type */
        switch(typ)
        {
        case DAT_NUMBER:
            if (osfrb(fp, buf, 4))
                goto ret_error;
            runpnum(ctx->bifcxrun, osrp4(buf));
            break;
            
        case DAT_SSTRING:
            /* get the size */
            if (osfrb(fp, buf, 2))
                goto ret_error;
            len = osrp2(buf);
            
            /* reserve space */
            runhres(ctx->bifcxrun, len, 0);
            
            /* read the string into the reserved space */
            if (osfrb(fp, ctx->bifcxrun->runcxhp + 2, len - 2))
                goto ret_error;
            
            /* set up the string */
            oswp2(ctx->bifcxrun->runcxhp, len);
            val.runstyp = DAT_SSTRING;
            val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
            
            /* consume the space */
            ctx->bifcxrun->runcxhp += len;
            
            /* push the value */
            runrepush(ctx->bifcxrun, &val);
            break;
            
        case DAT_TRUE:
            val.runstyp = DAT_TRUE;
            runpush(ctx->bifcxrun, DAT_TRUE, &val);
            break;
            
        default:
            goto ret_error;
        }
    }
    else
    {
        uchar  buf[257];
        uchar *dst;
        uchar *src;
        uint   len;
        uint   res_total;
        int    found_nl;

        /* 
         *   reserve some space in the heap - we'll initially reserve
         *   space for twice our buffer, in case every single character
         *   needs to be expanded into an escape sequence
         */
        res_total = sizeof(buf) * 2;
        runhres(ctx->bifcxrun, res_total, 0);

        /* set up our output value */
        val.runstyp = DAT_SSTRING;
        val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
        dst = ctx->bifcxrun->runcxhp + 2;

        /* keep going until we find a newline or run out of data */
        for (found_nl = FALSE ; !found_nl ; )
        {
            /* text-mode - read the result into our buffer */
            if (!osfgets((char *)buf, sizeof(buf) - 1, fp))
            {
                /* 
                 *   if we found a newline, return what we have;
                 *   otherwise, return an error 
                 */
                if (found_nl)
                    break;
                else
                    goto ret_error;
            }
            
            /* 
             *   make sure it's null-terminated, in case the buffer was
             *   full 
             */
            buf[256] = '\0';
            
            /* translate into the heap area we've reserved */
            for (src = buf ; *src != '\0' ; ++src, ++dst)
            {
                /* determine if we need translations */
                switch(*src)
                {
                case '\n':
                case '\r':
                    /* translate to a newline sequence */
                    *dst++ = '\\';
                    *dst = 'n';
                    
                    /* note that we've found our newline */
                    found_nl = TRUE;
                    break;
                    
                case '\t':
                    /* translate to a tab sequence */
                    *dst++ = '\\';
                    *dst = 't';
                    break;
                    
                case '\\':
                    /* expand to a double-backslash sequence */
                    *dst++ = '\\';
                    *dst = '\\';
                    break;

                default:
                    /* leave other characters intact */
                    *dst = *src;
                    break;
                }
            }

            /*
             *   If we didn't find the newline, we'll need more space.
             *   This is a bit tricky, because the space we've already set
             *   up may move if we compact the heap while asking for more
             *   space.  So, remember our current length, reserve another
             *   buffer-full of space, and set everything up at the new
             *   output location if necessary.  
             */
            if (!found_nl)
            {
                /* reserve another buffer-full (double for expansion) */
                res_total += sizeof(buf) * 2;

                /* note our current offset */
                len = dst - val.runsv.runsvstr;
                oswp2(val.runsv.runsvstr, len);

                /* ask for the space */
                runhres(ctx->bifcxrun, res_total, 0);

                /* 
                 *   Since we were at the top of the heap before, we
                 *   should still be at the top of the heap.  If not,
                 *   we'll have to copy from our old location to the new
                 *   top of the heap.  
                 */
                if (val.runsv.runsvstr != ctx->bifcxrun->runcxhp)
                {
                    /* copy our existing text to our new location */
                    memmove(ctx->bifcxrun->runcxhp, val.runsv.runsvstr, len);

                    /* fix up our pointer */
                    val.runsv.runsvstr = ctx->bifcxrun->runcxhp;
                }

                /* re-establish our output pointer at our new location */
                dst = val.runsv.runsvstr + len;
            }
        }

        /* finish setting up the string */
        len = dst - val.runsv.runsvstr;
        oswp2(val.runsv.runsvstr, len);

        /* consume the space */
        ctx->bifcxrun->runcxhp += len;

        /* push the value */
        runrepush(ctx->bifcxrun, &val);
    }

    /* success - we've already pushed the return value */
    return;

ret_error:
    runpnil(ctx->bifcxrun);
}

void bifcapture(bifcxdef *ctx, int argc)
{
    mcmcxdef *mcx = ctx->bifcxrun->runcxmem;
    mcmon     obj;
    uint      siz;
    uint      ofs;
    uchar    *p;

    /* get the capture on/off flag */
    bifcntargs(ctx, 1, argc);
    switch(runtostyp(ctx->bifcxrun))
    {
    case DAT_TRUE:
        /* turn on capturing */
        tiocapture(ctx->bifcxtio, mcx, TRUE);

        /*
         *   The return value is a status code used to restore the
         *   original status on the bracketing call to turn off output.
         *   The only status necessary is the current output size. 
         */
        siz = tiocapturesize(ctx->bifcxtio);
        runpnum(ctx->bifcxrun, (long)siz);
        break;

    case DAT_NUMBER:
        /* get the original offset */
        ofs = runpopnum(ctx->bifcxrun);

        /* get the capture object and size */
        obj = tiogetcapture(ctx->bifcxtio);
        siz = tiocapturesize(ctx->bifcxtio);
        if (obj == MCMONINV)
        {
            runpnil(ctx->bifcxrun);
            return;
        }

        /* turn off capturing and reset the buffer on the outermost call */
        if (ofs == 0)
        {
            tiocapture(ctx->bifcxtio, mcx, FALSE);
            tioclrcapture(ctx->bifcxtio);
        }

        /* lock the object */
        p = mcmlck(mcx, obj);

        /* include only the part that happened after the matching call */
        p += ofs;
        siz = (ofs > siz) ? 0 : siz - ofs;

        ERRBEGIN(ctx->bifcxerr)

        /* push the string onto the stack */
        runpstr(ctx->bifcxrun, (char *)p, siz, 0);
        
        ERRCLEAN(ctx->bifcxerr)
            /* done with the object - unlock it */
            mcmunlck(mcx, obj);
        ERRENDCLN(ctx->bifcxerr)

        /* done with the object - unlock it */
        mcmunlck(mcx, obj);
        break;

    default:
        runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "outcapture");
    }
}

/*
 *   systemInfo 
 */
void bifsysinfo(bifcxdef *ctx, int argc)
{
    runsdef val;
    int id;
    long result;

    /* see what we have */
    switch(id = (int)runpopnum(ctx->bifcxrun))
    {
    case SYSINFO_SYSINFO:
        /* systemInfo call is supported in this version - return true */
        bifcntargs(ctx, 1, argc);
        val.runstyp = DAT_TRUE;
        runpush(ctx->bifcxrun, DAT_TRUE, &val);
        break;

    case SYSINFO_VERSION:
        /* get the run-time version string */
        bifcntargs(ctx, 1, argc);
        runpushcstr(ctx->bifcxrun, TADS_RUNTIME_VERSION,
                    strlen(TADS_RUNTIME_VERSION), 0);
        break;

    case SYSINFO_OS_NAME:
        /* get the operating system name */
        bifcntargs(ctx, 1, argc);
        runpushcstr(ctx->bifcxrun, OS_SYSTEM_NAME, strlen(OS_SYSTEM_NAME), 0);
        break;
        
    case SYSINFO_HTML:
    case SYSINFO_JPEG:
    case SYSINFO_PNG:
    case SYSINFO_WAV:
    case SYSINFO_MIDI:
    case SYSINFO_WAV_MIDI_OVL:
    case SYSINFO_WAV_OVL:
    case SYSINFO_PREF_IMAGES:
    case SYSINFO_PREF_SOUNDS:
    case SYSINFO_PREF_MUSIC:
    case SYSINFO_PREF_LINKS:
    case SYSINFO_MPEG:
    case SYSINFO_MPEG1:
    case SYSINFO_MPEG2:
    case SYSINFO_MPEG3:
    case SYSINFO_LINKS_HTTP:
    case SYSINFO_LINKS_FTP:
    case SYSINFO_LINKS_NEWS:
    case SYSINFO_LINKS_MAILTO:
    case SYSINFO_LINKS_TELNET:
    case SYSINFO_PNG_TRANS:
    case SYSINFO_PNG_ALPHA:
    case SYSINFO_OGG:
    case SYSINFO_MNG:
    case SYSINFO_MNG_TRANS:
    case SYSINFO_MNG_ALPHA:
    case SYSINFO_TEXT_HILITE:
    case SYSINFO_INTERP_CLASS:
        /* 
         *   these information types are all handled by the OS layer, and
         *   take no additional arguments 
         */
        bifcntargs(ctx, 1, argc);
        if (os_get_sysinfo(id, 0, &result))
        {
            /* we got a valid result - return it */
            runpnum(ctx->bifcxrun, result);
        }
        else
        {
            /* the code was unknown - return nil */
            runpnil(ctx->bifcxrun);
        }
        break;

    case SYSINFO_HTML_MODE:
        /* ask the output formatter for its current HTML setting */
        bifcntargs(ctx, 1, argc);
        val.runstyp = runclog(tio_is_html_mode());
        runpush(ctx->bifcxrun, val.runstyp, &val);
        break;

    case SYSINFO_TEXT_COLORS:
        /* 
         *   Text colors are only supported in full HTML interpreters.  If
         *   this is an HTML interpreter, ask the underlying OS layer about
         *   color support; otherwise, colors are not available, since we
         *   don't handle colors in our text-only HTML subset.
         *   
         *   Colors are NOT supported in the HTML mini-parser in text-only
         *   interpreters in TADS 2.  So, even if we're running in HTML
         *   mode, if this is a text-only interpreter, we can't display text
         *   colors.  
         */
        bifcntargs(ctx, 1, argc);
        if (os_get_sysinfo(SYSINFO_HTML, 0, &result) && result != 0)
        {
            /* 
             *   we're in HTML mode, so ask the underlying HTML OS
             *   implementation for its level of text color support 
             */
            if (os_get_sysinfo(id, 0, &result))
            {
                /* push the OS-level result */
                runpnum(ctx->bifcxrun, result);
            }
            else
            {
                /* the OS code doesn't recognize it; assume no support */
                runpnum(ctx->bifcxrun, SYSINFO_TXC_NONE);
            }
        }
        else
        {
            /* we're a text-only interpreter - no color support */
            runpnum(ctx->bifcxrun, SYSINFO_TXC_NONE);
        }
        break;

    case SYSINFO_BANNERS:
        /* TADS 2 does not offer banner support */
        bifcntargs(ctx, 1, argc);
        runpnum(ctx->bifcxrun, 0);
        break;
        
    default:
        /* 
         *   Other codes fail harmlessly with a nil return value.  Pop all
         *   remaining arguments and return nil. 
         */
        for ( ; argc > 1 ; --argc)
            rundisc(ctx->bifcxrun);
        runpnil(ctx->bifcxrun);
        break;
    }
}

/*
 *   morePrompt - display the more prompt and wait for the user to respond 
 */
void bifmore(bifcxdef *ctx, int argc)
{
    /* this function takes no arguments */
    bifcntargs(ctx, 0, argc);

    /* display the MORE prompt */
    tioflushn(ctx->bifcxtio, 1);
    out_more_prompt();
}

/*
 *   parserSetMe 
 */
void bifsetme(bifcxdef *ctx, int argc)
{
    objnum new_me;
    
    /* this function takes one argument */
    bifcntargs(ctx, 1, argc);

    /* get the new "Me" object */
    new_me = runpopobj(ctx->bifcxrun);

    /* "Me" cannot be nil */
    if (new_me == MCMONINV)
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "parserSetMe");

    /* set the current "Me" object in the parser */
    voc_set_me(ctx->bifcxrun->runcxvoc, new_me);
}

/*
 *   parserGetMe 
 */
void bifgetme(bifcxdef *ctx, int argc)
{
    /* this function takes no arguments */
    bifcntargs(ctx, 0, argc);

    /* return the current Me object */
    runpobj(ctx->bifcxrun, ctx->bifcxrun->runcxvoc->voccxme);
}

/*
 *   reSearch 
 */
void bifresearch(bifcxdef *ctx, int argc)
{
    uchar  *patstr;
    size_t  patlen;
    uchar  *searchstr;
    size_t  searchlen;
    int     result_len;
    int     match_ofs;
    
    /* this function takes two parameters: pattern, string */
    bifcntargs(ctx, 2, argc);

    /* get the pattern string */
    patstr = runpopstr(ctx->bifcxrun);
    patlen = osrp2(patstr) - 2;
    patstr += 2;

    /* get the search string */
    searchstr = runpopstr(ctx->bifcxrun);
    searchlen = osrp2(searchstr) - 2;
    searchstr += 2;

    /* search for the pattern in the string */
    match_ofs = re_compile_and_search(&ctx->bifcxregex,
                                      (char *)patstr, patlen,
                                      (char *)searchstr, searchlen,
                                      &result_len);

    /* 
     *   if we didn't match, return nil; otherwise, return a list with the
     *   match offset and length 
     */
    if (match_ofs < 0)
    {
        /* no match - return nil */
        runpnil(ctx->bifcxrun);
    }
    else
    {
        ushort listsiz;
        runsdef val;
        uchar *p;
        
        /* 
         *   build a list consisting of two numbers and a string: two
         *   bytes for the list header, then two elements at (one byte for
         *   the datatype header, four bytes for the number), then the
         *   string element with (one byte for the datatype, two bytes for
         *   the string length prefix, and the bytes of the string) 
         */
        listsiz = 2 + (1+4)*2 + (1 + 2 + (ushort)(result_len));

        /* allocate the space */
        runhres(ctx->bifcxrun, listsiz, 0);

        /* set up the list stack item */
        val.runstyp = DAT_LIST;
        p = val.runsv.runsvstr = ctx->bifcxrun->runcxhp;

        /* set the list's length */
        oswp2(p, listsiz);
        p += 2;

        /* 
         *   Add the offset element.  For consistency with TADS
         *   conventions, use 1 as the offset of the first character in
         *   the string - this makes it easy to use the offset value with
         *   substr(). 
         */
        *p++ = DAT_NUMBER;
        oswp4(p, match_ofs + 1);
        p += 4;

        /* add the length element */
        *p++ = DAT_NUMBER;
        oswp4(p, result_len);
        p += 4;

        /* add the result string */
        *p++ = DAT_SSTRING;
        oswp2(p, result_len + 2);
        p += 2;
        memcpy(p, ctx->bifcxregex.strbuf + match_ofs, result_len);

        /* reserve the space in the heap */
        ctx->bifcxrun->runcxhp += listsiz;

        /* return the list */
        runrepush(ctx->bifcxrun, &val);
    }
}

/* reGetGroup */
void bifregroup(bifcxdef *ctx, int argc)
{
    int grp;
    size_t len;
    re_group_register *reg;
    ushort hplen;
    runsdef val;
    uchar *p;
    long numval;
    
    /* this function takes one parameter: the group number to retrieve */
    bifcntargs(ctx, 1, argc);

    /* get the group number */
    grp = (int)runpopnum(ctx->bifcxrun);

    /* make sure it's within range */
    if (grp < 1 || grp > RE_GROUP_REG_CNT)
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "reGetGroup");

    /* adjust from a 1-bias to an array index */
    --grp;

    /* if the group was never set, return nil */
    if (grp >= ctx->bifcxregex.cur_group)
    {
        runpnil(ctx->bifcxrun);
        return;
    }

    /* get the register */
    reg = &ctx->bifcxregex.regs[grp];

    /* if the group wasn't set, return nil */
    if (reg->start_ofs == 0 || reg->end_ofs == 0)
    {
        runpnil(ctx->bifcxrun);
        return;
    }

    /* calculate the length of the string in this group */
    len = reg->end_ofs - reg->start_ofs;

    /* 
     *   reserve the necessary heap space: two bytes for the list length
     *   prefix, two number elements (one byte each for the type, four
     *   bytes each for the value), and the string element (one byte for
     *   the type, two bytes for the length prefix, plus the string
     *   itself).  
     */
    hplen = (ushort)(2 + 2*(1+4) + (1 + 2 + len));
    runhres(ctx->bifcxrun, hplen, 0);

    /* set up the stack value */
    val.runstyp = DAT_LIST;
    p = val.runsv.runsvstr = ctx->bifcxrun->runcxhp;

    /* put in the list length prefix */
    oswp2(p, hplen);
    p += 2;

    /* add the starting character position of the group - adjust to 1-bias */
    *p++ = DAT_NUMBER;
    numval = (long)(reg->start_ofs - ctx->bifcxregex.strbuf) + 1;
    oswp4(p, numval);
    p += 4;

    /* add the length of the group */
    *p++ = DAT_NUMBER;
    numval = (long)(reg->end_ofs - reg->start_ofs);
    oswp4(p, numval);
    p += 4;

    /* set up the string */
    *p++ = DAT_SSTRING;
    oswp2(p, len+2);
    p += 2;
    memcpy(p, reg->start_ofs, len);

    /* consume the heap space */
    ctx->bifcxrun->runcxhp += hplen;

    /* push the result */
    runrepush(ctx->bifcxrun, &val);
}


/*
 *   inputevent 
 */
void bifinpevt(bifcxdef *ctx, int argc)
{
    unsigned long timeout;
    int use_timeout;
    os_event_info_t info;
    int evt;
    uchar *p;
    ushort lstsiz;
    runsdef val;
    size_t paramlen;
    char keyname[20];
    
    /* check for a timeout value */
    if (argc == 0)
    {
        /* there's no timeout */
        use_timeout = FALSE;
        timeout = 0;
    }
    else if (argc >= 1)
    {
        /* get the timeout value */
        use_timeout = TRUE;
        timeout = (unsigned long)runpopnum(ctx->bifcxrun);
    }

    /* ensure we don't have too many arguments */
    if (argc > 1)
        runsig(ctx->bifcxrun, ERR_BIFARGC);

    /* flush any pending output */
    tioflushn(ctx->bifcxtio, 0);

    /* reset count of lines since keyboard input */
    tioreset(ctx->bifcxtio);

    /* ask the OS code for an event */
    evt = os_get_event(timeout, use_timeout, &info);

    /* 
     *   the list always minimally needs two bytes of length prefix plus a
     *   number with the event code (one byte for the type, four bytes for
     *   the value) 
     */
    lstsiz = 2 + (1 + 4);

    /* figure out how much space we'll need based on the event type */
    switch(evt)
    {
    case OS_EVT_KEY:
        /* 
         *   we need space for a string with one or two bytes (depending
         *   on whether or not we have an extended key code) - 1 byte for
         *   type code, 2 for length prefix, and 1 or 2 for the string's
         *   contents 
         */
        paramlen = (info.key[0] == 0 ? 2 : 1);

        /* map the extended key */
        get_ext_key_name(keyname, info.key[0], info.key[1]);

        /* determine the length we need for the string */
        paramlen = strlen(keyname);

        /* add it into the list */
        lstsiz += 1 + 2 + paramlen;
        break;

    case OS_EVT_HREF:
        /* 
         *   we need space for the href string - 1 byte for type code, 2
         *   for length prefix, plus the string's contents 
         */
        paramlen = strlen(info.href);
        lstsiz += 1 + 2 + (ushort)paramlen;
        break;

    default:
        /* other event types have no extra data */
        break;
    }

    /* allocate space for the list */
    runhres(ctx->bifcxrun, lstsiz, 0);

    /* set up the stack value */
    val.runstyp = DAT_LIST;
    p = val.runsv.runsvstr = ctx->bifcxrun->runcxhp;

    /* set up the list length prefix */
    oswp2(p, lstsiz);
    p += 2;

    /* set up the event type element */
    *p++ = DAT_NUMBER;
    oswp4(p, evt);
    p += 4;

    /* add the event parameters, if any */
    switch(evt)
    {
    case OS_EVT_KEY:
        /* set up the string for the key */
        *p++ = DAT_SSTRING;
        oswp2(p, paramlen + 2);
        p += 2;

        /* add the characters to the string */
        memcpy(p, keyname, paramlen);
        p += paramlen;
        break;

    case OS_EVT_HREF:
        /* add the string for the href */
        *p++ = DAT_SSTRING;
        oswp2(p, paramlen + 2);
        memcpy(p + 2, info.href, paramlen);
        break;
    }

    /* consume the heap space */
    ctx->bifcxrun->runcxhp += lstsiz;

    /* push the result */
    runrepush(ctx->bifcxrun, &val);
}

/* timeDelay */
void bifdelay(bifcxdef *ctx, int argc)
{
    long delay;
    
    /* ensure we have the right number of arguments */
    bifcntargs(ctx, 1, argc);

    /* flush any pending output */
    tioflushn(ctx->bifcxtio, 0);

    /* get the delay time */
    delay = runpopnum(ctx->bifcxrun);

    /* let the system perform the delay */
    os_sleep_ms(delay);
}

/* setOutputFilter */
void bifsetoutfilter(bifcxdef *ctx, int argc)
{
    /* ensure we have the right number of arguments */
    bifcntargs(ctx, 1, argc);

    /* see what we have */
    switch(runtostyp(ctx->bifcxrun))
    {
    case DAT_NIL:
        /* remove the current filter */
        out_set_filter(MCMONINV);

        /* discard the argument */
        rundisc(ctx->bifcxrun);
        break;

    case DAT_FNADDR:
        /* set the filter to the given function */
        out_set_filter(runpopfn(ctx->bifcxrun));
        break;

    default:
        /* anything else is invalid */
        runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "setOutputFilter");
    }
}

/*
 *   Get an optional object argument.  If the next argument is not an
 *   object value, or we're out of arguments, we'll return MCMONINV.
 *   Otherwise, we'll pop the object value and return it, decrementing the
 *   remaining argument counter provided. 
 */
static objnum bif_get_optional_obj_arg(bifcxdef *ctx, int *rem_argc)
{
    /* if we're out of arguments, there's no object value */
    if (*rem_argc == 0)
        return MCMONINV;

    /* 
     *   if the next argument is not an object or nil, we're out of object
     *   arguments 
     */
    if (runtostyp(ctx->bifcxrun) != DAT_OBJECT
        && runtostyp(ctx->bifcxrun) != DAT_NIL)
        return MCMONINV;

    /* we have an object - remove it from the remaining argument count */
    --(*rem_argc);

    /* pop and return the object value */
    return runpopobjnil(ctx->bifcxrun);
}

/*
 *   execCommand flag values 
 */
#define EC_HIDE_SUCCESS     0x00000001
#define EC_HIDE_ERROR       0x00000002
#define EC_SKIP_VALIDDO     0x00000004
#define EC_SKIP_VALIDIO     0x00000008

/*
 *   execCommand - execute a recursive command 
 */
void bifexec(bifcxdef *ctx, int argc)
{
    objnum actor;
    objnum verb;
    objnum dobj;
    objnum prep;
    objnum iobj;
    int    err;
    uint   capture_start;
    uint   capture_end;
    objnum capture_obj;
    ulong  flags;
    int    hide_any;
    int    rem_argc;
    
    /* 
     *   Check for the correct argument count.  The first two arguments
     *   are required; additional arguments are optional. 
     */
    if (argc < 2 || argc > 6)
        runsig(ctx->bifcxrun, ERR_BIFARGC);

    /* pop the arguments - actor, verb, dobj, prep, iobj */
    actor = runpopobjnil(ctx->bifcxrun);
    verb = runpopobjnil(ctx->bifcxrun);

    /* 
     *   The other object arguments are optional.  If we run into a
     *   numeric argument, it's the flags value, in which case we're out
     *   of objects. 
     */
    rem_argc = argc - 2;
    dobj = bif_get_optional_obj_arg(ctx, &rem_argc);
    prep = bif_get_optional_obj_arg(ctx, &rem_argc);
    iobj = bif_get_optional_obj_arg(ctx, &rem_argc);

    /* if we have a flags argument, pop it */
    if (rem_argc > 0)
    {
        /* the last argument is the flags - pop the numeric value */
        flags = runpopnum(ctx->bifcxrun);

        /* remove it from the remaining argument counter */
        --rem_argc;
    }
    else
    {
        /* no flags specified - use zero by default */
        flags = 0;
    }

    /* 
     *   make sure we don't have any arguments left - if we do, then it
     *   means that we got an incorrect type and skipped an argument when
     *   we were trying to sense the meanings of the arguments from their
     *   types 
     */
    if (rem_argc != 0)
        runsig1(ctx->bifcxrun, ERR_INVTBIF, ERRTSTR, "execCommand");

    /* if we're hiding any output, start output capture */
    hide_any = ((flags & (EC_HIDE_SUCCESS | EC_HIDE_ERROR)) != 0);
    if (hide_any)
    {
        /* start capturing */
        tiocapture(ctx->bifcxtio, ctx->bifcxrun->runcxmem, TRUE);

        /* note the current output position */
        capture_start = tiocapturesize(ctx->bifcxtio);
    }

    /* execute the command */
    err = execmd_recurs(ctx->bifcxrun->runcxvoc,
                        actor, verb, dobj, prep, iobj,
                        (flags & EC_SKIP_VALIDDO) == 0,
                        (flags & EC_SKIP_VALIDIO) == 0);

    /* if we're hiding any output, end hiding */
    if (hide_any)
    {
        uchar *p;
        int hide;
        
        /* get the capture buffer size */
        capture_end = tiocapturesize(ctx->bifcxtio);

        /* turn off capture if it wasn't already on when we started */
        if (capture_start == 0)
            tiocapture(ctx->bifcxtio, ctx->bifcxrun->runcxmem, FALSE);

        /* determine whether we're hiding or showing the result */
        if (err == 0)
            hide = ((flags & EC_HIDE_SUCCESS) != 0);
        else
            hide = ((flags & EC_HIDE_ERROR) != 0);

        /* show or hide the result, as appropriate */
        if (hide)
        {
            /* 
             *   We're hiding this result, so do not display the string.
             *   If there's an enclosing capture, remove the string from
             *   the enclosing capture.  
             */
            if (capture_start != 0)
                tiopopcapture(ctx->bifcxtio, capture_start);
        }
        else
        {
            /* 
             *   We're showing the text.  If we're in an enclosing
             *   capture, do nothing - simply leave the string in the
             *   enclosing capture buffer; otherwise, actually display it 
             */
            if (capture_start == 0)
            {
                /* lock the capture object */
                capture_obj = tiogetcapture(ctx->bifcxtio);
                p = mcmlck(ctx->bifcxrun->runcxmem, capture_obj);
                
                ERRBEGIN(ctx->bifcxerr)
                {
                    /* display the string */
                    outformatlen((char *)p + capture_start,
                                 capture_end - capture_start);
                }
                ERRCLEAN(ctx->bifcxerr)
                {
                    /* unlock the capture object before signalling out */
                    mcmunlck(ctx->bifcxrun->runcxmem, capture_obj);
                }
                ERRENDCLN(ctx->bifcxerr);

                /* unlock the capture object */
                mcmunlck(ctx->bifcxrun->runcxmem, capture_obj);
            }
        }
        
        /* clear the capture buffer if it wasn't on when we started */
        if (capture_start == 0)
            tioclrcapture(ctx->bifcxtio);
    }

    /* push the result code */
    runpnum(ctx->bifcxrun, err);
}

/* 
 *   parserGetObj - get one of the objects associated with the command 
 */
void bifgetobj(bifcxdef *ctx, int argc)
{
    int id;
    objnum obj;
    voccxdef *voc = ctx->bifcxrun->runcxvoc;
    
    /* check the argument count */
    bifcntargs(ctx, 1, argc);

    /* get the argument */
    id = (int)runpopnum(ctx->bifcxrun);

    /* get the appropriate object */
    switch(id)
    {
    case 1:
        /* get the current actor */
        obj = voc->voccxactor;

        /* if there's no current actor, use the current 'me' by default */
        if (obj == MCMONINV)
            obj = voc->voccxme;

        /* done */
        break;

    case 2:
        /* verb */
        obj = voc->voccxverb;
        break;

    case 3:
        /* direct object */
        obj = (voc->voccxdobj == 0 ? MCMONINV : voc->voccxdobj->vocolobj);
        break;

    case 4:
        /* preposition */
        obj = voc->voccxprep;
        break;

    case 5:
        /* indirect object */
        obj = (voc->voccxiobj == 0 ? MCMONINV : voc->voccxiobj->vocolobj);
        break;

    case 6:
        /* "it" */
        obj = voc->voccxit;
        break;

    case 7:
        /* "him" */
        obj = voc->voccxhim;
        break;

    case 8:
        /* "her" */
        obj = voc->voccxher;
        break;

    case 9:
        /* them */
        voc_push_objlist(voc, voc->voccxthm, voc->voccxthc);

        /* 
         *   return directly, since we've already pushed the result (it's
         *   a list, not an object) 
         */
        return;

    default:
        /* invalid argument */
        runsig1(ctx->bifcxrun, ERR_INVVBIF, ERRTSTR, "parserGetObj");
        break;
    }

    /* return the object */
    runpobj(ctx->bifcxrun, obj);
}

/*
 *   parseNounList - parse a noun list.  Call like this:
 *   
 *   parserParseNounList(wordlist, typelist, starting_index, complain,
 *   multi, check_actor); 
 */
void bifparsenl(bifcxdef *ctx, int argc)
{
    /* check the argument count */
    bifcntargs(ctx, 6, argc);

    /* call the parser */
    voc_parse_np(ctx->bifcxrun->runcxvoc);
}

/*
 *   parserTokenize - given a string, produce a list of tokens.  Returns
 *   nil on error, or a list of token strings.
 *   
 *   parserTokenize(commandString); 
 */
void bifprstok(bifcxdef *ctx, int argc)
{
    /* check arguments */
    bifcntargs(ctx, 1, argc);

    /* call the parser */
    voc_parse_tok(ctx->bifcxrun->runcxvoc);
}

/*
 *   parserGetTokTypes - given a list of tokens (represented as strings),
 *   get a corresponding list of token types.
 *   
 *   parserGetTokTypes(tokenList); 
 */
void bifprstoktyp(bifcxdef *ctx, int argc)
{
    /* check arguments */
    bifcntargs(ctx, 1, argc);

    /* call the parser */
    voc_parse_types(ctx->bifcxrun->runcxvoc);
}

/*
 *   parserDictLookup - given a list of tokens and their types, produce a
 *   list of all of the objects that match all of the words.
 *   
 *   parserDictLookup(tokenList, typeList); 
 */
void bifprsdict(bifcxdef *ctx, int argc)
{
    /* check arguments */
    bifcntargs(ctx, 2, argc);

    /* call the parser */
    voc_parse_dict_lookup(ctx->bifcxrun->runcxvoc);
}

/*
 *   parserResolveObjects - resolve an object list of the sort returned by
 *   parseNounList.  Validates and disambiguates the objects.
 *   
 *   parserResolveObjects(actor, verb, prep, otherobj, usageType,
 *   verprop, tokenList, objList, silent) 
 */
void bifprsrslv(bifcxdef *ctx, int argc)
{
    /* check arguments */
    bifcntargs(ctx, 9, argc);

    /* call the parser */
    voc_parse_disambig(ctx->bifcxrun->runcxvoc);
}

/*
 *   parserReplaceCommand - replace the current command line with a new
 *   string.  Aborts the current command. 
 */
void bifprsrplcmd(bifcxdef *ctx, int argc)
{
    /* check arguments */
    bifcntargs(ctx, 1, argc);

    /* call the parser */
    voc_parse_replace_cmd(ctx->bifcxrun->runcxvoc);
}

/*
 *   exitobj - throw a RUNEXITOBJ error 
 */
void bifexitobj(bifcxdef *ctx, int argc)
{
    /* no arguments are allowed */
    bifcntargs(ctx, 0, argc);

    /* throw the RUNEXITOBJ error */
    errsig(ctx->bifcxerr, ERR_RUNEXITOBJ);
}

/*
 *   Standard system button labels for bifinpdlg() 
 */
#define BIFINPDLG_LBL_OK      1
#define BIFINPDLG_LBL_CANCEL  2
#define BIFINPDLG_LBL_YES     3
#define BIFINPDLG_LBL_NO      4

/*
 *   inputdialog 
 */
void bifinpdlg(bifcxdef *ctx, int argc)
{
    uchar *p;
    char prompt[256];
    char lblbuf[256];
    char *labels[10];
    char *dst;
    uint len;
    size_t bcnt;
    int default_resp, cancel_resp;
    int resp;
    int std_btns;
    int icon_id;

    /* check for proper arguments */
    bifcntargs(ctx, 5, argc);

    /* get the icon number */
    icon_id = runpopnum(ctx->bifcxrun);

    /* get the prompt string */
    p = runpopstr(ctx->bifcxrun);
    bifcstr(ctx, prompt, (size_t)sizeof(prompt), p);

    /* check for a standard button set selection */
    if (runtostyp(ctx->bifcxrun) == DAT_NUMBER)
    {
        /* get the standard button set ID */
        std_btns = runpopnum(ctx->bifcxrun);

        /* there are no actual buttons */
        bcnt = 0;
    }
    else
    {
        /* we're not using standard buttons */
        std_btns = 0;
        
        /* get the response string list */
        p = runpoplst(ctx->bifcxrun);
        len = osrp2(p);
        p += 2;
        
        /* build our internal button list */
        for (bcnt = 0, dst = lblbuf ; len != 0 ; lstadv(&p, &len))
        {
            /* see what we have */
            if (*p == DAT_SSTRING)
            {
                /* it's a label string - convert to a C string */
                bifcstr(ctx, dst, sizeof(lblbuf) - (dst - lblbuf), p + 1);
                
                /* set this button to point to the converted text */
                labels[bcnt++] = dst;
                
                /* move past this label in the button buffer */
                dst += strlen(dst) + 1;
            }
            else if (*p == DAT_NUMBER)
            {
                int id;
                int resid;
                
                /* it's a standard system label ID - get the ID */
                id = (int)osrp4(p + 1);

                /* translate it to the appropriate string resource */
                switch(id)
                {
                case BIFINPDLG_LBL_OK:
                    resid = RESID_BTN_OK;
                    break;
                    
                case BIFINPDLG_LBL_CANCEL:
                    resid = RESID_BTN_CANCEL;
                    break;
                    
                case BIFINPDLG_LBL_YES:
                    resid = RESID_BTN_YES;
                    break;
                    
                case BIFINPDLG_LBL_NO:
                    resid = RESID_BTN_NO;
                    break;

                default:
                    resid = 0;
                    break;
                }

                /* 
                 *   if we got a valid resource ID, load the resource;
                 *   otherwise, skip this button
                 */
                if (resid != 0
                    && !os_get_str_rsc(resid, dst,
                                       sizeof(lblbuf) - (dst - lblbuf)))
                {
                    /* set this button to point to the converted text */
                    labels[bcnt++] = dst;

                    /* move past this label in the button buffer */
                    dst += strlen(dst) + 1;
                }
            }
            
            /* if we have exhausted our label array, stop now */
            if (bcnt >= sizeof(labels)/sizeof(labels[0])
                || dst >= lblbuf + sizeof(lblbuf))
                break;
        }
    }

    /* get the default response */
    if (runtostyp(ctx->bifcxrun) == DAT_NIL)
    {
        rundisc(ctx->bifcxrun);
        default_resp = 0;
    }
    else
        default_resp = runpopnum(ctx->bifcxrun);

    /* get the cancel response */
    if (runtostyp(ctx->bifcxrun) == DAT_NIL)
    {
        rundisc(ctx->bifcxrun);
        cancel_resp = 0;
    }
    else
        cancel_resp = runpopnum(ctx->bifcxrun);

    /* flush output before showing the dialog */
    tioflushn(ctx->bifcxtio, 0);

    /* show the dialog */
    resp = tio_input_dialog(icon_id, prompt, std_btns,
                            (const char **)labels, bcnt,
                            default_resp, cancel_resp);

    /* return the result */
    runpnum(ctx->bifcxrun, resp);
}

/*
 *   Determine if a resource exists 
 */
void bifresexists(bifcxdef *ctx, int argc)
{
    uchar *p;
    char resname[OSFNMAX];
    appctxdef *appctx;
    int found;
    runsdef val;
    
    /* check for proper arguments */
    bifcntargs(ctx, 1, argc);

    /* get the resource name string */
    p = runpopstr(ctx->bifcxrun);
    bifcstr(ctx, resname, (size_t)sizeof(resname), p);

    /* 
     *   if we have a host application context, and it provides a resource
     *   finder function, ask the resource finder if the resource is
     *   available; otherwise, report that the resource is not loadable,
     *   since we must not be running a version of the interpreter that
     *   supports external resource loading 
     */
    appctx = ctx->bifcxappctx;
    found = (appctx != 0
             && appctx->resfile_exists != 0
             && (*appctx->resfile_exists)(appctx->resfile_exists_ctx,
                                          resname, strlen(resname)));

    /* push the result */
    runpush(ctx->bifcxrun, runclog(found), &val);
}

Generated by  Doxygen 1.6.0   Back to index