/* shortcut: this function creates a piece of code that corresponds to <internal func name> = function () internal "<internal func name>"; */ Tobj Pfunction (char *ifnam, int ifnum) { int ui, ai, vi, si, fi, li1, li2, di, ifi, ifn; Creset (); ui = Cnew (C_CODE); ai = Cnew (C_ASSIGN); Csetfp (ui, ai); vi = Cnew (C_GVAR); si = Cstring (ifnam); Csetfp (vi, si); Csetfp (ai, vi); fi = Cnew (C_FUNCTION); Csetnext (vi, fi); li1 = Cinteger (0); Csetfp (fi, li1); li2 = Cinteger (0); Csetnext (li1, li2); di = Cnew (C_DECL); Csetfp (di, C_NULL); Csetnext (li2, di); ifi = Cnew (C_INTERNAL); ifn = Cinteger ((long) ifnum); Csetfp (ifi, ifn); Csetnext (di, ifi); Csetinteger (li1, (long) (Cgetindex () - fi)); Csetinteger (li2, 0); return Tcode (cbufp, 0, cbufi); }
/* 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; }
/* shortcut: this function creates a piece of code that corresponds to <func name> (<args>); where <args> is the second argument (ao) */ Tobj Pfcall (Tobj fo, Tobj ao) { int ui, fi, ffi, ai, aai; Creset (); ui = Cnew (C_CODE); fi = Cnew (C_FCALL); Csetfp (ui, fi); ffi = Cnew (C_PVAR); Csetobject (ffi, fo); Csetfp (fi, ffi); ai = Cnew (C_ARGS); Csetnext (ffi, ai); if (ao) { aai = Cnew (C_PVAR); Csetobject (aai, ao); Csetfp (ai, aai); } else Csetfp (ai, C_NULL); return Tcode (cbufp, 0, cbufi); }
Tobj Punit (Psrc_t *sp) { int ui, ei; Lsetsrc (sp->flag, sp->s, sp->fp, sp->tok, sp->lnum); Creset (); flvi = llvi = 0; if (setjmp (eljbuf) != 0) return NULL; while (Ltok == L_SEMI) Lgtok (); if (Ltok == L_EOF) return NULL; ui = Cnew (C_CODE); ei = pexpr (); Csetfp (ui, ei); Lgetsrc (&sp->flag, &sp->s, &sp->fp, &sp->tok, &sp->lnum); return Tcode (cbufp, 0, cbufi); }
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; }