vm/math.cpp

   1 #include "master.hpp"
   2 #include <sstream>
   3 #include <iomanip>
   4 #include <stdexcept>
   5
   6 namespace factor {
   7
   8 void factor_vm::primitive_bignum_to_fixnum() {
   9   ctx->replace(tag_fixnum(bignum_to_fixnum(untag<bignum>(ctx->peek()))));
  10 }
  11
  12 void factor_vm::primitive_bignum_to_fixnum_strict() {
  13   ctx->replace(tag_fixnum(bignum_to_fixnum_strict(untag<bignum>(ctx->peek()))));
  14 }
  15
  16 void factor_vm::primitive_float_to_fixnum() {
  17   ctx->replace(tag_fixnum(float_to_fixnum(ctx->peek())));
  18 }
  19
  20 // does not allocate, even though from_signed_cell can allocate
  21 // Division can only overflow when we are dividing the most negative fixnum
  22 // by -1.
  23 void factor_vm::primitive_fixnum_divint() {
  24   fixnum y = untag_fixnum(ctx->pop());
  25   fixnum x = untag_fixnum(ctx->peek());
  26   fixnum result = x / y;
  27   if (result == -fixnum_min)
  28     // Does not allocate
  29     ctx->replace(from_signed_cell(-fixnum_min));
  30   else
  31     ctx->replace(tag_fixnum(result));
  32 }
  33
  34 // does not allocate, even though from_signed_cell can allocate
  35 void factor_vm::primitive_fixnum_divmod() {
  36   cell* s0 = (cell*)(ctx->datastack);
  37   cell* s1 = (cell*)(ctx->datastack - sizeof(cell));
  38   fixnum y = untag_fixnum(*s0);
  39   fixnum x = untag_fixnum(*s1);
  40   if (y == -1 && x == fixnum_min) {
  41     // Does not allocate
  42     *s1 = from_signed_cell(-fixnum_min);
  43     *s0 = tag_fixnum(0);
  44   } else {
  45     *s1 = tag_fixnum(x / y);
  46     *s0 = tag_fixnum(x % y);
  47   }
  48 }
  49
  50
  51 // If we're shifting right by n bits, we won't overflow as long as none of the
  52 // high WORD_SIZE-TAG_BITS-n bits are set.
  53 inline fixnum factor_vm::sign_mask(fixnum x) {
  54     return x >> (WORD_SIZE - 1);
  55 }
  56
  57 inline fixnum factor_vm::branchless_max(fixnum x, fixnum y) {
  58   return (x - ((x - y) & sign_mask(x - y)));
  59 }
  60
  61 inline fixnum factor_vm::branchless_abs(fixnum x) {
  62   return (x ^ sign_mask(x)) - sign_mask(x);
  63 }
  64
  65 // Allocates memory
  66 void factor_vm::primitive_fixnum_shift() {
  67   fixnum y = untag_fixnum(ctx->pop());
  68   fixnum x = untag_fixnum(ctx->peek());
  69
  70   if (x == 0)
  71     return;
  72   else if (y < 0) {
  73     y = branchless_max(y, -WORD_SIZE + 1);
  74     ctx->replace(tag_fixnum(x >> -y));
  75     return;
  76   } else if (y < WORD_SIZE - TAG_BITS) {
  77     fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y));
  78     if (!(branchless_abs(x) & mask)) {
  79       ctx->replace(tag_fixnum(x << y));
  80       return;
  81     }
  82   }
  83
  84   ctx->replace(tag<bignum>(bignum_arithmetic_shift(fixnum_to_bignum(x), y)));
  85 }
  86
  87 // Allocates memory
  88 void factor_vm::primitive_fixnum_to_bignum() {
  89   ctx->replace(tag<bignum>(fixnum_to_bignum(untag_fixnum(ctx->peek()))));
  90 }
  91
  92 // Allocates memory
  93 void factor_vm::primitive_float_to_bignum() {
  94   ctx->replace(tag<bignum>(float_to_bignum(ctx->peek())));
  95 }
  96
  97 #define POP_BIGNUMS(x, y)                \
  98   bignum* y = untag<bignum>(ctx->pop()); \
  99   bignum* x = untag<bignum>(ctx->peek());
 100
 101 void factor_vm::primitive_bignum_eq() {
 102   POP_BIGNUMS(x, y);
 103   ctx->replace(tag_boolean(bignum_equal_p(x, y)));
 104 }
 105
 106 // Allocates memory
 107 void factor_vm::primitive_bignum_add() {
 108   POP_BIGNUMS(x, y);
 109   ctx->replace(tag<bignum>(bignum_add(x, y)));
 110 }
 111
 112 // Allocates memory
 113 void factor_vm::primitive_bignum_subtract() {
 114   POP_BIGNUMS(x, y);
 115   ctx->replace(tag<bignum>(bignum_subtract(x, y)));
 116 }
 117
 118 // Allocates memory
 119 void factor_vm::primitive_bignum_multiply() {
 120   POP_BIGNUMS(x, y);
 121   ctx->replace(tag<bignum>(bignum_multiply(x, y)));
 122 }
 123
 124 // Allocates memory
 125 void factor_vm::primitive_bignum_divint() {
 126   POP_BIGNUMS(x, y);
 127   ctx->replace(tag<bignum>(bignum_quotient(x, y)));
 128 }
 129
 130 // Allocates memory
 131 void factor_vm::primitive_bignum_divmod() {
 132   cell* s0 = (cell*)(ctx->datastack);
 133   cell* s1 = (cell*)(ctx->datastack - sizeof(cell));
 134   bignum* y = untag<bignum>(*s0);
 135   bignum* x = untag<bignum>(*s1);
 136   bignum* q, *r;
 137   bignum_divide(x, y, &q, &r);
 138   *s1 = tag<bignum>(q);
 139   *s0 = bignum_maybe_to_fixnum(r);
 140 }
 141
 142 void factor_vm::primitive_bignum_mod() {
 143   POP_BIGNUMS(x, y);
 144   cell val = bignum_maybe_to_fixnum(bignum_remainder(x, y));
 145   ctx->replace(val);
 146 }
 147
 148 void factor_vm::primitive_bignum_gcd() {
 149   POP_BIGNUMS(x, y);
 150   ctx->replace(tag<bignum>(bignum_gcd(x, y)));
 151 }
 152
 153 void factor_vm::primitive_bignum_and() {
 154   POP_BIGNUMS(x, y);
 155   ctx->replace(tag<bignum>(bignum_bitwise_and(x, y)));
 156 }
 157
 158 void factor_vm::primitive_bignum_or() {
 159   POP_BIGNUMS(x, y);
 160   ctx->replace(tag<bignum>(bignum_bitwise_ior(x, y)));
 161 }
 162
 163 void factor_vm::primitive_bignum_xor() {
 164   POP_BIGNUMS(x, y);
 165   ctx->replace(tag<bignum>(bignum_bitwise_xor(x, y)));
 166 }
 167
 168 // Allocates memory
 169 void factor_vm::primitive_bignum_shift() {
 170   fixnum y = untag_fixnum(ctx->pop());
 171   bignum* x = untag<bignum>(ctx->peek());
 172   ctx->replace(tag<bignum>(bignum_arithmetic_shift(x, y)));
 173 }
 174
 175 void factor_vm::primitive_bignum_less() {
 176   POP_BIGNUMS(x, y);
 177   ctx->replace(tag_boolean(bignum_compare(x, y) == BIGNUM_COMPARISON_LESS));
 178 }
 179
 180 void factor_vm::primitive_bignum_lesseq() {
 181   POP_BIGNUMS(x, y);
 182   ctx->replace(tag_boolean(bignum_compare(x, y) != BIGNUM_COMPARISON_GREATER));
 183 }
 184
 185 void factor_vm::primitive_bignum_greater() {
 186   POP_BIGNUMS(x, y);
 187   ctx->replace(tag_boolean(bignum_compare(x, y) == BIGNUM_COMPARISON_GREATER));
 188 }
 189
 190 void factor_vm::primitive_bignum_greatereq() {
 191   POP_BIGNUMS(x, y);
 192   ctx->replace(tag_boolean(bignum_compare(x, y) != BIGNUM_COMPARISON_LESS));
 193 }
 194
 195 void factor_vm::primitive_bignum_not() {
 196   ctx->replace(tag<bignum>(bignum_bitwise_not(untag<bignum>(ctx->peek()))));
 197 }
 198
 199 void factor_vm::primitive_bignum_bitp() {
 200   int bit = (int)to_fixnum(ctx->pop());
 201   bignum* x = untag<bignum>(ctx->peek());
 202   ctx->replace(tag_boolean(bignum_logbitp(bit, x)));
 203 }
 204
 205 void factor_vm::primitive_bignum_log2() {
 206   ctx->replace(tag<bignum>(bignum_integer_length(untag<bignum>(ctx->peek()))));
 207 }
 208
 209 // Allocates memory
 210 void factor_vm::primitive_fixnum_to_float() {
 211   ctx->replace(allot_float(fixnum_to_float(ctx->peek())));
 212 }
 213
 214 // Allocates memory
 215 void factor_vm::primitive_format_float() {
 216   char* locale = alien_offset(ctx->pop());
 217   char* format = alien_offset(ctx->pop());
 218   fixnum precision = untag_fixnum(ctx->pop());
 219   fixnum width = untag_fixnum(ctx->pop());
 220   char* fill = alien_offset(ctx->pop());
 221   double value = untag_float_check(ctx->peek());
 222   std::ostringstream localized_stream;
 223   try {
 224     localized_stream.imbue(std::locale(locale));
 225   } catch (const runtime_error&) {
 226     byte_array* array = allot_byte_array(0);
 227     ctx->replace(tag<byte_array>(array));
 228     return;
 229   }
 230   switch (format[0]) {
 231     case 'f': localized_stream << std::fixed; break;
 232     case 'e': localized_stream << std::scientific; break;
 233   }
 234   if (isupper(format[0])) {
 235     localized_stream << std::uppercase;
 236   }
 237   if (fill[0] != '\0') {
 238     localized_stream << std::setfill(fill[0]);
 239   }
 240   if (width >= 0) {
 241     localized_stream << std::setw(static_cast<int>(width));
 242   }
 243   if (precision >= 0) {
 244     localized_stream << std::setprecision(static_cast<int>(precision));
 245   }
 246   localized_stream << value;
 247   const std::string& tmp = localized_stream.str();
 248   const char* cstr = tmp.c_str();
 249   size_t size = tmp.length();
 250   byte_array* array = allot_byte_array(size);
 251   memcpy(array->data<char>(), cstr, size);
 252   ctx->replace(tag<byte_array>(array));
 253 }
 254
 255 #define POP_FLOATS(x, y)              \
 256   double y = untag_float(ctx->pop()); \
 257   double x = untag_float(ctx->peek());
 258
 259 void factor_vm::primitive_float_eq() {
 260   POP_FLOATS(x, y);
 261   ctx->replace(tag_boolean(x == y));
 262 }
 263
 264 // Allocates memory
 265 void factor_vm::primitive_float_add() {
 266   POP_FLOATS(x, y);
 267   ctx->replace(allot_float(x + y));
 268 }
 269
 270 // Allocates memory
 271 void factor_vm::primitive_float_subtract() {
 272   POP_FLOATS(x, y);
 273   ctx->replace(allot_float(x - y));
 274 }
 275
 276 // Allocates memory
 277 void factor_vm::primitive_float_multiply() {
 278   POP_FLOATS(x, y);
 279   ctx->replace(allot_float(x * y));
 280 }
 281
 282 // Allocates memory
 283 void factor_vm::primitive_float_divfloat() {
 284   POP_FLOATS(x, y);
 285   ctx->replace(allot_float(x / y));
 286 }
 287
 288 void factor_vm::primitive_float_less() {
 289   POP_FLOATS(x, y);
 290   ctx->replace(tag_boolean(x < y));
 291 }
 292
 293 void factor_vm::primitive_float_lesseq() {
 294   POP_FLOATS(x, y);
 295   ctx->replace(tag_boolean(x <= y));
 296 }
 297
 298 void factor_vm::primitive_float_greater() {
 299   POP_FLOATS(x, y);
 300   ctx->replace(tag_boolean(x > y));
 301 }
 302
 303 void factor_vm::primitive_float_greatereq() {
 304   POP_FLOATS(x, y);
 305   ctx->replace(tag_boolean(x >= y));
 306 }
 307
 308 // Allocates memory
 309 void factor_vm::primitive_float_bits() {
 310   ctx->replace(
 311       from_unsigned_cell(float_bits((float)untag_float_check(ctx->peek()))));
 312 }
 313
 314 // Allocates memory
 315 void factor_vm::primitive_bits_float() {
 316   ctx->replace(allot_float(bits_float((uint32_t)to_cell(ctx->peek()))));
 317 }
 318
 319 void factor_vm::primitive_double_bits() {
 320   ctx->replace(from_unsigned_8(double_bits(untag_float_check(ctx->peek()))));
 321 }
 322
 323 // Allocates memory
 324 void factor_vm::primitive_bits_double() {
 325   ctx->replace(allot_float(bits_double(to_unsigned_8(ctx->peek()))));
 326 }
 327
 328 // Cannot allocate.
 329 #define CELL_TO_FOO(name, type, converter)              \
 330   type factor_vm::name(cell tagged) {                   \
 331     switch (TAG(tagged)) {                              \
 332       case FIXNUM_TYPE:                                 \
 333         return (type)untag_fixnum(tagged);              \
 334       case BIGNUM_TYPE:                                 \
 335         return converter(untag<bignum>(tagged));        \
 336       default:                                          \
 337         type_error(FIXNUM_TYPE, tagged);                \
 338         return 0; /* can't happen */                    \
 339     }                                                   \
 340   }                                                     \
 341   VM_C_API type name(cell tagged, factor_vm* parent) {  \
 342     return parent->name(tagged);                        \
 343   }
 344
 345 CELL_TO_FOO(to_fixnum, fixnum, bignum_to_fixnum)
 346 CELL_TO_FOO(to_fixnum_strict, fixnum, bignum_to_fixnum_strict)
 347 CELL_TO_FOO(to_cell, cell, bignum_to_cell)
 348 CELL_TO_FOO(to_signed_8, int64_t, bignum_to_long_long)
 349 CELL_TO_FOO(to_unsigned_8, uint64_t, bignum_to_ulong_long)
 350
 351 // Allocates memory
 352 VM_C_API cell from_signed_cell(fixnum integer, factor_vm* parent) {
 353   return parent->from_signed_cell(integer);
 354 }
 355
 356 // Allocates memory
 357 VM_C_API cell from_unsigned_cell(cell integer, factor_vm* parent) {
 358   return parent->from_unsigned_cell(integer);
 359 }
 360
 361 // Allocates memory
 362 cell factor_vm::from_signed_8(int64_t n) {
 363   if (n < fixnum_min || n > fixnum_max)
 364     return tag<bignum>(long_long_to_bignum(n));
 365   else
 366     return tag_fixnum((fixnum)n);
 367 }
 368
 369 VM_C_API cell from_signed_8(int64_t n, factor_vm* parent) {
 370   return parent->from_signed_8(n);
 371 }
 372
 373 // Allocates memory
 374 cell factor_vm::from_unsigned_8(uint64_t n) {
 375   if (n > (uint64_t)fixnum_max)
 376     return tag<bignum>(ulong_long_to_bignum(n));
 377   else
 378     return tag_fixnum((fixnum)n);
 379 }
 380
 381 VM_C_API cell from_unsigned_8(uint64_t n, factor_vm* parent) {
 382   return parent->from_unsigned_8(n);
 383 }
 384
 385 // Cannot allocate
 386 float factor_vm::to_float(cell value) {
 387   return (float)untag_float_check(value);
 388 }
 389
 390 // Cannot allocate
 391 double factor_vm::to_double(cell value) { return untag_float_check(value); }
 392
 393 // The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
 394 // overflow, they call these functions.
 395 // Allocates memory
 396 inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y) {
 397   ctx->replace(
 398       tag<bignum>(fixnum_to_bignum(untag_fixnum(x) + untag_fixnum(y))));
 399 }
 400
 401 VM_C_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm* parent) {
 402   parent->overflow_fixnum_add(x, y);
 403 }
 404
 405 // Allocates memory
 406 inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y) {
 407   ctx->replace(
 408       tag<bignum>(fixnum_to_bignum(untag_fixnum(x) - untag_fixnum(y))));
 409 }
 410
 411 VM_C_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm* parent) {
 412   parent->overflow_fixnum_subtract(x, y);
 413 }
 414
 415 // Allocates memory
 416 inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y) {
 417   data_root<bignum> bx(fixnum_to_bignum(x), this);
 418   data_root<bignum> by(fixnum_to_bignum(y), this);
 419   cell ret = tag<bignum>(bignum_multiply(bx.untagged(), by.untagged()));
 420   ctx->replace(ret);
 421 }
 422
 423 VM_C_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm* parent) {
 424   parent->overflow_fixnum_multiply(x, y);
 425 }
 426
 427 }