6 inline void factorvm::primitive_bignum_to_fixnum()
8 drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
11 PRIMITIVE(bignum_to_fixnum)
13 PRIMITIVE_GETVM()->primitive_bignum_to_fixnum();
16 inline void factorvm::primitive_float_to_fixnum()
18 drepl(tag_fixnum(float_to_fixnum(dpeek())));
21 PRIMITIVE(float_to_fixnum)
23 PRIMITIVE_GETVM()->primitive_float_to_fixnum();
26 /* Division can only overflow when we are dividing the most negative fixnum
28 inline void factorvm::primitive_fixnum_divint()
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));
36 drepl(tag_fixnum(result));
39 PRIMITIVE(fixnum_divint)
41 PRIMITIVE_GETVM()->primitive_fixnum_divint();
44 inline void factorvm::primitive_fixnum_divmod()
46 cell y = ((cell *)ds)[0];
47 cell x = ((cell *)ds)[-1];
48 if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min))
50 ((cell *)ds)[-1] = allot_integer(-fixnum_min);
51 ((cell *)ds)[0] = tag_fixnum(0);
55 ((cell *)ds)[-1] = tag_fixnum(untag_fixnum(x) / untag_fixnum(y));
56 ((cell *)ds)[0] = (fixnum)x % (fixnum)y;
60 PRIMITIVE(fixnum_divmod)
62 PRIMITIVE_GETVM()->primitive_fixnum_divmod();
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.
69 inline fixnum factorvm::sign_mask(fixnum x)
71 return x >> (WORD_SIZE - 1);
74 inline fixnum factorvm::branchless_max(fixnum x, fixnum y)
76 return (x - ((x - y) & sign_mask(x - y)));
79 inline fixnum factorvm::branchless_abs(fixnum x)
81 return (x ^ sign_mask(x)) - sign_mask(x);
84 inline void factorvm::primitive_fixnum_shift()
86 fixnum y = untag_fixnum(dpop());
87 fixnum x = untag_fixnum(dpeek());
93 y = branchless_max(y,-WORD_SIZE + 1);
94 drepl(tag_fixnum(x >> -y));
97 else if(y < WORD_SIZE - TAG_BITS)
99 fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y));
100 if(!(branchless_abs(x) & mask))
102 drepl(tag_fixnum(x << y));
107 drepl(tag<bignum>(bignum_arithmetic_shift(
108 fixnum_to_bignum(x),y)));
111 PRIMITIVE(fixnum_shift)
113 PRIMITIVE_GETVM()->primitive_fixnum_shift();
116 inline void factorvm::primitive_fixnum_to_bignum()
118 drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
121 PRIMITIVE(fixnum_to_bignum)
123 PRIMITIVE_GETVM()->primitive_fixnum_to_bignum();
126 inline void factorvm::primitive_float_to_bignum()
128 drepl(tag<bignum>(float_to_bignum(dpeek())));
131 PRIMITIVE(float_to_bignum)
133 PRIMITIVE_GETVM()->primitive_float_to_bignum();
136 #define POP_BIGNUMS(x,y) \
137 bignum * y = untag<bignum>(dpop()); \
138 bignum * x = untag<bignum>(dpop());
140 inline void factorvm::primitive_bignum_eq()
143 box_boolean(bignum_equal_p(x,y));
148 PRIMITIVE_GETVM()->primitive_bignum_eq();
151 inline void factorvm::primitive_bignum_add()
154 dpush(tag<bignum>(bignum_add(x,y)));
157 PRIMITIVE(bignum_add)
159 PRIMITIVE_GETVM()->primitive_bignum_add();
162 inline void factorvm::primitive_bignum_subtract()
165 dpush(tag<bignum>(bignum_subtract(x,y)));
168 PRIMITIVE(bignum_subtract)
170 PRIMITIVE_GETVM()->primitive_bignum_subtract();
173 inline void factorvm::primitive_bignum_multiply()
176 dpush(tag<bignum>(bignum_multiply(x,y)));
179 PRIMITIVE(bignum_multiply)
181 PRIMITIVE_GETVM()->primitive_bignum_multiply();
184 inline void factorvm::primitive_bignum_divint()
187 dpush(tag<bignum>(bignum_quotient(x,y)));
190 PRIMITIVE(bignum_divint)
192 PRIMITIVE_GETVM()->primitive_bignum_divint();
195 inline void factorvm::primitive_bignum_divmod()
199 bignum_divide(x,y,&q,&r);
200 dpush(tag<bignum>(q));
201 dpush(tag<bignum>(r));
204 PRIMITIVE(bignum_divmod)
206 PRIMITIVE_GETVM()->primitive_bignum_divmod();
209 inline void factorvm::primitive_bignum_mod()
212 dpush(tag<bignum>(bignum_remainder(x,y)));
215 PRIMITIVE(bignum_mod)
217 PRIMITIVE_GETVM()->primitive_bignum_mod();
220 inline void factorvm::primitive_bignum_and()
223 dpush(tag<bignum>(bignum_bitwise_and(x,y)));
226 PRIMITIVE(bignum_and)
228 PRIMITIVE_GETVM()->primitive_bignum_and();
231 inline void factorvm::primitive_bignum_or()
234 dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
239 PRIMITIVE_GETVM()->primitive_bignum_or();
242 inline void factorvm::primitive_bignum_xor()
245 dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
248 PRIMITIVE(bignum_xor)
250 PRIMITIVE_GETVM()->primitive_bignum_xor();
253 inline void factorvm::primitive_bignum_shift()
255 fixnum y = untag_fixnum(dpop());
256 bignum* x = untag<bignum>(dpop());
257 dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
260 PRIMITIVE(bignum_shift)
262 PRIMITIVE_GETVM()->primitive_bignum_shift();
265 inline void factorvm::primitive_bignum_less()
268 box_boolean(bignum_compare(x,y) == bignum_comparison_less);
271 PRIMITIVE(bignum_less)
273 PRIMITIVE_GETVM()->primitive_bignum_less();
276 inline void factorvm::primitive_bignum_lesseq()
279 box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
282 PRIMITIVE(bignum_lesseq)
284 PRIMITIVE_GETVM()->primitive_bignum_lesseq();
287 inline void factorvm::primitive_bignum_greater()
290 box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
293 PRIMITIVE(bignum_greater)
295 PRIMITIVE_GETVM()->primitive_bignum_greater();
298 inline void factorvm::primitive_bignum_greatereq()
301 box_boolean(bignum_compare(x,y) != bignum_comparison_less);
304 PRIMITIVE(bignum_greatereq)
306 PRIMITIVE_GETVM()->primitive_bignum_greatereq();
309 inline void factorvm::primitive_bignum_not()
311 drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
314 PRIMITIVE(bignum_not)
316 PRIMITIVE_GETVM()->primitive_bignum_not();
319 inline void factorvm::primitive_bignum_bitp()
321 fixnum bit = to_fixnum(dpop());
322 bignum *x = untag<bignum>(dpop());
323 box_boolean(bignum_logbitp(bit,x));
326 PRIMITIVE(bignum_bitp)
328 PRIMITIVE_GETVM()->primitive_bignum_bitp();
331 inline void factorvm::primitive_bignum_log2()
333 drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
336 PRIMITIVE(bignum_log2)
338 PRIMITIVE_GETVM()->primitive_bignum_log2();
341 unsigned int factorvm::bignum_producer(unsigned int digit)
343 unsigned char *ptr = (unsigned char *)alien_offset(dpeek());
344 return *(ptr + digit);
347 unsigned int bignum_producer(unsigned int digit, factorvm *myvm)
349 return myvm->bignum_producer(digit);
352 inline void factorvm::primitive_byte_array_to_bignum()
354 cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
355 bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
356 drepl(tag<bignum>(result));
359 PRIMITIVE(byte_array_to_bignum)
361 PRIMITIVE_GETVM()->primitive_byte_array_to_bignum();
364 cell factorvm::unbox_array_size()
366 switch(tagged<object>(dpeek()).type())
370 fixnum n = untag_fixnum(dpeek());
371 if(n >= 0 && n < (fixnum)array_size_max)
380 bignum * zero = untag<bignum>(bignum_zero);
381 bignum * max = cell_to_bignum(array_size_max);
382 bignum * n = untag<bignum>(dpeek());
383 if(bignum_compare(n,zero) != bignum_comparison_less
384 && bignum_compare(n,max) == bignum_comparison_less)
387 return bignum_to_cell(n);
393 general_error(ERROR_ARRAY_SIZE,dpop(),tag_fixnum(array_size_max),NULL);
394 return 0; /* can't happen */
397 inline void factorvm::primitive_fixnum_to_float()
399 drepl(allot_float(fixnum_to_float(dpeek())));
402 PRIMITIVE(fixnum_to_float)
404 PRIMITIVE_GETVM()->primitive_fixnum_to_float();
407 inline void factorvm::primitive_bignum_to_float()
409 drepl(allot_float(bignum_to_float(dpeek())));
412 PRIMITIVE(bignum_to_float)
414 PRIMITIVE_GETVM()->primitive_bignum_to_float();
417 inline void factorvm::primitive_str_to_float()
419 byte_array *bytes = untag_check<byte_array>(dpeek());
420 cell capacity = array_capacity(bytes);
422 char *c_str = (char *)(bytes + 1);
424 double f = strtod(c_str,&end);
425 if(end == c_str + capacity - 1)
426 drepl(allot_float(f));
431 PRIMITIVE(str_to_float)
433 PRIMITIVE_GETVM()->primitive_str_to_float();
436 inline void factorvm::primitive_float_to_str()
438 byte_array *array = allot_byte_array(33);
439 snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
440 dpush(tag<byte_array>(array));
443 PRIMITIVE(float_to_str)
445 PRIMITIVE_GETVM()->primitive_float_to_str();
448 #define POP_FLOATS(x,y) \
449 double y = untag_float(dpop()); \
450 double x = untag_float(dpop());
452 inline void factorvm::primitive_float_eq()
460 PRIMITIVE_GETVM()->primitive_float_eq();
463 inline void factorvm::primitive_float_add()
471 PRIMITIVE_GETVM()->primitive_float_add();
474 inline void factorvm::primitive_float_subtract()
480 PRIMITIVE(float_subtract)
482 PRIMITIVE_GETVM()->primitive_float_subtract();
485 inline void factorvm::primitive_float_multiply()
491 PRIMITIVE(float_multiply)
493 PRIMITIVE_GETVM()->primitive_float_multiply();
496 inline void factorvm::primitive_float_divfloat()
502 PRIMITIVE(float_divfloat)
504 PRIMITIVE_GETVM()->primitive_float_divfloat();
507 inline void factorvm::primitive_float_mod()
510 box_double(fmod(x,y));
515 PRIMITIVE_GETVM()->primitive_float_mod();
518 inline void factorvm::primitive_float_less()
524 PRIMITIVE(float_less)
526 PRIMITIVE_GETVM()->primitive_float_less();
529 inline void factorvm::primitive_float_lesseq()
535 PRIMITIVE(float_lesseq)
537 PRIMITIVE_GETVM()->primitive_float_lesseq();
540 inline void factorvm::primitive_float_greater()
546 PRIMITIVE(float_greater)
548 PRIMITIVE_GETVM()->primitive_float_greater();
551 inline void factorvm::primitive_float_greatereq()
557 PRIMITIVE(float_greatereq)
559 PRIMITIVE_GETVM()->primitive_float_greatereq();
562 inline void factorvm::primitive_float_bits()
564 box_unsigned_4(float_bits(untag_float_check(dpop())));
567 PRIMITIVE(float_bits)
569 PRIMITIVE_GETVM()->primitive_float_bits();
572 inline void factorvm::primitive_bits_float()
574 box_float(bits_float(to_cell(dpop())));
577 PRIMITIVE(bits_float)
579 PRIMITIVE_GETVM()->primitive_bits_float();
582 inline void factorvm::primitive_double_bits()
584 box_unsigned_8(double_bits(untag_float_check(dpop())));
587 PRIMITIVE(double_bits)
589 PRIMITIVE_GETVM()->primitive_double_bits();
592 inline void factorvm::primitive_bits_double()
594 box_double(bits_double(to_unsigned_8(dpop())));
597 PRIMITIVE(bits_double)
599 PRIMITIVE_GETVM()->primitive_bits_double();
602 fixnum factorvm::to_fixnum(cell tagged)
607 return untag_fixnum(tagged);
609 return bignum_to_fixnum(untag<bignum>(tagged));
611 type_error(FIXNUM_TYPE,tagged);
612 return 0; /* can't happen */
616 VM_C_API fixnum to_fixnum(cell tagged,factorvm *myvm)
619 return VM_PTR->to_fixnum(tagged);
622 cell factorvm::to_cell(cell tagged)
624 return (cell)to_fixnum(tagged);
627 VM_C_API cell to_cell(cell tagged, factorvm *myvm)
630 return VM_PTR->to_cell(tagged);
633 void factorvm::box_signed_1(s8 n)
635 dpush(tag_fixnum(n));
638 VM_C_API void box_signed_1(s8 n,factorvm *myvm)
641 return VM_PTR->box_signed_1(n);
644 void factorvm::box_unsigned_1(u8 n)
646 dpush(tag_fixnum(n));
649 VM_C_API void box_unsigned_1(u8 n,factorvm *myvm)
652 return VM_PTR->box_unsigned_1(n);
655 void factorvm::box_signed_2(s16 n)
657 dpush(tag_fixnum(n));
660 VM_C_API void box_signed_2(s16 n,factorvm *myvm)
663 return VM_PTR->box_signed_2(n);
666 void factorvm::box_unsigned_2(u16 n)
668 dpush(tag_fixnum(n));
671 VM_C_API void box_unsigned_2(u16 n,factorvm *myvm)
674 return VM_PTR->box_unsigned_2(n);
677 void factorvm::box_signed_4(s32 n)
679 dpush(allot_integer(n));
682 VM_C_API void box_signed_4(s32 n,factorvm *myvm)
685 return VM_PTR->box_signed_4(n);
688 void factorvm::box_unsigned_4(u32 n)
690 dpush(allot_cell(n));
693 VM_C_API void box_unsigned_4(u32 n,factorvm *myvm)
696 return VM_PTR->box_unsigned_4(n);
699 void factorvm::box_signed_cell(fixnum integer)
701 dpush(allot_integer(integer));
704 VM_C_API void box_signed_cell(fixnum integer,factorvm *myvm)
707 return VM_PTR->box_signed_cell(integer);
710 void factorvm::box_unsigned_cell(cell cell)
712 dpush(allot_cell(cell));
715 VM_C_API void box_unsigned_cell(cell cell,factorvm *myvm)
718 return VM_PTR->box_unsigned_cell(cell);
721 void factorvm::box_signed_8(s64 n)
723 if(n < fixnum_min || n > fixnum_max)
724 dpush(tag<bignum>(long_long_to_bignum(n)));
726 dpush(tag_fixnum(n));
729 VM_C_API void box_signed_8(s64 n,factorvm *myvm)
732 return VM_PTR->box_signed_8(n);
735 s64 factorvm::to_signed_8(cell obj)
737 switch(tagged<object>(obj).type())
740 return untag_fixnum(obj);
742 return bignum_to_long_long(untag<bignum>(obj));
744 type_error(BIGNUM_TYPE,obj);
749 VM_C_API s64 to_signed_8(cell obj,factorvm *myvm)
752 return VM_PTR->to_signed_8(obj);
755 void factorvm::box_unsigned_8(u64 n)
757 if(n > (u64)fixnum_max)
758 dpush(tag<bignum>(ulong_long_to_bignum(n)));
760 dpush(tag_fixnum(n));
763 VM_C_API void box_unsigned_8(u64 n,factorvm *myvm)
766 return VM_PTR->box_unsigned_8(n);
769 u64 factorvm::to_unsigned_8(cell obj)
771 switch(tagged<object>(obj).type())
774 return untag_fixnum(obj);
776 return bignum_to_ulong_long(untag<bignum>(obj));
778 type_error(BIGNUM_TYPE,obj);
783 VM_C_API u64 to_unsigned_8(cell obj,factorvm *myvm)
786 return VM_PTR->to_unsigned_8(obj);
789 void factorvm::box_float(float flo)
791 dpush(allot_float(flo));
794 VM_C_API void box_float(float flo, factorvm *myvm)
797 return VM_PTR->box_float(flo);
800 float factorvm::to_float(cell value)
802 return untag_float_check(value);
805 VM_C_API float to_float(cell value,factorvm *myvm)
808 return VM_PTR->to_float(value);
811 void factorvm::box_double(double flo)
813 dpush(allot_float(flo));
816 VM_C_API void box_double(double flo,factorvm *myvm)
819 return VM_PTR->box_double(flo);
822 double factorvm::to_double(cell value)
824 return untag_float_check(value);
827 VM_C_API double to_double(cell value,factorvm *myvm)
830 return VM_PTR->to_double(value);
833 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
834 overflow, they call these functions. */
835 inline void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
837 drepl(tag<bignum>(fixnum_to_bignum(
838 untag_fixnum(x) + untag_fixnum(y))));
841 VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
843 PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
846 inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
848 drepl(tag<bignum>(fixnum_to_bignum(
849 untag_fixnum(x) - untag_fixnum(y))));
852 VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
854 PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
857 inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
859 bignum *bx = fixnum_to_bignum(x);
861 bignum *by = fixnum_to_bignum(y);
863 drepl(tag<bignum>(bignum_multiply(bx,by)));
866 VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
868 PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);