exec.c   [plain text]

/*
    This software may only be used by you under license from AT&T Corp.
    ("AT&T").  A copy of AT&T's Source Code Agreement is available at
    AT&T's Internet website having the URL:
    <http://www.research.att.com/sw/tools/graphviz/license/source.html>
    If you received this software without first entering into a license
    with AT&T, you have an infringing copy of this software and cannot use
    it without violating AT&T's intellectual property rights.
*/

#pragma prototyped
/* Lefteris Koutsofios - AT&T Bell Laboratories */

#include "common.h"
#include "mem.h"
#include "code.h"
#include "tbl.h"
#include "str.h"
#include "exec.h"
#include "internal.h"

static lvar_t *lvarp;
static int lvarn, llvari, flvari;
#define LVARINCR 1000
#define LVARSIZE sizeof (lvar_t)

Tobj root, null;
Tobj rtno;
int Erun;
int Eerrlevel, Estackdepth, Eshowbody, Eshowcalls, Eoktorun;

#define PUSHJMP(op, np, b) op = (volatile jmp_buf *) np, np = (jmp_buf *) &b
#define POPJMP(op, np) np = (jmp_buf *) op

/* longjmps for normal program execution */
typedef enum {
    PLJ_BREAK, PLJ_CONTINUE, PLJ_RETURN, PLJ_SIZE
} PLJtype_t;
static jmp_buf *pljbufp1, *pljbufp2;
static PLJtype_t pljtype;

/* longjmp for error handling */
static jmp_buf *eljbufp;

/* error levels and types */
typedef enum {
    ERR0, ERR1, ERR2, ERR3, ERR4, ERR5
} errlevel_t;
typedef enum {
    ERRNOLHS, ERRNORHS, ERRNOSUCHFUNC, ERRBADARG, ERRARGMIS, ERRNOTATABLE,
    ERRIFUNCERR, ERRRECRUN, ERRTABLECHANGED
} errnum_t;
static char *errnam[] = {
    "no variable",
    "no value",
    "no such function",
    "bad argument",
    "argument number mismatch",
    "not a table",
    "internal function call error",
    "recursive run attempt",
    "table changed during a forin loop",
};

static int errdo;

/* stack information */
typedef struct sinfo_t {
    Tobj co, fco;
    int ci, fci;
    int flvari, llvari;
} sinfo_t;
#define SINFOSIZE sizeof (sinfo_t)
#define SINFOINCR 100
static sinfo_t *sinfop;
static int sinfoi, sinfon;

typedef enum {
    TNK_LI, TNK_O, TNK_S
} tnktype_t;
typedef struct tnk_t {
    tnktype_t type;
    union {
        int li;
        struct {
            Tobj to, ko;
        } tnko;
        struct {
            Ctype_t kt;
            Tobj to, co;
            int vi;
        } tnks;
    } u;
} tnk_t;

typedef struct Num_t {
    Ctype_t type;
    union {
        long i;
        double d;
        Tobj no;
    } u;
} Num_t;

static long rootm;
static int running;

static Tobj eeval (Tobj, int);
static Tobj efcall (Tobj, int);
static void ewhilest (Tobj, int);
static void eforst (Tobj, int);
static void eforinst (Tobj, int);

static Tobj getval (Tobj, int);
static int getvar (Tobj, int, tnk_t *);
static void setvar (tnk_t, Tobj);
static int boolop (Tobj);
static int orderop (Tobj, Ctype_t, Tobj);
static Tobj arithop (Num_t *, Ctype_t, Num_t *);
static void err (int, int, Tobj, int);
static void printbody (char *, int);

void Einit (void) {
    root = Ttable (100);
    rootm = Mpushmark (root);
    Tinss (root, "null", (null = Ttable (2)));
    rtno = NULL;
    pljbufp1 = pljbufp2 = NULL, pljtype = (PLJtype_t)0;
    eljbufp = NULL;
    lvarp = Marrayalloc ((long) LVARINCR * LVARSIZE);
    lvarn = LVARINCR;
    llvari = 0;
    flvari = 0;
    sinfop = Marrayalloc ((long) SINFOINCR * SINFOSIZE);
    sinfon = SINFOINCR;
    sinfoi = 0;
    Erun = FALSE;
    running = 0;
    Eoktorun = FALSE;
}

void Eterm (void) {
    Marrayfree (sinfop), sinfop = NULL, sinfon = 0, sinfoi = 0;
    Marrayfree (lvarp), lvarp = NULL, lvarn = 0, llvari = 0, flvari = 0;
    rtno = NULL;
    null = NULL;
    Mpopmark (rootm);
}

