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 = factor::digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
 359         bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
 360         drepl(tag<bignum>(result));
 361 }
 362
 363 PRIMITIVE(byte_array_to_bignum)
 364 {
 365         PRIMITIVE_GETVM()->primitive_byte_array_to_bignum();
 366 }
 367
 368 cell factorvm::unbox_array_size()
 369 {
 370         switch(tagged<object>(dpeek()).type())
 371         {
 372         case FIXNUM_TYPE:
 373                 {
 374                         fixnum n = untag_fixnum(dpeek());
 375                         if(n >= 0 && n < (fixnum)array_size_max)
 376                         {
 377                                 dpop();
 378                                 return n;
 379                         }
 380                         break;
 381                 }
 382         case BIGNUM_TYPE:
 383                 {
 384                         bignum * zero = untag<bignum>(bignum_zero);
 385                         bignum * max = cell_to_bignum(array_size_max);
 386                         bignum * n = untag<bignum>(dpeek());
 387                         if(bignum_compare(n,zero) != bignum_comparison_less
 388                                 && bignum_compare(n,max) == bignum_comparison_less)
 389                         {
 390                                 dpop();
 391                                 return bignum_to_cell(n);
 392                         }
 393                         break;
 394                 }
 395         }
 396
 397         general_error(ERROR_ARRAY_SIZE,dpop(),tag_fixnum(array_size_max),NULL);
 398         return 0; /* can't happen */
 399 }
 400
 401
 402 inline void factorvm::primitive_fixnum_to_float()
 403 {
 404         drepl(allot_float(fixnum_to_float(dpeek())));
 405 }
 406
 407 PRIMITIVE(fixnum_to_float)
 408 {
 409         PRIMITIVE_GETVM()->primitive_fixnum_to_float();
 410 }
 411
 412 inline void factorvm::primitive_bignum_to_float()
 413 {
 414         drepl(allot_float(bignum_to_float(dpeek())));
 415 }
 416
 417 PRIMITIVE(bignum_to_float)
 418 {
 419         PRIMITIVE_GETVM()->primitive_bignum_to_float();
 420 }
 421
 422 inline void factorvm::primitive_str_to_float()
 423 {
 424         byte_array *bytes = untag_check<byte_array>(dpeek());
 425         cell capacity = array_capacity(bytes);
 426
 427         char *c_str = (char *)(bytes + 1);
 428         char *end = c_str;
 429         double f = strtod(c_str,&end);
 430         if(end == c_str + capacity - 1)
 431                 drepl(allot_float(f));
 432         else
 433                 drepl(F);
 434 }
 435
 436 PRIMITIVE(str_to_float)
 437 {
 438         PRIMITIVE_GETVM()->primitive_str_to_float();
 439 }
 440
 441 inline void factorvm::primitive_float_to_str()
 442 {
 443         byte_array *array = allot_byte_array(33);
 444         snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
 445         dpush(tag<byte_array>(array));
 446 }
 447
 448 PRIMITIVE(float_to_str)
 449 {
 450         PRIMITIVE_GETVM()->primitive_float_to_str();
 451 }
 452
 453 #define POP_FLOATS(x,y) \
 454         double y = untag_float(dpop()); \
 455         double x = untag_float(dpop());
 456
 457 inline void factorvm::primitive_float_eq()
 458 {
 459         POP_FLOATS(x,y);
 460         box_boolean(x == y);
 461 }
 462
 463 PRIMITIVE(float_eq)
 464 {
 465         PRIMITIVE_GETVM()->primitive_float_eq();
 466 }
 467
 468 inline void factorvm::primitive_float_add()
 469 {
 470         POP_FLOATS(x,y);
 471         box_double(x + y);
 472 }
 473
 474 PRIMITIVE(float_add)
 475 {
 476         PRIMITIVE_GETVM()->primitive_float_add();
 477 }
 478
 479 inline void factorvm::primitive_float_subtract()
 480 {
 481         POP_FLOATS(x,y);
 482         box_double(x - y);
 483 }
 484
 485 PRIMITIVE(float_subtract)
 486 {
 487         PRIMITIVE_GETVM()->primitive_float_subtract();
 488 }
 489
 490 inline void factorvm::primitive_float_multiply()
 491 {
 492         POP_FLOATS(x,y);
 493         box_double(x * y);
 494 }
 495
 496 PRIMITIVE(float_multiply)
 497 {
 498         PRIMITIVE_GETVM()->primitive_float_multiply();
 499 }
 500
 501 inline void factorvm::primitive_float_divfloat()
 502 {
 503         POP_FLOATS(x,y);
 504         box_double(x / y);
 505 }
 506
 507 PRIMITIVE(float_divfloat)
 508 {
 509         PRIMITIVE_GETVM()->primitive_float_divfloat();
 510 }
 511
 512 inline void factorvm::primitive_float_mod()
 513 {
 514         POP_FLOATS(x,y);
 515         box_double(fmod(x,y));
 516 }
 517
 518 PRIMITIVE(float_mod)
 519 {
 520         PRIMITIVE_GETVM()->primitive_float_mod();
 521 }
 522
 523 inline void factorvm::primitive_float_less()
 524 {
 525         POP_FLOATS(x,y);
 526         box_boolean(x < y);
 527 }
 528
 529 PRIMITIVE(float_less)
 530 {
 531         PRIMITIVE_GETVM()->primitive_float_less();
 532 }
 533
 534 inline void factorvm::primitive_float_lesseq()
 535 {
 536         POP_FLOATS(x,y);
 537         box_boolean(x <= y);
 538 }
 539
 540 PRIMITIVE(float_lesseq)
 541 {
 542         PRIMITIVE_GETVM()->primitive_float_lesseq();
 543 }
 544
 545 inline void factorvm::primitive_float_greater()
 546 {
 547         POP_FLOATS(x,y);
 548         box_boolean(x > y);
 549 }
 550
 551 PRIMITIVE(float_greater)
 552 {
 553         PRIMITIVE_GETVM()->primitive_float_greater();
 554 }
 555
 556 inline void factorvm::primitive_float_greatereq()
 557 {
 558         POP_FLOATS(x,y);
 559         box_boolean(x >= y);
 560 }
 561
 562 PRIMITIVE(float_greatereq)
 563 {
 564         PRIMITIVE_GETVM()->primitive_float_greatereq();
 565 }
 566
 567 inline void factorvm::primitive_float_bits()
 568 {
 569         box_unsigned_4(float_bits(untag_float_check(dpop())));
 570 }
 571
 572 PRIMITIVE(float_bits)
 573 {
 574         PRIMITIVE_GETVM()->primitive_float_bits();
 575 }
 576
 577 inline void factorvm::primitive_bits_float()
 578 {
 579         box_float(bits_float(to_cell(dpop())));
 580 }
 581
 582 PRIMITIVE(bits_float)
 583 {
 584         PRIMITIVE_GETVM()->primitive_bits_float();
 585 }
 586
 587 inline void factorvm::primitive_double_bits()
 588 {
 589         box_unsigned_8(double_bits(untag_float_check(dpop())));
 590 }
 591
 592 PRIMITIVE(double_bits)
 593 {
 594         PRIMITIVE_GETVM()->primitive_double_bits();
 595 }
 596
 597 inline void factorvm::primitive_bits_double()
 598 {
 599         box_double(bits_double(to_unsigned_8(dpop())));
 600 }
 601
 602 PRIMITIVE(bits_double)
 603 {
 604         PRIMITIVE_GETVM()->primitive_bits_double();
 605 }
 606
 607 fixnum factorvm::to_fixnum(cell tagged)
 608 {
 609         switch(TAG(tagged))
 610         {
 611         case FIXNUM_TYPE:
 612                 return untag_fixnum(tagged);
 613         case BIGNUM_TYPE:
 614                 return bignum_to_fixnum(untag<bignum>(tagged));
 615         default:
 616                 type_error(FIXNUM_TYPE,tagged);
 617                 return 0; /* can't happen */
 618         }
 619 }
 620
 621 VM_C_API fixnum to_fixnum(cell tagged,factorvm *myvm)
 622 {
 623         ASSERTVM();
 624         return VM_PTR->to_fixnum(tagged);
 625 }
 626
 627 cell factorvm::to_cell(cell tagged)
 628 {
 629         return (cell)to_fixnum(tagged);
 630 }
 631
 632 VM_C_API cell to_cell(cell tagged, factorvm *myvm)
 633 {
 634         ASSERTVM();
 635         return VM_PTR->to_cell(tagged);
 636 }
 637
 638 void factorvm::box_signed_1(s8 n)
 639 {
 640         dpush(tag_fixnum(n));
 641 }
 642
 643 VM_C_API void box_signed_1(s8 n,factorvm *myvm)
 644 {
 645         ASSERTVM();
 646         return VM_PTR->box_signed_1(n);
 647 }
 648
 649 void factorvm::box_unsigned_1(u8 n)
 650 {
 651         dpush(tag_fixnum(n));
 652 }
 653
 654 VM_C_API void box_unsigned_1(u8 n,factorvm *myvm)
 655 {
 656         ASSERTVM();
 657         return VM_PTR->box_unsigned_1(n);
 658 }
 659
 660 void factorvm::box_signed_2(s16 n)
 661 {
 662         dpush(tag_fixnum(n));
 663 }
 664
 665 VM_C_API void box_signed_2(s16 n,factorvm *myvm)
 666 {
 667         ASSERTVM();
 668         return VM_PTR->box_signed_2(n);
 669 }
 670
 671 void factorvm::box_unsigned_2(u16 n)
 672 {
 673         dpush(tag_fixnum(n));
 674 }
 675
 676 VM_C_API void box_unsigned_2(u16 n,factorvm *myvm)
 677 {
 678         ASSERTVM();
 679         return VM_PTR->box_unsigned_2(n);
 680 }
 681
 682 void factorvm::box_signed_4(s32 n)
 683 {
 684         dpush(allot_integer(n));
 685 }
 686
 687 VM_C_API void box_signed_4(s32 n,factorvm *myvm)
 688 {
 689         ASSERTVM();
 690         return VM_PTR->box_signed_4(n);
 691 }
 692
 693 void factorvm::box_unsigned_4(u32 n)
 694 {
 695         dpush(allot_cell(n));
 696 }
 697
 698 VM_C_API void box_unsigned_4(u32 n,factorvm *myvm)
 699 {
 700         ASSERTVM();
 701         return VM_PTR->box_unsigned_4(n);
 702 }
 703
 704 void factorvm::box_signed_cell(fixnum integer)
 705 {
 706         dpush(allot_integer(integer));
 707 }
 708
 709 VM_C_API void box_signed_cell(fixnum integer,factorvm *myvm)
 710 {
 711         ASSERTVM();
 712         return VM_PTR->box_signed_cell(integer);
 713 }
 714
 715 void factorvm::box_unsigned_cell(cell cell)
 716 {
 717         dpush(allot_cell(cell));
 718 }
 719
 720 VM_C_API void box_unsigned_cell(cell cell,factorvm *myvm)
 721 {
 722         ASSERTVM();
 723         return VM_PTR->box_unsigned_cell(cell);
 724 }
 725
 726 void factorvm::box_signed_8(s64 n)
 727 {
 728         if(n < fixnum_min || n > fixnum_max)
 729                 dpush(tag<bignum>(long_long_to_bignum(n)));
 730         else
 731                 dpush(tag_fixnum(n));
 732 }
 733
 734 VM_C_API void box_signed_8(s64 n,factorvm *myvm)
 735 {
 736         ASSERTVM();
 737         return VM_PTR->box_signed_8(n);
 738 }
 739
 740 s64 factorvm::to_signed_8(cell obj)
 741 {
 742         switch(tagged<object>(obj).type())
 743         {
 744         case FIXNUM_TYPE:
 745                 return untag_fixnum(obj);
 746         case BIGNUM_TYPE:
 747                 return bignum_to_long_long(untag<bignum>(obj));
 748         default:
 749                 type_error(BIGNUM_TYPE,obj);
 750                 return 0;
 751         }
 752 }
 753
 754 VM_C_API s64 to_signed_8(cell obj,factorvm *myvm)
 755 {
 756         ASSERTVM();
 757         return VM_PTR->to_signed_8(obj);
 758 }
 759
 760 void factorvm::box_unsigned_8(u64 n)
 761 {
 762         if(n > (u64)fixnum_max)
 763                 dpush(tag<bignum>(ulong_long_to_bignum(n)));
 764         else
 765                 dpush(tag_fixnum(n));
 766 }
 767
 768 VM_C_API void box_unsigned_8(u64 n,factorvm *myvm)
 769 {
 770         ASSERTVM();
 771         return VM_PTR->box_unsigned_8(n);
 772 }
 773
 774 u64 factorvm::to_unsigned_8(cell obj)
 775 {
 776         switch(tagged<object>(obj).type())
 777         {
 778         case FIXNUM_TYPE:
 779                 return untag_fixnum(obj);
 780         case BIGNUM_TYPE:
 781                 return bignum_to_ulong_long(untag<bignum>(obj));
 782         default:
 783                 type_error(BIGNUM_TYPE,obj);
 784                 return 0;
 785         }
 786 }
 787
 788 VM_C_API u64 to_unsigned_8(cell obj,factorvm *myvm)
 789 {
 790         ASSERTVM();
 791         return VM_PTR->to_unsigned_8(obj);
 792 }
 793
 794 void factorvm::box_float(float flo)
 795 {
 796         dpush(allot_float(flo));
 797 }
 798
 799 VM_C_API void box_float(float flo,factorvm *myvm)      // not sure if this is ever called
 800 {
 801         ASSERTVM();
 802         return VM_PTR->box_float(flo);
 803 }
 804
 805 float factorvm::to_float(cell value)
 806 {
 807         return untag_float_check(value);
 808 }
 809
 810 VM_C_API float to_float(cell value,factorvm *myvm)
 811 {
 812         ASSERTVM();
 813         return VM_PTR->to_float(value);
 814 }
 815
 816 void factorvm::box_double(double flo)
 817 {
 818         dpush(allot_float(flo));
 819 }
 820
 821 VM_C_API void box_double(double flo,factorvm *myvm)
 822 {
 823         ASSERTVM();
 824         return VM_PTR->box_double(flo);
 825 }
 826
 827 double factorvm::to_double(cell value)
 828 {
 829         return untag_float_check(value);
 830 }
 831
 832 VM_C_API double to_double(cell value,factorvm *myvm)
 833 {
 834         ASSERTVM();
 835         return VM_PTR->to_double(value);
 836 }
 837
 838 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
 839 overflow, they call these functions. */
 840 inline void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
 841 {
 842         drepl(tag<bignum>(fixnum_to_bignum(
 843                 untag_fixnum(x) + untag_fixnum(y))));
 844 }
 845
 846 VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
 847 {
 848         PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
 849 }
 850
 851 inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
 852 {
 853         drepl(tag<bignum>(fixnum_to_bignum(
 854                 untag_fixnum(x) - untag_fixnum(y))));
 855 }
 856
 857 VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
 858 {
 859         PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
 860 }
 861
 862 inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
 863 {
 864         bignum *bx = fixnum_to_bignum(x);
 865         GC_BIGNUM(bx,this);
 866         bignum *by = fixnum_to_bignum(y);
 867         GC_BIGNUM(by,this);
 868         drepl(tag<bignum>(bignum_multiply(bx,by)));
 869 }
 870
 871 VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
 872 {
 873         PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
 874 }
 875
 876 }