vm/math.cpp

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