Tobj Eunit (Tobj co) {
    volatile jmp_buf *oeljbufp;
    volatile int ownsinfoi;
    volatile long m;
    volatile Tobj lrtno;

    jmp_buf eljbuf;

#if 0
    if (running && !Eoktorun) {
        err (ERRRECRUN, ERR2, NULL, 0);
        return NULL;
    }
#endif
    Eoktorun = FALSE;

    if (!co)
        return NULL;

    if (Tgettype (co) != T_CODE)
        panic (POS, "Eunit", "argument type is not T_CODE");

    m = Mpushmark (co);
    PUSHJMP (oeljbufp, eljbufp, eljbuf);
    ownsinfoi = sinfoi++;
    if (sinfoi == sinfon) {
        sinfop = Marraygrow (sinfop, (long) (sinfon + SINFOINCR) * SINFOSIZE);
        sinfon += SINFOINCR;
    }
    sinfop[ownsinfoi].co = co;
    sinfop[ownsinfoi].ci = TCgetfp (co, 0);
    sinfop[ownsinfoi].fco = NULL;
    sinfop[ownsinfoi].flvari = flvari;
    sinfop[ownsinfoi].llvari = llvari;
    running++;
    if (setjmp (*eljbufp))
        lrtno = NULL;
    else
        lrtno = eeval (co, TCgetfp (co, 0));
    running--;
    rtno = NULL;
    flvari = sinfop[ownsinfoi].flvari;
    llvari = sinfop[ownsinfoi].llvari;
    sinfoi = ownsinfoi;
    POPJMP (oeljbufp, eljbufp);
    Mpopmark (m);
    Erun = TRUE;
    return lrtno;
}

/* shortcut: this function executes a piece of code that corresponds to
   <internal func name> = function () internal "<internal func name>";
*/
Tobj Efunction (Tobj co, char *ifnam) {
    Tobj v1o;
    int fi;

    fi = TCgetnext (co, TCgetfp (co, TCgetfp (co, 0)));
    v1o = Tcode (TCgetaddr (co, fi), fi,
            (int) TCgetinteger (co, TCgetfp (co, fi)));
    Tinss (root, ifnam, v1o);
    return v1o;
}

