exec.c

Graphviz - Graph Drawing Programs from AT&T Research and Lucent Bell Labs See doc/build.html for

/* $Id: exec.c,v 1.2 2006/06/27 12:43:47 ellson Exp $ $Revision: 1.2 $ */
/* vim:set shiftwidth=4 ts=8: */

/**********************************************************
*      This software is part of the graphviz package      *
*                http://www.graphviz.org/                 *
*                                                         *
*            Copyright (c) 1994-2004 AT&T Corp.           *
*                and is licensed under the                *
*            Common Public License, Version 1.0           *
*                      by AT&T Corp.                      *
*                                                         *
*        Information and Software Systems Research        *
*              AT&T Research, Florham Park NJ             *
**********************************************************/

/* 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_tt {
    Ctype_t type;
    union {
	long i;
	double d;
	Tobj no;
    } u;
} num_tt;

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_tt *, Ctype_t, num_tt *);
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 = 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)
	panic1(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_tt lnum, rnum;
    long m1, 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;
	}
	/* 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:
	panic1(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)
	    panic1(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;
	    }