vm/math.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 inline void factorvm::primitive_bignum_to_fixnum()
   7 {
   8         drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
   9 }
  10
  11 PRIMITIVE(bignum_to_fixnum)
  12 {
  13         PRIMITIVE_GETVM()->primitive_bignum_to_fixnum();
  14 }
  15
  16 inline void factorvm::primitive_float_to_fixnum()
  17 {
  18         drepl(tag_fixnum(float_to_fixnum(dpeek())));
  19 }
  20
  21 PRIMITIVE(float_to_fixnum)
  22 {
  23         PRIMITIVE_GETVM()->primitive_float_to_fixnum();
  24 }
  25
  26 /* Division can only overflow when we are dividing the most negative fixnum
  27 by -1. */
  28 inline void factorvm::primitive_fixnum_divint()
  29 {
  30         fixnum y = untag_fixnum(dpop()); \
  31         fixnum x = untag_fixnum(dpeek());
  32         fixnum result = x / y;
  33         if(result == -fixnum_min)
  34                 drepl(allot_integer(-fixnum_min));
  35         else
  36                 drepl(tag_fixnum(result));
  37 }
  38
  39 PRIMITIVE(fixnum_divint)
  40 {
  41         PRIMITIVE_GETVM()->primitive_fixnum_divint();
  42 }
  43
  44 inline void factorvm::primitive_fixnum_divmod()
  45 {
  46         cell y = ((cell *)ds)[0];
  47         cell x = ((cell *)ds)[-1];
  48         if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min))
  49         {
  50                 ((cell *)ds)[-1] = allot_integer(-fixnum_min);
  51                 ((cell *)ds)[0] = tag_fixnum(0);
  52         }
  53         else
  54         {
  55                 ((cell *)ds)[-1] = tag_fixnum(untag_fixnum(x) / untag_fixnum(y));
  56                 ((cell *)ds)[0] = (fixnum)x % (fixnum)y;
  57         }
  58 }
  59
  60 PRIMITIVE(fixnum_divmod)
  61 {
  62         PRIMITIVE_GETVM()->primitive_fixnum_divmod();
  63 }
  64
  65 /*
  66  * If we're shifting right by n bits, we won't overflow as long as none of the
  67  * high WORD_SIZE-TAG_BITS-n bits are set.
  68  */
  69 inline fixnum factorvm::sign_mask(fixnum x)
  70 {
  71         return x >> (WORD_SIZE - 1);
  72 }
  73
  74
  75 inline fixnum factorvm::branchless_max(fixnum x, fixnum y)
  76 {
  77         return (x - ((x - y) & sign_mask(x - y)));
  78 }
  79
  80
  81 inline fixnum factorvm::branchless_abs(fixnum x)
  82 {
  83         return (x ^ sign_mask(x)) - sign_mask(x);
  84 }
  85
  86
  87 inline void factorvm::primitive_fixnum_shift()
  88 {
  89         fixnum y = untag_fixnum(dpop());
  90         fixnum x = untag_fixnum(dpeek());
  91
  92         if(x == 0)
  93                 return;
  94         else if(y < 0)
  95         {
  96                 y = branchless_max(y,-WORD_SIZE + 1);
  97                 drepl(tag_fixnum(x >> -y));
  98                 return;
  99         }
 100         else if(y < WORD_SIZE - TAG_BITS)
 101         {
 102                 fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y));
 103                 if(!(branchless_abs(x) & mask))
 104                 {
 105                         drepl(tag_fixnum(x << y));
 106                         return;
 107                 }
 108         }
 109
 110         drepl(tag<bignum>(bignum_arithmetic_shift(
 111                 fixnum_to_bignum(x),y)));
 112 }
 113
 114 PRIMITIVE(fixnum_shift)
 115 {
 116         PRIMITIVE_GETVM()->primitive_fixnum_shift();
 117 }
 118
 119 inline void factorvm::primitive_fixnum_to_bignum()
 120 {
 121         drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
 122 }
 123
 124 PRIMITIVE(fixnum_to_bignum)
 125 {
 126         PRIMITIVE_GETVM()->primitive_fixnum_to_bignum();
 127 }
 128
 129 inline void factorvm::primitive_float_to_bignum()
 130 {
 131         drepl(tag<bignum>(float_to_bignum(dpeek())));
 132 }
 133
 134 PRIMITIVE(float_to_bignum)
 135 {
 136         PRIMITIVE_GETVM()->primitive_float_to_bignum();
 137 }
 138
 139 #define POP_BIGNUMS(x,y) \
 140         bignum * y = untag<bignum>(dpop()); \
 141         bignum * x = untag<bignum>(dpop());
 142
 143 inline void factorvm::primitive_bignum_eq()
 144 {
 145         POP_BIGNUMS(x,y);
 146         box_boolean(bignum_equal_p(x,y));
 147 }
 148
 149 PRIMITIVE(bignum_eq)
 150 {
 151         PRIMITIVE_GETVM()->primitive_bignum_eq();
 152 }
 153
 154 inline void factorvm::primitive_bignum_add()
 155 {
 156         POP_BIGNUMS(x,y);
 157         dpush(tag<bignum>(bignum_add(x,y)));
 158 }
 159
 160 PRIMITIVE(bignum_add)
 161 {
 162         PRIMITIVE_GETVM()->primitive_bignum_add();
 163 }
 164
 165 inline void factorvm::primitive_bignum_subtract()
 166 {
 167         POP_BIGNUMS(x,y);
 168         dpush(tag<bignum>(bignum_subtract(x,y)));
 169 }
 170
 171 PRIMITIVE(bignum_subtract)
 172 {
 173         PRIMITIVE_GETVM()->primitive_bignum_subtract();
 174 }
 175
 176 inline void factorvm::primitive_bignum_multiply()
 177 {
 178         POP_BIGNUMS(x,y);
 179         dpush(tag<bignum>(bignum_multiply(x,y)));
 180 }
 181
 182 PRIMITIVE(bignum_multiply)
 183 {
 184         PRIMITIVE_GETVM()->primitive_bignum_multiply();
 185 }
 186
 187 inline void factorvm::primitive_bignum_divint()
 188 {
 189         POP_BIGNUMS(x,y);
 190         dpush(tag<bignum>(bignum_quotient(x,y)));
 191 }
 192
 193 PRIMITIVE(bignum_divint)
 194 {
 195         PRIMITIVE_GETVM()->primitive_bignum_divint();
 196 }
 197
 198 inline void factorvm::primitive_bignum_divmod()
 199 {
 200         bignum *q, *r;
 201         POP_BIGNUMS(x,y);
 202         bignum_divide(x,y,&q,&r);
 203         dpush(tag<bignum>(q));
 204         dpush(tag<bignum>(r));
 205 }
 206
 207 PRIMITIVE(bignum_divmod)
 208 {
 209         PRIMITIVE_GETVM()->primitive_bignum_divmod();
 210 }
 211
 212 inline void factorvm::primitive_bignum_mod()
 213 {
 214         POP_BIGNUMS(x,y);
 215         dpush(tag<bignum>(bignum_remainder(x,y)));
 216 }
 217
 218 PRIMITIVE(bignum_mod)
 219 {
 220         PRIMITIVE_GETVM()->primitive_bignum_mod();
 221 }
 222
 223 inline void factorvm::primitive_bignum_and()
 224 {
 225         POP_BIGNUMS(x,y);
 226         dpush(tag<bignum>(bignum_bitwise_and(x,y)));
 227 }
 228
 229 PRIMITIVE(bignum_and)
 230 {
 231         PRIMITIVE_GETVM()->primitive_bignum_and();
 232 }
 233
 234 inline void factorvm::primitive_bignum_or()
 235 {
 236         POP_BIGNUMS(x,y);
 237         dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
 238 }
 239
 240 PRIMITIVE(bignum_or)
 241 {
 242         PRIMITIVE_GETVM()->primitive_bignum_or();
 243 }
 244
 245 inline void factorvm::primitive_bignum_xor()
 246 {
 247         POP_BIGNUMS(x,y);
 248         dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
 249 }
 250
 251 PRIMITIVE(bignum_xor)
 252 {
 253         PRIMITIVE_GETVM()->primitive_bignum_xor();
 254 }
 255
 256 inline void factorvm::primitive_bignum_shift()
 257 {
 258         fixnum y = untag_fixnum(dpop());
 259         bignum* x = untag<bignum>(dpop());
 260         dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
 261 }
 262
 263 PRIMITIVE(bignum_shift)
 264 {
 265         PRIMITIVE_GETVM()->primitive_bignum_shift();
 266 }
 267
 268 inline void factorvm::primitive_bignum_less()
 269 {
 270         POP_BIGNUMS(x,y);
 271         box_boolean(bignum_compare(x,y) == bignum_comparison_less);
 272 }
 273
 274 PRIMITIVE(bignum_less)
 275 {
 276         PRIMITIVE_GETVM()->primitive_bignum_less();
 277 }
 278
 279 inline void factorvm::primitive_bignum_lesseq()
 280 {
 281         POP_BIGNUMS(x,y);
 282         box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
 283 }
 284
 285 PRIMITIVE(bignum_lesseq)
 286 {
 287         PRIMITIVE_GETVM()->primitive_bignum_lesseq();
 288 }
 289
 290 inline void factorvm::primitive_bignum_greater()
 291 {
 292         POP_BIGNUMS(x,y);
 293         box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
 294 }
 295
 296 PRIMITIVE(bignum_greater)
 297 {
 298         PRIMITIVE_GETVM()->primitive_bignum_greater();
 299 }
 300
 301 inline void factorvm::primitive_bignum_greatereq()
 302 {
 303         POP_BIGNUMS(x,y);
 304         box_boolean(bignum_compare(x,y) != bignum_comparison_less);
 305 }
 306
 307 PRIMITIVE(bignum_greatereq)
 308 {
 309         PRIMITIVE_GETVM()->primitive_bignum_greatereq();
 310 }
 311
 312 inline void factorvm::primitive_bignum_not()
 313 {
 314         drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
 315 }
 316
 317 PRIMITIVE(bignum_not)
 318 {
 319         PRIMITIVE_GETVM()->primitive_bignum_not();
 320 }
 321
 322 inline void factorvm::primitive_bignum_bitp()
 323 {
 324         fixnum bit = to_fixnum(dpop());
 325         bignum *x = untag<bignum>(dpop());
 326         box_boolean(bignum_logbitp(bit,x));
 327 }
 328
 329 PRIMITIVE(bignum_bitp)
 330 {
 331         PRIMITIVE_GETVM()->primitive_bignum_bitp();
 332 }
 333
 334 inline void factorvm::primitive_bignum_log2()
 335 {
 336         drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
 337 }
 338
 339 PRIMITIVE(bignum_log2)
 340 {
 341         PRIMITIVE_GETVM()->primitive_bignum_log2();
 342 }
 343
 344 unsigned int factorvm::bignum_producer(unsigned int digit)
 345 {
 346         unsigned char *ptr = (unsigned char *)alien_offset(dpeek());
 347         return *(ptr + digit);
 348 }
 349
 350 unsigned int bignum_producer(unsigned int digit, factorvm *myvm)
 351 {
 352         return myvm->bignum_producer(digit);
 353 }
 354
 355 inline void factorvm::primitive_byte_array_to_bignum()
 356 {
 357         cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
 358         bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
 359         drepl(tag<bignum>(result));
 360 }
 361
 362 PRIMITIVE(byte_array_to_bignum)
 363 {
 364         PRIMITIVE_GETVM()->primitive_byte_array_to_bignum();
 365 }
 366
 367 cell factorvm::unbox_array_size()
 368 {
 369         switch(tagged<object>(dpeek()).type())
 370         {
 371         case FIXNUM_TYPE:
 372                 {
 373                         fixnum n = untag_fixnum(dpeek());
 374                         if(n >= 0 && n < (fixnum)array_size_max)
 375                         {
 376                                 dpop();
 377                                 return n;
 378                         }
 379                         break;
 380                 }
 381         case BIGNUM_TYPE:
 382                 {
 383                         bignum * zero = untag<bignum>(bignum_zero);
 384                         bignum * max = cell_to_bignum(array_size_max);
 385                         bignum * n = untag<bignum>(dpeek());
 386                         if(bignum_compare(n,zero) != bignum_comparison_less
 387                                 && bignum_compare(n,max) == bignum_comparison_less)
 388                         {
 389                                 dpop();
 390                                 return bignum_to_cell(n);
 391                         }
 392                         break;
 393                 }
 394         }
 395
 396         general_error(ERROR_ARRAY_SIZE,dpop(),tag_fixnum(array_size_max),NULL);
 397         return 0; /* can't happen */
 398 }
 399
 400
 401 inline void factorvm::primitive_fixnum_to_float()
 402 {
 403         drepl(allot_float(fixnum_to_float(dpeek())));
 404 }
 405
 406 PRIMITIVE(fixnum_to_float)
 407 {
 408         PRIMITIVE_GETVM()->primitive_fixnum_to_float();
 409 }
 410
 411 inline void factorvm::primitive_bignum_to_float()
 412 {
 413         drepl(allot_float(bignum_to_float(dpeek())));
 414 }
 415
 416 PRIMITIVE(bignum_to_float)
 417 {
 418         PRIMITIVE_GETVM()->primitive_bignum_to_float();
 419 }
 420
 421 inline void factorvm::primitive_str_to_float()
 422 {
 423         byte_array *bytes = untag_check<byte_array>(dpeek());
 424         cell capacity = array_capacity(bytes);
 425
 426         char *c_str = (char *)(bytes + 1);
 427         char *end = c_str;
 428         double f = strtod(c_str,&end);
 429         if(end == c_str + capacity - 1)
 430                 drepl(allot_float(f));
 431         else
 432                 drepl(F);
 433 }
 434
 435 PRIMITIVE(str_to_float)
 436 {
 437         PRIMITIVE_GETVM()->primitive_str_to_float();
 438 }
 439
 440 inline void factorvm::primitive_float_to_str()
 441 {
 442         byte_array *array = allot_byte_array(33);
 443         snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
 444         dpush(tag<byte_array>(array));
 445 }
 446
 447 PRIMITIVE(float_to_str)
 448 {
 449         PRIMITIVE_GETVM()->primitive_float_to_str();
 450 }
 451
 452 #define POP_FLOATS(x,y) \
 453         double y = untag_float(dpop()); \
 454         double x = untag_float(dpop());
 455
 456 inline void factorvm::primitive_float_eq()
 457 {
 458         POP_FLOATS(x,y);
 459         box_boolean(x == y);
 460 }
 461
 462 PRIMITIVE(float_eq)
 463 {
 464         PRIMITIVE_GETVM()->primitive_float_eq();
 465 }
 466
 467 inline void factorvm::primitive_float_add()
 468 {
 469         POP_FLOATS(x,y);
 470         box_double(x + y);
 471 }
 472
 473 PRIMITIVE(float_add)
 474 {
 475         PRIMITIVE_GETVM()->primitive_float_add();
 476 }
 477
 478 inline void factorvm::primitive_float_subtract()
 479 {
 480         POP_FLOATS(x,y);
 481         box_double(x - y);
 482 }
 483
 484 PRIMITIVE(float_subtract)
 485 {
 486         PRIMITIVE_GETVM()->primitive_float_subtract();
 487 }
 488
 489 inline void factorvm::primitive_float_multiply()
 490 {
 491         POP_FLOATS(x,y);
 492         box_double(x * y);
 493 }
 494
 495 PRIMITIVE(float_multiply)
 496 {
 497         PRIMITIVE_GETVM()->primitive_float_multiply();
 498 }
 499
 500 inline void factorvm::primitive_float_divfloat()
 501 {
 502         POP_FLOATS(x,y);
 503         box_double(x / y);
 504 }
 505
 506 PRIMITIVE(float_divfloat)
 507 {
 508         PRIMITIVE_GETVM()->primitive_float_divfloat();
 509 }
 510
 511 inline void factorvm::primitive_float_mod()
 512 {
 513         POP_FLOATS(x,y);
 514         box_double(fmod(x,y));
 515 }
 516
 517 PRIMITIVE(float_mod)
 518 {
 519         PRIMITIVE_GETVM()->primitive_float_mod();
 520 }
 521
 522 inline void factorvm::primitive_float_less()
 523 {
 524         POP_FLOATS(x,y);
 525         box_boolean(x < y);
 526 }
 527
 528 PRIMITIVE(float_less)
 529 {
 530         PRIMITIVE_GETVM()->primitive_float_less();
 531 }
 532
 533 inline void factorvm::primitive_float_lesseq()
 534 {
 535         POP_FLOATS(x,y);
 536         box_boolean(x <= y);
 537 }
 538
 539 PRIMITIVE(float_lesseq)
 540 {
 541         PRIMITIVE_GETVM()->primitive_float_lesseq();
 542 }
 543
 544 inline void factorvm::primitive_float_greater()
 545 {
 546         POP_FLOATS(x,y);
 547         box_boolean(x > y);
 548 }
 549
 550 PRIMITIVE(float_greater)
 551 {
 552         PRIMITIVE_GETVM()->primitive_float_greater();
 553 }
 554
 555 inline void factorvm::primitive_float_greatereq()
 556 {
 557         POP_FLOATS(x,y);
 558         box_boolean(x >= y);
 559 }
 560
 561 PRIMITIVE(float_greatereq)
 562 {
 563         PRIMITIVE_GETVM()->primitive_float_greatereq();
 564 }
 565
 566 inline void factorvm::primitive_float_bits()
 567 {
 568         box_unsigned_4(float_bits(untag_float_check(dpop())));
 569 }
 570
 571 PRIMITIVE(float_bits)
 572 {
 573         PRIMITIVE_GETVM()->primitive_float_bits();
 574 }
 575
 576 inline void factorvm::primitive_bits_float()
 577 {
 578         box_float(bits_float(to_cell(dpop())));
 579 }
 580
 581 PRIMITIVE(bits_float)
 582 {
 583         PRIMITIVE_GETVM()->primitive_bits_float();
 584 }
 585
 586 inline void factorvm::primitive_double_bits()
 587 {
 588         box_unsigned_8(double_bits(untag_float_check(dpop())));
 589 }
 590
 591 PRIMITIVE(double_bits)
 592 {
 593         PRIMITIVE_GETVM()->primitive_double_bits();
 594 }
 595
 596 inline void factorvm::primitive_bits_double()
 597 {
 598         box_double(bits_double(to_unsigned_8(dpop())));
 599 }
 600
 601 PRIMITIVE(bits_double)
 602 {
 603         PRIMITIVE_GETVM()->primitive_bits_double();
 604 }
 605
 606 fixnum factorvm::to_fixnum(cell tagged)
 607 {
 608         switch(TAG(tagged))
 609         {
 610         case FIXNUM_TYPE:
 611                 return untag_fixnum(tagged);
 612         case BIGNUM_TYPE:
 613                 return bignum_to_fixnum(untag<bignum>(tagged));
 614         default:
 615                 type_error(FIXNUM_TYPE,tagged);
 616                 return 0; /* can't happen */
 617         }
 618 }
 619
 620 VM_C_API fixnum to_fixnum(cell tagged,factorvm *myvm)
 621 {
 622         ASSERTVM();
 623         return VM_PTR->to_fixnum(tagged);
 624 }
 625
 626 cell factorvm::to_cell(cell tagged)
 627 {
 628         return (cell)to_fixnum(tagged);
 629 }
 630
 631 VM_C_API cell to_cell(cell tagged, factorvm *myvm)
 632 {
 633         ASSERTVM();
 634         return VM_PTR->to_cell(tagged);
 635 }
 636
 637 void factorvm::box_signed_1(s8 n)
 638 {
 639         dpush(tag_fixnum(n));
 640 }
 641
 642 VM_C_API void box_signed_1(s8 n,factorvm *myvm)
 643 {
 644         ASSERTVM();
 645         return VM_PTR->box_signed_1(n);
 646 }
 647
 648 void factorvm::box_unsigned_1(u8 n)
 649 {
 650         dpush(tag_fixnum(n));
 651 }
 652
 653 VM_C_API void box_unsigned_1(u8 n,factorvm *myvm)
 654 {
 655         ASSERTVM();
 656         return VM_PTR->box_unsigned_1(n);
 657 }
 658
 659 void factorvm::box_signed_2(s16 n)
 660 {
 661         dpush(tag_fixnum(n));
 662 }
 663
 664 VM_C_API void box_signed_2(s16 n,factorvm *myvm)
 665 {
 666         ASSERTVM();
 667         return VM_PTR->box_signed_2(n);
 668 }
 669
 670 void factorvm::box_unsigned_2(u16 n)
 671 {
 672         dpush(tag_fixnum(n));
 673 }
 674
 675 VM_C_API void box_unsigned_2(u16 n,factorvm *myvm)
 676 {
 677         ASSERTVM();
 678         return VM_PTR->box_unsigned_2(n);
 679 }
 680
 681 void factorvm::box_signed_4(s32 n)
 682 {
 683         dpush(allot_integer(n));
 684 }
 685
 686 VM_C_API void box_signed_4(s32 n,factorvm *myvm)
 687 {
 688         ASSERTVM();
 689         return VM_PTR->box_signed_4(n);
 690 }
 691
 692 void factorvm::box_unsigned_4(u32 n)
 693 {
 694         dpush(allot_cell(n));
 695 }
 696
 697 VM_C_API void box_unsigned_4(u32 n,factorvm *myvm)
 698 {
 699         ASSERTVM();
 700         return VM_PTR->box_unsigned_4(n);
 701 }
 702
 703 void factorvm::box_signed_cell(fixnum integer)
 704 {
 705         dpush(allot_integer(integer));
 706 }
 707
 708 VM_C_API void box_signed_cell(fixnum integer,factorvm *myvm)
 709 {
 710         ASSERTVM();
 711         return VM_PTR->box_signed_cell(integer);
 712 }
 713
 714 void factorvm::box_unsigned_cell(cell cell)
 715 {
 716         dpush(allot_cell(cell));
 717 }
 718
 719 VM_C_API void box_unsigned_cell(cell cell,factorvm *myvm)
 720 {
 721         ASSERTVM();
 722         return VM_PTR->box_unsigned_cell(cell);
 723 }
 724
 725 void factorvm::box_signed_8(s64 n)
 726 {
 727         if(n < fixnum_min || n > fixnum_max)
 728                 dpush(tag<bignum>(long_long_to_bignum(n)));
 729         else
 730                 dpush(tag_fixnum(n));
 731 }
 732
 733 VM_C_API void box_signed_8(s64 n,factorvm *myvm)
 734 {
 735         ASSERTVM();
 736         return VM_PTR->box_signed_8(n);
 737 }
 738
 739 s64 factorvm::to_signed_8(cell obj)
 740 {
 741         switch(tagged<object>(obj).type())
 742         {
 743         case FIXNUM_TYPE:
 744                 return untag_fixnum(obj);
 745         case BIGNUM_TYPE:
 746                 return bignum_to_long_long(untag<bignum>(obj));
 747         default:
 748                 type_error(BIGNUM_TYPE,obj);
 749                 return 0;
 750         }
 751 }
 752
 753 VM_C_API s64 to_signed_8(cell obj,factorvm *myvm)
 754 {
 755         ASSERTVM();
 756         return VM_PTR->to_signed_8(obj);
 757 }
 758
 759 void factorvm::box_unsigned_8(u64 n)
 760 {
 761         if(n > (u64)fixnum_max)
 762                 dpush(tag<bignum>(ulong_long_to_bignum(n)));
 763         else
 764                 dpush(tag_fixnum(n));
 765 }
 766
 767 VM_C_API void box_unsigned_8(u64 n,factorvm *myvm)
 768 {
 769         ASSERTVM();
 770         return VM_PTR->box_unsigned_8(n);
 771 }
 772
 773 u64 factorvm::to_unsigned_8(cell obj)
 774 {
 775         switch(tagged<object>(obj).type())
 776         {
 777         case FIXNUM_TYPE:
 778                 return untag_fixnum(obj);
 779         case BIGNUM_TYPE:
 780                 return bignum_to_ulong_long(untag<bignum>(obj));
 781         default:
 782                 type_error(BIGNUM_TYPE,obj);
 783                 return 0;
 784         }
 785 }
 786
 787 VM_C_API u64 to_unsigned_8(cell obj,factorvm *myvm)
 788 {
 789         ASSERTVM();
 790         return VM_PTR->to_unsigned_8(obj);
 791 }
 792
 793 void factorvm::box_float(float flo)
 794 {
 795         dpush(allot_float(flo));
 796 }
 797
 798 VM_C_API void box_float(float flo, factorvm *myvm)
 799 {
 800         ASSERTVM();
 801         return VM_PTR->box_float(flo);
 802 }
 803
 804 float factorvm::to_float(cell value)
 805 {
 806         return untag_float_check(value);
 807 }
 808
 809 VM_C_API float to_float(cell value,factorvm *myvm)
 810 {
 811         ASSERTVM();
 812         return VM_PTR->to_float(value);
 813 }
 814
 815 void factorvm::box_double(double flo)
 816 {
 817         dpush(allot_float(flo));
 818 }
 819
 820 VM_C_API void box_double(double flo,factorvm *myvm)
 821 {
 822         ASSERTVM();
 823         return VM_PTR->box_double(flo);
 824 }
 825
 826 double factorvm::to_double(cell value)
 827 {
 828         return untag_float_check(value);
 829 }
 830
 831 VM_C_API double to_double(cell value,factorvm *myvm)
 832 {
 833         ASSERTVM();
 834         return VM_PTR->to_double(value);
 835 }
 836
 837 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
 838 overflow, they call these functions. */
 839 inline void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
 840 {
 841         drepl(tag<bignum>(fixnum_to_bignum(
 842                 untag_fixnum(x) + untag_fixnum(y))));
 843 }
 844
 845 VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
 846 {
 847         PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
 848 }
 849
 850 inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
 851 {
 852         drepl(tag<bignum>(fixnum_to_bignum(
 853                 untag_fixnum(x) - untag_fixnum(y))));
 854 }
 855
 856 VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
 857 {
 858         PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
 859 }
 860
 861 inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
 862 {
 863         bignum *bx = fixnum_to_bignum(x);
 864         GC_BIGNUM(bx,this);
 865         bignum *by = fixnum_to_bignum(y);
 866         GC_BIGNUM(by,this);
 867         drepl(tag<bignum>(bignum_multiply(bx,by)));
 868 }
 869
 870 VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
 871 {
 872         PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
 873 }
 874
 875 }