static Tobj eeval (Tobj co, int ci) {
    Tobj v1o, v2o, v3o;
    Ttype_t ttype;
    Ctype_t ctype;
    tnk_t tnk;
    Num_t lnum, rnum;
    long m1 = 0, m2;
    int i1, i2, res;

tailrec:
    errdo = TRUE;
    v1o = NULL;
    ctype = TCgettype (co, ci);
    switch (ctype) {
    case C_ASSIGN:
        i1 = TCgetfp (co, ci);
        if ((v1o = eeval (co, TCgetnext (co, i1))) == NULL) {
            err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
            return NULL;
        }
        m1 = Mpushmark (v1o);
        res = getvar (co, i1, &tnk);
        Mpopmark (m1);
        if (res == -1) {
            err (ERRNOLHS, ERR3, co, i1);
            return NULL;
        }
        setvar (tnk, v1o);
        return v1o;
    case C_OR:
    case C_AND:
    case C_NOT:
        i1 = TCgetfp (co, ci);
        if ((v1o = eeval (co, i1)) == NULL)
            err (ERRNORHS, ERR4, co, i1);
        switch (ctype) {
        case C_OR:
            if (boolop (v1o) == TRUE)
                return Ttrue;
            if ((v1o = eeval (co, TCgetnext (co, i1))) == NULL)
                err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
            return (boolop (v1o) == TRUE) ? Ttrue: Tfalse;
        case C_AND:
            if (boolop (v1o) == FALSE)
                return Tfalse;
            if ((v1o = eeval (co, TCgetnext (co, i1))) == NULL)
                err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
            return (boolop (v1o) == FALSE) ? Tfalse: Ttrue;
        case C_NOT:
            return (boolop (v1o) == TRUE) ? Tfalse: Ttrue;
	default:
	    break;
        }
        /* NOT REACHED */
        return Tfalse;
    case C_EQ:
    case C_NE:
    case C_LT:
    case C_LE:
    case C_GT:
    case C_GE:
        i1 = TCgetfp (co, ci);
        if ((v1o = eeval (co, i1)) == NULL)
            err (ERRNORHS, ERR4, co, i1);
        else
            m1 = Mpushmark (v1o);
        if ((v2o = eeval (co, TCgetnext (co, i1))) == NULL)
            err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
        if (v1o)
            Mpopmark (m1);
        return (orderop (v1o, ctype, v2o) == TRUE) ? Ttrue: Tfalse;
    case C_PLUS:
    case C_MINUS:
    case C_MUL:
    case C_DIV:
    case C_MOD:
    case C_UMINUS:
        i1 = TCgetfp (co, ci);
        if ((lnum.type = TCgettype (co, i1)) == C_INTEGER)
            lnum.u.i = TCgetinteger (co, i1);
        else if (lnum.type == C_REAL)
            lnum.u.d = TCgetreal (co, i1);
        else if ((lnum.u.no = eeval (co, i1)) == NULL) {
            err (ERRNORHS, ERR4, co, i1);
            return NULL;
        }
        if (ctype == C_UMINUS) {
            if (!(v1o = arithop (&lnum, ctype, NULL)))
                err (ERRNORHS, ERR4, co, ci);
            return v1o;
        }
        if (lnum.type != C_INTEGER && lnum.type != C_REAL)
            m1 = Mpushmark (lnum.u.no);
        i1 = TCgetnext (co, i1);
        if ((rnum.type = TCgettype (co, i1)) == C_INTEGER)
            rnum.u.i = TCgetinteger (co, i1);
        else if (rnum.type == C_REAL)
            rnum.u.d = TCgetreal (co, i1);
        else if ((rnum.u.no = eeval (co, i1)) == NULL)
            err (ERRNORHS, ERR4, co, i1);
        if (lnum.type != C_INTEGER && lnum.type != C_REAL)
            Mpopmark (m1);
        if (!(v1o = arithop (&lnum, ctype, &rnum)))
            err (ERRNORHS, ERR4, co, ci);
        return v1o;
    case C_PEXPR:
        ci = TCgetfp (co, ci);
        goto tailrec;
    case C_FCALL:
        return efcall (co, ci);
    case C_INTEGER:
        return Tinteger (TCgetinteger (co, ci));
    case C_REAL:
        return Treal (TCgetreal (co, ci));
    case C_STRING:
        return Tstring (TCgetstring (co, ci));
    case C_GVAR:
    case C_LVAR:
    case C_PVAR:
        return getval (co, ci);
    case C_FUNCTION:
        return Tcode (TCgetaddr (co, ci), ci,
                (int) TCgetinteger (co, TCgetfp (co, ci)));
    case C_TCONS:
        v1o = Ttable (0);
        m1 = Mpushmark (v1o);
        for (i1 = TCgetfp (co, ci); i1 != C_NULL;
                i1 = TCgetnext (co, TCgetnext (co, i1))) {
            if (!(v3o = eeval (co, TCgetnext (co, i1)))) {
                err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
                continue;
            }
            m2 = Mpushmark (v3o);
            if (!(v2o = eeval (co, i1))) {
                err (ERRNOLHS, ERR3, co, i1);
                Mpopmark (m2);
                continue;
            }
            ttype = Tgettype (v2o);
            if (ttype == T_INTEGER || ttype == T_REAL || ttype == T_STRING)
                Tinso (v1o, v2o, v3o);
            else
                err (ERRNOLHS, ERR1, co, i1);
        }
        Mpopmark (m1);
        return v1o;
    case C_STMT:
        for (i1 = TCgetfp (co, ci); i1 != C_NULL; )
            if ((i2 = TCgetnext (co, i1)) != C_NULL) {
                eeval (co, i1);
                i1 = i2;
            } else {
                ci = i1;
                goto tailrec;
            }
        /* NOT REACHED */
        break;
    case C_IF:
        i1 = TCgetfp (co, ci);
        if (!(v1o = eeval (co, i1)))
            err (ERRNORHS, ERR5, co, i1);
        if (boolop (v1o) == TRUE) {
            ci = TCgetnext (co, i1);
            goto tailrec;
        } else if ((ci = TCgetnext (co, TCgetnext (co, i1))) != C_NULL)
            goto tailrec;
        break;
    case C_WHILE:
        ewhilest (co, ci);
        break;
    case C_FOR:
        eforst (co, ci);
        break;
    case C_FORIN:
        eforinst (co, ci);
        break;
    case C_BREAK:
        pljtype = PLJ_BREAK;
        longjmp (*pljbufp1, 1);
        /* NOT REACHED */
        break;
    case C_CONTINUE:
        pljtype = PLJ_CONTINUE;
        longjmp (*pljbufp1, 1);
        /* NOT REACHED */
        break;
    case C_RETURN:
        if ((i1 = TCgetfp (co, ci)) != C_NULL)
            rtno = eeval (co, i1);
        pljtype = PLJ_RETURN;
        longjmp (*pljbufp2, 1);
        /* NOT REACHED */
        break;
    default:
        panic (POS, "eeval", "unknown program token type %d", ctype);
    }
    return v1o;
}

