void
prim_pow(PRIM_PROTOTYPE)
{
CHECKOP(2);
oper1 = POP();
oper2 = POP();
if (oper2->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (2)");
if (!no_good(oper1->data.fnumber) && !no_good(oper2->data.fnumber)) {
if (fabs(oper2->data.fnumber) < DBL_EPSILON) {
fresult = 0.0;
} else if (oper2->data.fnumber < 0.0 &&
oper1->data.fnumber != floor(oper1->data.fnumber))
{
fresult = 0.0;
fr->error.error_flags.imaginary = 1;
} else {
fresult = pow(oper2->data.fnumber, oper1->data.fnumber);
}
} else {
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
CLEAR(oper2);
PushFloat(fresult);
}
void
prim_xyz_to_polar(PRIM_PROTOTYPE)
{
float dist, theta, phi;
double x, y, z;
CHECKOP(3);
oper3 = POP();
oper2 = POP();
oper1 = POP();
if ( oper1->type == PROG_INTEGER )
{ oper1->type = PROG_FLOAT;
oper1->data.fnumber = oper1->data.number;
}
if ( oper2->type == PROG_INTEGER )
{ oper2->type = PROG_FLOAT;
oper2->data.fnumber = oper1->data.number;
}
if ( oper3->type == PROG_INTEGER )
{ oper3->type = PROG_FLOAT;
oper3->data.fnumber = oper1->data.number;
}
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (oper2->type != PROG_FLOAT)
abort_interp("Non-float argument. (2)");
if (oper3->type != PROG_FLOAT)
abort_interp("Non-float argument. (3)");
x = oper1->data.fnumber;
y = oper2->data.fnumber;
z = oper3->data.fnumber;
if (no_good(x) || no_good(y) || no_good(z)) {
dist = 0.0;
theta = 0.0;
phi = 0.0;
fr->error.error_flags.nan = 1;
} else {
dist = (float) sqrt((x * x) + (y * y) + (z * z));
if (dist > 0.0) {
theta = (float) atan2(y, x);
phi = (float) acos(z / dist);
} else {
theta = 0.0;
phi = 0.0;
}
}
CLEAR(oper1);
CLEAR(oper2);
CLEAR(oper3);
PushFloat(dist);
PushFloat(theta);
PushFloat(phi);
}
void
prim_divide(PRIM_PROTOTYPE)
{
CHECKOP(2);
oper1 = POP();
oper2 = POP();
if (!arith_type(oper2, oper1))
abort_interp("Invalid argument type");
if ((oper1->type == PROG_FLOAT) || (oper2->type == PROG_FLOAT)) {
if ((oper1->type == PROG_INTEGER && !oper1->data.number) ||
(oper1->type == PROG_FLOAT && fabs(oper1->data.fnumber)
< DBL_EPSILON)) {
fresult = tp_alt_infinity_handler ?
((oper2->type ==
PROG_INTEGER) ? oper2->data.number : oper2->data.fnumber) *
INF : 0.0;
fr->error.error_flags.div_zero = 1;
} else {
tf1 =
(oper2->type ==
PROG_FLOAT) ? oper2->data.fnumber : oper2->data.number;
tf2 =
(oper1->type ==
PROG_FLOAT) ? oper1->data.fnumber : oper1->data.number;
if (!no_good(tf1) && !no_good(tf2)) {
fresult = tf1 / tf2;
} else {
if (ISNAN(tf1) || ISNAN(tf2)) {
fresult = tp_alt_infinity_handler ? NAN : 0.0;
if (!tp_alt_infinity_handler)
fr->error.error_flags.nan = 1;
} else {
fresult = tp_alt_infinity_handler ? (tf1 / tf2) : 0.0;
if (!tp_alt_infinity_handler)
fr->error.error_flags.f_bounds = 1;
}
}
}
} else {
if (oper1->data.number) {
result = oper2->data.number / oper1->data.number;
} else {
result = 0;
fr->error.error_flags.div_zero = 1;
}
}
tmp = (oper2->type == PROG_FLOAT
|| oper1->type == PROG_FLOAT) ? PROG_FLOAT : oper2->type;
CLEAR(oper1);
CLEAR(oper2);
if (tmp == PROG_FLOAT)
push(arg, top, tmp, MIPSCAST & fresult);
else
push(arg, top, tmp, MIPSCAST & result);
}
void
prim_polar_to_xyz(PRIM_PROTOTYPE)
{
float x, y, z;
double dist, theta, phi;
CHECKOP(3);
oper3 = POP();
oper2 = POP();
oper1 = POP();
if ( oper1->type == PROG_INTEGER )
{ oper1->type = PROG_FLOAT;
oper1->data.fnumber = oper1->data.number;
}
if ( oper2->type == PROG_INTEGER )
{ oper2->type = PROG_FLOAT;
oper2->data.fnumber = oper1->data.number;
}
if ( oper3->type == PROG_INTEGER )
{ oper3->type = PROG_FLOAT;
oper3->data.fnumber = oper1->data.number;
}
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (oper2->type != PROG_FLOAT)
abort_interp("Non-float argument. (2)");
if (oper3->type != PROG_FLOAT)
abort_interp("Non-float argument. (3)");
dist = oper1->data.fnumber;
theta = oper2->data.fnumber;
phi = oper3->data.fnumber;
if (no_good(dist) || no_good(theta) || no_good(phi)) {
x = 0.0;
y = 0.0;
z = 0.0;
fr->error.error_flags.nan = 1;
} else {
x = (float) (dist * cos(theta) * sin(phi));
y = (float) (dist * sin(theta) * sin(phi));
z = (float) (dist * cos(phi));
}
CLEAR(oper1);
CLEAR(oper2);
CLEAR(oper3);
PushFloat(x);
PushFloat(y);
PushFloat(z);
}
void
prim_sqrt(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if ( oper1->type == PROG_INTEGER )
{ oper1->type = PROG_FLOAT;
oper1->data.fnumber = oper1->data.number;
}
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
if (oper1->data.fnumber < 0.0) {
fresult = 0.0;
fr->error.error_flags.imaginary = 1;
} else {
fresult = (float) sqrt((double) oper1->data.fnumber);
}
} else {
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
PushFloat(fresult);
}
void
prim_modf(PRIM_PROTOTYPE)
{
float tresult;
double dresult;
CHECKOP(1);
oper1 = POP();
if ( oper1->type == PROG_INTEGER )
{ oper1->type = PROG_FLOAT;
oper1->data.fnumber = oper1->data.number;
}
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
fresult = (float) modf((double) oper1->data.fnumber, &dresult);
} else {
fresult = 0.0;
tresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
tresult = (float) dresult;
CHECKOFLOW(2);
PushFloat(tresult);
PushFloat(fresult);
}
void
prim_tan(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if ( oper1->type == PROG_INTEGER )
{ oper1->type = PROG_FLOAT;
oper1->data.fnumber = oper1->data.number;
}
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
fresult = fmod((oper1->data.fnumber - H_PI), F_PI);
if (fresult < 0.000001 || fresult > (F_PI - 0.000001)) {
fresult = (float) tan((double) oper1->data.fnumber);
} else {
fresult = 0.0;
fr->error.error_flags.nan = 1;
}
} else {
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
PushFloat(fresult);
}
void
prim_round(PRIM_PROTOTYPE)
{
double temp, tshift, tnum, fstore;
CHECKOP(2);
oper1 = POP();
oper2 = POP();
if (oper1->type != PROG_INTEGER)
abort_interp("Non-integer argument. (2)");
if (oper2->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (oper1->type < 0)
abort_interp("Precision argument must be a positive integer. (2)");
if (!no_good(oper2->data.fnumber)) {
temp = pow(10.0, (double) oper1->data.number);
tshift = temp * ((double) oper2->data.fnumber);
tnum = modf(tshift, &fstore);
if (tnum >= 0.5) {
fstore = fstore + 1.0;
} else {
if (tnum <= -0.5) {
fstore = fstore - 1.0;
}
}
fstore = fstore / temp;
fresult = (float) fstore;
} else {
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
CLEAR(oper2);
PushFloat(fresult);
}
void
prim_subtract(PRIM_PROTOTYPE)
{
CHECKOP(2);
oper1 = POP();
oper2 = POP();
if (!arith_type(oper2, oper1))
abort_interp("Invalid argument type.");
if ((oper1->type == PROG_FLOAT) || (oper2->type == PROG_FLOAT)) {
tf1 =
(oper2->type ==
PROG_FLOAT) ? oper2->data.fnumber : oper2->data.number;
tf2 =
(oper1->type ==
PROG_FLOAT) ? oper1->data.fnumber : oper1->data.number;
if (!no_good(tf1) && !no_good(tf2)) {
fresult = tf1 - tf2;
} else {
if (ISNAN(tf1) || ISNAN(tf2)) {
fresult = tp_alt_infinity_handler ? NAN : 0.0;
if (!tp_alt_infinity_handler)
fr->error.error_flags.nan = 1;
} else {
fresult = tp_alt_infinity_handler ? (tf1 + tf2) : 0.0;
if (!tp_alt_infinity_handler)
fr->error.error_flags.f_bounds = 1;
}
}
} else {
result = oper2->data.number - oper1->data.number;
tl = (double) oper2->data.number - (double) oper1->data.number;
if (!arith_good(tl))
fr->error.error_flags.i_bounds = 1;
}
tmp = (oper2->type == PROG_FLOAT
|| oper1->type == PROG_FLOAT) ? PROG_FLOAT : oper2->type;
CLEAR(oper1);
CLEAR(oper2);
if (tmp == PROG_FLOAT)
push(arg, top, tmp, MIPSCAST & fresult);
else
push(arg, top, tmp, MIPSCAST & result);
}
void
prim_pow(PRIM_PROTOTYPE)
{
CHECKOP(2);
oper1 = POP();
oper2 = POP();
if ( oper1->type == PROG_INTEGER )
{ oper1->type = PROG_FLOAT;
oper1->data.fnumber = oper1->data.number;
}
if ( oper2->type == PROG_INTEGER )
{ oper2->type = PROG_FLOAT;
oper2->data.fnumber = oper1->data.number;
}
if (oper2->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (2)");
if (!no_good(oper1->data.fnumber) && !no_good(oper2->data.fnumber)) {
if (((oper2->data.fnumber < SMALL_NUM && oper2->data.fnumber > NSMALL_NUM) &&
(oper1->data.fnumber < SMALL_NUM))
||
((oper2->data.fnumber < SMALL_NUM) &&
(oper1->data.fnumber != (float) ((int) oper1->data.fnumber)))) {
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
} else {
fresult = (float)
pow((double) oper2->data.fnumber, (double) oper1->data.fnumber);
}
} else {
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
CLEAR(oper2);
PushFloat(fresult);
}
void
prim_atan(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
fresult = atan(oper1->data.fnumber);
} else {
fresult = H_PI;
}
CLEAR(oper1);
PushFloat(fresult);
}
void
prim_floor(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
fresult = (float) floor((double) oper1->data.fnumber);
} else {
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
PushFloat(fresult);
}
void
prim_cos(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
fresult = cos(oper1->data.fnumber);
} else {
/* FIXME: This should be NaN. */
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
PushFloat(fresult);
}
void
prim_atan(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if ( oper1->type == PROG_INTEGER )
{ oper1->type = PROG_FLOAT;
oper1->data.fnumber = oper1->data.number;
}
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
fresult = (float) atan((double) oper1->data.fnumber);
} else {
fresult = H_PI;
}
CLEAR(oper1);
PushFloat(fresult);
}
void
prim_log10(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber) && oper1->data.fnumber > 0.0) {
fresult = log10(oper1->data.fnumber);
} else if (oper1->data.fnumber > 0.0) {
fresult = INF;
fr->error.error_flags.f_bounds = 1;
} else {
fresult = 0.0;
fr->error.error_flags.imaginary = 1;
}
CLEAR(oper1);
PushFloat(fresult);
}
void
prim_tan(PRIM_PROTOTYPE)
{
CHECKOP(1);
oper1 = POP();
if (oper1->type != PROG_FLOAT)
abort_interp("Non-float argument. (1)");
if (!no_good(oper1->data.fnumber)) {
fresult = fmod((oper1->data.fnumber - H_PI), F_PI);
if (fabs(fresult) > DBL_EPSILON && fabs(fresult-F_PI) > DBL_EPSILON) {
fresult = tan(oper1->data.fnumber);
} else {
fresult = 0.0;
fr->error.error_flags.nan = 1;
}
} else {
/* FIXME: This should be NaN. */
fresult = 0.0;
fr->error.error_flags.f_bounds = 1;
}
CLEAR(oper1);
PushFloat(fresult);
}
