Exemple #1
0
/* 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;
}
Exemple #2
0
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;
}
Exemple #3
0
static void buildlist (txtnode_t *pnode) {
    Tkvindex_t tkvi;
    Tobj ko, vo;
    int vtype;
    txtnode_t *cnode;

    pnode->u.f.t.n = ((Ttable_t *) pnode->vo)->n;
    if (!(pnode->u.f.t.list = malloc (
        max (pnode->u.f.t.n, 1) * sizeof (txtnode_t)
    )))
        panic (POS, "buildlist", "list malloc failed");

    for (
        cnode = &pnode->u.f.t.list[0], Tgetfirst (pnode->vo, &tkvi);
        tkvi.kvp; Tgetnext (&tkvi)
    ) {
        ko = tkvi.kvp->ko, vo = tkvi.kvp->vo;
        vtype = Tgettype (vo);
        if (vtype == T_CODE && TCgettype (vo, TCgetnext (
            vo, TCgetnext (vo, TCgetnext (vo, TCgetfp (vo, 0)))
        )) == C_INTERNAL) {
            pnode->u.f.t.n--;
            continue;
        }
        *cnode = defnode;
        cnode->vo = vo;
        cnode->ko = ko;
        cnode->ttype = vtype;
        cnode++;
    }
    qsort (
        (char *) pnode->u.f.t.list, pnode->u.f.t.n, sizeof (txtnode_t), cmp
    );
}
Exemple #4
0
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);
}
Exemple #5
0
static Tobj getval(Tobj co, int ci)
{
    Tobj cvo, cko, cto;
    Ctype_t ct, vt;
    int vi, ni, nn;

    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;
}
Exemple #6
0
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);
}
Exemple #7
0
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;
}
Exemple #8
0
static void rebuildlist (txtnode_t *pnode) {
    Tkvindex_t tkvi;
    Tobj ko, vo;
    int vtype;
    txtnode_t *cnode;
    txtnode_t *olist, *nlist;
    txtnode_t tmpnode;
    int on, nn, i, j, cmpval;

    cmpval = 0;
    olist = pnode->u.f.t.list;
    on = pnode->u.f.t.n;
    pnode->u.f.t.n = ((Ttable_t *) pnode->vo)->n;
    if (!(pnode->u.f.t.list = malloc (
        max (pnode->u.f.t.n, 1) * sizeof (txtnode_t)
    )))
        panic (POS, "rebuildlist", "list malloc failed");

    for (
        cnode = &pnode->u.f.t.list[0], Tgetfirst (pnode->vo, &tkvi);
        tkvi.kvp; Tgetnext (&tkvi)
    ) {
        ko = tkvi.kvp->ko, vo = tkvi.kvp->vo;
        vtype = Tgettype (vo);
        if (vtype == T_CODE && TCgettype (vo, TCgetnext (
            vo, TCgetnext (vo, TCgetnext (vo, TCgetfp (vo, 0)))
        )) == C_INTERNAL) {
            pnode->u.f.t.n--;
            continue;
        }
        *cnode = defnode;
        cnode->vo = vo;
        cnode->ko = ko;
        cnode->ttype = vtype;
        cnode++;
    }
    qsort ((char *) pnode->u.f.t.list, pnode->u.f.t.n, sizeof (txtnode_t), cmp);
    nlist = pnode->u.f.t.list;
    nn = pnode->u.f.t.n;
    for (i = 0, j = 0; i < nn; i++) {
        while (j < on && (cmpval = cmp (&olist[j], &nlist[i])) < 0)
            j++;
        if (j < on && cmpval == 0 && nlist[i].vo == olist[j].vo)
            tmpnode = olist[j], olist[j] = nlist[i], nlist[i] = tmpnode, j++;
    }
    for (j = 0; j < on; j++)
        unfillnode (&olist[j]);
    free (olist);
}
Exemple #9
0
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);
}
Exemple #10
0
static int getvar(Tobj co, int ci, tnk_t * tnkp)
{
    Tobj cvo, cko, cto;
    Ctype_t ct, vt;
    long m;
    int vi, ovi, nn, 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;
}
Exemple #11
0
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;
	    }
	    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;
}
Exemple #12
0
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;
}
Exemple #13
0
static void codestr (Tobj co, int ci) {
    int ct, ct1;
    int ci1, ci2;

    if (highci == ci)
        appends (" >> ");
    switch ((ct = TCgettype (co, ci))) {
    case C_ASSIGN:
        codestr (co, (ci1 = TCgetfp (co, ci)));
        appends (" = ");
        codestr (co, TCgetnext (co, ci1));
        break;
    case C_OR:
    case C_AND:
    case C_EQ:
    case C_NE:
    case C_LT:
    case C_LE:
    case C_GT:
    case C_GE:
    case C_PLUS:
    case C_MINUS:
    case C_MUL:
    case C_DIV:
    case C_MOD:
        codestr (co, (ci1 = TCgetfp (co, ci)));
        switch (ct) {
        case C_OR:    appends (" | ");  break;
        case C_AND:   appends (" & ");  break;
        case C_EQ:    appends (" == "); break;
        case C_NE:    appends (" ~= "); break;
        case C_LT:    appends (" < ");  break;
        case C_LE:    appends (" <= "); break;
        case C_GT:    appends (" > ");  break;
        case C_GE:    appends (" >= "); break;
        case C_PLUS:  appends (" + ");  break;
        case C_MINUS: appends (" - ");  break;
        case C_MUL:   appends (" * ");  break;
        case C_DIV:   appends (" / ");  break;
        case C_MOD:   appends (" % ");  break;
        }
        codestr (co, TCgetnext (co, ci1));
        break;
    case C_NOT:
        appends ("~");
        codestr (co, TCgetfp (co, ci));
        break;
    case C_UMINUS:
        appends ("-");
        codestr (co, TCgetfp (co, ci));
        break;
    case C_PEXPR:
        appends ("(");
        codestr (co, TCgetfp (co, ci));
        appends (")");
        break;
    case C_FCALL:
        codestr (co, (ci1 = TCgetfp (co, ci)));
        appends (" (");
        codestr (co, TCgetnext (co, ci1));
        appends (")");
        break;
    case C_INTEGER:
        appendi (TCgetinteger (co, ci));
        break;
    case C_REAL:
        appendd (TCgetreal (co, ci));
        break;
    case C_STRING:
        appends ("\""), appends (TCgetstring (co, ci)), appends ("\"");
        break;
    case C_GVAR:
    case C_LVAR:
        ci1 = TCgetfp (co, ci);
        appends (TCgetstring (co, ci1));
        if (ct == C_LVAR)
            ci1 = TCgetnext (co, ci1);
        for (
            ci1 = TCgetnext (co, ci1); ci1 != C_NULL;
            ci1 = TCgetnext (co, ci1)
        ) {
            switch (TCgettype (co, ci1)) {
            case C_STRING:
                appends ("."), appends (TCgetstring (co, ci1));
                break;
            case C_INTEGER:
                appends ("[");
                appendi (TCgetinteger (co, ci1));
                appends ("]");
                break;
            case C_REAL:
                appends ("[");
                appendd (TCgetreal (co, ci1));
                appends ("]");
                break;
            default:
                appends ("[");
                codestr (co, ci1);
                appends ("]");
            }
        }
        break;
    case C_PVAR:
        appends ("<var>");
        break;
    case C_FUNCTION:
        ci1 = TCgetnext (co, TCgetnext (co, TCgetfp (co, ci)));
        appends ("function (");
        codestr (co, ci1);
        ci1 = TCgetnext (co, ci1);
        if (TCgettype (co, ci1) == C_INTERNAL) {
            appends (") internal \"");
            appends (Ifuncs[TCgetinteger (co, TCgetfp (co, ci1))].name);
            appends ("\"");
        } else {
            appends (") {");
            INDINC (2);
            for (; ci1 != C_NULL; ci1 = TCgetnext (co, ci1)) {
                appendnl ();
                if (TCgettype (co, ci1) == C_DECL)
                    appends ("local "), codestr (co, ci1), appends (";");
                else
                    codestr (co, ci1);
            }
            INDDEC (2);
            appendnl ();
            appends ("}");
        }
        break;
    case C_TCONS:
        appends ("[");
        INDINC (2);
        ci1 = TCgetfp (co, ci);
        while (ci1 != C_NULL) {
            appendnl ();
            codestr (co, ci1);
            appends (" = ");
            ci1 = TCgetnext (co, ci1);
            codestr (co, ci1);
            appends (";");
            ci1 = TCgetnext (co, ci1);
        }
        INDDEC (2);
        appendnl ();
        appends ("]");
        break;
    case C_DECL:
        ci1 = TCgetfp (co, ci);
        while (ci1 != C_NULL) {
            appends (TCgetstring (co, ci1));
            ci1 = TCgetnext (co, ci1);
            if (ci1 != C_NULL)
                appends (", ");
        }
        break;
    case C_STMT:
        ci1 = TCgetfp (co, ci);
        if (ci1 == C_NULL) {
            appends (";");
            break;
        }
        if (TCgetnext (co, ci1) == C_NULL) {
            codestr (co, ci1);
            ct1 = TCgettype (co, ci1);
            if (!C_ISSTMT (ct1))
                appends (";");
        } else {
            appends (" {");
            INDINC (2);
            for (; ci1 != C_NULL; ci1 = TCgetnext (co, ci1)) {
                appendnl ();
                codestr (co, ci1);
            }
            INDDEC (2);
            appendnl ();
            appends ("}");
        }
        break;
    case C_IF:
        ci1 = TCgetfp (co, ci);
        appends ("if (");
        codestr (co, ci1);
        appends (")");
        ci1 = TCgetnext (co, ci1);
        ci2 = TCgetfp (co, ci1);
        if (ci2 == C_NULL || TCgetnext (co, ci2) == C_NULL) {
            INDINC (2);
            appendnl ();
            codestr (co, ci1);
            INDDEC (2);
        } else {
            codestr (co, ci1);
        }
        ci1 = TCgetnext (co, ci1);
        if (ci1 == C_NULL)
            break;
        if (ci2 == C_NULL || TCgetnext (co, ci2) == C_NULL) {
            appendnl ();
            appends ("else");
        } else {
            appends (" else");
        }
        ci2 = TCgetfp (co, ci1);
        if (ci2 == C_NULL || TCgetnext (co, ci2) == C_NULL) {
            INDINC (2);
            appendnl ();
            codestr (co, ci1);
            INDDEC (2);
        } else {
            codestr (co, ci1);
        }
        break;
    case C_WHILE:
        ci1 = TCgetfp (co, ci);
        appends ("while (");
        codestr (co, ci1);
        ci1 = TCgetnext (co, ci1);
        ci2 = TCgetfp (co, ci1);
        if (ci2 == C_NULL || TCgetnext (co, ci2) == C_NULL) {
            appends (")");
            INDINC (2);
            appendnl ();
            codestr (co, ci1);
            INDDEC (2);
        } else {
            appends (")");
            codestr (co, ci1);
        }
        break;
    case C_FOR:
        ci1 = TCgetfp (co, ci);
        appends ("for (");
        codestr (co, ci1);
        appends ("; ");
        ci1 = TCgetnext (co, ci1);
        codestr (co, ci1);
        appends ("; ");
        ci1 = TCgetnext (co, ci1);
        codestr (co, ci1);
        ci1 = TCgetnext (co, ci1);
        ci2 = TCgetfp (co, ci1);
        if (ci2 == C_NULL || TCgetnext (co, ci2) == C_NULL) {
            appends (")");
            INDINC (2);
            appendnl ();
            codestr (co, ci1);
            INDDEC (2);
        } else {
            appends (")");
            codestr (co, ci1);
        }
        break;
    case C_FORIN:
        ci1 = TCgetfp (co, ci);
        appends ("for (");
        codestr (co, ci1);
        appends (" in ");
        ci1 = TCgetnext (co, ci1);
        codestr (co, ci1);
        ci1 = TCgetnext (co, ci1);
        ci2 = TCgetfp (co, ci1);
        if (ci2 == C_NULL || TCgetnext (co, ci2) == C_NULL) {
            appends (")");
            INDINC (2);
            appendnl ();
            codestr (co, ci1);
            INDDEC (2);
        } else {
            appends (")");
            codestr (co, ci1);
        }
        break;
    case C_BREAK:
        appends ("break;");
        break;
    case C_CONTINUE:
        appends ("continue;");
        break;
    case C_RETURN:
        ci1 = TCgetfp (co, ci);
        appends ("return");
        if (ci1 != C_NULL) {
            appends (" ");
            codestr (co, ci1);
        }
        appends (";");
        break;
    case C_ARGS:
        ci1 = TCgetfp (co, ci);
        while (ci1 != C_NULL) {
            codestr (co, ci1);
            ci1 = TCgetnext (co, ci1);
            if (ci1 != C_NULL)
                appends (", ");
        }
        break;
    default:
        panic1 (POS, "codestr", "bad object type: %d", ct);
    }
}