static Tobj efcall (Tobj co, int ci) {
    volatile jmp_buf *opljbufp1, *opljbufp2;
    volatile long m;
    volatile int bi, ownsinfoi, li, ln;

    jmp_buf pljbuf;
    Tobj fdo, vo, lrtno;
    int i, fci, ai, di, di1, fid;

    ownsinfoi = sinfoi++;
    if (sinfoi == sinfon) {
        sinfop = Marraygrow (sinfop, (long) (sinfon + SINFOINCR) * SINFOSIZE);
        sinfon += SINFOINCR;
    }
    sinfop[ownsinfoi].co = co;
    sinfop[ownsinfoi].ci = ci;
    sinfop[ownsinfoi].fco = NULL;
    sinfop[ownsinfoi].flvari = flvari;
    sinfop[ownsinfoi].llvari = llvari;
    fci = TCgetfp (co, ci);
    if (!(fdo = getval (co, fci)) || Tgettype (fdo) != T_CODE) {
        err (ERRNOSUCHFUNC, ERR2, co, fci);
        sinfoi = ownsinfoi;
        return NULL;
    }

    m = Mpushmark ((Tobj) fdo);
    ai = TCgetfp (co, TCgetnext (co, fci));
    ln = (int) TCgetinteger (fdo, (li = TCgetnext (fdo, TCgetfp (fdo, 0))));
    di = TCgetnext (fdo, li);
    bi = TCgetnext (fdo, di);
    if (bi != C_NULL && TCgettype (fdo, bi) == C_INTERNAL) {
        for (i = 0; ai != C_NULL; ai = TCgetnext (co, ai), i++) {
            if (!(vo = eeval (co, ai))) {
                err (ERRBADARG, ERR2, co, ai);
                Mpopmark (m);
                llvari = sinfop[ownsinfoi].llvari;
                sinfoi = ownsinfoi;
                return NULL;
            }
            if (llvari + 1 > lvarn) {
                lvarp = Marraygrow (lvarp, (long) (llvari + 1) * LVARSIZE);
                lvarn = llvari + 1;
            }
            lvarp[llvari].m = Mpushmark ((lvarp[llvari].o = vo));
            llvari++;
        }
        fid = (int) TCgetinteger (fdo, TCgetfp (fdo, bi));
        if (Ifuncs[fid].min > i || Ifuncs[fid].max < i) {
            err (ERRARGMIS, ERR2, co, ci);
            Mpopmark (m);
            llvari = sinfop[ownsinfoi].llvari;
            sinfoi = ownsinfoi;
            return NULL;
        }
        flvari = sinfop[ownsinfoi].llvari;
        sinfop[ownsinfoi].fco = fdo;
        sinfop[ownsinfoi].fci = bi;
        if (fid < 0 || fid >= Ifuncn)
            panic (POS, "efcall", "no such internal function: %d", fid);
        rtno = Ttrue;
        if ((*Ifuncs[fid].func) (i, &lvarp[flvari]) == L_FAILURE) {
            rtno = NULL;
            err (ERRIFUNCERR, ERR2, co, ci);
        }
    } else {
        if (llvari + ln > lvarn) {
            lvarp = Marraygrow (lvarp, (long) (llvari + ln) * LVARSIZE);
            lvarn = llvari + ln;
        }
        di1 = TCgetfp (fdo, di);
        for (i = 0; i < ln && di1 != C_NULL && ai != C_NULL;
                i++, ai = TCgetnext (co, ai)) {
            if (!(vo = eeval (co, ai))) {
                err (ERRBADARG, ERR2, co, ai);
                Mpopmark (m);
                llvari = sinfop[ownsinfoi].llvari;
                sinfoi = ownsinfoi;
                return NULL;
            }
            lvarp[llvari].m = Mpushmark ((lvarp[llvari].o = vo));
            llvari++;
            di1 = TCgetnext (fdo, di1);
        }
        if (di1 != C_NULL || ai != C_NULL) {
            err (ERRARGMIS, ERR2, co, ci);
            Mpopmark (m);
            llvari = sinfop[ownsinfoi].llvari;
            sinfoi = ownsinfoi;
            return NULL;
        }
        for (; i < ln; i++, llvari++)
            lvarp[llvari].m = Mpushmark ((lvarp[llvari].o = NULL));
        flvari = sinfop[ownsinfoi].llvari;
        PUSHJMP (opljbufp2, pljbufp2, pljbuf);
        opljbufp1 = (volatile jmp_buf *) pljbufp1;
        if (setjmp (*pljbufp2)) {
            ;
        } else {
            sinfop[ownsinfoi].fco = fdo;
            for (; bi != C_NULL; bi = TCgetnext (fdo, bi)) {
                sinfop[ownsinfoi].fci = bi;
                if (TCgettype (fdo, bi) != C_DECL)
                    eeval ((Tobj) fdo, bi);
            }
        }
        POPJMP (opljbufp2, pljbufp2);
        pljbufp1 = (jmp_buf *) opljbufp1;
    }
    flvari = sinfop[ownsinfoi].flvari;
    llvari = sinfop[ownsinfoi].llvari;
    sinfoi = ownsinfoi;
    Mpopmark (m);
    lrtno = rtno, rtno = NULL;
    errdo = TRUE;
    return lrtno;
}

