git.gag.com Git - debian/yforth/blob - float.c

   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:     float.c
   8  * Abstract:        floating word set
   9  */
  10
  11 #include <math.h>
  12 #include <stdio.h>
  13 #include <string.h>
  14 #include <stdlib.h>
  15 #include <ctype.h>
  16 #include "yforth.h"
  17 #include "core.h"
  18 #include "float.h"
  19
  20 /**************************************************************************/
  21 /* WORDS ******************************************************************/
  22 /**************************************************************************/
  23
  24 void _to_float() {
  25         register Cell len = *sp++;
  26         register Char *s = (Char *) *sp;
  27         extern Char *s_tmp_buffer[];
  28         Char *endptr;
  29         memcpy(s_tmp_buffer, s, len);
  30         if (toupper(s[len - 1]) == 'E' || toupper(s[len - 1]) == 'D') s[len++] = '0';
  31         s[len] = '\0';
  32         *--fp = (Real) strtod(s, &endptr);
  33         if (!*endptr) *sp = FFLAG(1);
  34         else {
  35                 *sp = FFLAG(0);
  36                 fp++;
  37         }
  38 }
  39
  40 void _d_to_f() {
  41         register DCell d = GET_DCELL(sp);
  42         *--fp = (Real) d;
  43         sp += 2;
  44 }
  45
  46 void _f_store() {
  47         register Real *addr = (Real *) *sp++;
  48         *addr = *fp++;
  49 }
  50
  51 void _f_star() {
  52         fp[1] *= fp[0];
  53         fp++;
  54 }
  55
  56 void _f_plus() {
  57         fp[1] += fp[0];
  58         fp++;
  59 }
  60
  61 void _f_minus() {
  62         fp[1] -= fp[0];
  63         fp++;
  64 }
  65
  66 void _f_slash() {
  67         fp[1] /= fp[0];
  68         fp++;
  69 }
  70
  71 void _f_zero_less() {
  72         sp--;
  73         *sp = FFLAG(*fp < 0.0);
  74         fp++;
  75 }
  76
  77 void _f_zero_equals() {
  78         sp--;
  79         *sp = FFLAG(*fp == 0.0);
  80         fp++;
  81 }
  82
  83 void _f_less_than() {
  84         sp--;
  85         *sp = FFLAG(fp[1] < fp[0]);
  86         fp += 2;
  87 }
  88
  89 void _f_to_d() {
  90         register DCell d = (DCell) *fp++;
  91         sp -= 2;
  92         PUT_DCELL(sp, d);
  93 }
  94
  95 void _f_fetch() {
  96         *--fp = *((Real *) *sp++);
  97 }
  98
  99 void _f_constant() {
 100         register Real r = *fp++;
 101         create_definition(A_FCONSTANT);
 102         compile_real(r);
 103         mark_word(_last);
 104 }
 105
 106 void _f_depth() {
 107         *--sp = fp_top - fp;
 108 }
 109
 110 void _f_drop() {
 111         fp++;
 112 }
 113
 114 void _f_dupe() {
 115         fp--;
 116         fp[0] = fp[1];
 117 }
 118
 119 void _f_literal() {
 120         compile_cell((Cell) _do_fliteral);
 121         compile_real(fp[0]);
 122         fp++;
 123 }
 124
 125 void _float_plus() {
 126         sp[0] += sizeof(Real);
 127 }
 128
 129 void _floats() {
 130         sp[0] *= sizeof(Real);
 131 }
 132
 133 void _floor() {
 134         fp[0] = floor(fp[0]);
 135 }
 136
 137 void _f_max() {
 138         if (fp[0] > fp[1]) fp[1] = fp[0];
 139         fp++;
 140 }
 141
 142 void _f_min() {
 143         if (fp[0] < fp[1]) fp[1] = fp[0];
 144         fp++;
 145 }
 146
 147 void _f_negate() {
 148         fp[0] = -fp[0];
 149 }
 150
 151 void _f_over() {
 152         fp--;
 153         fp[0] = fp[2];
 154 }
 155
 156 void _f_rote() {
 157         register Real temp = fp[0];
 158         fp[0] = fp[2];
 159         fp[2] = fp[1];
 160         fp[1] = temp;
 161 }
 162
 163 void _f_round() {
 164         fp[0] = floor(fp[0] + 0.5);
 165 }
 166
 167 void _f_swap() {
 168         register Real temp = fp[0];
 169         fp[0] = fp[1];
 170         fp[1] = temp;
 171 }
 172
 173 void _f_variable() {
 174         create_definition(A_FVARIABLE);
 175         compile_real(0.0);
 176         mark_word(_last);
 177 }
 178
 179 void _represent() {
 180     register Real x = *fp++;
 181     register int m;
 182     register int sign = 0;
 183     static char buf[128];
 184     if (x < 0.0) {
 185         sign = 1;
 186         x = -x;
 187     }
 188     if (x != 0.0) {
 189         m = (int) floor(log10(x)) + 1;
 190         x /= pow(10, m);
 191         if (x >= 1.0) {
 192             x /= 10;
 193             m++;
 194         }
 195     } else m = 0;
 196     sprintf(buf, "%0.*f", sp[0], x);
 197     strncpy((Char *) sp[1], buf + 2, sp[0]);
 198     sp--;
 199     sp[2] = m;
 200     sp[1] = FFLAG(sign);
 201         sp[0] = FFLAG(1);
 202 }
 203