1 /* yForth? - Written by Luca Padovani (C) 1996/97
2 * ------------------------------------------------------------------------
3 * This software is FreeWare as long as it comes with this header in each
4 * source file, anyway you can use it or any part of it whatever
5 * you want. It comes without any warranty, so use it at your own risk.
6 * ------------------------------------------------------------------------
7 * Module name: floate.c
8 * Abstract: floating-extension word set
16 /**************************************************************************/
17 /* VARIABLES **************************************************************/
18 /**************************************************************************/
20 static Cell precision = 15;
22 /**************************************************************************/
23 /* WORDS ******************************************************************/
24 /**************************************************************************/
27 register double *addr = (double *) *sp++;
28 *addr = (double) *fp++;
32 register double *addr = (double *) *sp++;
36 void _d_float_plus() {
37 sp[0] += sizeof(double);
41 sp[0] *= sizeof(double);
45 fp[1] = pow(fp[1], fp[0]);
50 printf("%.*f ", precision, (double) *fp++);
65 *fp = log(*fp + sqrt(*fp * *fp - 1));
81 *fp = log(*fp + sqrt(*fp * *fp + 1));
90 fp[1] = atan2(fp[1], fp[0]);
98 *fp = 0.5 * log((1 + *fp) / (1 - *fp));
111 register Real r = *fp++;
112 register int esp = 0;
114 while (r < 1.0 || r > 1000.0) {
123 printf("%.*fE%d ", precision, (double) r, esp);
130 void _f_exp_m_one() {
131 *fp = exp(*fp) - 1.0;
139 *fp = log(*fp) + 1.0;
147 printf("%.*e ", precision, (double) *fp++);
176 void _f_proximate() {
177 register Real r3 = *fp++;
178 register Real r2 = *fp++;
179 register Real r1 = *fp++;
180 if (r3 > 0.0) *--sp = FFLAG(fabs(r1 - r2) < r3);
181 else if (r3 < 0.0) *--sp = FFLAG(fabs(r1 - r2) < (-r3) * (fabs(r1) + fabs(r2)));
182 else *--sp = FFLAG(r1 == r2);
189 void _set_precision() {
194 register float *addr = (float *) *sp++;
195 *addr = (float) *fp++;
199 register float *addr = (float *) *sp++;
200 *--fp = (Real) *addr;
203 void _s_float_plus() {
204 sp[0] += sizeof(float);
208 sp[0] *= sizeof(float);