native/arithmetic.c

   1 #include "factor.h"
   2
   3 FIXNUM to_fixnum(CELL tagged)
   4 {
   5         switch(type_of(tagged))
   6         {
   7         case FIXNUM_TYPE:
   8                 return untag_fixnum_fast(tagged);
   9         case BIGNUM_TYPE:
  10                 return bignum_to_fixnum(tagged);
  11         default:
  12                 type_error(FIXNUM_TYPE,tagged);
  13                 return -1; /* can't happen */
  14         }
  15 }
  16
  17 #define CELL_TO_INTEGER(result) \
  18         FIXNUM _result = (result); \
  19         if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
  20                 env.dt = tag_bignum(fixnum_to_bignum(_result)); \
  21         else \
  22                 env.dt = tag_fixnum(_result);
  23
  24 #define BIGNUM_2_TO_INTEGER(result) \
  25         BIGNUM_2 _result = (result); \
  26         if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
  27                 env.dt = tag_bignum(bignum(_result)); \
  28         else \
  29                 env.dt = tag_fixnum(_result);
  30
  31 /* ADDITION */
  32 INLINE void add_fixnum(CELL x, CELL y)
  33 {
  34         CELL_TO_INTEGER(untag_fixnum_fast(x) + untag_fixnum_fast(y));
  35 }
  36
  37 INLINE void add_bignum(CELL x, CELL y)
  38 {
  39         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
  40                 + ((BIGNUM*)UNTAG(y))->n));
  41 }
  42
  43 BINARY_OP(add)
  44
  45 /* SUBTRACTION */
  46 INLINE void subtract_fixnum(CELL x, CELL y)
  47 {
  48         CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y));
  49 }
  50
  51 INLINE void subtract_bignum(CELL x, CELL y)
  52 {
  53         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
  54                 - ((BIGNUM*)UNTAG(y))->n));
  55 }
  56
  57 BINARY_OP(subtract)
  58
  59 /* MULTIPLICATION */
  60 INLINE void multiply_fixnum(CELL x, CELL y)
  61 {
  62         BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
  63                 * (BIGNUM_2)untag_fixnum_fast(y));
  64 }
  65
  66 INLINE void multiply_bignum(CELL x, CELL y)
  67 {
  68         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
  69                 * ((BIGNUM*)UNTAG(y))->n));
  70 }
  71
  72 BINARY_OP(multiply)
  73
  74 /* DIVMOD */
  75 INLINE void divmod_fixnum(CELL x, CELL y)
  76 {
  77         ldiv_t q = ldiv(x,y);
  78         /* division takes common factor of 8 out. */
  79         dpush(tag_fixnum(q.quot));
  80         env.dt = q.rem;
  81 }
  82
  83 INLINE void divmod_bignum(CELL x, CELL y)
  84 {
  85         dpush(tag_object(bignum(((BIGNUM*)UNTAG(x))->n
  86                 / ((BIGNUM*)UNTAG(y))->n)));
  87         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
  88                 % ((BIGNUM*)UNTAG(y))->n));
  89 }
  90
  91 BINARY_OP(divmod)
  92
  93 /* MOD */
  94 INLINE void mod_fixnum(CELL x, CELL y)
  95 {
  96         env.dt = x % y;
  97 }
  98
  99 INLINE void mod_bignum(CELL x, CELL y)
 100 {
 101         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
 102                 % ((BIGNUM*)UNTAG(y))->n));
 103 }
 104
 105 BINARY_OP(mod)
 106
 107 /* AND */
 108 INLINE void and_fixnum(CELL x, CELL y)
 109 {
 110         env.dt = x & y;
 111 }
 112
 113 INLINE void and_bignum(CELL x, CELL y)
 114 {
 115         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
 116                 & ((BIGNUM*)UNTAG(y))->n));
 117 }
 118
 119 BINARY_OP(and)
 120
 121 /* OR */
 122 INLINE void or_fixnum(CELL x, CELL y)
 123 {
 124         env.dt = x | y;
 125 }
 126
 127 INLINE void or_bignum(CELL x, CELL y)
 128 {
 129         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
 130                 | ((BIGNUM*)UNTAG(y))->n));
 131 }
 132
 133 BINARY_OP(or)
 134
 135 /* XOR */
 136 INLINE void xor_fixnum(CELL x, CELL y)
 137 {
 138         env.dt = x ^ y;
 139 }
 140
 141 INLINE void xor_bignum(CELL x, CELL y)
 142 {
 143         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
 144                 ^ ((BIGNUM*)UNTAG(y))->n));
 145 }
 146
 147 BINARY_OP(xor)
 148
 149 /* SHIFTLEFT */
 150 INLINE void shiftleft_fixnum(CELL x, CELL y)
 151 {
 152         BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
 153                 << (BIGNUM_2)untag_fixnum_fast(y));
 154 }
 155
 156 INLINE void shiftleft_bignum(CELL x, CELL y)
 157 {
 158         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
 159                 << ((BIGNUM*)UNTAG(y))->n));
 160 }
 161
 162 BINARY_OP(shiftleft)
 163
 164 /* SHIFTRIGHT */
 165 INLINE void shiftright_fixnum(CELL x, CELL y)
 166 {
 167         BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
 168                 >> (BIGNUM_2)untag_fixnum_fast(y));
 169 }
 170
 171 INLINE void shiftright_bignum(CELL x, CELL y)
 172 {
 173         env.dt = tag_object(bignum(((BIGNUM*)UNTAG(x))->n
 174                 >> ((BIGNUM*)UNTAG(y))->n));
 175 }
 176
 177 BINARY_OP(shiftright)
 178
 179 /* LESS */
 180 INLINE void less_fixnum(CELL x, CELL y)
 181 {
 182         env.dt = tag_boolean((FIXNUM)x < (FIXNUM)y);
 183 }
 184
 185 INLINE void less_bignum(CELL x, CELL y)
 186 {
 187         env.dt = tag_boolean(((BIGNUM*)UNTAG(x))->n
 188                 < ((BIGNUM*)UNTAG(y))->n);
 189 }
 190
 191 BINARY_OP(less)
 192
 193 /* LESSEQ */
 194 INLINE void lesseq_fixnum(CELL x, CELL y)
 195 {
 196         env.dt = tag_boolean((FIXNUM)x <= (FIXNUM)y);
 197 }
 198
 199 INLINE void lesseq_bignum(CELL x, CELL y)
 200 {
 201         env.dt = tag_boolean(((BIGNUM*)UNTAG(x))->n
 202                 <= ((BIGNUM*)UNTAG(y))->n);
 203 }
 204
 205 BINARY_OP(lesseq)
 206
 207 /* GREATER */
 208 INLINE void greater_fixnum(CELL x, CELL y)
 209 {
 210         env.dt = tag_boolean((FIXNUM)x > (FIXNUM)y);
 211 }
 212
 213 INLINE void greater_bignum(CELL x, CELL y)
 214 {
 215         env.dt = tag_boolean(((BIGNUM*)UNTAG(x))->n
 216                 > ((BIGNUM*)UNTAG(y))->n);
 217 }
 218
 219 BINARY_OP(greater)
 220
 221 /* GREATEREQ */
 222 INLINE void greatereq_fixnum(CELL x, CELL y)
 223 {
 224         env.dt = tag_boolean((FIXNUM)x >= (FIXNUM)y);
 225 }
 226
 227 INLINE void greatereq_bignum(CELL x, CELL y)
 228 {
 229         env.dt = tag_boolean(((BIGNUM*)UNTAG(x))->n
 230                 >= ((BIGNUM*)UNTAG(y))->n);
 231 }
 232
 233 BINARY_OP(greatereq)