/* 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;
}
int Itablesize (int argc, lvar_t *argv) {
Tobj vo;
if (Tgettype ((vo = argv[0].o)) != T_TABLE)
return L_FAILURE;
rtno = Tinteger (((Ttable_t *) vo)->n);
return L_SUCCESS;
}
static Tobj arithop(num_tt * lnum, Ctype_t op, num_tt * rnum)
{
double d1, d2, d3;
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;
}
result:
if (d3 == (double) (long) d3)
return Tinteger((long) d3);
return Treal(d3);
}
int Iopenio (int argc, lvar_t *argv) {
int rtn;
if (argc == 3)
rtn = IOopen (
Tgetstring (argv[0].o),
Tgetstring (argv[1].o), Tgetstring (argv[2].o), NULL
);
else
rtn = IOopen (
Tgetstring (argv[0].o),
Tgetstring (argv[1].o), Tgetstring (argv[2].o),
Tgetstring (argv[3].o)
);
rtno = NULL;
if (rtn == -1)
return L_SUCCESS;
rtno = Tinteger (rtn);
return L_SUCCESS;
}
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;
}
int Imatch (int argc, lvar_t *argv) {
if (!T_ISSTRING (argv[0].o) || !T_ISSTRING (argv[1].o))
return L_FAILURE;
rtno = Tinteger (strmatch (Tgetstring (argv[0].o), Tgetstring (argv[1].o)));
return L_SUCCESS;
}
int Istrlen (int argc, lvar_t *argv) {
rtno = Tinteger (strlen (Tgetstring (argv[0].o)));
return L_SUCCESS;
}
int Itoint (int argc, lvar_t *argv) {
rtno = Tinteger ((long) Tgetnumber (argv[0].o));
return L_SUCCESS;
}