1 /* yForth? - A Forth interpreter written in ANSI C
2 * Copyright (C) 2012 Luca Padovani
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 * ------------------------------------------------------------------------
17 * Module name: floate.c
18 * Abstract: floating-extension word set
26 /**************************************************************************/
27 /* VARIABLES **************************************************************/
28 /**************************************************************************/
30 static Cell precision = 15;
32 /**************************************************************************/
33 /* WORDS ******************************************************************/
34 /**************************************************************************/
37 register double *addr = (double *) *sp++;
38 *addr = (double) *fp++;
42 register double *addr = (double *) *sp++;
46 void _d_float_plus() {
47 sp[0] += sizeof(double);
51 sp[0] *= sizeof(double);
55 fp[1] = pow(fp[1], fp[0]);
60 printf("%.*f ", precision, (double) *fp++);
75 *fp = log(*fp + sqrt(*fp * *fp - 1));
91 *fp = log(*fp + sqrt(*fp * *fp + 1));
100 fp[1] = atan2(fp[1], fp[0]);
108 *fp = 0.5 * log((1 + *fp) / (1 - *fp));
121 register Real r = *fp++;
122 register int esp = 0;
124 while (r < 1.0 || r > 1000.0) {
133 printf("%.*fE%d ", precision, (double) r, esp);
140 void _f_exp_m_one() {
141 *fp = exp(*fp) - 1.0;
149 *fp = log(*fp) + 1.0;
157 printf("%.*e ", precision, (double) *fp++);
186 void _f_proximate() {
187 register Real r3 = *fp++;
188 register Real r2 = *fp++;
189 register Real r1 = *fp++;
190 if (r3 > 0.0) *--sp = FFLAG(fabs(r1 - r2) < r3);
191 else if (r3 < 0.0) *--sp = FFLAG(fabs(r1 - r2) < (-r3) * (fabs(r1) + fabs(r2)));
192 else *--sp = FFLAG(r1 == r2);
199 void _set_precision() {
204 register float *addr = (float *) *sp++;
205 *addr = (float) *fp++;
209 register float *addr = (float *) *sp++;
210 *--fp = (Real) *addr;
213 void _s_float_plus() {
214 sp[0] += sizeof(float);
218 sp[0] *= sizeof(float);