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); }
static int orderop(Tobj v1o, Ctype_t op, Tobj v2o) { Ctype_t t1, t2; long i1, i2; int r; double d1, d2; if (!v1o || !v2o) { if ((v1o || v2o) && op == C_NE) return TRUE; return FALSE; } t1 = Tgettype(v1o), t2 = Tgettype(v2o); if (t1 == T_STRING && t2 == T_STRING) { r = Strcmp(Tgetstring(v1o), Tgetstring(v2o)); } else if (t1 == T_INTEGER && t2 == T_INTEGER) { i1 = Tgetinteger(v1o), i2 = Tgetinteger(v2o); r = (i1 == i2) ? 0 : ((i1 < i2) ? -1 : 1); } else if (t1 == T_INTEGER && t2 == T_REAL) { i1 = Tgetinteger(v1o), d2 = Tgetreal(v2o); r = (i1 == d2) ? 0 : ((i1 < d2) ? -1 : 1); } else if (t1 == T_REAL && t2 == T_INTEGER) { d1 = Tgetreal(v1o), i2 = Tgetinteger(v2o); r = (d1 == i2) ? 0 : ((d1 < i2) ? -1 : 1); } else if (t1 == T_REAL && t2 == T_REAL) { d1 = Tgetreal(v1o), d2 = Tgetreal(v2o); r = (d1 == d2) ? 0 : ((d1 < d2) ? -1 : 1); } else if (t1 == t2) { if (op != C_EQ && op != C_NE) return FALSE; r = (v1o == v2o) ? 0 : 1; } else { return FALSE; } switch (op) { case C_EQ: return (r == 0) ? TRUE : FALSE; case C_NE: return (r != 0) ? TRUE : FALSE; case C_LT: return (r < 0) ? TRUE : FALSE; case C_LE: return (r <= 0) ? TRUE : FALSE; case C_GT: return (r > 0) ? TRUE : FALSE; case C_GE: return (r >= 0) ? TRUE : FALSE; } panic1(POS, "orderop", "bad op code"); return FALSE; /* NOT REACHED */ }
int Iconcat (int argc, lvar_t *argv) { Tobj ao; char buf2[50]; char *s; int i, n, bufi; for (bufi = 0, i = 0; i < argc; i++) { ao = argv[i].o; switch (Tgettype (argv[i].o)) { case T_STRING: if (bufi + (n = strlen (Tgetstring (ao)) + 1) > bufn) growbufp (bufi + n); for (s = Tgetstring (ao); *s; s++) bufp[bufi++] = *s; break; case T_INTEGER: if (bufi + 50 > bufn) growbufp (bufi + 50); sprintf (buf2, "%ld", Tgetinteger (ao)); for (s = buf2; *s; s++) bufp[bufi++] = *s; break; case T_REAL: if (bufi + 50 > bufn) growbufp (bufi + 50); sprintf (buf2, "%f", Tgetreal (ao)); for (s = buf2; *s; s++) bufp[bufi++] = *s; break; } } bufp[bufi] = '\000'; rtno = Tstring (bufp); return L_SUCCESS; }
int Iquote (int argc, lvar_t *argv) { Tobj so, ao, qo; char *s, *s1, *s2, *qs, *as; char buf2[50]; int n, bufi; if ( (Tgettype ((so = argv[0].o)) != T_STRING && !T_ISNUMBER (so)) || (argc > 1 && Tgettype ((qo = argv[1].o)) != T_STRING) || (argc > 2 && Tgettype ((ao = argv[2].o)) != T_STRING) ) return L_FAILURE; switch (Tgettype (so)) { case T_STRING: s = Tgetstring (so); break; case T_INTEGER: sprintf (buf2, "%ld", Tgetinteger (so)); s = &buf2[0]; break; case T_REAL: sprintf (buf2, "%f", Tgetreal (so)); s = &buf2[0]; break; } if (argc > 1) qs = Tgetstring (qo); else qs = "'\""; if (argc > 2) as = Tgetstring (ao); else as = NULL; bufi = 0; if ((n = strlen (s) + 3) * 2 > bufn) growbufp (n * 2); /* the *2 is max for chars to quote */ if (as) bufp[bufi++] = *as; for (s1 = s; *s1; s1++) { for (s2 = qs; *s2; s2++) if (*s1 == *s2) { bufp[bufi++] = '\\', bufp[bufi++] = *s1; break; } if (!*s2) { switch (*s1) { case '\n': bufp[bufi++] = '\\', bufp[bufi++] = 'n'; break; case '\r': bufp[bufi++] = '\\', bufp[bufi++] = 'r'; break; default: bufp[bufi++] = *s1; break; } } } if (as) bufp[bufi++] = *as; bufp[bufi] = '\000'; rtno = Tstring (bufp); return L_SUCCESS; }
int Iwritegraph (int argc, lvar_t *argv) { int ioi; if ( !T_ISNUMBER (argv[0].o) || !T_ISTABLE (argv[1].o) || !T_ISINTEGER (argv[2].o) ) return L_FAILURE; if ((ioi = Tgetnumber (argv[0].o)) < 0 || ioi >= ion) return L_FAILURE; D2Lwritegraph (ioi, argv[1].o, Tgetinteger (argv[2].o)); return L_SUCCESS; }
static int cmp (const void *a, const void *b) { int atype, btype; txtnode_t *anode, *bnode; double d1, d2; d1 = 0.0, d2 = 0.0; anode = (txtnode_t *) a, bnode = (txtnode_t *) b; atype = Tgettype (anode->ko), btype = Tgettype (bnode->ko); if (atype != btype) return (atype - btype); if (atype == T_STRING) return strcmp (Tgetstring (anode->ko), Tgetstring (bnode->ko)); if (atype == T_INTEGER) d1 = Tgetinteger (anode->ko), d2 = Tgetinteger (bnode->ko); else if (atype == T_REAL) d1 = Tgetreal (anode->ko), d2 = Tgetreal (bnode->ko); if (d1 < d2) return -1; else if (d1 > d2) return 1; else return 0; /* but this should never happen since keys are unique */ }
int Iecho (int argc, lvar_t *argv) { int i; for (i = 0; i < argc; i++) { switch (Tgettype (argv[i].o)) { case T_STRING: printf ("%s", Tgetstring (argv[i].o)); break; case T_INTEGER: printf ("%ld", Tgetinteger (argv[i].o)); break; case T_REAL: printf ("%f", Tgetreal (argv[i].o)); break; case T_TABLE: printf ("[\n"), Dtrace (argv[i].o, 4); break; } } printf ("\n"); return L_SUCCESS; }
static void scalarstr (Tobj to) { switch (Tgettype (to)) { case T_INTEGER: appendi (Tgetinteger (to)); break; case T_REAL: appendd (Tgetreal (to)); break; case T_STRING: appends ("\""), appends (Tgetstring (to)), appends ("\""); break; case T_CODE: codestr (to, 0); break; } }
static int boolop(Tobj vo) { long i; double d; if (!vo) return FALSE; switch (Tgettype(vo)) { case T_INTEGER: i = Tgetinteger(vo); return (i == 0) ? FALSE : TRUE; case T_REAL: d = Tgetreal(vo); return (d == 0.0) ? FALSE : TRUE; case T_TABLE: if (vo == null) return FALSE; return TRUE; default: return TRUE; } }