Beispiel #1
0
/* LEFTY builtin */
int C2Lreadcsmessage (int argc, lvar_t *argv) {

#if 0 /* not finished yet */
    io_t *p;
    int ioi, n;
    Msg_call_t msg;
    Tobj to;
    int tm;

    ioi = Tgetnumber (argv[0].o);
    if (ioi < 0 || ioi >= ion)
        return L_FAILURE;

    p = &iop[ioi];
    fseek (p->ofp, 0L, 1);
    if ((n = msgrecv (fileno (p->ifp), &msg)) <= 0)
        return L_FAILURE;
    to = Ttable (6);
    tm = Mpushmark (to);
    Tinss (to, "id", Tinteger (MSG_CHANNEL_USR (msg.channel)));
    Tinss (to, "pid", Tinteger (MSG_CHANNEL_SYS (msg.channel)));
    rtno = to;
    Mpopmark (tm);
#endif

    return L_SUCCESS;
}
Beispiel #2
0
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;
}
Beispiel #3
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;
}
Beispiel #4
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;
}
Beispiel #5
0
int Isplit (int argc, lvar_t *argv) {
    Tobj so, fo;
    char *sp, *sp2, *s;
    char fc, tc, qmode;
    long rtnm, rtni;
    int bufi, qflag;

    if (
        Tgettype ((so = argv[0].o)) != T_STRING ||
        Tgettype ((fo = argv[1].o)) != T_STRING
    )
        return L_FAILURE;
    qflag = (argc == 3) ? FALSE : TRUE;
    sp = Tgetstring (so);
    s = Tgetstring (fo);
    if (s[0] == '\\' && s[1] == 'n')
        fc = '\n';
    else
        fc = s[0];
    rtno = Ttable (4);
    rtnm = Mpushmark (rtno);
    rtni = 0;
    if (s[0] == 0) {
        for (sp2 = sp; *sp2; sp2++) {
            tc = *(sp2 + 1), *(sp2 + 1) = '\000';
            Tinsi (rtno, rtni++, Tstring (sp2));
            *(sp2 + 1) = tc;
        }
    } else if (qflag && (fc == ' ' || fc == '	')) {
        while (*sp == fc)
            sp++;
        while (*sp) {
            bufi = 0;
            qmode = 0;
            for (sp2 = sp; *sp2; sp2++) {
                if (bufi == bufn)
                    growbufp (bufn + BUFINCR);
                if (*sp2 == '"' || *sp2 == '\'') {
                    if (qmode) {
                        if (qmode == *sp2)
                            qmode = 0;
                        else
                            bufp[bufi++] = *sp2;
                    } else
                        qmode = *sp2;
                } else if (*sp2 == fc && !qmode)
                    break;
                else
                    bufp[bufi++] = *sp2;
            }
            if (bufi == bufn)
                growbufp (bufn + BUFINCR);
            bufp[bufi] = 0;
            Tinsi (rtno, rtni++, Tstring (bufp));
            while (*sp2 == fc)
                sp2++;
            sp = sp2;
        }
    } else {
        while (*sp) {
            for (sp2 = sp; *sp2 && *sp2 != fc; sp2++)
                ;
            tc = *sp2, *sp2 = '\000';
            Tinsi (rtno, rtni++, Tstring (sp));
            *sp2 = tc;
            if (*sp2) {
                sp2++;
                if (!*sp2)
                    Tinsi (rtno, rtni++, Tstring (""));
            }
            sp = sp2;
        }
    }
    Mpopmark (rtnm);
    return L_SUCCESS;
}