vm/math.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 inline void factorvm::vmprim_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()->vmprim_bignum_to_fixnum();
  14 }
  15
  16 inline void factorvm::vmprim_float_to_fixnum()
  17 {
  18         drepl(tag_fixnum(float_to_fixnum(dpeek())));
  19 }
  20
  21 PRIMITIVE(float_to_fixnum)
  22 {
  23         PRIMITIVE_GETVM()->vmprim_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::vmprim_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()->vmprim_fixnum_divint();
  42 }
  43
  44 inline void factorvm::vmprim_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()->vmprim_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::vmprim_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()->vmprim_fixnum_shift();
 117 }
 118
 119 inline void factorvm::vmprim_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()->vmprim_fixnum_to_bignum();
 127 }
 128
 129 inline void factorvm::vmprim_float_to_bignum()
 130 {
 131         drepl(tag<bignum>(float_to_bignum(dpeek())));
 132 }
 133
 134 PRIMITIVE(float_to_bignum)
 135 {
 136         PRIMITIVE_GETVM()->vmprim_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::vmprim_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()->vmprim_bignum_eq();
 152 }
 153
 154 inline void factorvm::vmprim_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()->vmprim_bignum_add();
 163 }
 164
 165 inline void factorvm::vmprim_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()->vmprim_bignum_subtract();
 174 }
 175
 176 inline void factorvm::vmprim_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()->vmprim_bignum_multiply();
 185 }
 186
 187 inline void factorvm::vmprim_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()->vmprim_bignum_divint();
 196 }
 197
 198 inline void factorvm::vmprim_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()->vmprim_bignum_divmod();
 210 }
 211
 212 inline void factorvm::vmprim_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()->vmprim_bignum_mod();
 221 }
 222
 223 inline void factorvm::vmprim_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()->vmprim_bignum_and();
 232 }
 233
 234 inline void factorvm::vmprim_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()->vmprim_bignum_or();
 243 }
 244
 245 inline void factorvm::vmprim_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()->vmprim_bignum_xor();
 254 }
 255
 256 inline void factorvm::vmprim_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()->vmprim_bignum_shift();
 266 }
 267
 268 inline void factorvm::vmprim_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()->vmprim_bignum_less();
 277 }
 278
 279 inline void factorvm::vmprim_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()->vmprim_bignum_lesseq();
 288 }
 289
 290 inline void factorvm::vmprim_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()->vmprim_bignum_greater();
 299 }
 300
 301 inline void factorvm::vmprim_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()->vmprim_bignum_greatereq();
 310 }
 311
 312 inline void factorvm::vmprim_bignum_not()
 313 {
 314         drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
 315 }
 316
 317 PRIMITIVE(bignum_not)
 318 {
 319         PRIMITIVE_GETVM()->vmprim_bignum_not();
 320 }
 321
 322 inline void factorvm::vmprim_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()->vmprim_bignum_bitp();
 332 }
 333
 334 inline void factorvm::vmprim_bignum_log2()
 335 {
 336         drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
 337 }
 338
 339 PRIMITIVE(bignum_log2)
 340 {
 341         PRIMITIVE_GETVM()->vmprim_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::vmprim_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()->vmprim_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::vmprim_fixnum_to_float()
 403 {
 404         drepl(allot_float(fixnum_to_float(dpeek())));
 405 }
 406
 407 PRIMITIVE(fixnum_to_float)
 408 {
 409         PRIMITIVE_GETVM()->vmprim_fixnum_to_float();
 410 }
 411
 412 inline void factorvm::vmprim_bignum_to_float()
 413 {
 414         drepl(allot_float(bignum_to_float(dpeek())));
 415 }
 416
 417 PRIMITIVE(bignum_to_float)
 418 {
 419         PRIMITIVE_GETVM()->vmprim_bignum_to_float();
 420 }
 421
 422 inline void factorvm::vmprim_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()->vmprim_str_to_float();
 439 }
 440
 441 inline void factorvm::vmprim_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()->vmprim_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::vmprim_float_eq()
 458 {
 459         POP_FLOATS(x,y);
 460         box_boolean(x == y);
 461 }
 462
 463 PRIMITIVE(float_eq)
 464 {
 465         PRIMITIVE_GETVM()->vmprim_float_eq();
 466 }
 467
 468 inline void factorvm::vmprim_float_add()
 469 {
 470         POP_FLOATS(x,y);
 471         box_double(x + y);
 472 }
 473
 474 PRIMITIVE(float_add)
 475 {
 476         PRIMITIVE_GETVM()->vmprim_float_add();
 477 }
 478
 479 inline void factorvm::vmprim_float_subtract()
 480 {
 481         POP_FLOATS(x,y);
 482         box_double(x - y);
 483 }
 484
 485 PRIMITIVE(float_subtract)
 486 {
 487         PRIMITIVE_GETVM()->vmprim_float_subtract();
 488 }
 489
 490 inline void factorvm::vmprim_float_multiply()
 491 {
 492         POP_FLOATS(x,y);
 493         box_double(x * y);
 494 }
 495
 496 PRIMITIVE(float_multiply)
 497 {
 498         PRIMITIVE_GETVM()->vmprim_float_multiply();
 499 }
 500
 501 inline void factorvm::vmprim_float_divfloat()
 502 {
 503         POP_FLOATS(x,y);
 504         box_double(x / y);
 505 }
 506
 507 PRIMITIVE(float_divfloat)
 508 {
 509         PRIMITIVE_GETVM()->vmprim_float_divfloat();
 510 }
 511
 512 inline void factorvm::vmprim_float_mod()
 513 {
 514         POP_FLOATS(x,y);
 515         box_double(fmod(x,y));
 516 }
 517
 518 PRIMITIVE(float_mod)
 519 {
 520         PRIMITIVE_GETVM()->vmprim_float_mod();
 521 }
 522
 523 inline void factorvm::vmprim_float_less()
 524 {
 525         POP_FLOATS(x,y);
 526         box_boolean(x < y);
 527 }
 528
 529 PRIMITIVE(float_less)
 530 {
 531         PRIMITIVE_GETVM()->vmprim_float_less();
 532 }
 533
 534 inline void factorvm::vmprim_float_lesseq()
 535 {
 536         POP_FLOATS(x,y);
 537         box_boolean(x <= y);
 538 }
 539
 540 PRIMITIVE(float_lesseq)
 541 {
 542         PRIMITIVE_GETVM()->vmprim_float_lesseq();
 543 }
 544
 545 inline void factorvm::vmprim_float_greater()
 546 {
 547         POP_FLOATS(x,y);
 548         box_boolean(x > y);
 549 }
 550
 551 PRIMITIVE(float_greater)
 552 {
 553         PRIMITIVE_GETVM()->vmprim_float_greater();
 554 }
 555
 556 inline void factorvm::vmprim_float_greatereq()
 557 {
 558         POP_FLOATS(x,y);
 559         box_boolean(x >= y);
 560 }
 561
 562 PRIMITIVE(float_greatereq)
 563 {
 564         PRIMITIVE_GETVM()->vmprim_float_greatereq();
 565 }
 566
 567 inline void factorvm::vmprim_float_bits()
 568 {
 569         box_unsigned_4(float_bits(untag_float_check(dpop())));
 570 }
 571
 572 PRIMITIVE(float_bits)
 573 {
 574         PRIMITIVE_GETVM()->vmprim_float_bits();
 575 }
 576
 577 inline void factorvm::vmprim_bits_float()
 578 {
 579         box_float(bits_float(to_cell(dpop())));
 580 }
 581
 582 PRIMITIVE(bits_float)
 583 {
 584         PRIMITIVE_GETVM()->vmprim_bits_float();
 585 }
 586
 587 inline void factorvm::vmprim_double_bits()
 588 {
 589         box_unsigned_8(double_bits(untag_float_check(dpop())));
 590 }
 591
 592 PRIMITIVE(double_bits)
 593 {
 594         PRIMITIVE_GETVM()->vmprim_double_bits();
 595 }
 596
 597 inline void factorvm::vmprim_bits_double()
 598 {
 599         box_double(bits_double(to_unsigned_8(dpop())));
 600 }
 601
 602 PRIMITIVE(bits_double)
 603 {
 604         PRIMITIVE_GETVM()->vmprim_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         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         return VM_PTR->to_cell(tagged);
 634 }
 635
 636 void factorvm::box_signed_1(s8 n)
 637 {
 638         dpush(tag_fixnum(n));
 639 }
 640
 641 VM_C_API void box_signed_1(s8 n,factorvm *myvm)
 642 {
 643         ASSERTVM();
 644         return VM_PTR->box_signed_1(n);
 645 }
 646
 647 void factorvm::box_unsigned_1(u8 n)
 648 {
 649         dpush(tag_fixnum(n));
 650 }
 651
 652 VM_C_API void box_unsigned_1(u8 n,factorvm *myvm)
 653 {
 654         ASSERTVM();
 655         return VM_PTR->box_unsigned_1(n);
 656 }
 657
 658 void factorvm::box_signed_2(s16 n)
 659 {
 660         dpush(tag_fixnum(n));
 661 }
 662
 663 VM_C_API void box_signed_2(s16 n,factorvm *myvm)
 664 {
 665         ASSERTVM();
 666         return VM_PTR->box_signed_2(n);
 667 }
 668
 669 void factorvm::box_unsigned_2(u16 n)
 670 {
 671         dpush(tag_fixnum(n));
 672 }
 673
 674 VM_C_API void box_unsigned_2(u16 n,factorvm *myvm)
 675 {
 676         ASSERTVM();
 677         return VM_PTR->box_unsigned_2(n);
 678 }
 679
 680 void factorvm::box_signed_4(s32 n)
 681 {
 682         dpush(allot_integer(n));
 683 }
 684
 685 VM_C_API void box_signed_4(s32 n,factorvm *myvm)
 686 {
 687         ASSERTVM();
 688         return VM_PTR->box_signed_4(n);
 689 }
 690
 691 void factorvm::box_unsigned_4(u32 n)
 692 {
 693         dpush(allot_cell(n));
 694 }
 695
 696 VM_C_API void box_unsigned_4(u32 n,factorvm *myvm)
 697 {
 698         ASSERTVM();
 699         return VM_PTR->box_unsigned_4(n);
 700 }
 701
 702 void factorvm::box_signed_cell(fixnum integer)
 703 {
 704         dpush(allot_integer(integer));
 705 }
 706
 707 VM_C_API void box_signed_cell(fixnum integer,factorvm *myvm)
 708 {
 709         ASSERTVM();
 710         return VM_PTR->box_signed_cell(integer);
 711 }
 712
 713 void factorvm::box_unsigned_cell(cell cell)
 714 {
 715         dpush(allot_cell(cell));
 716 }
 717
 718 VM_C_API void box_unsigned_cell(cell cell,factorvm *myvm)
 719 {
 720         ASSERTVM();
 721         return VM_PTR->box_unsigned_cell(cell);
 722 }
 723
 724 void factorvm::box_signed_8(s64 n)
 725 {
 726         if(n < fixnum_min || n > fixnum_max)
 727                 dpush(tag<bignum>(long_long_to_bignum(n)));
 728         else
 729                 dpush(tag_fixnum(n));
 730 }
 731
 732 VM_C_API void box_signed_8(s64 n,factorvm *myvm)
 733 {
 734         ASSERTVM();
 735         return VM_PTR->box_signed_8(n);
 736 }
 737
 738 s64 factorvm::to_signed_8(cell obj)
 739 {
 740         switch(tagged<object>(obj).type())
 741         {
 742         case FIXNUM_TYPE:
 743                 return untag_fixnum(obj);
 744         case BIGNUM_TYPE:
 745                 return bignum_to_long_long(untag<bignum>(obj));
 746         default:
 747                 type_error(BIGNUM_TYPE,obj);
 748                 return 0;
 749         }
 750 }
 751
 752 VM_C_API s64 to_signed_8(cell obj,factorvm *myvm)
 753 {
 754         ASSERTVM();
 755         return VM_PTR->to_signed_8(obj);
 756 }
 757
 758 void factorvm::box_unsigned_8(u64 n)
 759 {
 760         if(n > (u64)fixnum_max)
 761                 dpush(tag<bignum>(ulong_long_to_bignum(n)));
 762         else
 763                 dpush(tag_fixnum(n));
 764 }
 765
 766 VM_C_API void box_unsigned_8(u64 n,factorvm *myvm)
 767 {
 768         ASSERTVM();
 769         return VM_PTR->box_unsigned_8(n);
 770 }
 771
 772 u64 factorvm::to_unsigned_8(cell obj)
 773 {
 774         switch(tagged<object>(obj).type())
 775         {
 776         case FIXNUM_TYPE:
 777                 return untag_fixnum(obj);
 778         case BIGNUM_TYPE:
 779                 return bignum_to_ulong_long(untag<bignum>(obj));
 780         default:
 781                 type_error(BIGNUM_TYPE,obj);
 782                 return 0;
 783         }
 784 }
 785
 786 VM_C_API u64 to_unsigned_8(cell obj,factorvm *myvm)
 787 {
 788         ASSERTVM();
 789         return VM_PTR->to_unsigned_8(obj);
 790 }
 791
 792 void factorvm::box_float(float flo)
 793 {
 794         dpush(allot_float(flo));
 795 }
 796
 797 VM_C_API void box_float(float flo,factorvm *myvm)      // not sure if this is ever called
 798 {
 799         ASSERTVM();
 800         return VM_PTR->box_float(flo);
 801 }
 802
 803 float factorvm::to_float(cell value)
 804 {
 805         return untag_float_check(value);
 806 }
 807
 808 VM_C_API float to_float(cell value,factorvm *myvm)
 809 {
 810         return VM_PTR->to_float(value);
 811 }
 812
 813 void factorvm::box_double(double flo)
 814 {
 815         dpush(allot_float(flo));
 816 }
 817
 818 VM_C_API void box_double(double flo,factorvm *myvm)   // not sure if this is ever called
 819 {
 820         ASSERTVM();
 821         return VM_PTR->box_double(flo);
 822 }
 823
 824 double factorvm::to_double(cell value)
 825 {
 826         return untag_float_check(value);
 827 }
 828
 829 VM_C_API double to_double(cell value,factorvm *myvm)
 830 {
 831         return VM_PTR->to_double(value);
 832 }
 833
 834 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
 835 overflow, they call these functions. */
 836 void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
 837 {
 838         drepl(tag<bignum>(fixnum_to_bignum(
 839                 untag_fixnum(x) + untag_fixnum(y))));
 840 }
 841
 842 VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
 843 {
 844         return vm->overflow_fixnum_add(x,y);
 845 }
 846
 847 void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
 848 {
 849         drepl(tag<bignum>(fixnum_to_bignum(
 850                 untag_fixnum(x) - untag_fixnum(y))));
 851 }
 852
 853 VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
 854 {
 855         return vm->overflow_fixnum_subtract(x,y);
 856 }
 857
 858 void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
 859 {
 860         bignum *bx = fixnum_to_bignum(x);
 861         GC_BIGNUM(bx,this);
 862         bignum *by = fixnum_to_bignum(y);
 863         GC_BIGNUM(by,this);
 864         drepl(tag<bignum>(bignum_multiply(bx,by)));
 865 }
 866
 867 VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
 868 {
 869         return vm->overflow_fixnum_multiply(x,y);
 870 }
 871
 872 }