vm/math.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 cell bignum_zero;
   7 cell bignum_pos_one;
   8 cell bignum_neg_one;
   9
  10 PRIMITIVE(bignum_to_fixnum)
  11 {
  12         drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
  13 }
  14
  15 PRIMITIVE(float_to_fixnum)
  16 {
  17         drepl(tag_fixnum(float_to_fixnum(dpeek())));
  18 }
  19
  20 /* Division can only overflow when we are dividing the most negative fixnum
  21 by -1. */
  22 PRIMITIVE(fixnum_divint)
  23 {
  24         fixnum y = untag_fixnum(dpop()); \
  25         fixnum x = untag_fixnum(dpeek());
  26         fixnum result = x / y;
  27         if(result == -fixnum_min)
  28                 drepl(allot_integer(-fixnum_min));
  29         else
  30                 drepl(tag_fixnum(result));
  31 }
  32
  33 PRIMITIVE(fixnum_divmod)
  34 {
  35         cell y = ((cell *)ds)[0];
  36         cell x = ((cell *)ds)[-1];
  37         if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min))
  38         {
  39                 ((cell *)ds)[-1] = allot_integer(-fixnum_min);
  40                 ((cell *)ds)[0] = tag_fixnum(0);
  41         }
  42         else
  43         {
  44                 ((cell *)ds)[-1] = tag_fixnum(untag_fixnum(x) / untag_fixnum(y));
  45                 ((cell *)ds)[0] = (fixnum)x % (fixnum)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 static inline fixnum sign_mask(fixnum x)
  54 {
  55         return x >> (WORD_SIZE - 1);
  56 }
  57
  58 static inline fixnum branchless_max(fixnum x, fixnum y)
  59 {
  60         return (x - ((x - y) & sign_mask(x - y)));
  61 }
  62
  63 static inline fixnum branchless_abs(fixnum x)
  64 {
  65         return (x ^ sign_mask(x)) - sign_mask(x);
  66 }
  67
  68 PRIMITIVE(fixnum_shift)
  69 {
  70         fixnum y = untag_fixnum(dpop());
  71         fixnum x = untag_fixnum(dpeek());
  72
  73         if(x == 0)
  74                 return;
  75         else if(y < 0)
  76         {
  77                 y = branchless_max(y,-WORD_SIZE + 1);
  78                 drepl(tag_fixnum(x >> -y));
  79                 return;
  80         }
  81         else if(y < WORD_SIZE - TAG_BITS)
  82         {
  83                 fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y));
  84                 if(!(branchless_abs(x) & mask))
  85                 {
  86                         drepl(tag_fixnum(x << y));
  87                         return;
  88                 }
  89         }
  90
  91         drepl(tag<bignum>(bignum_arithmetic_shift(
  92                 fixnum_to_bignum(x),y)));
  93 }
  94
  95 PRIMITIVE(fixnum_to_bignum)
  96 {
  97         drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
  98 }
  99
 100 PRIMITIVE(float_to_bignum)
 101 {
 102         drepl(tag<bignum>(float_to_bignum(dpeek())));
 103 }
 104
 105 #define POP_BIGNUMS(x,y) \
 106         bignum * y = untag<bignum>(dpop()); \
 107         bignum * x = untag<bignum>(dpop());
 108
 109 PRIMITIVE(bignum_eq)
 110 {
 111         POP_BIGNUMS(x,y);
 112         box_boolean(bignum_equal_p(x,y));
 113 }
 114
 115 PRIMITIVE(bignum_add)
 116 {
 117         POP_BIGNUMS(x,y);
 118         dpush(tag<bignum>(bignum_add(x,y)));
 119 }
 120
 121 PRIMITIVE(bignum_subtract)
 122 {
 123         POP_BIGNUMS(x,y);
 124         dpush(tag<bignum>(bignum_subtract(x,y)));
 125 }
 126
 127 PRIMITIVE(bignum_multiply)
 128 {
 129         POP_BIGNUMS(x,y);
 130         dpush(tag<bignum>(bignum_multiply(x,y)));
 131 }
 132
 133 PRIMITIVE(bignum_divint)
 134 {
 135         POP_BIGNUMS(x,y);
 136         dpush(tag<bignum>(bignum_quotient(x,y)));
 137 }
 138
 139 PRIMITIVE(bignum_divmod)
 140 {
 141         bignum *q, *r;
 142         POP_BIGNUMS(x,y);
 143         bignum_divide(x,y,&q,&r);
 144         dpush(tag<bignum>(q));
 145         dpush(tag<bignum>(r));
 146 }
 147
 148 PRIMITIVE(bignum_mod)
 149 {
 150         POP_BIGNUMS(x,y);
 151         dpush(tag<bignum>(bignum_remainder(x,y)));
 152 }
 153
 154 PRIMITIVE(bignum_and)
 155 {
 156         POP_BIGNUMS(x,y);
 157         dpush(tag<bignum>(bignum_bitwise_and(x,y)));
 158 }
 159
 160 PRIMITIVE(bignum_or)
 161 {
 162         POP_BIGNUMS(x,y);
 163         dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
 164 }
 165
 166 PRIMITIVE(bignum_xor)
 167 {
 168         POP_BIGNUMS(x,y);
 169         dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
 170 }
 171
 172 PRIMITIVE(bignum_shift)
 173 {
 174         fixnum y = untag_fixnum(dpop());
 175         bignum* x = untag<bignum>(dpop());
 176         dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
 177 }
 178
 179 PRIMITIVE(bignum_less)
 180 {
 181         POP_BIGNUMS(x,y);
 182         box_boolean(bignum_compare(x,y) == bignum_comparison_less);
 183 }
 184
 185 PRIMITIVE(bignum_lesseq)
 186 {
 187         POP_BIGNUMS(x,y);
 188         box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
 189 }
 190
 191 PRIMITIVE(bignum_greater)
 192 {
 193         POP_BIGNUMS(x,y);
 194         box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
 195 }
 196
 197 PRIMITIVE(bignum_greatereq)
 198 {
 199         POP_BIGNUMS(x,y);
 200         box_boolean(bignum_compare(x,y) != bignum_comparison_less);
 201 }
 202
 203 PRIMITIVE(bignum_not)
 204 {
 205         drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
 206 }
 207
 208 PRIMITIVE(bignum_bitp)
 209 {
 210         fixnum bit = to_fixnum(dpop());
 211         bignum *x = untag<bignum>(dpop());
 212         box_boolean(bignum_logbitp(bit,x));
 213 }
 214
 215 PRIMITIVE(bignum_log2)
 216 {
 217         drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
 218 }
 219
 220 unsigned int bignum_producer(unsigned int digit)
 221 {
 222         unsigned char *ptr = (unsigned char *)alien_offset(dpeek());
 223         return *(ptr + digit);
 224 }
 225
 226 PRIMITIVE(byte_array_to_bignum)
 227 {
 228         cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
 229         bignum * result = digit_stream_to_bignum(n_digits,bignum_producer,0x100,0);
 230         drepl(tag<bignum>(result));
 231 }
 232
 233 cell unbox_array_size()
 234 {
 235         switch(tagged<object>(dpeek()).type())
 236         {
 237         case FIXNUM_TYPE:
 238                 {
 239                         fixnum n = untag_fixnum(dpeek());
 240                         if(n >= 0 && n < (fixnum)array_size_max)
 241                         {
 242                                 dpop();
 243                                 return n;
 244                         }
 245                         break;
 246                 }
 247         case BIGNUM_TYPE:
 248                 {
 249                         bignum * zero = untag<bignum>(bignum_zero);
 250                         bignum * max = cell_to_bignum(array_size_max);
 251                         bignum * n = untag<bignum>(dpeek());
 252                         if(bignum_compare(n,zero) != bignum_comparison_less
 253                                 && bignum_compare(n,max) == bignum_comparison_less)
 254                         {
 255                                 dpop();
 256                                 return bignum_to_cell(n);
 257                         }
 258                         break;
 259                 }
 260         }
 261
 262         general_error(ERROR_ARRAY_SIZE,dpop(),tag_fixnum(array_size_max),NULL);
 263         return 0; /* can't happen */
 264 }
 265
 266 PRIMITIVE(fixnum_to_float)
 267 {
 268         drepl(allot_float(fixnum_to_float(dpeek())));
 269 }
 270
 271 PRIMITIVE(bignum_to_float)
 272 {
 273         drepl(allot_float(bignum_to_float(dpeek())));
 274 }
 275
 276 PRIMITIVE(str_to_float)
 277 {
 278         byte_array *bytes = untag_check<byte_array>(dpeek());
 279         cell capacity = array_capacity(bytes);
 280
 281         char *c_str = (char *)(bytes + 1);
 282         char *end = c_str;
 283         double f = strtod(c_str,&end);
 284         if(end == c_str + capacity - 1)
 285                 drepl(allot_float(f));
 286         else
 287                 drepl(F);
 288 }
 289
 290 PRIMITIVE(float_to_str)
 291 {
 292         byte_array *array = allot_byte_array(33);
 293         snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
 294         dpush(tag<byte_array>(array));
 295 }
 296
 297 #define POP_FLOATS(x,y) \
 298         double y = untag_float(dpop()); \
 299         double x = untag_float(dpop());
 300
 301 PRIMITIVE(float_eq)
 302 {
 303         POP_FLOATS(x,y);
 304         box_boolean(x == y);
 305 }
 306
 307 PRIMITIVE(float_add)
 308 {
 309         POP_FLOATS(x,y);
 310         box_double(x + y);
 311 }
 312
 313 PRIMITIVE(float_subtract)
 314 {
 315         POP_FLOATS(x,y);
 316         box_double(x - y);
 317 }
 318
 319 PRIMITIVE(float_multiply)
 320 {
 321         POP_FLOATS(x,y);
 322         box_double(x * y);
 323 }
 324
 325 PRIMITIVE(float_divfloat)
 326 {
 327         POP_FLOATS(x,y);
 328         box_double(x / y);
 329 }
 330
 331 PRIMITIVE(float_mod)
 332 {
 333         POP_FLOATS(x,y);
 334         box_double(fmod(x,y));
 335 }
 336
 337 PRIMITIVE(float_less)
 338 {
 339         POP_FLOATS(x,y);
 340         box_boolean(x < y);
 341 }
 342
 343 PRIMITIVE(float_lesseq)
 344 {
 345         POP_FLOATS(x,y);
 346         box_boolean(x <= y);
 347 }
 348
 349 PRIMITIVE(float_greater)
 350 {
 351         POP_FLOATS(x,y);
 352         box_boolean(x > y);
 353 }
 354
 355 PRIMITIVE(float_greatereq)
 356 {
 357         POP_FLOATS(x,y);
 358         box_boolean(x >= y);
 359 }
 360
 361 PRIMITIVE(float_bits)
 362 {
 363         box_unsigned_4(float_bits(untag_float_check(dpop())));
 364 }
 365
 366 PRIMITIVE(bits_float)
 367 {
 368         box_float(bits_float(to_cell(dpop())));
 369 }
 370
 371 PRIMITIVE(double_bits)
 372 {
 373         box_unsigned_8(double_bits(untag_float_check(dpop())));
 374 }
 375
 376 PRIMITIVE(bits_double)
 377 {
 378         box_double(bits_double(to_unsigned_8(dpop())));
 379 }
 380
 381 VM_C_API fixnum to_fixnum(cell tagged)
 382 {
 383         switch(TAG(tagged))
 384         {
 385         case FIXNUM_TYPE:
 386                 return untag_fixnum(tagged);
 387         case BIGNUM_TYPE:
 388                 return bignum_to_fixnum(untag<bignum>(tagged));
 389         default:
 390                 type_error(FIXNUM_TYPE,tagged);
 391                 return 0; /* can't happen */
 392         }
 393 }
 394
 395 VM_C_API cell to_cell(cell tagged)
 396 {
 397         return (cell)to_fixnum(tagged);
 398 }
 399
 400 VM_C_API void box_signed_1(s8 n)
 401 {
 402         dpush(tag_fixnum(n));
 403 }
 404
 405 VM_C_API void box_unsigned_1(u8 n)
 406 {
 407         dpush(tag_fixnum(n));
 408 }
 409
 410 VM_C_API void box_signed_2(s16 n)
 411 {
 412         dpush(tag_fixnum(n));
 413 }
 414
 415 VM_C_API void box_unsigned_2(u16 n)
 416 {
 417         dpush(tag_fixnum(n));
 418 }
 419
 420 VM_C_API void box_signed_4(s32 n)
 421 {
 422         dpush(allot_integer(n));
 423 }
 424
 425 VM_C_API void box_unsigned_4(u32 n)
 426 {
 427         dpush(allot_cell(n));
 428 }
 429
 430 VM_C_API void box_signed_cell(fixnum integer)
 431 {
 432         dpush(allot_integer(integer));
 433 }
 434
 435 VM_C_API void box_unsigned_cell(cell cell)
 436 {
 437         dpush(allot_cell(cell));
 438 }
 439
 440 VM_C_API void box_signed_8(s64 n)
 441 {
 442         if(n < fixnum_min || n > fixnum_max)
 443                 dpush(tag<bignum>(long_long_to_bignum(n)));
 444         else
 445                 dpush(tag_fixnum(n));
 446 }
 447
 448 VM_C_API s64 to_signed_8(cell obj)
 449 {
 450         switch(tagged<object>(obj).type())
 451         {
 452         case FIXNUM_TYPE:
 453                 return untag_fixnum(obj);
 454         case BIGNUM_TYPE:
 455                 return bignum_to_long_long(untag<bignum>(obj));
 456         default:
 457                 type_error(BIGNUM_TYPE,obj);
 458                 return 0;
 459         }
 460 }
 461
 462 VM_C_API void box_unsigned_8(u64 n)
 463 {
 464         if(n > (u64)fixnum_max)
 465                 dpush(tag<bignum>(ulong_long_to_bignum(n)));
 466         else
 467                 dpush(tag_fixnum(n));
 468 }
 469
 470 VM_C_API u64 to_unsigned_8(cell obj)
 471 {
 472         switch(tagged<object>(obj).type())
 473         {
 474         case FIXNUM_TYPE:
 475                 return untag_fixnum(obj);
 476         case BIGNUM_TYPE:
 477                 return bignum_to_ulong_long(untag<bignum>(obj));
 478         default:
 479                 type_error(BIGNUM_TYPE,obj);
 480                 return 0;
 481         }
 482 }
 483
 484 VM_C_API void box_float(float flo)
 485 {
 486         dpush(allot_float(flo));
 487 }
 488
 489 VM_C_API float to_float(cell value)
 490 {
 491         return untag_float_check(value);
 492 }
 493
 494 VM_C_API void box_double(double flo)
 495 {
 496         dpush(allot_float(flo));
 497 }
 498
 499 VM_C_API double to_double(cell value)
 500 {
 501         return untag_float_check(value);
 502 }
 503
 504 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
 505 overflow, they call these functions. */
 506 VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
 507 {
 508         drepl(tag<bignum>(fixnum_to_bignum(
 509                 untag_fixnum(x) + untag_fixnum(y))));
 510 }
 511
 512 VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
 513 {
 514         drepl(tag<bignum>(fixnum_to_bignum(
 515                 untag_fixnum(x) - untag_fixnum(y))));
 516 }
 517
 518 VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
 519 {
 520         bignum *bx = fixnum_to_bignum(x);
 521         GC_BIGNUM(bx);
 522         bignum *by = fixnum_to_bignum(y);
 523         GC_BIGNUM(by);
 524         drepl(tag<bignum>(bignum_multiply(bx,by)));
 525 }
 526
 527 }