vm/math.cpp

   1 #include "master.hpp"
   2 #include <sstream>
   3 #include <iomanip>
   4
   5 namespace factor {
   6
   7 void factor_vm::primitive_bignum_to_fixnum() {
   8   ctx->replace(tag_fixnum(bignum_to_fixnum(untag<bignum>(ctx->peek()))));
   9 }
  10
  11 void factor_vm::primitive_bignum_to_fixnum_strict() {
  12   ctx->replace(tag_fixnum(bignum_to_fixnum_strict(untag<bignum>(ctx->peek()))));
  13 }
  14
  15 void factor_vm::primitive_float_to_fixnum() {
  16   ctx->replace(tag_fixnum(float_to_fixnum(ctx->peek())));
  17 }
  18
  19 /* does not allocate, even though from_signed_cell can allocate */
  20 /* Division can only overflow when we are dividing the most negative fixnum
  21 by -1. */
  22 void factor_vm::primitive_fixnum_divint() {
  23   fixnum y = untag_fixnum(ctx->pop());
  24   fixnum x = untag_fixnum(ctx->peek());
  25   fixnum result = x / y;
  26   if (result == -fixnum_min)
  27     /* Does not allocate */
  28     ctx->replace(from_signed_cell(-fixnum_min));
  29   else
  30     ctx->replace(tag_fixnum(result));
  31 }
  32
  33 /* does not allocate, even though from_signed_cell can allocate */
  34 void factor_vm::primitive_fixnum_divmod() {
  35   cell* s0 = (cell*)(ctx->datastack);
  36   cell* s1 = (cell*)(ctx->datastack - sizeof(cell));
  37   fixnum y = untag_fixnum(*s0);
  38   fixnum x = untag_fixnum(*s1);
  39   if (y == -1 && x == fixnum_min) {
  40     /* Does not allocate */
  41     *s1 = from_signed_cell(-fixnum_min);
  42     *s0 = tag_fixnum(0);
  43   } else {
  44     *s1 = tag_fixnum(x / y);
  45     *s0 = tag_fixnum(x % y);
  46   }
  47 }
  48
  49 /*
  50  * If we're shifting right by n bits, we won't overflow as long as none of the
  51  * high WORD_SIZE-TAG_BITS-n bits are set.
  52  */
  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   localized_stream.imbue(std::locale(locale));
 224   switch (format[0]) {
 225     case 'f': localized_stream << std::fixed; break;
 226     case 'e': localized_stream << std::scientific; break;
 227   }
 228   if (isupper(format[0])) {
 229     localized_stream << std::uppercase;
 230   }
 231   if (fill[0] != '\0') {
 232     localized_stream << std::setfill(fill[0]);
 233   }
 234   if (width >= 0) {
 235     localized_stream << std::setw(width);
 236   }
 237   if (precision >= 0) {
 238     localized_stream << std::setprecision(precision);
 239   }
 240   localized_stream << value;
 241   const std::string& tmp = localized_stream.str();
 242   const char* cstr = tmp.c_str();
 243   int size = tmp.length()+1;
 244   byte_array* array = allot_byte_array(size);
 245   memcpy(array->data<char>(), cstr, size);
 246   ctx->replace(tag<byte_array>(array));
 247 }
 248
 249 #define POP_FLOATS(x, y)              \
 250   double y = untag_float(ctx->pop()); \
 251   double x = untag_float(ctx->peek());
 252
 253 void factor_vm::primitive_float_eq() {
 254   POP_FLOATS(x, y);
 255   ctx->replace(tag_boolean(x == y));
 256 }
 257
 258 /* Allocates memory */
 259 void factor_vm::primitive_float_add() {
 260   POP_FLOATS(x, y);
 261   ctx->replace(allot_float(x + y));
 262 }
 263
 264 /* Allocates memory */
 265 void factor_vm::primitive_float_subtract() {
 266   POP_FLOATS(x, y);
 267   ctx->replace(allot_float(x - y));
 268 }
 269
 270 /* Allocates memory */
 271 void factor_vm::primitive_float_multiply() {
 272   POP_FLOATS(x, y);
 273   ctx->replace(allot_float(x * y));
 274 }
 275
 276 /* Allocates memory */
 277 void factor_vm::primitive_float_divfloat() {
 278   POP_FLOATS(x, y);
 279   ctx->replace(allot_float(x / y));
 280 }
 281
 282 void factor_vm::primitive_float_less() {
 283   POP_FLOATS(x, y);
 284   ctx->replace(tag_boolean(x < y));
 285 }
 286
 287 void factor_vm::primitive_float_lesseq() {
 288   POP_FLOATS(x, y);
 289   ctx->replace(tag_boolean(x <= y));
 290 }
 291
 292 void factor_vm::primitive_float_greater() {
 293   POP_FLOATS(x, y);
 294   ctx->replace(tag_boolean(x > y));
 295 }
 296
 297 void factor_vm::primitive_float_greatereq() {
 298   POP_FLOATS(x, y);
 299   ctx->replace(tag_boolean(x >= y));
 300 }
 301
 302 /* Allocates memory */
 303 void factor_vm::primitive_float_bits() {
 304   ctx->replace(
 305       from_unsigned_cell(float_bits((float)untag_float_check(ctx->peek()))));
 306 }
 307
 308 /* Allocates memory */
 309 void factor_vm::primitive_bits_float() {
 310   ctx->replace(allot_float(bits_float((uint32_t)to_cell(ctx->peek()))));
 311 }
 312
 313 void factor_vm::primitive_double_bits() {
 314   ctx->replace(from_unsigned_8(double_bits(untag_float_check(ctx->peek()))));
 315 }
 316
 317 /* Allocates memory */
 318 void factor_vm::primitive_bits_double() {
 319   ctx->replace(allot_float(bits_double(to_unsigned_8(ctx->peek()))));
 320 }
 321
 322 /* Cannot allocate. */
 323 #define CELL_TO_FOO(name, type, converter)              \
 324   type factor_vm::name(cell tagged) {                   \
 325     switch (TAG(tagged)) {                              \
 326       case FIXNUM_TYPE:                                 \
 327         return (type)untag_fixnum(tagged);              \
 328       case BIGNUM_TYPE:                                 \
 329         return converter(untag<bignum>(tagged));        \
 330       default:                                          \
 331         type_error(FIXNUM_TYPE, tagged);                \
 332         return 0; /* can't happen */                    \
 333     }                                                   \
 334   }                                                     \
 335   VM_C_API type name(cell tagged, factor_vm* parent) {  \
 336     return parent->name(tagged);                        \
 337   }
 338
 339 CELL_TO_FOO(to_fixnum, fixnum, bignum_to_fixnum)
 340 CELL_TO_FOO(to_fixnum_strict, fixnum, bignum_to_fixnum_strict)
 341 CELL_TO_FOO(to_cell, cell, bignum_to_cell)
 342 CELL_TO_FOO(to_signed_8, int64_t, bignum_to_long_long)
 343 CELL_TO_FOO(to_unsigned_8, uint64_t, bignum_to_ulong_long)
 344
 345 /* Allocates memory */
 346 VM_C_API cell from_signed_cell(fixnum integer, factor_vm* parent) {
 347   return parent->from_signed_cell(integer);
 348 }
 349
 350 /* Allocates memory */
 351 VM_C_API cell from_unsigned_cell(cell integer, factor_vm* parent) {
 352   return parent->from_unsigned_cell(integer);
 353 }
 354
 355 /* Allocates memory */
 356 cell factor_vm::from_signed_8(int64_t n) {
 357   if (n < fixnum_min || n > fixnum_max)
 358     return tag<bignum>(long_long_to_bignum(n));
 359   else
 360     return tag_fixnum((fixnum)n);
 361 }
 362
 363 VM_C_API cell from_signed_8(int64_t n, factor_vm* parent) {
 364   return parent->from_signed_8(n);
 365 }
 366
 367 /* Allocates memory */
 368 cell factor_vm::from_unsigned_8(uint64_t n) {
 369   if (n > (uint64_t)fixnum_max)
 370     return tag<bignum>(ulong_long_to_bignum(n));
 371   else
 372     return tag_fixnum((fixnum)n);
 373 }
 374
 375 VM_C_API cell from_unsigned_8(uint64_t n, factor_vm* parent) {
 376   return parent->from_unsigned_8(n);
 377 }
 378
 379 /* Cannot allocate */
 380 float factor_vm::to_float(cell value) {
 381   return (float)untag_float_check(value);
 382 }
 383
 384 /* Cannot allocate */
 385 double factor_vm::to_double(cell value) { return untag_float_check(value); }
 386
 387 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
 388    overflow, they call these functions. */
 389 /* Allocates memory */
 390 inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y) {
 391   ctx->replace(
 392       tag<bignum>(fixnum_to_bignum(untag_fixnum(x) + untag_fixnum(y))));
 393 }
 394
 395 VM_C_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm* parent) {
 396   parent->overflow_fixnum_add(x, y);
 397 }
 398
 399 /* Allocates memory */
 400 inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y) {
 401   ctx->replace(
 402       tag<bignum>(fixnum_to_bignum(untag_fixnum(x) - untag_fixnum(y))));
 403 }
 404
 405 VM_C_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm* parent) {
 406   parent->overflow_fixnum_subtract(x, y);
 407 }
 408
 409 /* Allocates memory */
 410 inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y) {
 411   data_root<bignum> bx(fixnum_to_bignum(x), this);
 412   data_root<bignum> by(fixnum_to_bignum(y), this);
 413   cell ret = tag<bignum>(bignum_multiply(bx.untagged(), by.untagged()));
 414   ctx->replace(ret);
 415 }
 416
 417 VM_C_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm* parent) {
 418   parent->overflow_fixnum_multiply(x, y);
 419 }
 420
 421 }