vm/math.cpp

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