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); }
/* 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; }
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; }
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; }
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; }
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 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; }