static void ewhilest (Tobj co, int ci) {
    volatile jmp_buf *opljbufp;
    volatile jmp_buf pljbuf;
    volatile Tobj c1o;
    volatile int ei, si;

    Tobj v1o;

    c1o = (volatile Tobj) co; /* protect argument from longjmp */
    ei = TCgetfp (c1o, ci);
    si = TCgetnext (c1o, ei);
    PUSHJMP (opljbufp, pljbufp1, pljbuf);
    for (;;) {
        if (!(v1o = eeval ((Tobj) c1o, ei)))
            err (ERRNORHS, ERR5, c1o, ei);
        if (boolop (v1o) == FALSE)
            break;
        if (setjmp (*pljbufp1)) {
            if (pljtype == PLJ_CONTINUE)
                continue;
            else if (pljtype == PLJ_BREAK)
                break;
        }
        eeval ((Tobj) c1o, si);
    }
    POPJMP (opljbufp, pljbufp1);
}

static void eforst (Tobj co, int ci) {
    volatile jmp_buf *opljbufp;
    volatile jmp_buf pljbuf;
    volatile Tobj c1o;
    volatile int ei1, ei2, ei3, si, eisnop1, eisnop2, eisnop3;

    Tobj v1o;

    c1o = (volatile Tobj) co; /* protect argument from longjmp */
    ei1 = TCgetfp (c1o, ci);
    ei2 = TCgetnext (c1o, ei1);
    ei3 = TCgetnext (c1o, ei2);
    si = TCgetnext (c1o, ei3);
    eisnop1 = (TCgettype (c1o, ei1) == C_NOP);
    eisnop2 = (TCgettype (c1o, ei2) == C_NOP);
    eisnop3 = (TCgettype (c1o, ei3) == C_NOP);
    PUSHJMP (opljbufp, pljbufp1, pljbuf);
    if (!eisnop1)
        eeval ((Tobj) c1o, ei1);
    for (;;) {
        if (!eisnop2) {
            if (!(v1o = eeval ((Tobj) c1o, ei2)))
                err (ERRNORHS, ERR5, c1o, ei2);
            if (boolop (v1o) == FALSE)
                break;
        }
        if (setjmp (*pljbufp1) != 0) {
            if (pljtype == PLJ_CONTINUE)
                ;
            else if (pljtype == PLJ_BREAK)
                break;
        } else {
            eeval ((Tobj) c1o, si);
        }
        if (!eisnop3)
            eeval ((Tobj) c1o, ei3);
    }
    POPJMP (opljbufp, pljbufp1);
}

