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;
}
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;
}
}
