git.gag.com Git - debian/yforth/blob - double.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:     double.c
   8  * Abstract:        double-number word set
   9  */
  10
  11 #include <stdio.h>
  12 #include "yforth.h"
  13 #include "core.h"
  14 #include "double.h"
  15
  16 /**************************************************************************/
  17 /* WORDS ******************************************************************/
  18 /**************************************************************************/
  19
  20 void _two_constant() {
  21         register DCell d = GET_DCELL(sp);
  22         sp += 2;
  23         create_definition(A_2CONSTANT);
  24         compile_cell((Cell) d);
  25         compile_cell((Cell) (d >> CellBits));
  26         mark_word(_last);
  27 }
  28
  29 void _two_literal() {
  30         compile_cell((Cell) _do_literal);
  31     compile_cell((Cell) sp[1]);
  32         compile_cell((Cell) _do_literal);
  33     compile_cell((Cell) sp[0]);
  34         sp += 2;
  35 }
  36
  37 void _two_variable() {
  38         create_definition(A_2VARIABLE);
  39         compile_cell(0);
  40         compile_cell(0);
  41         mark_word(_last);
  42 }
  43
  44 void _d_plus() {
  45         register DCell d1 = GET_DCELL(sp + 2);
  46         register DCell d2 = GET_DCELL(sp);
  47         d1 += d2;
  48         sp += 2;
  49         PUT_DCELL(sp, d1);
  50 }
  51
  52 void _d_minus() {
  53         register DCell d1 = GET_DCELL(sp + 2);
  54         register DCell d2 = GET_DCELL(sp);
  55         d1 -= d2;
  56         sp += 2;
  57         PUT_DCELL(sp, d1);
  58 }
  59
  60 void _d_dot() {
  61         register DCell u = GET_DCELL(sp);
  62         register int usign = u < 0;
  63         if (usign) u = -u;
  64         PUT_DCELL(sp, u);
  65         _less_number_sign();
  66         _number_sign_s();
  67         if (usign) {
  68                 *--sp = '-';
  69                 _hold();
  70         }
  71         _number_sign_greater();
  72         _type();
  73         putchar(' ');
  74 }
  75
  76 void _d_dot_r() {
  77         register Cell r = *sp++;
  78         register DCell u = GET_DCELL(sp);
  79         register int usign = u < 0;
  80         if (usign && _base == 10) u = -u;
  81         PUT_DCELL(sp, u);
  82         _less_number_sign();
  83         _number_sign_s();
  84         if (usign) {
  85                 *--sp = '-';
  86                 _hold();
  87         }
  88         _number_sign_greater();
  89         if (sp[0] < r) {
  90                 sp--;
  91                 sp[0] = r - sp[1];
  92                 _spaces();
  93         }
  94         _type();
  95         putchar(' ');
  96 }
  97
  98 void _d_zero_less() {
  99         register DCell d = GET_DCELL(sp);
 100         sp++;
 101         sp[0] = FFLAG(d < 0);
 102 }
 103
 104 void _d_zero_equals() {
 105         register DCell d = GET_DCELL(sp);
 106         sp++;
 107         sp[0] = FFLAG(d == 0);
 108 }
 109
 110 void _d_two_star() {
 111         register DCell d = GET_DCELL(sp);
 112         d <<= 1;
 113         PUT_DCELL(sp, d);
 114 }
 115
 116 void _d_two_slash() {
 117         register DCell d = GET_DCELL(sp);
 118         d >>= 1;
 119         PUT_DCELL(sp, d);
 120 }
 121
 122 void _d_less_than() {
 123         register DCell d1 = GET_DCELL(sp + 2);
 124         register DCell d2 = GET_DCELL(sp);
 125         sp += 3;
 126         sp[0] = FFLAG(d1 < d2);
 127 }
 128
 129 void _d_equals() {
 130         register DCell d1 = GET_DCELL(sp + 2);
 131         register DCell d2 = GET_DCELL(sp);
 132         sp += 3;
 133         sp[0] = FFLAG(d1 == d2);
 134 }
 135
 136 void _dabs() {
 137         register DCell d = GET_DCELL(sp);
 138         d = d > 0 ? d : -d;
 139         PUT_DCELL(sp, d);
 140 }
 141
 142 void _dmax() {
 143         register DCell d1 = GET_DCELL(sp + 2);
 144         register DCell d2 = GET_DCELL(sp);
 145         sp += 2;
 146         if (d2 > d1) PUT_DCELL(sp, d2);
 147 }
 148
 149 void _dmin() {
 150         register DCell d1 = GET_DCELL(sp + 2);
 151         register DCell d2 = GET_DCELL(sp);
 152         sp += 2;
 153         if (d2 < d1) PUT_DCELL(sp, d2);
 154 }
 155
 156 void _dnegate() {
 157         register DCell d = -GET_DCELL(sp);
 158         PUT_DCELL(sp, d);
 159 }
 160
 161 void _m_star_slash() {
 162         register Cell n2 = *sp++;
 163         register Cell n1 = *sp++;
 164         register DCell d = GET_DCELL(sp);
 165         d = (d * n1) / n2;
 166         PUT_DCELL(sp, d);
 167 }
 168
 169 void _m_plus() {
 170         _s_to_d();
 171         _d_plus();
 172 }
 173
 174