static void eforinst (Tobj co, int ci) {
    volatile jmp_buf *opljbufp;
    volatile jmp_buf pljbuf;
    volatile Tobj tblo, c1o;
    volatile Tkvindex_t tkvi;
    volatile tnk_t tnk;
    volatile long km, t;
    volatile int ei1, ei2, si;

    c1o = (volatile Tobj) co; /* protect argument from longjmp */
    ei1 = TCgetfp (c1o, ci);
    ei2 = TCgetnext (c1o, ei1);
    si = TCgetnext (c1o, ei2);
    if (getvar ((Tobj) c1o, ei1, (tnk_t *) &tnk) == -1) {
        err (ERRNOLHS, ERR3, c1o, ei1);
        return;
    }
    if (tnk.type == TNK_O)
        km = Mpushmark (tnk.u.tnko.ko);
    if (!(tblo = (volatile Tobj) eeval ((Tobj) c1o, ei2))) {
        if (tnk.type == TNK_O)
            Mpopmark (km);
        err (ERRNORHS, ERR4, c1o, ei2);
        return;
    }
    if (Tgettype (tblo) != T_TABLE) {
        err (ERRNOTATABLE, ERR1, c1o, ei2);
        return;
    }
    PUSHJMP (opljbufp, pljbufp1, pljbuf);
    t = Tgettime (tblo);
    for (Tgetfirst ((Tobj) tblo, (Tkvindex_t *) &tkvi); tkvi.kvp;
            Tgetnext ((Tkvindex_t *) &tkvi)) {
        setvar (tnk, tkvi.kvp->ko);
        if (setjmp (*pljbufp1) != 0) {
            if (pljtype == PLJ_CONTINUE)
                continue;
            else if (pljtype == PLJ_BREAK)
                break;
        }
        eeval ((Tobj) c1o, si);
        if (t != Tgettime (tblo)) {
            err (ERRTABLECHANGED, ERR1, c1o, ei2);
            break;
        }
    }
    POPJMP (opljbufp, pljbufp1);
    if (tnk.type == TNK_O)
        Mpopmark (km);
}

static Tobj getval (Tobj co, int ci) {
    Tobj cvo=NULL, cko=NULL, cto=NULL;
    Ctype_t ct=(Ctype_t)0, vt=(Ctype_t)0;
    int vi, ni, nn = 0;

    if ((ct = TCgettype (co, ci)) == C_LVAR) {
        nn = (int) TCgetinteger (co, (ni = TCgetnext (co, TCgetfp (co, ci))));
        cto = cvo = lvarp[flvari + nn].o;
        if (!cto)
            return NULL;
        vi = TCgetnext (co, ni);
    } else if (ct == C_GVAR) {
        cto = root;
        vi = TCgetfp (co, ci);
    } else if (ct == C_PVAR)
        return TCgetobject (co, ci);
    else
        return NULL;

    while (vi != C_NULL) {
        if (Tgettype (cto) != T_TABLE)
            return NULL;
        if ((vt = TCgettype (co, vi)) == C_STRING) {
            if (!(cvo = Tfinds (cto, TCgetstring (co, vi))))
                return NULL;
        } else if (vt == C_INTEGER) {
            if (!(cvo = Tfindi (cto, TCgetinteger (co, vi))))
                return NULL;
        } else if (vt == C_REAL) {
            if (!(cvo = Tfindr (cto, TCgetreal (co, vi))))
                return NULL;
        } else {
            if (!(cko = eeval (co, vi)) || !(cvo = Tfindo (cto, cko)))
                return NULL;
        }
        cto = cvo;
        vi = TCgetnext (co, vi);
    }
    return cvo;
}

static int getvar (Tobj co, int ci, tnk_t *tnkp) {
    Tobj cvo=NULL, cko=NULL, cto=NULL;
    Ctype_t ct=(Ctype_t)0, vt=(Ctype_t)0;
    long m;
    int vi, ovi, nn=0, ni;

    if ((ct = TCgettype (co, ci)) == C_LVAR) {
        nn = (int) TCgetinteger (co, (ni = TCgetnext (co, TCgetfp (co, ci))));
        cvo = cto = lvarp[flvari + nn].o;
        vi = TCgetnext (co, ni);
        if (vi != C_NULL && (!cvo || Tgettype (cvo) != T_TABLE))
            Mresetmark (lvarp[flvari + nn].m,
                    (lvarp[flvari + nn].o = cvo = cto = Ttable (0)));
    } else if (ct == C_GVAR) { /* else it's a global variable */
        cvo = root;
        vi = TCgetfp (co, ci);
    } else {
        return -1;
    }

    ovi = -1;
    while (vi != C_NULL) {
        cto = cvo;
        if ((vt = TCgettype (co, vi)) == C_STRING) {
            cvo = Tfinds (cto, TCgetstring (co, vi));
        } else if (vt == C_INTEGER) {
            cvo = Tfindi (cto, TCgetinteger (co, vi));
        } else if (vt == C_REAL) {
            cvo = Tfindr (cto, TCgetreal (co, vi));
        } else {
            if (!(cko = eeval (co, vi)) || !(T_ISSTRING (cko) ||
                    T_ISNUMBER (cko)))
                return -1;
            cvo = Tfindo (cto, cko);
        }
        ovi = vi, vi = TCgetnext (co, vi);
        if (vi != C_NULL && (!cvo || Tgettype (cvo) != T_TABLE)) {
            if (vt == C_STRING)
                Tinss (cto, TCgetstring (co, ovi), (cvo = Ttable (0)));
            else if (vt == C_INTEGER)
                Tinsi (cto, TCgetinteger (co, ovi), (cvo = Ttable (0)));
            else if (vt == C_REAL)
                Tinsr (cto, TCgetreal (co, ovi), (cvo = Ttable (0)));
            else
                m = Mpushmark (cko), Tinso (cto, cko, (cvo = Ttable (0))),
                        Mpopmark (m);
        }
    }
    if (ct == C_LVAR && ovi == -1) {
        tnkp->type = TNK_LI;
        tnkp->u.li = nn;
    } else {
        switch (vt) {
        case C_STRING:
        case C_INTEGER:
        case C_REAL:
            tnkp->type = TNK_S;
            tnkp->u.tnks.kt = vt;
            tnkp->u.tnks.to = cto;
            tnkp->u.tnks.co = co;
            tnkp->u.tnks.vi = ovi;
            break;
        default:
            tnkp->type = TNK_O;
            tnkp->u.tnko.to = cto;
            tnkp->u.tnko.ko = cko;
            break;
        }
    }
    return 0;
}

