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 * ------------------------------------------------------------------------
8 * Abstract: floating word set
20 /**************************************************************************/
21 /* WORDS ******************************************************************/
22 /**************************************************************************/
25 register Cell len = *sp++;
26 register Char *s = (Char *) *sp;
27 extern Char *s_tmp_buffer[];
29 memcpy(s_tmp_buffer, s, len);
30 if (toupper(s[len - 1]) == 'E' || toupper(s[len - 1]) == 'D') s[len++] = '0';
32 *--fp = (Real) strtod(s, &endptr);
33 if (!*endptr) *sp = FFLAG(1);
41 register DCell d = GET_DCELL(sp);
47 register Real *addr = (Real *) *sp++;
73 *sp = FFLAG(*fp < 0.0);
77 void _f_zero_equals() {
79 *sp = FFLAG(*fp == 0.0);
85 *sp = FFLAG(fp[1] < fp[0]);
90 register DCell d = (DCell) *fp++;
96 *--fp = *((Real *) *sp++);
100 register Real r = *fp++;
101 create_definition(A_FCONSTANT);
120 compile_cell((Cell) _do_fliteral);
126 sp[0] += sizeof(Real);
130 sp[0] *= sizeof(Real);
134 fp[0] = floor(fp[0]);
138 if (fp[0] > fp[1]) fp[1] = fp[0];
143 if (fp[0] < fp[1]) fp[1] = fp[0];
157 register Real temp = fp[0];
164 fp[0] = floor(fp[0] + 0.5);
168 register Real temp = fp[0];
174 create_definition(A_FVARIABLE);
180 register Real x = *fp++;
182 register int sign = 0;
183 static char buf[128];
189 m = (int) floor(log10(x)) + 1;
196 sprintf(buf, "%0.*f", sp[0], x);
197 strncpy((Char *) sp[1], buf + 2, sp[0]);