void
bignum_float(void)
{
double d;
d = convert_rational_to_double(pop());
push_double(d);
}
void
add_numbers(void)
{
double a, b;
if (isrational(stack[tos - 1]) && isrational(stack[tos - 2])) {
qadd();
return;
}
save();
p2 = pop();
p1 = pop();
if (isdouble(p1))
a = p1->u.d;
else
a = convert_rational_to_double(p1);
if (isdouble(p2))
b = p2->u.d;
else
b = convert_rational_to_double(p2);
push_double(a + b);
restore();
}
void
negate_number(void)
{
save();
p1 = pop();
if (iszero(p1)) {
push(p1);
restore();
return;
}
switch (p1->k) {
case NUM:
p2 = alloc();
p2->k = NUM;
p2->u.q.a = mcopy(p1->u.q.a);
p2->u.q.b = mcopy(p1->u.q.b);
MSIGN(p2->u.q.a) *= -1;
push(p2);
break;
case DOUBLE:
push_double(-p1->u.d);
break;
default:
stop("bug caught in mp_negate_number");
break;
}
restore();
}
void
arcsinh(void)
{
double d;
save();
p1 = pop();
if (car(p1) == symbol(SINH)) {
push(cadr(p1));
restore();
return;
}
if (isdouble(p1)) {
d = p1->u.d;
d = log(d + sqrt(d * d + 1.0));
push_double(d);
restore();
return;
}
if (iszero(p1)) {
push(zero);
restore();
return;
}
push_symbol(ARCSINH);
push(p1);
list(2);
restore();
}
void
divide_numbers(void)
{
double a, b;
if (isrational(stack[tos - 1]) && isrational(stack[tos - 2])) {
qdiv();
return;
}
save();
p2 = pop();
p1 = pop();
if (iszero(p2))
stop("divide by zero");
if (isdouble(p1))
a = p1->u.d;
else
a = convert_rational_to_double(p1);
if (isdouble(p2))
b = p2->u.d;
else
b = convert_rational_to_double(p2);
push_double(a / b);
restore();
}
void
invert_number(void)
{
unsigned int *a, *b;
save();
p1 = pop();
if (iszero(p1))
stop("divide by zero");
if (isdouble(p1)) {
push_double(1 / p1->u.d);
restore();
return;
}
a = mcopy(p1->u.q.a);
b = mcopy(p1->u.q.b);
MSIGN(b) = MSIGN(a);
MSIGN(a) = 1;
p1 = alloc();
p1->k = NUM;
p1->u.q.a = b;
p1->u.q.b = a;
push(p1);
restore();
}
static void
yyerf(void)
{
double d;
p1 = pop();
if (isdouble(p1)) {
d = 1.0 - erfc(p1->u.d);
push_double(d);
return;
}
if (isnegativeterm(p1)) {
push_symbol(ERF);
push(p1);
negate();
list(2);
negate();
return;
}
push_symbol(ERF);
push(p1);
list(2);
return;
}
void
arctanh(void)
{
double d;
save();
p1 = pop();
if (car(p1) == symbol(TANH)) {
push(cadr(p1));
restore();
return;
}
if (isdouble(p1)) {
d = p1->u.d;
if (d < -1.0 || d > 1.0)
stop("arctanh function argument is not in the interval [-1,1]");
d = log((1.0 + d) / (1.0 - d)) / 2.0;
push_double(d);
restore();
return;
}
if (iszero(p1)) {
push(zero);
restore();
return;
}
push_symbol(ARCTANH);
push(p1);
list(2);
restore();
}
void
arccosh(void)
{
double d;
save();
p1 = pop();
if (car(p1) == symbol(COSH)) {
push(cadr(p1));
restore();
return;
}
if (isdouble(p1)) {
d = p1->u.d;
if (d < 1.0)
stop("arccosh function argument is less than 1.0");
d = log(d + sqrt(d * d - 1.0));
push_double(d);
restore();
return;
}
if (isplusone(p1)) {
push(zero);
restore();
return;
}
push_symbol(ARCCOSH);
push(p1);
list(2);
restore();
}
Status push_constant(const char *value, Stack **operands)
{
double x = 0.0;
if (strcasecmp(value, "e") == 0)
{
x = M_E;
}
else if (strcasecmp(value, "pi") == 0)
{
x = M_PI;
}
else if (strcasecmp(value, "tau") == 0)
{
x = M_PI * 2;
}
else
{
return ERROR_UNDEFINED_CONSTANT;
}
push_double(x, operands);
return OK;
}
Status apply_operator(const Operator *operator, Stack **operands)
{
if (!operator || !*operands)
{
return ERROR_SYNTAX;
}
if (operator->arity == OPERATOR_UNARY)
{
return apply_unary_operator(operator, operands);
}
double y = pop_double(operands);
if (!*operands)
{
return ERROR_SYNTAX;
}
double x = pop_double(operands);
Status status = OK;
switch (operator->symbol)
{
case '^':
x = pow(x, y);
break;
case '*':
x = x * y;
break;
case '/':
x = x / y;
break;
case '%':
x = fmod(x, y);
break;
case '+':
x = x + y;
break;
case '-':
x = x - y;
break;
default:
return ERROR_UNRECOGNIZED;
}
push_double(x, operands);
return status;
}
Status apply_function(const char *function, Stack **operands)
{
if (!*operands)
{
return ERROR_FUNCTION_ARGUMENTS;
}
double x = pop_double(operands);
if (strcasecmp(function, "abs") == 0)
{
x = fabs(x);
}
else if (strcasecmp(function, "sqrt") == 0)
{
x = sqrt(x);
}
else if (strcasecmp(function, "ln") == 0)
{
x = log(x);
}
else if (strcasecmp(function, "lb") == 0)
{
x = log2(x);
}
else if (strcasecmp(function, "lg") == 0 || strcasecmp(function, "log") == 0)
{
x = log10(x);
}
else if (strcasecmp(function, "cos") == 0)
{
x = cos(x);
}
else if (strcasecmp(function, "sin") == 0)
{
x = sin(x);
}
else if (strcasecmp(function, "tan") == 0)
{
x = tan(x);
}
else
{
return ERROR_UNDEFINED_FUNCTION;
}
push_double(x, operands);
return OK;
}
Status push_number(const char *value, Stack **operands)
{
char *end_pointer = NULL;
double x = strtod(value, &end_pointer);
// If not all of the value is converted, the rest is invalid.
if (value + strlen(value) != end_pointer)
{
return ERROR_SYNTAX;
}
push_double(x, operands);
return OK;
}
void
get_xy(double t)
{
eval_f(t);
p1 = pop();
if (istensor(p1)) {
if (p1->u.tensor->nelem >= 2) {
XT = p1->u.tensor->elem[0];
YT = p1->u.tensor->elem[1];
} else {
XT = symbol(NIL);
YT = symbol(NIL);
}
return;
}
push_double(t);
XT = pop();
YT = p1;
}
Status apply_unary_operator(const Operator *operator, Stack **operands)
{
double x = pop_double(operands);
switch (operator->symbol)
{
case '+':
break;
case '-':
x = -x;
break;
case '!':
x = tgamma(x + 1);
break;
default:
return ERROR_UNRECOGNIZED;
}
push_double(x, operands);
return OK;
}
void
yybessely(void)
{
double d;
int n;
N = pop();
X = pop();
push(N);
n = pop_integer();
if (isdouble(X) && n != (int) 0x80000000) {
d = yn(n, X->u.d);
push_double(d);
return;
}
if (isnegativeterm(N)) {
push_integer(-1);
push(N);
power();
push_symbol(BESSELY);
push(X);
push(N);
negate();
list(3);
multiply();
return;
}
push_symbol(BESSELY);
push(X);
push(N);
list(3);
return;
}
void
yysinh(void)
{
double d;
p1 = pop();
if (car(p1) == symbol(ARCSINH)) {
push(cadr(p1));
return;
}
if (isdouble(p1)) {
d = sinh(p1->u.d);
if (fabs(d) < 1e-10)
d = 0.0;
push_double(d);
return;
}
if (iszero(p1)) {
push(zero);
return;
}
push_symbol(SINH);
push(p1);
list(2);
}
void
yyfloor(void)
{
double d;
p1 = pop();
if (!isnum(p1)) {
push_symbol(FLOOR);
push(p1);
list(2);
return;
}
if (isdouble(p1)) {
d = floor(p1->u.d);
push_double(d);
return;
}
if (isinteger(p1)) {
push(p1);
return;
}
p3 = alloc();
p3->k = NUM;
p3->u.q.a = mdiv(p1->u.q.a, p1->u.q.b);
p3->u.q.b = mint(1);
push(p3);
if (isnegativenumber(p1)) {
push_integer(-1);
add();
}
}
void
eval_f(double t)
{
// These must be volatile or it crashes. (Compiler error?)
// Read it backwards, save_tos is a volatile int, etc.
int volatile save_tos;
U ** volatile save_frame;
save();
save_tos = tos;
save_frame = frame;
draw_flag++;
if (setjmp(draw_stop_return)) {
tos = save_tos;
push(symbol(NIL));
frame = save_frame;
restore();
draw_flag--;
return;
}
push_double(t);
p1 = pop();
set_binding(T, p1);
push(F);
eval();
yyfloat();
eval();
restore();
draw_flag--;
}
void
arctan(void)
{
double d;
save();
p1 = pop();
if (car(p1) == symbol(TAN)) {
push(cadr(p1));
restore();
return;
}
if (isdouble(p1)) {
errno = 0;
d = atan(p1->u.d);
if (errno)
stop("arctan function error");
push_double(d);
restore();
return;
}
if (iszero(p1)) {
push(zero);
restore();
return;
}
if (isnegative(p1)) {
push(p1);
negate();
arctan();
negate();
restore();
return;
}
// arctan(sin(a) / cos(a)) ?
if (find(p1, symbol(SIN)) && find(p1, symbol(COS))) {
push(p1);
numerator();
p2 = pop();
push(p1);
denominator();
p3 = pop();
if (car(p2) == symbol(SIN) && car(p3) == symbol(COS) && equal(cadr(p2), cadr(p3))) {
push(cadr(p2));
restore();
return;
}
}
// arctan(1/sqrt(3)) -> pi/6
if (car(p1) == symbol(POWER) && equaln(cadr(p1), 3) && equalq(caddr(p1), -1, 2)) {
push_rational(1, 6);
push(symbol(PI));
multiply();
restore();
return;
}
// arctan(1) -> pi/4
if (equaln(p1, 1)) {
push_rational(1, 4);
push(symbol(PI));
multiply();
restore();
return;
}
// arctan(sqrt(3)) -> pi/3
if (car(p1) == symbol(POWER) && equaln(cadr(p1), 3) && equalq(caddr(p1), 1, 2)) {
push_rational(1, 3);
push(symbol(PI));
multiply();
restore();
return;
}
push_symbol(ARCTAN);
push(p1);
list(2);
restore();
}
void
yypower(void)
{
int n;
p2 = pop();
p1 = pop();
// both base and exponent are rational numbers?
if (isrational(p1) && isrational(p2)) {
push(p1);
push(p2);
qpow();
return;
}
// both base and exponent are either rational or double?
if (isnum(p1) && isnum(p2)) {
push(p1);
push(p2);
dpow();
return;
}
if (istensor(p1)) {
power_tensor();
return;
}
if (p1 == symbol(E) && car(p2) == symbol(LOG)) {
push(cadr(p2));
return;
}
if (p1 == symbol(E) && isdouble(p2)) {
push_double(exp(p2->u.d));
return;
}
// 1 ^ a -> 1
// a ^ 0 -> 1
if (equal(p1, one) || iszero(p2)) {
push(one);
return;
}
// a ^ 1 -> a
if (equal(p2, one)) {
push(p1);
return;
}
// (a * b) ^ c -> (a ^ c) * (b ^ c)
if (car(p1) == symbol(MULTIPLY)) {
p1 = cdr(p1);
push(car(p1));
push(p2);
power();
p1 = cdr(p1);
while (iscons(p1)) {
push(car(p1));
push(p2);
power();
multiply();
p1 = cdr(p1);
}
return;
}
// (a ^ b) ^ c -> a ^ (b * c)
if (car(p1) == symbol(POWER)) {
push(cadr(p1));
push(caddr(p1));
push(p2);
multiply();
power();
return;
}
// (a + b) ^ n -> (a + b) * (a + b) ...
if (expanding && isadd(p1) && isnum(p2)) {
push(p2);
n = pop_integer();
// this && n != 0x80000000 added by DDC
// as it's not always the case that 0x80000000
// is negative
if (n > 1 && n != 0x80000000) {
power_sum(n);
return;
}
}
// sin(x) ^ 2n -> (1 - cos(x) ^ 2) ^ n
if (trigmode == 1 && car(p1) == symbol(SIN) && iseveninteger(p2)) {
push_integer(1);
push(cadr(p1));
cosine();
push_integer(2);
power();
subtract();
push(p2);
push_rational(1, 2);
multiply();
power();
return;
}
// cos(x) ^ 2n -> (1 - sin(x) ^ 2) ^ n
if (trigmode == 2 && car(p1) == symbol(COS) && iseveninteger(p2)) {
push_integer(1);
push(cadr(p1));
sine();
push_integer(2);
power();
subtract();
push(p2);
push_rational(1, 2);
multiply();
power();
return;
}
// complex number? (just number, not expression)
if (iscomplexnumber(p1)) {
// integer power?
// n will be negative here, positive n already handled
if (isinteger(p2)) {
// / \ n
// -n | a - ib |
// (a + ib) = | -------- |
// | 2 2 |
// \ a + b /
push(p1);
conjugate();
p3 = pop();
push(p3);
push(p3);
push(p1);
multiply();
divide();
push(p2);
negate();
power();
return;
}
// noninteger or floating power?
if (isnum(p2)) {
#if 1 // use polar form
push(p1);
mag();
push(p2);
power();
push_integer(-1);
push(p1);
arg();
push(p2);
multiply();
push(symbol(PI));
divide();
power();
multiply();
#else // use exponential form
push(p1);
mag();
push(p2);
power();
push(symbol(E));
push(p1);
arg();
push(p2);
multiply();
push(imaginaryunit);
multiply();
power();
multiply();
#endif
return;
}
}
if (simplify_polar())
return;
push_symbol(POWER);
push(p1);
push(p2);
list(3);
}
void
eval_nroots(void)
{
volatile int h, i, k, n;
push(cadr(p1));
eval();
push(caddr(p1));
eval();
p2 = pop();
if (p2 == symbol(NIL))
guess();
else
push(p2);
p2 = pop();
p1 = pop();
if (!ispoly(p1, p2))
stop("nroots: polynomial?");
// mark the stack
h = tos;
// get the coefficients
push(p1);
push(p2);
n = coeff();
if (n > YMAX)
stop("nroots: degree?");
// convert the coefficients to real and imaginary doubles
for (i = 0; i < n; i++) {
push(stack[h + i]);
real();
yyfloat();
eval();
p1 = pop();
push(stack[h + i]);
imag();
yyfloat();
eval();
p2 = pop();
if (!isdouble(p1) || !isdouble(p2))
stop("nroots: coefficients?");
c[i].r = p1->u.d;
c[i].i = p2->u.d;
}
// pop the coefficients
tos = h;
// n is the number of coefficients, n = deg(p) + 1
monic(n);
for (k = n; k > 1; k--) {
findroot(k);
if (fabs(a.r) < DELTA)
a.r = 0.0;
if (fabs(a.i) < DELTA)
a.i = 0.0;
push_double(a.r);
push_double(a.i);
push(imaginaryunit);
multiply();
add();
divpoly(k);
}
// now make n equal to the number of roots
n = tos - h;
if (n > 1) {
sort_stack(n);
p1 = alloc_tensor(n);
p1->u.tensor->ndim = 1;
p1->u.tensor->dim[0] = n;
for (i = 0; i < n; i++)
p1->u.tensor->elem[i] = stack[h + i];
tos = h;
push(p1);
}
}
void
bignum_scan_float(char *s)
{
//push_double(atof(s));
push_double(mystrtod((char*)s, NULL));
}
void
yybesselj(void)
{
double d;
int n;
N = pop();
X = pop();
push(N);
n = pop_integer();
// numerical result
if (isdouble(X) && n != (int) 0x80000000) {
//d = jn(n, X->u.d);
push_double(d);
return;
}
// bessej(0,0) = 1
if (iszero(X) && iszero(N)) {
push_integer(1);
return;
}
// besselj(0,n) = 0
if (iszero(X) && n != (int) 0x80000000) {
push_integer(0);
return;
}
// half arguments
if (N->k == NUM && MEQUAL(N->u.q.b, 2)) {
// n = 1/2
if (MEQUAL(N->u.q.a, 1)) {
push_integer(2);
push_symbol(PI);
divide();
push(X);
divide();
push_rational(1, 2);
power();
push(X);
sine();
multiply();
return;
}
// n = -1/2
if (MEQUAL(N->u.q.a, -1)) {
push_integer(2);
push_symbol(PI);
divide();
push(X);
divide();
push_rational(1, 2);
power();
push(X);
cosine();
multiply();
return;
}
// besselj(x,n) = (2/x) (n-sgn(n)) besselj(x,n-sgn(n)) - besselj(x,n-2*sgn(n))
push_integer(MSIGN(N->u.q.a));
SGN = pop();
push_integer(2);
push(X);
divide();
push(N);
push(SGN);
subtract();
multiply();
push(X);
push(N);
push(SGN);
subtract();
besselj();
multiply();
push(X);
push(N);
push_integer(2);
push(SGN);
multiply();
subtract();
besselj();
subtract();
return;
}
push(symbol(BESSELJ));
push(X);
push(N);
list(3);
}
void
cosine_of_angle(void)
{
int n;
double d;
if (car(p1) == symbol(ARCCOS)) {
push(cadr(p1));
return;
}
if (isdouble(p1)) {
d = cos(p1->u.d);
if (fabs(d) < 1e-10)
d = 0.0;
push_double(d);
return;
}
// cosine function is symmetric, cos(-x) = cos(x)
if (isnegative(p1)) {
push(p1);
negate();
p1 = pop();
}
// cos(arctan(x)) = 1 / sqrt(1 + x^2)
// see p. 173 of the CRC Handbook of Mathematical Sciences
if (car(p1) == symbol(ARCTAN)) {
push_integer(1);
push(cadr(p1));
push_integer(2);
power();
add();
push_rational(-1, 2);
power();
return;
}
// multiply by 180/pi
push(p1);
push_integer(180);
multiply();
push_symbol(PI);
divide();
n = pop_integer();
if (n < 0) {
push(symbol(COS));
push(p1);
list(2);
return;
}
switch (n % 360) {
case 90:
case 270:
push_integer(0);
break;
case 60:
case 300:
push_rational(1, 2);
break;
case 120:
case 240:
push_rational(-1, 2);
break;
case 45:
case 315:
push_rational(1, 2);
push_integer(2);
push_rational(1, 2);
power();
multiply();
break;
case 135:
case 225:
push_rational(-1, 2);
push_integer(2);
push_rational(1, 2);
power();
multiply();
break;
case 30:
case 330:
push_rational(1, 2);
push_integer(3);
push_rational(1, 2);
power();
multiply();
break;
case 150:
case 210:
push_rational(-1, 2);
push_integer(3);
push_rational(1, 2);
power();
multiply();
break;
case 0:
push_integer(1);
break;
case 180:
push_integer(-1);
break;
default:
push(symbol(COS));
push(p1);
list(2);
break;
}
}