1 /*
2  * qtrans - transcendental functions for real numbers
3  *
4  * Copyright (C) 1999-2007,2021  David I. Bell and Ernest Bowen
5  *
6  * Primary author:  David I. Bell
7  *
8  * Calc is open software; you can redistribute it and/or modify it under
9  * the terms of the version 2.1 of the GNU Lesser General Public License
10  * as published by the Free Software Foundation.
11  *
12  * Calc is distributed in the hope that it will be useful, but WITHOUT
13  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14  * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
15  * Public License for more details.
16  *
17  * A copy of version 2.1 of the GNU Lesser General Public License is
18  * distributed with calc under the filename COPYING-LGPL.  You should have
19  * received a copy with calc; if not, write to Free Software Foundation, Inc.
20  * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
21  *
22  * Under source code control:	1990/02/15 01:48:22
23  * File existed as early as:	before 1990
24  *
25  * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
26  */
27 
28 /*
29  * Transcendental functions for real numbers.
30  * These are sin, cos, exp, ln, power, cosh, sinh.
31  */
32 
33 
34 #include "qmath.h"
35 
36 
37 #include "banned.h"	/* include after system header <> includes */
38 
39 
40 HALF _qlgenum_[] = { 36744 };
41 HALF _qlgeden_[] = { 25469 };
42 NUMBER _qlge_ = { { _qlgenum_, 1, 0 }, { _qlgeden_, 1, 0 }, 1, NULL };
43 
44 /*
45  * cache the natural logarithm of 10
46  */
47 STATIC NUMBER *ln_10 = NULL;
48 STATIC NUMBER *ln_10_epsilon = NULL;
49 
50 /*
51  * cache pi
52  *
53  * pivalue[LAST_PI_EPSILON] - last epsilon used to calculate pi
54  * pivalue[LAST_PI_VALUE] - last calculated pi
55  *			      given pivalue[LAST_PI_EPSILON] epsilon
56  * pivalue[LAST_PI_DIV_180_EPSILON] - last epsilon used to calculate pi/180
57  * pivalue[LAST_PI_DIV_180_VALUE] - last calculated pi/180 given
58  *				      pivalue[LAST_PI_DIV_180_EPSILON] epsilon
59  * pivalue[LAST_PI_DIV_200_EPSILON] - last epsilon used to calculate pi/200
60  * pivalue[LAST_PI_DIV_200_VALUE] - last calculated pi/200 given
61  *				      pivalue[LAST_PI_DIV_200_EPSILON] epsilon
62  */
63 enum pi_cache {
64 	LAST_PI_EPSILON = 0,
65 	LAST_PI_VALUE,
66 	LAST_PI_DIV_180_EPSILON,
67 	LAST_PI_DIV_180_VALUE,
68 	LAST_PI_DIV_200_EPSILON,
69 	LAST_PI_DIV_200_VALUE,
70 	PI_CACHE_LEN	/* must be last */
71 };
72 STATIC NUMBER *pivalue[PI_CACHE_LEN] = {
73 	NULL,	/* LAST_PI_EPSILON */
74 	NULL,	/* LAST_PI_VALUE */
75 	NULL,	/* LAST_PI_DIV_180_EPSILON */
76 	NULL,	/* LAST_PI_DIV_180_VALUE */
77 	NULL,	/* LAST_PI_DIV_200_EPSILON */
78 	NULL,	/* LAST_PI_DIV_200_VALUE */
79 };
80 
81 /*
82  * other static function declarations
83  */
84 STATIC NUMBER *qexprel(NUMBER *q, long bitnum);
85 
86 /*
87  * Evaluate and store in specified locations the sin and cos of a given
88  * number to accuracy corresponding to a specified number of binary digits.
89  */
90 void
qsincos(NUMBER * q,long bitnum,NUMBER ** vs,NUMBER ** vc)91 qsincos(NUMBER *q, long bitnum, NUMBER **vs, NUMBER **vc)
92 {
93 	long n, m, k, h, s, t, d;
94 	NUMBER *qtmp1, *qtmp2;
95 	ZVALUE X, cossum, sinsum, mul, ztmp1, ztmp2, ztmp3;
96 
97 	qtmp1 = qqabs(q);
98 	h = qilog2(qtmp1);
99 	qfree(qtmp1);
100 	k = bitnum + h + 1;
101 	if (k < 0) {
102 		*vs = qlink(&_qzero_);
103 		*vc = qlink(&_qone_);
104 		return;
105 	}
106 	s = k;
107 	if (k) {
108 		do {
109 			t = s;
110 			s = (s + k/s)/2;
111 		}
112 		while (t > s);
113 	}		/* s is int(sqrt(k)) */
114 	s++;
115 	if (s < -h)
116 		s = -h;
117 	n = h + s;	/* n is number of squaring that will be required */
118 	m = bitnum + n;
119 	while (s > 0) {		/* increasing m by ilog2(s) */
120 		s >>= 1;
121 		m++;
122 	}			/* m is working number of bits */
123 	qtmp1 = qscale(q, m - n);
124 	zquo(qtmp1->num, qtmp1->den, &X, 24);
125 	qfree(qtmp1);
126 	if (ziszero(X)) {
127 		zfree(X);
128 		*vs = qlink(&_qzero_);
129 		*vc = qlink(&_qone_);
130 		return;
131 	}
132 	zbitvalue(m, &cossum);
133 	zcopy(X, &sinsum);
134 	zcopy(X, &mul);
135 	d = 1;
136 	for (;;) {
137 		X.sign = !X.sign;
138 		zmul(X, mul, &ztmp1);
139 		zfree(X);
140 		zshift(ztmp1, -m, &ztmp2);
141 		zfree(ztmp1);
142 		zdivi(ztmp2, ++d, &X);
143 		zfree(ztmp2);
144 		if (ziszero(X))
145 			break;
146 		zadd(cossum, X, &ztmp1);
147 		zfree(cossum);
148 		cossum = ztmp1;
149 		zmul(X, mul, &ztmp1);
150 		zfree(X);
151 		zshift(ztmp1, -m, &ztmp2);
152 		zfree(ztmp1);
153 		zdivi(ztmp2, ++d, &X);
154 		zfree(ztmp2);
155 		if (ziszero(X))
156 			break;
157 		zadd(sinsum, X, &ztmp1);
158 		zfree(sinsum);
159 		sinsum = ztmp1;
160 	}
161 	zfree(X);
162 	zfree(mul);
163 	while (n-- > 0) {
164 		zsquare(cossum, &ztmp1);
165 		zsquare(sinsum, &ztmp2);
166 		zsub(ztmp1, ztmp2, &ztmp3);
167 		zfree(ztmp1);
168 		zfree(ztmp2);
169 		zmul(cossum, sinsum, &ztmp1);
170 		zfree(cossum);
171 		zfree(sinsum);
172 		zshift(ztmp3, -m, &cossum);
173 		zfree(ztmp3);
174 		zshift(ztmp1, 1 - m, &sinsum);
175 		zfree(ztmp1);
176 	}
177 	h = zlowbit(cossum);
178 	qtmp1 = qalloc();
179 	if (m > h) {
180 		zshift(cossum, -h, &qtmp1->num);
181 		zbitvalue(m - h, &qtmp1->den);
182 	} else {
183 		zshift(cossum, - m, &qtmp1->num);
184 	}
185 	zfree(cossum);
186 	*vc = qtmp1;
187 	h = zlowbit(sinsum);
188 	qtmp2 = qalloc();
189 	if (m > h) {
190 		zshift(sinsum, -h, &qtmp2->num);
191 		zbitvalue(m - h, &qtmp2->den);
192 	} else {
193 		zshift(sinsum, -m, &qtmp2->num);
194 	}
195 	zfree(sinsum);
196 	*vs = qtmp2;
197 	return;
198 }
199 
200 /*
201  * Calculate the cosine of a number to a near multiple of epsilon.
202  * This calls qsincos() and discards the value of sin.
203  */
204 NUMBER *
qcos(NUMBER * q,NUMBER * epsilon)205 qcos(NUMBER *q, NUMBER *epsilon)
206 {
207 	NUMBER *sin, *cos, *res;
208 	long n;
209 
210 	if (qiszero(epsilon)) {
211 		math_error("Zero epsilon value for cosine");
212 		/*NOTREACHED*/
213 	}
214 	if (qiszero(q))
215 		return qlink(&_qone_);
216 	n = -qilog2(epsilon);
217 	if (n < 0)
218 		return qlink(&_qzero_);
219 	qsincos(q, n + 2, &sin, &cos);
220 	qfree(sin);
221 	res = qmappr(cos, epsilon, 24);
222 	qfree(cos);
223 	return res;
224 }
225 
226 
227 
228 /*
229  * This calls qsincos() and discards the value of cos.
230  */
231 NUMBER *
qsin(NUMBER * q,NUMBER * epsilon)232 qsin(NUMBER *q, NUMBER *epsilon)
233 {
234 	NUMBER *sin, *cos, *res;
235 	long n;
236 
237 	if (qiszero(epsilon)) {
238 		math_error("Zero epsilon value for sine");
239 		/*NOTREACHED*/
240 	}
241 	n = -qilog2(epsilon);
242 	if (qiszero(q) || n < 0)
243 		return qlink(&_qzero_);
244 	qsincos(q, n + 2, &sin, &cos);
245 	qfree(cos);
246 	res = qmappr(sin, epsilon, 24);
247 	qfree(sin);
248 	return res;
249 }
250 
251 
252 /*
253  * Calculate the tangent function.
254  */
255 NUMBER *
qtan(NUMBER * q,NUMBER * epsilon)256 qtan(NUMBER *q, NUMBER *epsilon)
257 {
258 	NUMBER *sin, *cos, *tan, *res;
259 	long n, k, m;
260 
261 	if (qiszero(epsilon)) {
262 		math_error("Zero epsilon value for tangent");
263 		/*NOTREACHED*/
264 	}
265 	if (qiszero(q))
266 		return qlink(q);
267 	n = qilog2(epsilon);
268 	k = (n > 0) ? 4 + n/2 : 4;
269 	for (;;) {
270 		qsincos(q, 2 * k - n, &sin, &cos);
271 		if (qiszero(cos)) {
272 			qfree(sin);
273 			qfree(cos);
274 			k = 2 * k - n + 4;
275 			continue;
276 		}
277 		m = -qilog2(cos);
278 		if (m < k)
279 			 break;
280 		qfree(sin);
281 		qfree(cos);
282 		k = m + 1;
283 	}
284 	tan = qqdiv(sin, cos);
285 	qfree(sin);
286 	qfree(cos);
287 	res = qmappr(tan, epsilon, 24);
288 	qfree(tan);
289 	return res;
290 }
291 
292 
293 /*
294  * Calculate the cotangent function.
295  */
296 NUMBER *
qcot(NUMBER * q,NUMBER * epsilon)297 qcot(NUMBER *q, NUMBER *epsilon)
298 {
299 	NUMBER *sin, *cos, *cot, *res;
300 	long n, k, m;
301 
302 	if (qiszero(epsilon)) {
303 		math_error("Zero epsilon value for cotangent");
304 		/*NOTREACHED*/
305 	}
306 	if (qiszero(q)) {
307 		math_error("Zero argument for cotangent");
308 		/*NOTREACHED*/
309 	}
310 	k = -qilog2(q);
311 	n = qilog2(epsilon);
312 	if (k < 0)
313 		k = (n > 0) ? n/2 : 0;
314 	k += 4;
315 	for (;;) {
316 		qsincos(q, 2 * k - n, &sin, &cos);
317 		if (qiszero(sin)) {
318 			qfree(sin);
319 			qfree(cos);
320 			k = 2 * k - n + 4;
321 			continue;
322 		}
323 		m = -qilog2(sin);
324 		if (m < k)
325 			 break;
326 		qfree(sin);
327 		qfree(cos);
328 		k = m + 1;
329 	}
330 	cot = qqdiv(cos, sin);
331 	qfree(sin);
332 	qfree(cos);
333 	res = qmappr(cot, epsilon, 24);
334 	qfree(cot);
335 	return res;
336 }
337 
338 
339 /*
340  * Calculate the secant function.
341  */
342 NUMBER *
qsec(NUMBER * q,NUMBER * epsilon)343 qsec(NUMBER *q, NUMBER *epsilon)
344 {
345 	NUMBER *sin, *cos, *sec, *res;
346 	long n, k, m;
347 
348 	if (qiszero(epsilon)) {
349 		math_error("Zero epsilon value for secant");
350 		/*NOTREACHED*/
351 	}
352 	if (qiszero(q))
353 		return qlink(&_qone_);
354 	n = qilog2(epsilon);
355 	k = (n > 0) ? 4 + n/2 : 4;
356 	for (;;) {
357 		qsincos(q, 2 * k - n, &sin, &cos);
358 		qfree(sin);
359 		if (qiszero(cos)) {
360 			qfree(cos);
361 			k = 2 * k - n + 4;
362 			continue;
363 		}
364 		m = -qilog2(cos);
365 		if (m < k)
366 			 break;
367 		qfree(cos);
368 		k = m + 1;
369 	}
370 	sec = qinv(cos);
371 	qfree(cos);
372 	res = qmappr(sec, epsilon, 24);
373 	qfree(sec);
374 	return res;
375 }
376 
377 
378 /*
379  * Calculate the cosecant function.
380  */
381 NUMBER *
qcsc(NUMBER * q,NUMBER * epsilon)382 qcsc(NUMBER *q, NUMBER *epsilon)
383 {
384 	NUMBER *sin, *cos, *csc, *res;
385 	long n, k, m;
386 
387 	if (qiszero(epsilon)) {
388 		math_error("Zero epsilon value for cosecant");
389 		/*NOTREACHED*/
390 	}
391 	if (qiszero(q)) {
392 		math_error("Zero argument for cosecant");
393 		/*NOTREACHED*/
394 	}
395 	k = -qilog2(q);
396 	n = qilog2(epsilon);
397 	if (k < 0)
398 		k = (n > 0) ? n/2 : 0;
399 	k += 4;
400 	for (;;) {
401 		qsincos(q, 2 * k - n, &sin, &cos);
402 		qfree(cos);
403 		if (qiszero(sin)) {
404 			qfree(sin);
405 			k = 2 * k - n + 4;
406 			continue;
407 		}
408 		m = -qilog2(sin);
409 		if (m < k)
410 			 break;
411 		qfree(sin);
412 		k = m + 1;
413 	}
414 	csc = qinv(sin);
415 	qfree(sin);
416 	res = qmappr(csc, epsilon, 24);
417 	qfree(csc);
418 	return res;
419 }
420 /*
421  * Calculate the arcsine function.
422  * The result is in the range -pi/2 to pi/2.
423  */
424 NUMBER *
qasin(NUMBER * q,NUMBER * epsilon)425 qasin(NUMBER *q, NUMBER *epsilon)
426 {
427 	NUMBER *qtmp1, *qtmp2, *epsilon1;
428 	ZVALUE ztmp;
429 	BOOL neg;
430 	FLAG r;
431 
432 	if (qiszero(epsilon)) {
433 		math_error("Zero epsilon value for asin");
434 		/*NOTREACHED*/
435 	}
436 	if (qiszero(q))
437 		return qlink(&_qzero_);
438 	ztmp = q->num;
439 	neg = ztmp.sign;
440 	ztmp.sign = 0;
441 	r = zrel(ztmp, q->den);
442 	if (r > 0)
443 		return NULL;
444 	if (r == 0) {
445 		epsilon1 = qscale(epsilon, 1L);
446 		qtmp2 = qpi(epsilon1);
447 		qtmp1 = qscale(qtmp2, -1L);
448 	} else {
449 		epsilon1 = qscale(epsilon, -2L);
450 		qtmp1 = qalloc();
451 		zsquare(q->num, &qtmp1->num);
452 		zsquare(q->den, &ztmp);
453 		zsub(ztmp, qtmp1->num, &qtmp1->den);
454 		zfree(ztmp);
455 		qtmp2 = qsqrt(qtmp1, epsilon1, 24);
456 		qfree(qtmp1);
457 		qtmp1 = qatan(qtmp2, epsilon);
458 	}
459 	qfree(qtmp2);
460 	qfree(epsilon1);
461 	if (neg) {
462 		qtmp2 = qneg(qtmp1);
463 		qfree(qtmp1);
464 		return(qtmp2);
465 	}
466 	return qtmp1;
467 }
468 
469 
470 
471 /*
472  * Calculate the acos function.
473  * The result is in the range 0 to pi.
474  */
475 NUMBER *
qacos(NUMBER * q,NUMBER * epsilon)476 qacos(NUMBER *q, NUMBER *epsilon)
477 {
478 	NUMBER *q1, *q2, *epsilon1;
479 	ZVALUE z;
480 
481 	if (qiszero(epsilon)) {
482 		math_error("Zero epsilon value for acos");
483 		/*NOTREACHED*/
484 	}
485 	if (qisone(q))
486 		return qlink(&_qzero_);
487 	if (qisnegone(q))
488 		return qpi(epsilon);
489 
490 	z = q->num;
491 	z.sign = 0;
492 	if (zrel(z, q->den) > 0)
493 		return NULL;
494 	epsilon1 = qscale(epsilon, -3L);		/* ??? */
495 	q1 = qalloc();
496 	zsub(q->den, q->num, &q1->num);
497 	zadd(q->den, q->num, &q1->den);
498 	q2 = qsqrt(q1, epsilon1, 24L);
499 	qfree(q1);
500 	qfree(epsilon1);
501 	epsilon1 = qscale(epsilon, -1L);
502 	q1 = qatan(q2, epsilon1);
503 	qfree(epsilon1);
504 	qfree(q2);
505 	q2 = qscale(q1, 1L);
506 	qfree(q1)
507 	return q2;
508 }
509 
510 
511 /*
512  * Calculate the arctangent function to the nearest or next to nearest
513  * multiple of epsilon.	 Algorithm uses
514  *	atan(x) = 2 * atan(x/(1 + sqrt(1+x^2)))
515  * to reduce x to a small value and then
516  *	atan(x) = x - x^3/3 + ...
517  */
518 NUMBER *
qatan(NUMBER * q,NUMBER * epsilon)519 qatan(NUMBER *q, NUMBER *epsilon)
520 {
521 	long m, k, i;
522 	FULL d;
523 	ZVALUE X, D, DD, sum, mul, term, ztmp1, ztmp2;
524 	NUMBER *qtmp, *res;
525 	BOOL sign;
526 
527 	if (qiszero(epsilon)) {
528 		math_error("Zero epsilon value for arctangent");
529 		/*NOTREACHED*/
530 	}
531 	if (qiszero(q))
532 		return qlink(&_qzero_);
533 	m = 12 - qilog2(epsilon);
534 		/* 4 bits for 4 doublings; 8 for rounding */
535 	if (m < 8)
536 		m = 8;		/* m is number of working binary digits */
537 	qtmp = qscale(q, m);
538 	zquo(qtmp->num, qtmp->den, &X, 24);
539 	qfree(qtmp);
540 	zbitvalue(m, &D);	/* q has become X/D */
541 	zsquare(D, &DD);
542 	i = 4;			/* maybe this should be larger */
543 	while (i-- > 0 && !ziszero(X)) {
544 		zsquare(X, &ztmp1);
545 		zadd(ztmp1, DD, &ztmp2);
546 		zfree(ztmp1);
547 		zsqrt(ztmp2, &ztmp1, 24L);
548 		zfree(ztmp2);
549 		zadd(ztmp1, D, &ztmp2);
550 		zfree(ztmp1);
551 		zshift(X, m, &ztmp1);
552 		zfree(X);
553 		zquo(ztmp1, ztmp2, &X, 24L);
554 		zfree(ztmp1);
555 		zfree(ztmp2);
556 	}
557 	zfree(DD);
558 	zfree(D);
559 	if (ziszero(X)) {
560 		zfree(X);
561 		return qlink(&_qzero_);
562 	}
563 	zcopy(X, &sum);
564 	zsquare(X, &ztmp1);
565 	zshift(ztmp1, -m, &mul);
566 	zfree(ztmp1);
567 	d = 3;
568 	sign = !X.sign;
569 	for (;;) {
570 		if (d > BASE) {
571 			math_error("Too many terms required for atan");
572 			/*NOTREACHED*/
573 		}
574 		zmul(X, mul, &ztmp1);
575 		zfree(X);
576 		zshift(ztmp1, -m, &X);	/* X now (original X)^d */
577 		zfree(ztmp1);
578 		zdivi(X, d, &term);
579 		if (ziszero(term)) {
580 			zfree(term);
581 			break;
582 		}
583 		term.sign = sign;
584 		zadd(sum, term, &ztmp1);
585 		zfree(sum);
586 		zfree(term);
587 		sum = ztmp1;
588 		sign = !sign;
589 		d += 2;
590 	}
591 	zfree(mul);
592 	zfree(X);
593 	qtmp = qalloc();
594 	k = zlowbit(sum);
595 	if (k) {
596 		zshift(sum, -k, &qtmp->num);
597 		zfree(sum);
598 	} else {
599 		qtmp->num = sum;
600 	}
601 	zbitvalue(m - 4 - k, &qtmp->den);
602 	res = qmappr(qtmp, epsilon, 24L);
603 	qfree(qtmp);
604 	return res;
605 }
606 
607 /*
608  * Inverse secant function
609  */
610 NUMBER *
qasec(NUMBER * q,NUMBER * epsilon)611 qasec(NUMBER *q, NUMBER *epsilon)
612 {
613 	NUMBER *tmp, *res;
614 
615 	tmp = qinv(q);
616 	res = qacos(tmp, epsilon);
617 	qfree(tmp);
618 	return res;
619 }
620 
621 
622 /*
623  * Inverse cosecant function
624  */
625 NUMBER *
qacsc(NUMBER * q,NUMBER * epsilon)626 qacsc(NUMBER *q, NUMBER *epsilon)
627 {
628 	NUMBER *tmp, *res;
629 
630 	tmp = qinv(q);
631 	res = qasin(tmp, epsilon);
632 	qfree(tmp);
633 	return res;
634 }
635 
636 
637 /*
638  * Inverse cotangent function
639  */
640 NUMBER *
qacot(NUMBER * q,NUMBER * epsilon)641 qacot(NUMBER *q, NUMBER *epsilon)
642 {
643 	NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
644 
645 	if (qiszero(epsilon)) {
646 		math_error("Zero epsilon for acot");
647 		/*NOTREACHED*/
648 	}
649 	if (qiszero(q)) {
650 		epsilon1 = qscale(epsilon, 1L);
651 		tmp1 = qpi(epsilon1);
652 		qfree(epsilon1);
653 		tmp2 = qscale(tmp1, -1L);
654 		qfree(tmp1);
655 		return tmp2;
656 	}
657 	tmp1 = qinv(q);
658 	if (!qisneg(q)) {
659 		tmp2 = qatan(tmp1, epsilon);
660 		qfree(tmp1);
661 		return tmp2;
662 	}
663 	epsilon1 = qscale(epsilon, -2L);
664 	tmp2 = qatan(tmp1, epsilon1);
665 	qfree(tmp1);
666 	tmp1 = qpi(epsilon1);
667 	qfree(epsilon1);
668 	tmp3 = qqadd(tmp1, tmp2);
669 	qfree(tmp1);
670 	qfree(tmp2);
671 	tmp1 = qmappr(tmp3, epsilon, 24L);
672 	qfree(tmp3);
673 	return tmp1;
674 }
675 
676 
677 /*
678  * Calculate the angle which is determined by the point (x,y).
679  * This is the same as atan(y/x) for positive x, but is continuous
680  * except for y = 0, x <= 0.  By convention, y is the first argument.
681  * For all x, y, -pi < atan2 <= pi.  For example, qatan2(1, -1) = 3/4 * pi.
682  */
683 NUMBER *
qatan2(NUMBER * qy,NUMBER * qx,NUMBER * epsilon)684 qatan2(NUMBER *qy, NUMBER *qx, NUMBER *epsilon)
685 {
686 	NUMBER *tmp1, *tmp2, *tmp3, *epsilon2;
687 
688 	if (qiszero(epsilon)) {
689 		math_error("Zero epsilon value for atan2");
690 		/*NOTREACHED*/
691 	}
692 	if (qiszero(qy) && qiszero(qx)) {
693 		/* conform to 4.3BSD ANSI/IEEE 754-1985 math lib */
694 		return qlink(&_qzero_);
695 	}
696 	/*
697 	 * If the point is on the negative real axis, then the answer is pi.
698 	 */
699 	if (qiszero(qy) && qisneg(qx))
700 		return qpi(epsilon);
701 	/*
702 	 * If the point is in the right half plane, then use the normal atan.
703 	 */
704 	if (!qisneg(qx) && !qiszero(qx)) {
705 		if (qiszero(qy))
706 			return qlink(&_qzero_);
707 		tmp1 = qqdiv(qy, qx);
708 		tmp2 = qatan(tmp1, epsilon);
709 		qfree(tmp1);
710 		return tmp2;
711 	}
712 	/*
713 	 * The point is in the left half plane (x <= 0) with nonzero y.
714 	 * Calculate the angle by using the formula:
715 	 *	atan2(y,x) = 2 * atan(sgn(y) * sqrt((x/y)^2 + 1) - x/y).
716 	 */
717 	epsilon2 = qscale(epsilon, -4L);
718 	tmp1 = qqdiv(qx, qy);
719 	tmp2 = qsquare(tmp1);
720 	tmp3 = qqadd(tmp2, &_qone_);
721 	qfree(tmp2);
722 	tmp2 = qsqrt(tmp3, epsilon2, 24L | (qy->num.sign * 64));
723 	qfree(tmp3);
724 	tmp3 = qsub(tmp2, tmp1);
725 	qfree(tmp2);
726 	qfree(tmp1);
727 	qfree(epsilon2);
728 	epsilon2 = qscale(epsilon, -1L);
729 	tmp1 = qatan(tmp3, epsilon2);
730 	qfree(epsilon2);
731 	qfree(tmp3);
732 	tmp2 = qscale(tmp1, 1L);
733 	qfree(tmp1);
734 	return tmp2;
735 }
736 
737 
738 /*
739  * Calculate the value of pi to within the required epsilon.
740  * This uses the following formula which only needs integer calculations
741  * except for the final operation:
742  *	pi = 1 / SUMOF(comb(2 * N, N) ^ 3 * (42 * N + 5) / 2 ^ (12 * N + 4)),
743  * where the summation runs from N=0.  This formula gives about 6 bits of
744  * accuracy per term.  Since the denominator for each term is a power of two,
745  * we can simply use shifts to sum the terms.  The combinatorial numbers
746  * in the formula are calculated recursively using the formula:
747  *	comb(2*(N+1), N+1) = 2 * comb(2 * N, N) * (2 * N + 1) / N.
748  */
749 NUMBER *
qpi(NUMBER * epsilon)750 qpi(NUMBER *epsilon)
751 {
752 	ZVALUE comb;			/* current combinatorial value */
753 	ZVALUE sum;			/* current sum */
754 	ZVALUE tmp1, tmp2;
755 	NUMBER *r, *t1, qtmp;
756 	long shift;			/* current shift of result */
757 	long N;				/* current term number */
758 	long bits;			/* needed number of bits of precision */
759 	long t;
760 
761 	/* firewall */
762 	if (qiszero(epsilon)) {
763 		math_error("zero epsilon value for pi");
764 		/*NOTREACHED*/
765 	}
766 
767 	/* use pi cache if epsilon marches, else flush if needed */
768 	if (pivalue[LAST_PI_EPSILON] != NULL &&
769 	    pivalue[LAST_PI_VALUE] != NULL &&
770 	    epsilon == pivalue[LAST_PI_EPSILON]) {
771 		return qlink(pivalue[LAST_PI_VALUE]);
772 	}
773 	if (pivalue[LAST_PI_EPSILON] != NULL) {
774 		qfree(pivalue[LAST_PI_EPSILON]);
775 	}
776 	if (pivalue[LAST_PI_VALUE] != NULL) {
777 		qfree(pivalue[LAST_PI_VALUE]);
778 	}
779 
780 	bits = -qilog2(epsilon) + 4;
781 	if (bits < 4)
782 		bits = 4;
783 	comb = _one_;
784 	itoz(5L, &sum);
785 	N = 0;
786 	shift = 4;
787 	do {
788 		t = 1 + (++N & 0x1);
789 		(void) zdivi(comb, N / (3 - t), &tmp1);
790 		zfree(comb);
791 		zmuli(tmp1, t * (2 * N - 1), &comb);
792 		zfree(tmp1);
793 		zsquare(comb, &tmp1);
794 		zmul(comb, tmp1, &tmp2);
795 		zfree(tmp1);
796 		zmuli(tmp2, 42 * N + 5, &tmp1);
797 		zfree(tmp2);
798 		zshift(sum, 12L, &tmp2);
799 		zfree(sum);
800 		zadd(tmp1, tmp2, &sum);
801 		t = zhighbit(tmp1);
802 		zfree(tmp1);
803 		zfree(tmp2);
804 		shift += 12;
805 	} while ((shift - t) < bits);
806 	zfree(comb);
807 	qtmp.num = _one_;
808 	qtmp.den = sum;
809 	t1 = qscale(&qtmp, shift);
810 	zfree(sum);
811 	r = qmappr(t1, epsilon, 24L);
812 	qfree(t1);
813 	pivalue[LAST_PI_EPSILON] = qlink(epsilon);
814 	pivalue[LAST_PI_VALUE] = qlink(r);
815 	return r;
816 }
817 
818 
819 /*
820  * qpidiv180 - calculate pi / 180
821  *
822  * This function returns pi/180 as used to covert between radians and degrees.
823  */
824 NUMBER *
qpidiv180(NUMBER * epsilon)825 qpidiv180(NUMBER *epsilon)
826 {
827 	NUMBER *pi, *pidiv180;
828 
829 	/* firewall */
830 	if (qiszero(epsilon)) {
831 		math_error("zero epsilon value for qpidiv180");
832 		/*NOTREACHED*/
833 	}
834 
835 	/* use pi/180 cache if epsilon marches, else flush if needed */
836 	if (pivalue[LAST_PI_DIV_180_EPSILON] != NULL &&
837 	    pivalue[LAST_PI_DIV_180_VALUE] != NULL &&
838 	    epsilon == pivalue[LAST_PI_DIV_180_EPSILON]) {
839 		return qlink(pivalue[LAST_PI_DIV_180_VALUE]);
840 	}
841 	if (pivalue[LAST_PI_DIV_180_EPSILON] != NULL) {
842 		qfree(pivalue[LAST_PI_DIV_180_EPSILON]);
843 	}
844 	if (pivalue[LAST_PI_DIV_180_VALUE] != NULL) {
845 		qfree(pivalue[LAST_PI_DIV_180_VALUE]);
846 	}
847 
848 	/* let qpi() returned cached pi or calculate new as needed */
849 	pi = qpi(epsilon);
850 
851 	/* calculate pi/180 */
852 	pidiv180 = qdivi(pi, 180);
853 
854 	/* cache epsilon and pi/180 */
855 	pivalue[LAST_PI_DIV_180_EPSILON] = qlink(epsilon);
856 	pivalue[LAST_PI_DIV_180_VALUE] = qlink(pidiv180);
857 
858 	/* return pi/180 */
859 	return pidiv180;
860 }
861 
862 
863 /*
864  * qpidiv200 - calculate pi / 200
865  *
866  * This function returns pi/200 as used to covert between radians and gradians.
867  */
868 NUMBER *
qpidiv200(NUMBER * epsilon)869 qpidiv200(NUMBER *epsilon)
870 {
871 	NUMBER *pi, *pidiv200;
872 
873 	/* firewall */
874 	if (qiszero(epsilon)) {
875 		math_error("zero epsilon value for qpidiv200");
876 		/*NOTREACHED*/
877 	}
878 
879 	/* use pi/200 cache if epsilon marches, else flush if needed */
880 	if (pivalue[LAST_PI_DIV_200_EPSILON] != NULL &&
881 	    pivalue[LAST_PI_DIV_200_VALUE] != NULL &&
882 	    epsilon == pivalue[LAST_PI_DIV_200_EPSILON]) {
883 		return qlink(pivalue[LAST_PI_DIV_200_VALUE]);
884 	}
885 	if (pivalue[LAST_PI_DIV_200_EPSILON] != NULL) {
886 		qfree(pivalue[LAST_PI_DIV_200_EPSILON]);
887 	}
888 	if (pivalue[LAST_PI_DIV_200_VALUE] != NULL) {
889 		qfree(pivalue[LAST_PI_DIV_200_VALUE]);
890 	}
891 
892 	/* let qpi() returned cached pi or calculate new as needed */
893 	pi = qpi(epsilon);
894 
895 	/* calculate pi/200 */
896 	pidiv200 = qdivi(pi, 200);
897 
898 	/* cache epsilon and pi/200 */
899 	pivalue[LAST_PI_DIV_200_EPSILON] = qlink(epsilon);
900 	pivalue[LAST_PI_DIV_200_VALUE] = qlink(pidiv200);
901 
902 	/* return pi/200 */
903 	return pidiv200;
904 }
905 
906 
907 /*
908  * Calculate the exponential function to the nearest or next to nearest
909  * multiple of the positive number epsilon.
910  */
911 NUMBER *
qexp(NUMBER * q,NUMBER * epsilon)912 qexp(NUMBER *q, NUMBER *epsilon)
913 {
914 	long m, n;
915 	NUMBER *tmp1, *tmp2;
916 
917 	if (qiszero(epsilon)) {
918 		math_error("Zero epsilon value for exp");
919 		/*NOTREACHED*/
920 	}
921 	if (qiszero(q))
922 		return qlink(&_qone_);
923 	tmp1 = qmul(q, &_qlge_);
924 	m = qtoi(tmp1);		/* exp(q) < 2^(m+1) or m == MAXLONG */
925 	qfree(tmp1);
926 
927 	if (m > (1 << 30))
928 		return NULL;
929 
930 	n = qilog2(epsilon);	/* 2^n <= epsilon < 2^(n+1) */
931 	if (m < n)
932 		return qlink(&_qzero_);
933 	tmp1 = qqabs(q);
934 	tmp2 = qexprel(tmp1, m - n + 1);
935 	qfree(tmp1);
936 	if (tmp2 == NULL)
937 		return NULL;
938 	if (qisneg(q)) {
939 		tmp1 = qinv(tmp2);
940 		qfree(tmp2);
941 		tmp2 = tmp1;
942 	}
943 	tmp1 = qmappr(tmp2, epsilon, 24L);
944 	qfree(tmp2);
945 	return tmp1;
946 }
947 
948 
949 /*
950  * Calculate the exponential function with relative error corresponding
951  * to a specified number of significant bits
952  * Requires *q >= 0, bitnum >= 0.
953  * This returns NULL if more than 2^30 working bits would be required.
954  */
955 S_FUNC NUMBER *
qexprel(NUMBER * q,long bitnum)956 qexprel(NUMBER *q, long bitnum)
957 {
958 	long n, m, k, h, s, t, d;
959 	NUMBER *qtmp1;
960 	ZVALUE X, B, sum, term, ztmp1, ztmp2;
961 
962 	h = qilog2(q);
963 	k = bitnum + h + 1;
964 	if (k < 0)
965 		return qlink(&_qone_);
966 	s = k;
967 	if (k) {
968 		do {
969 			t = s;
970 			s = (s + k/s)/2;
971 		}
972 		while (t > s);
973 	}		/* s is int(sqrt(k)) */
974 	s++;
975 	if (s < -h)
976 		s = -h;
977 	n = h + s;	/* n is number of squarings that will be required */
978 	m = bitnum + n;
979 	if (m > (1 << 30))
980 		return NULL;
981 	while (s > 0) {		/* increasing m by ilog2(s) */
982 		s >>= 1;
983 		m++;
984 	}			/* m is working number of bits */
985 	qtmp1 = qscale(q, m - n);
986 	zquo(qtmp1->num, qtmp1->den, &X, 24);
987 	qfree(qtmp1);
988 	if (ziszero(X)) {
989 		zfree(X);
990 		return qlink(&_qone_);
991 	}
992 	zbitvalue(m, &sum);
993 	zcopy(X, &term);
994 	d = 1;
995 	do {
996 		zadd(sum, term, &ztmp1);
997 		zfree(sum);
998 		sum = ztmp1;
999 		zmul(term, X, &ztmp1);
1000 		zfree(term);
1001 		zshift(ztmp1, -m, &ztmp2);
1002 		zfree(ztmp1);
1003 		zdivi(ztmp2, ++d, &term);
1004 		zfree(ztmp2);
1005 	}
1006 	while (!ziszero(term));
1007 	zfree(term);
1008 	zfree(X);
1009 	k = 0;
1010 	zbitvalue(2 * m + 1, &B);
1011 	while (n-- > 0) {
1012 		k *= 2;
1013 		zsquare(sum, &ztmp1);
1014 		zfree(sum);
1015 		if (zrel(ztmp1, B) >= 0) {
1016 			zshift(ztmp1, -m - 1, &sum);
1017 			k++;
1018 		} else {
1019 			zshift(ztmp1, -m, &sum);
1020 		}
1021 		zfree(ztmp1);
1022 	}
1023 	zfree(B);
1024 	h = zlowbit(sum);
1025 	qtmp1 = qalloc();
1026 	if (m > h + k) {
1027 		zshift(sum, -h, &qtmp1->num);
1028 		zbitvalue(m - h - k, &qtmp1->den);
1029 	}
1030 	else
1031 		zshift(sum, k - m, &qtmp1->num);
1032 	zfree(sum);
1033 	return qtmp1;
1034 }
1035 
1036 
1037 /*
1038  * Calculate the natural logarithm of a number accurate to the specified
1039  * positive epsilon.
1040  */
1041 NUMBER *
qln(NUMBER * q,NUMBER * epsilon)1042 qln(NUMBER *q, NUMBER *epsilon)
1043 {
1044 	long m, n, k, h, d;
1045 	ZVALUE term, sum, mul, pow, X, D, B, ztmp;
1046 	NUMBER *qtmp, *res;
1047 	BOOL neg;
1048 
1049 	if (qiszero(q) || qiszero(epsilon)) {
1050 		math_error("logarithm of 0");
1051 		/*NOTREACHED*/
1052 	}
1053 	if (qisunit(q))
1054 		return qlink(&_qzero_);
1055 	q = qqabs(q);			/* Ignore sign of q */
1056 	neg = (zrel(q->num, q->den) < 0);
1057 	if (neg) {
1058 		qtmp = qinv(q);
1059 		qfree(q);
1060 		q = qtmp;
1061 	}
1062 	k = qilog2(q);
1063 	m = -qilog2(epsilon);		/* m will be number of working bits */
1064 	if (m < 0)
1065 		m = 0;
1066 	h = k;
1067 	while (h > 0) {
1068 		h /= 2;
1069 		m++;			/* Add 1 for each sqrt until X < 2 */
1070 	}
1071 	m += 18;	/* 8 more sqrts, 8 for rounding, 2 for epsilon/4 */
1072 	qtmp = qscale(q, m - k);
1073 	zquo(qtmp->num, qtmp->den, &X, 24L);
1074 	qfree(q);
1075 	qfree(qtmp);
1076 
1077 	zbitvalue(m, &D);		/* Now "q" = X/D */
1078 	zbitvalue(m - 8, &ztmp);
1079 	zadd(D, ztmp, &B);		/* Will take sqrts until X <= B */
1080 	zfree(ztmp);
1081 
1082 	n = 1;			/* n is to count 1 + number of sqrts */
1083 
1084 	while (k > 0 || zrel(X, B) > 0) {
1085 		n++;
1086 		zshift(X, m + (k & 1), &ztmp);
1087 		zfree(X);
1088 		zsqrt(ztmp, &X, 24);
1089 		zfree(ztmp)
1090 		k /= 2;
1091 	}
1092 	zfree(B);
1093 	zsub(X, D, &pow);	/* pow, mul used as tmps */
1094 	zadd(X, D, &mul);
1095 	zfree(X);
1096 	zfree(D);
1097 	zshift(pow, m, &ztmp);
1098 	zfree(pow);
1099 	zquo(ztmp, mul, &pow, 24);	/* pow now (X - D)/(X + D) */
1100 	zfree(ztmp);
1101 	zfree(mul);
1102 
1103 	zcopy(pow, &sum);	/* pow is first term of sum */
1104 	zsquare(pow, &ztmp);
1105 	zshift(ztmp, -m, &mul); /* mul is now multiplier for powers */
1106 	zfree(ztmp);
1107 
1108 	d = 1;
1109 	for (;;) {
1110 		zmul(pow, mul, &ztmp);
1111 		zfree(pow);
1112 		zshift(ztmp, -m, &pow);
1113 		zfree(ztmp);
1114 		d += 2;
1115 		zdivi(pow, d, &term);	/* Round down div should be round off */
1116 		if (ziszero(term)) {
1117 			zfree(term);
1118 			break;
1119 		}
1120 		zadd(sum, term, &ztmp);
1121 		zfree(term);
1122 		zfree(sum);
1123 		sum = ztmp;
1124 	}
1125 	zfree(pow);
1126 	zfree(mul);
1127 	qtmp = qalloc();	/* qtmp is to be 2^n * sum / 2^m */
1128 	k = zlowbit(sum);
1129 	sum.sign = neg;
1130 	if (k + n >= m) {
1131 		zshift(sum, n - m, &qtmp->num);
1132 		zfree(sum);
1133 	} else {
1134 		if (k) {
1135 			zshift(sum, -k, &qtmp->num);
1136 			zfree(sum);
1137 		} else {
1138 			qtmp->num = sum;
1139 		}
1140 		zbitvalue(m - k - n, &qtmp->den);
1141 	}
1142 	res = qmappr(qtmp, epsilon, 24L);
1143 	qfree(qtmp);
1144 	return res;
1145 }
1146 
1147 
1148 /*
1149  * Calculate the base 10 logarithm
1150  *
1151  *	log(q) = ln(q) / ln(10)
1152  */
1153 NUMBER *
qlog(NUMBER * q,NUMBER * epsilon)1154 qlog(NUMBER *q, NUMBER *epsilon)
1155 {
1156 	int need_new_ln_10 = TRUE;	/* FALSE => use cached ln_10 value */
1157 	NUMBER *ln_q;			/* ln(x) */
1158 	NUMBER *ret;			/* base 10 logarithm of x */
1159 
1160 	/* firewall */
1161 	if (qiszero(q) || qiszero(epsilon)) {
1162 		math_error("logarithm of 0");
1163 		/*NOTREACHED*/
1164 	}
1165 
1166 	/*
1167 	 * shortcut for small integer powers of 10
1168 	 */
1169 	if (qisint(q) && qispos(q) && !zge8192b(q->num) && ziseven(q->num)) {
1170 		BOOL is_10_power;	/* TRUE ==> q is a power of 10 */
1171 		long ilog_10;		/* integer log base 10 */
1172 
1173 		/* try for a quick small power of 10 log */
1174 		ilog_10 = zlog10(q->num, &is_10_power );
1175 		if (is_10_power == TRUE) {
1176 			/* is small power of 10, return log */
1177 			return itoq(ilog_10);
1178 		}
1179 		/* q is an even integer that is not a power of 10 */
1180 	}
1181 
1182 	/*
1183 	 * compute ln(c) first
1184 	 */
1185 	ln_q = qln(q, epsilon);
1186 	/* log(1) == 0 */
1187 	if (qiszero(ln_q)) {
1188 		return ln_q;
1189 	}
1190 
1191 	/*
1192 	 * save epsilon for ln(10) if needed
1193 	 */
1194 	if (ln_10_epsilon == NULL) {
1195 		/* first time call */
1196 		ln_10_epsilon = qcopy(epsilon);
1197 	} else if (qcmp(ln_10_epsilon, epsilon) == TRUE) {
1198 		/* replaced cached value with epsilon arg */
1199 		qfree(ln_10_epsilon);
1200 		ln_10_epsilon = qcopy(epsilon);
1201 	} else if (ln_10 != NULL) {
1202 		/* the previously computed ln(2) is OK to use */
1203 		need_new_ln_10 = FALSE;
1204 	}
1205 
1206 	/*
1207 	 * compute ln(10) if needed
1208 	 */
1209 	if (need_new_ln_10 == TRUE) {
1210 		if (ln_10 != NULL) {
1211 			qfree(ln_10);
1212 		}
1213 		ln_10 = qln(&_qten_, ln_10_epsilon);
1214 	}
1215 
1216 	/*
1217 	 * return ln(q) / ln(10)
1218 	 */
1219 	ret = qqdiv(ln_q, ln_10);
1220 	qfree(ln_q);
1221 	return ret;
1222 }
1223 
1224 
1225 /*
1226  * Calculate the result of raising one number to the power of another.
1227  * The result is calculated to the nearest or next to nearest multiple of
1228  * epsilon.
1229  */
1230 NUMBER *
qpower(NUMBER * q1,NUMBER * q2,NUMBER * epsilon)1231 qpower(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
1232 {
1233 	NUMBER *tmp1, *tmp2, *epsilon2;
1234 	NUMBER *q1tmp, *q2tmp;
1235 	long m, n;
1236 
1237 	if (qiszero(epsilon)) {
1238 		math_error("Zero epsilon for power");
1239 		/*NOTREACHED*/
1240 	}
1241 	if (qiszero(q1) && qisneg(q2)) {
1242 		math_error("Negative power of zero");
1243 		/*NOTREACHED*/
1244 	}
1245 	if (qiszero(q2) || qisone(q1))
1246 		return qlink(&_qone_);
1247 	if (qiszero(q1))
1248 		return qlink(&_qzero_);
1249 	if (qisneg(q1)) {
1250 		math_error("Negative base for qpower");
1251 		/*NOTREACHED*/
1252 	}
1253 	if (qisone(q2))
1254 		return qmappr(q1, epsilon, 24);
1255 	if (zrel(q1->num, q1->den) < 0) {
1256 		q1tmp = qinv(q1);
1257 		q2tmp = qneg(q2);
1258 	} else {
1259 		q1tmp = qlink(q1);
1260 		q2tmp = qlink(q2);
1261 	}
1262 	if (qisone(q2tmp)) {
1263 		qfree(q2tmp);
1264 		q2tmp = qmappr(q1tmp, epsilon, 24);
1265 		qfree(q1tmp);
1266 		return q2tmp;
1267 	}
1268 	m = qilog2(q1tmp);
1269 	n = qilog2(epsilon);
1270 	if (qisneg(q2tmp)) {
1271 		if (m > 0) {
1272 			tmp1 = itoq(m);
1273 			tmp2 = qmul(tmp1, q2tmp);
1274 			m = qtoi(tmp2);
1275 		} else {
1276 			tmp1 = qdec(q1tmp);
1277 			tmp2 = qqdiv(tmp1, q1tmp);
1278 			qfree(tmp1);
1279 			tmp1 = qmul(tmp2, q2tmp);
1280 			qfree(tmp2);
1281 			tmp2 = qmul(tmp1, &_qlge_);
1282 			m = qtoi(tmp2);
1283 		}
1284 	} else {
1285 		if (m > 0) {
1286 			tmp1 = itoq(m + 1);
1287 			tmp2 = qmul(tmp1, q2tmp);
1288 			m = qtoi(tmp2);
1289 		} else {
1290 			tmp1 = qdec(q1tmp);
1291 			tmp2 = qmul(tmp1, q2tmp);
1292 			qfree(tmp1);
1293 			tmp1 = qmul(tmp2, &_qlge_);
1294 			m = qtoi(tmp1);
1295 		}
1296 	}
1297 	qfree(tmp1);
1298 	qfree(tmp2);
1299 	if (m > (1 << 30)) {
1300 		qfree(q1tmp);
1301 		qfree(q2tmp);
1302 		return NULL;
1303 	}
1304 	m += 1;
1305 	if (m < n) {
1306 		qfree(q1tmp);
1307 		qfree(q2tmp);
1308 		return qlink(&_qzero_);
1309 	}
1310 	tmp1 = qqdiv(epsilon, q2tmp);
1311 	tmp2 = qscale(tmp1, -m - 4);
1312 	epsilon2 = qqabs(tmp2);
1313 	qfree(tmp1);
1314 	qfree(tmp2);
1315 	tmp1 = qln(q1tmp, epsilon2);
1316 	qfree(epsilon2);
1317 	tmp2 = qmul(tmp1, q2tmp);
1318 	qfree(tmp1);
1319 	qfree(q1tmp);
1320 	qfree(q2tmp);
1321 	if (qisneg(tmp2)) {
1322 		tmp1 = qneg(tmp2);
1323 		qfree(tmp2);
1324 		tmp2 = qexprel(tmp1, m - n + 3);
1325 		if (tmp2 == NULL) {
1326 			qfree(tmp1);
1327 			return NULL;
1328 		}
1329 		qfree(tmp1);
1330 		tmp1 = qinv(tmp2);
1331 	} else {
1332 		tmp1 = qexprel(tmp2, m - n + 3) ;
1333 		if (tmp1 == NULL) {
1334 			qfree(tmp2);
1335 			return NULL;
1336 		}
1337 	}
1338 	qfree(tmp2);
1339 	tmp2 = qmappr(tmp1, epsilon, 24L);
1340 	qfree(tmp1);
1341 	return tmp2;
1342 }
1343 
1344 
1345 /*
1346  * Calculate the K-th root of a number to within the specified accuracy.
1347  */
1348 NUMBER *
qroot(NUMBER * q1,NUMBER * q2,NUMBER * epsilon)1349 qroot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
1350 {
1351 	NUMBER *tmp1, *tmp2;
1352 	int neg;
1353 
1354 	if (qiszero(epsilon)) {
1355 		math_error("Zero epsilon for root");
1356 		/*NOTREACHED*/
1357 	}
1358 	if (qisneg(q2) || qiszero(q2) || qisfrac(q2)) {
1359 		math_error("Taking bad root of number");
1360 		/*NOTREACHED*/
1361 	}
1362 	if (qiszero(q1) || qisone(q1) || qisone(q2))
1363 		return qlink(q1);
1364 	if (qistwo(q2))
1365 		return qsqrt(q1, epsilon, 24L);
1366 	neg = qisneg(q1);
1367 	if (neg) {
1368 		if (ziseven(q2->num)) {
1369 			math_error("Taking even root of negative number");
1370 			/*NOTREACHED*/
1371 		}
1372 		q1 = qqabs(q1);
1373 	}
1374 	tmp2 = qinv(q2);
1375 	tmp1 = qpower(q1, tmp2, epsilon);
1376 	qfree(tmp2);
1377 	if (tmp1 == NULL)
1378 		return NULL;
1379 	if (neg) {
1380 		tmp2 = qneg(tmp1);
1381 		qfree(tmp1);
1382 		tmp1 = tmp2;
1383 	}
1384 	return tmp1;
1385 }
1386 
1387 
1388 /* Calculate the hyperbolic cosine function to the nearest or next to
1389  * nearest multiple of epsilon.
1390  * This is calculated using cosh(x) = (exp(x) + 1/exp(x))/2;
1391  */
1392 NUMBER *
qcosh(NUMBER * q,NUMBER * epsilon)1393 qcosh(NUMBER *q, NUMBER *epsilon)
1394 {
1395 	NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
1396 
1397 	epsilon1 = qscale(epsilon, -2);
1398 	tmp1 = qqabs(q);
1399 	tmp2 = qexp(tmp1, epsilon1);
1400 	qfree(tmp1);
1401 	qfree(epsilon1);
1402 	if (tmp2 == NULL)
1403 		return NULL;
1404 	tmp1 = qinv(tmp2);
1405 	tmp3 = qqadd(tmp1, tmp2);
1406 	qfree(tmp1)
1407 	qfree(tmp2)
1408 	tmp1 = qscale(tmp3, -1);
1409 	qfree(tmp3);
1410 	tmp2 = qmappr(tmp1, epsilon, 24L);
1411 	qfree(tmp1);
1412 	return tmp2;
1413 }
1414 
1415 
1416 /*
1417  * Calculate the hyperbolic sine to the nearest or next to nearest
1418  * multiple of epsilon.
1419  * This is calculated using sinh(x) = (exp(x) - 1/exp(x))/2.
1420  */
1421 NUMBER *
qsinh(NUMBER * q,NUMBER * epsilon)1422 qsinh(NUMBER *q, NUMBER *epsilon)
1423 {
1424 	NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
1425 
1426 	if (qiszero(q))
1427 		return qlink(&_qzero_);
1428 	epsilon1 = qscale(epsilon, -3);
1429 	tmp1 = qqabs(q);
1430 	tmp2 = qexp(tmp1, epsilon1);
1431 	qfree(tmp1);
1432 	qfree(epsilon1);
1433 	if (tmp2 == NULL)
1434 		return NULL;
1435 	tmp1 = qinv(tmp2);
1436 	tmp3 = qispos(q) ? qsub(tmp2, tmp1) : qsub(tmp1, tmp2);
1437 	qfree(tmp1)
1438 	qfree(tmp2)
1439 	tmp1 = qscale(tmp3, -1);
1440 	qfree(tmp3);
1441 	tmp2 = qmappr(tmp1, epsilon, 24L);
1442 	qfree(tmp1);
1443 	return tmp2;
1444 }
1445 
1446 
1447 /*
1448  * Calculate the hyperbolic tangent to the nearest or next to nearest
1449  * multiple of epsilon.
1450  * This is calculated using the formulae:
1451  *	tanh(x) = 1 or -1 for very large abs(x)
1452  *	tanh(x) = (+ or -)(1 - 2 * exp(2 * x))	for large abx(x)
1453  *	tanh(x) = (exp(2*x) - 1)/(exp(2*x) + 1) otherwise
1454  */
1455 NUMBER *
qtanh(NUMBER * q,NUMBER * epsilon)1456 qtanh(NUMBER *q, NUMBER *epsilon)
1457 {
1458 	NUMBER *tmp1, *tmp2, *tmp3;
1459 	long n, m;
1460 
1461 	n = qilog2(epsilon);
1462 	if (n > 0 || qiszero(q))
1463 		return qlink(&_qzero_);
1464 	n = -n;
1465 	tmp1 = qqabs(q);
1466 	tmp2 = qmul(tmp1, &_qlge_);
1467 	m = qtoi(tmp2);		/* exp(|q|) < 2^(m+1) or m == MAXLONG */
1468 	qfree(tmp2);
1469 	if (m > 1 + n/2) {
1470 		qfree(tmp1);
1471 		return q->num.sign ? qlink(&_qnegone_) : qlink(&_qone_);
1472 	}
1473 	tmp2 = qscale(tmp1, 1);
1474 	qfree(tmp1);
1475 	tmp1 = qexprel(tmp2, 2 + n);
1476 	qfree(tmp2);
1477 	if (m > 1 + n/4) {
1478 		tmp2 = qqdiv(&_qtwo_, tmp1);
1479 		qfree(tmp1);
1480 		tmp1 = qsub(&_qone_, tmp2);
1481 		qfree(tmp2);
1482 	} else {
1483 		tmp2 = qdec(tmp1);
1484 		tmp3 = qinc(tmp1);
1485 		qfree(tmp1);
1486 		tmp1 = qqdiv(tmp2, tmp3);
1487 		qfree(tmp2);
1488 		qfree(tmp3);
1489 	}
1490 	tmp2 = qmappr(tmp1, epsilon, 24L);
1491 	qfree(tmp1);
1492 	if (qisneg(q)) {
1493 		tmp1 = qneg(tmp2);
1494 		qfree(tmp2);
1495 		return tmp1;
1496 	}
1497 	return tmp2;
1498 }
1499 
1500 
1501 /*
1502  * Hyperbolic cotangent.
1503  * Calculated using coth(x) = 1 + 2/(exp(2*x) - 1)
1504  */
1505 NUMBER *
qcoth(NUMBER * q,NUMBER * epsilon)1506 qcoth(NUMBER *q, NUMBER *epsilon)
1507 {
1508 	NUMBER *tmp1, *tmp2, *res;
1509 	long n, k;
1510 
1511 	if (qiszero(epsilon)) {
1512 		math_error("Zero epsilon value for coth");
1513 		/*NOTREACHED*/
1514 	}
1515 	if (qiszero(q)) {
1516 		math_error("Zero argument for coth");
1517 		/*NOTREACHED*/
1518 	}
1519 	tmp1 = qscale(q, 1);
1520 	tmp2 = qqabs(tmp1);
1521 	qfree(tmp1);
1522 	k = qilog2(tmp2);
1523 	n = qilog2(epsilon);
1524 	if (k > 0) {
1525 		tmp1 = qmul(&_qlge_, tmp2);
1526 		k = qtoi(tmp1);
1527 		qfree(tmp1);
1528 	} else {
1529 		k = 2 * k;
1530 	}
1531 	k = 4 - k - n;
1532 	if (k < 4)
1533 		k = 4;
1534 	tmp1 = qexprel(tmp2,  k);
1535 	qfree(tmp2);
1536 	tmp2 = qdec(tmp1);
1537 	qfree(tmp1);
1538 	if (qiszero(tmp2)) {
1539 		math_error("This should not happen ????");
1540 		/*NOTREACHED*/
1541 	}
1542 	tmp1 = qinv(tmp2);
1543 	qfree(tmp2);
1544 	tmp2 = qscale(tmp1, 1);
1545 	qfree(tmp1);
1546 	tmp1 = qinc(tmp2);
1547 	qfree(tmp2);
1548 	if (qisneg(q)) {
1549 		tmp2 = qneg(tmp1);
1550 		qfree(tmp1);
1551 		tmp1 = tmp2;
1552 	}
1553 	res = qmappr(tmp1, epsilon, 24L);
1554 	qfree(tmp1);
1555 	return res;
1556 }
1557 
1558 
1559 NUMBER *
qsech(NUMBER * q,NUMBER * epsilon)1560 qsech(NUMBER *q, NUMBER *epsilon)
1561 {
1562 	NUMBER *tmp1, *tmp2, *tmp3, *res;
1563 	long n, k;
1564 
1565 	if (qiszero(epsilon)) {
1566 		math_error("Zero epsilon value for sech");
1567 		/*NOTREACHED*/
1568 	}
1569 	if (qiszero(q))
1570 		return qlink(&_qone_);
1571 
1572 	tmp1 = qqabs(q);
1573 	k = 0;
1574 	if (zrel(tmp1->num, tmp1->den) >= 0) {
1575 		tmp2 = qmul(&_qlge_, tmp1);
1576 		k = qtoi(tmp2);
1577 		qfree(tmp2);
1578 	}
1579 	n = qilog2(epsilon);
1580 	if (k + n > 1) {
1581 		qfree(tmp1);
1582 		return qlink(&_qzero_);
1583 	}
1584 	tmp2 = qexprel(tmp1, 4 - k - n);
1585 	qfree(tmp1);
1586 	tmp1 = qinv(tmp2);
1587 	tmp3 = qqadd(tmp1, tmp2);
1588 	qfree(tmp1);
1589 	qfree(tmp2);
1590 	tmp1 = qinv(tmp3);
1591 	qfree(tmp3);
1592 	tmp2 = qscale(tmp1, 1);
1593 	qfree(tmp1);
1594 	res = qmappr(tmp2, epsilon, 24L);
1595 	qfree(tmp2);
1596 	return res;
1597 }
1598 
1599 
1600 NUMBER *
qcsch(NUMBER * q,NUMBER * epsilon)1601 qcsch(NUMBER *q, NUMBER *epsilon)
1602 {
1603 	NUMBER *tmp1, *tmp2, *tmp3, *res;
1604 	long n, k;
1605 
1606 	if (qiszero(epsilon)) {
1607 		math_error("Zero epsilon value for csch");
1608 		/*NOTREACHED*/
1609 	}
1610 	if (qiszero(q)) {
1611 		math_error("Zero argument for csch");
1612 		/*NOTREACHED*/
1613 	}
1614 
1615 	n = qilog2(epsilon);
1616 	tmp1 = qqabs(q);
1617 	if (zrel(tmp1->num, tmp1->den) >= 0) {
1618 		tmp2 = qmul(&_qlge_, tmp1);
1619 		k = qtoi(tmp2);
1620 		qfree(tmp2);
1621 	} else {
1622 		k = 2 * qilog2(tmp1);
1623 	}
1624 	if (k + n >= 1) {
1625 		qfree(tmp1);
1626 		return qlink(&_qzero_);
1627 	}
1628 	tmp2 = qexprel(tmp1, 4 - k - n);
1629 	qfree(tmp1);
1630 	tmp1 = qinv(tmp2);
1631 	if (qisneg(q))
1632 		tmp3 = qsub(tmp1, tmp2);
1633 	else
1634 		tmp3 = qsub(tmp2, tmp1);
1635 	qfree(tmp1);
1636 	qfree(tmp2);
1637 	tmp1 = qinv(tmp3);
1638 	qfree(tmp3)
1639 	tmp2 = qscale(tmp1, 1);
1640 	qfree(tmp1);
1641 	res = qmappr(tmp2, epsilon, 24L);
1642 	qfree(tmp2);
1643 	return res;
1644 }
1645 
1646 
1647 /*
1648  * Compute the hyperbolic arccosine within the specified accuracy.
1649  * This is calculated using the formula:
1650  *	acosh(x) = ln(x + sqrt(x^2 - 1)).
1651  */
1652 NUMBER *
qacosh(NUMBER * q,NUMBER * epsilon)1653 qacosh(NUMBER *q, NUMBER *epsilon)
1654 {
1655 	NUMBER *tmp1, *tmp2, *epsilon1;
1656 	long n;
1657 
1658 	if (qiszero(epsilon)) {
1659 		math_error("Zero epsilon value for acosh");
1660 		/*NOTREACHED*/
1661 	}
1662 	if (qisone(q))
1663 		return qlink(&_qzero_);
1664 	if (zrel(q->num, q->den) < 0)
1665 		return NULL;
1666 	n = qilog2(epsilon);
1667 	epsilon1 = qbitvalue(n - 3);
1668 	tmp1 = qsquare(q);
1669 	tmp2 = qdec(tmp1);
1670 	qfree(tmp1);
1671 	tmp1 = qsqrt(tmp2, epsilon1, 24L);
1672 	qfree(tmp2);
1673 	tmp2 = qqadd(tmp1, q);
1674 	qfree(tmp1);
1675 	tmp1 = qln(tmp2, epsilon1);
1676 	qfree(tmp2);
1677 	qfree(epsilon1);
1678 	tmp2 = qmappr(tmp1, epsilon, 24L);
1679 	qfree(tmp1);
1680 	return tmp2;
1681 }
1682 
1683 
1684 /*
1685  * Compute the hyperbolic arcsine within the specified accuracy.
1686  * This is calculated using the formula:
1687  *	asinh(x) = ln(x + sqrt(x^2 + 1)).
1688  */
1689 NUMBER *
qasinh(NUMBER * q,NUMBER * epsilon)1690 qasinh(NUMBER *q, NUMBER *epsilon)
1691 {
1692 	NUMBER *tmp1, *tmp2, *epsilon1;
1693 	long n;
1694 	BOOL neg;
1695 
1696 	if (qiszero(epsilon)) {
1697 		math_error("Zero epsilon value for asinh");
1698 		/*NOTREACHED*/
1699 	}
1700 	if (qiszero(q))
1701 		return qlink(&_qzero_);
1702 	neg = qisneg(q);
1703 	q = qqabs(q);
1704 	n = qilog2(epsilon);
1705 	epsilon1 = qbitvalue(n - 3);
1706 	tmp1 = qsquare(q);
1707 	tmp2 = qinc(tmp1);
1708 	qfree(tmp1);
1709 	tmp1 = qsqrt(tmp2, epsilon1, 24L);
1710 	qfree(tmp2);
1711 	tmp2 = qqadd(tmp1, q);
1712 	qfree(tmp1);
1713 	tmp1 = qln(tmp2, epsilon1);
1714 	qfree(tmp2);
1715 	qfree(q);
1716 	qfree(epsilon1);
1717 	tmp2 = qmappr(tmp1, epsilon, 24L);
1718 	if (neg) {
1719 		tmp1 = qneg(tmp2);
1720 		qfree(tmp2);
1721 		return tmp1;
1722 	}
1723 	return tmp2;
1724 }
1725 
1726 
1727 /*
1728  * Compute the hyperbolic arctangent within the specified accuracy.
1729  * This is calculated using the formula:
1730  *	atanh(x) = ln((1 + x) / (1 - x)) / 2.
1731  */
1732 NUMBER *
qatanh(NUMBER * q,NUMBER * epsilon)1733 qatanh(NUMBER *q, NUMBER *epsilon)
1734 {
1735 	NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
1736 	ZVALUE z;
1737 
1738 	if (qiszero(epsilon)) {
1739 		math_error("Zero epsilon value for atanh");
1740 		/*NOTREACHED*/
1741 	}
1742 	if (qiszero(q))
1743 		return qlink(&_qzero_);
1744 	z = q->num;
1745 	z.sign = 0;
1746 	if (zrel(z, q->den) >= 0)
1747 		return NULL;
1748 	tmp1 = qinc(q);
1749 	tmp2 = qsub(&_qone_, q);
1750 	tmp3 = qqdiv(tmp1, tmp2);
1751 	qfree(tmp1);
1752 	qfree(tmp2);
1753 	epsilon1 = qscale(epsilon, 1L);
1754 	tmp1 = qln(tmp3, epsilon1);
1755 	qfree(tmp3);
1756 	tmp2 = qscale(tmp1, -1L);
1757 	qfree(tmp1);
1758 	qfree(epsilon1);
1759 	return tmp2;
1760 }
1761 
1762 
1763 /*
1764  * Inverse hyperbolic secant function
1765  */
1766 NUMBER *
qasech(NUMBER * q,NUMBER * epsilon)1767 qasech(NUMBER *q, NUMBER *epsilon)
1768 {
1769 	NUMBER *tmp, *res;
1770 
1771 	tmp = qinv(q);
1772 	res = qacosh(tmp, epsilon);
1773 	qfree(tmp);
1774 	return res;
1775 }
1776 
1777 
1778 /*
1779  * Inverse hyperbolic cosecant function
1780  */
1781 NUMBER *
qacsch(NUMBER * q,NUMBER * epsilon)1782 qacsch(NUMBER *q, NUMBER *epsilon)
1783 {
1784 	NUMBER *tmp, *res;
1785 
1786 	tmp = qinv(q);
1787 	res = qasinh(tmp, epsilon);
1788 	qfree(tmp);
1789 	return res;
1790 }
1791 
1792 
1793 /*
1794  * Inverse hyperbolic cotangent function
1795  */
1796 NUMBER *
qacoth(NUMBER * q,NUMBER * epsilon)1797 qacoth(NUMBER *q, NUMBER *epsilon)
1798 {
1799 	NUMBER *tmp, *res;
1800 
1801 	tmp = qinv(q);
1802 	res = qatanh(tmp, epsilon);
1803 	qfree(tmp);
1804 	return res;
1805 }
1806