static void setvar (tnk_t tnk, Tobj vo) {
    switch (tnk.type) {
    case TNK_LI:
        Mresetmark (lvarp[flvari + tnk.u.li].m,
                (lvarp[flvari + tnk.u.li].o = vo));
        break;
    case TNK_O:
        Tinso (tnk.u.tnko.to, tnk.u.tnko.ko, vo);
        break;
    default:
        switch (tnk.u.tnks.kt) {
        case C_STRING:
            Tinss (tnk.u.tnks.to,
                    TCgetstring (tnk.u.tnks.co, tnk.u.tnks.vi), vo);
            break;
        case C_INTEGER:
            Tinsi (tnk.u.tnks.to,
                    TCgetinteger (tnk.u.tnks.co, tnk.u.tnks.vi), vo);
            break;
        case C_REAL:
            Tinsr (tnk.u.tnks.to, TCgetreal (tnk.u.tnks.co, tnk.u.tnks.vi), vo);
            break;
	default:
	    break;
        }
        break;
    }
}

static int boolop (Tobj vo) {
    long i;
    double d;

    if (!vo)
        return FALSE;

    switch (Tgettype (vo)) {
    case T_INTEGER:
        i = Tgetinteger (vo);
        return (i == 0) ? FALSE : TRUE;
    case T_REAL:
        d = Tgetreal (vo);
        return (d == 0.0) ? FALSE : TRUE;
    case T_TABLE:
        if (vo == null)
            return FALSE;
        return TRUE;
    default:
        return TRUE;
    }
}

static int orderop (Tobj v1o, Ctype_t op, Tobj v2o) {
    Ctype_t t1, t2;
    long i1, i2;
    int r;
    double d1, d2;

    if (!v1o || !v2o) {
        if ((v1o || v2o) && op == C_NE)
            return TRUE;
        return FALSE;
    }
    t1 = (Ctype_t)Tgettype (v1o), t2 = (Ctype_t)Tgettype (v2o);
    if (t1 == T_STRING && t2 == T_STRING) {
        r = Strcmp (Tgetstring (v1o), Tgetstring (v2o));
    } else if (t1 == T_INTEGER && t2 == T_INTEGER) {
        i1 = Tgetinteger (v1o), i2 = Tgetinteger (v2o);
        r = (i1 == i2) ? 0 : ((i1 < i2) ? -1 : 1);
    } else if (t1 == T_INTEGER && t2 == T_REAL) {
        i1 = Tgetinteger (v1o), d2 = Tgetreal (v2o);
        r = (i1 == d2) ? 0 : ((i1 < d2) ? -1 : 1);
    } else if (t1 == T_REAL && t2 == T_INTEGER) {
        d1 = Tgetreal (v1o), i2 = Tgetinteger (v2o);
        r = (d1 == i2) ? 0 : ((d1 < i2) ? -1 : 1);
    } else if (t1 == T_REAL && t2 == T_REAL) {
        d1 = Tgetreal (v1o), d2 = Tgetreal (v2o);
        r = (d1 == d2) ? 0 : ((d1 < d2) ? -1 : 1);
    } else if (t1 == t2) {
        if (op != C_EQ && op != C_NE)
            return FALSE;
        r = (v1o == v2o) ? 0 : 1;
    } else {
        return FALSE;
    }
    switch (op) {
    case C_EQ: return (r == 0) ? TRUE : FALSE;
    case C_NE: return (r != 0) ? TRUE : FALSE;
    case C_LT: return (r <  0) ? TRUE : FALSE;
    case C_LE: return (r <= 0) ? TRUE : FALSE;
    case C_GT: return (r >  0) ? TRUE : FALSE;
    case C_GE: return (r >= 0) ? TRUE : FALSE;
    default:
	break;
    }
    panic (POS, "orderop", "bad op code");
    return FALSE; /* NOT REACHED */
}

