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: float.c
18 * Abstract: floating word set
30 /**************************************************************************/
31 /* WORDS ******************************************************************/
32 /**************************************************************************/
35 register Cell len = *sp++;
36 register Char *s = (Char *) *sp;
37 extern Char *s_tmp_buffer[];
39 memcpy(s_tmp_buffer, s, len);
40 if (toupper(s[len - 1]) == 'E' || toupper(s[len - 1]) == 'D') s[len++] = '0';
42 *--fp = (Real) strtod(s, &endptr);
43 if (!*endptr) *sp = FFLAG(1);
51 register DCell d = GET_DCELL(sp);
57 register Real *addr = (Real *) *sp++;
83 *sp = FFLAG(*fp < 0.0);
87 void _f_zero_equals() {
89 *sp = FFLAG(*fp == 0.0);
95 *sp = FFLAG(fp[1] < fp[0]);
100 register DCell d = (DCell) *fp++;
106 *--fp = *((Real *) *sp++);
110 register Real r = *fp++;
111 create_definition(A_FCONSTANT);
130 compile_cell((Cell) _do_fliteral);
136 sp[0] += sizeof(Real);
140 sp[0] *= sizeof(Real);
144 fp[0] = floor(fp[0]);
148 if (fp[0] > fp[1]) fp[1] = fp[0];
153 if (fp[0] < fp[1]) fp[1] = fp[0];
167 register Real temp = fp[0];
174 fp[0] = floor(fp[0] + 0.5);
178 register Real temp = fp[0];
184 create_definition(A_FVARIABLE);
190 register Real x = *fp++;
192 register int sign = 0;
193 static char buf[128];
199 m = (int) floor(log10(x)) + 1;
206 sprintf(buf, "%0.*f", sp[0], x);
207 strncpy((Char *) sp[1], buf + 2, sp[0]);