static Tobj arithop (Num_t *lnum, Ctype_t op, Num_t *rnum) {
    double d1, d2, d3 = 0.0;

    if (!rnum && op != C_UMINUS)
        return NULL;
    if (lnum->type == C_INTEGER)
        d1 = lnum->u.i;
    else if (lnum->type == C_REAL)
        d1 = lnum->u.d;
    else if (!lnum->u.no)
        return NULL;
    else if (Tgettype (lnum->u.no) == T_INTEGER)
        d1 = Tgetinteger (lnum->u.no);
    else if (Tgettype (lnum->u.no) == T_REAL)
        d1 = Tgetreal (lnum->u.no);
    else
        return NULL;
    if (op == C_UMINUS) {
        d3 = -d1;
        goto result;
    }
    if (rnum->type == C_INTEGER)
        d2 = rnum->u.i;
    else if (rnum->type == C_REAL)
        d2 = rnum->u.d;
    else if (!rnum->u.no)
        return NULL;
    else if (Tgettype (rnum->u.no) == T_INTEGER)
        d2 = Tgetinteger (rnum->u.no);
    else if (Tgettype (rnum->u.no) == T_REAL)
        d2 = Tgetreal (rnum->u.no);
    else
        return NULL;
    switch (op) {
    case C_PLUS:  d3 = d1 + d2;               break;
    case C_MINUS: d3 = d1 - d2;               break;
    case C_MUL:   d3 = d1 * d2;               break;
    case C_DIV:   d3 = d1 / d2;               break;
    case C_MOD:   d3 = (long) d1 % (long) d2; break;
    default:
	break;
    }
result:
    if (d3 == (double) (long) d3)
        return Tinteger ((long) d3);
    return Treal (d3);
}

static void err (int errnum, int level, Tobj co, int ci) {
    char *s;
    int si, i;

    if (level > Eerrlevel || !errdo)
        return;
    s = "";
    fprintf (stderr, "runtime error: %s\n", errnam[errnum]);
    if (!co)
        return;
    if (Estackdepth < 1)
        return;
    if (!sinfop[(si = sinfoi - 1)].fco && si > 0)
        si--;
    if (Eshowbody > 0) {
        if (co == sinfop[si].fco)
            s = Scfull (co, 0, ci);
        else if (co == sinfop[si].co)
            s = Scfull (co, TCgetfp (co, 0), ci);
        printbody (s, Eshowbody), free (s);
        if (Estackdepth == 1) {
            fprintf (stderr, "\n");
            errdo = FALSE;
        }
        for (i = si; i >= 0; i--) {
            if (sinfop[i].fco) {
                s = Scfull (sinfop[i].fco, 0, sinfop[i].fci);
                printbody (s, Eshowbody), free (s);
            }
        }
        s = Scfull (sinfop[0].co, TCgetfp (sinfop[0].co, 0), sinfop[0].ci);
        printbody (s, Eshowbody), free (s);
    }
    fprintf (stderr, "\n");
    errdo = FALSE;
}

static void printbody (char *s, int mode) {
    char *s1, *s2;
    char c;

    if (mode == 2) {
        fprintf (stderr, "%s\n", s);
        return;
    }
    c = '\000';
    for (s1 = s; *s1; s1++)
        if (*s1 == '>' && *(s1 + 1) && *(s1 + 1) == '>')
            break;
    if (!*s1)
        return;
    for (; s1 != s; s1--)
        if (*(s1 - 1) == '\n')
            break;
    for (s2 = s1; *s2; s2++)
        if (*s2 == '\n')
            break;
    if (*s2)
        c = *s2, *s2 = '\000';
    fprintf (stderr, "%s\n", s1);
    if (c)
        *s2 = c;
}