1 /* :tabSize=2:indentSize=2:noTabs=true:
3 Copyright (C) 1989-94 Massachusetts Institute of Technology
4 Portions copyright (C) 2004-2008 Slava Pestov
6 This material was developed by the Scheme project at the Massachusetts
7 Institute of Technology, Department of Electrical Engineering and
8 Computer Science. Permission to copy and modify this software, to
9 redistribute either the original software or a modified version, and
10 to use this software for any purpose is granted, subject to the
11 following restrictions and understandings.
13 1. Any copy made of this software must include this copyright notice
16 2. Users of this software agree to make their best efforts (a) to
17 return to the MIT Scheme project any improvements or extensions that
18 they make, so that these may be included in future releases; and (b)
19 to inform MIT of noteworthy uses of this software.
21 3. All materials developed as a consequence of the use of this
22 software shall duly acknowledge such use, in accordance with the usual
23 standards of acknowledging credit in academic research.
25 4. MIT has made no warrantee or representation that the operation of
26 this software will be error-free, and MIT is under no obligation to
27 provide any services, by way of maintenance, update, or otherwise.
29 5. In conjunction with products arising from the use of this material,
30 there shall be no use of the name of the Massachusetts Institute of
31 Technology nor of any adaptation thereof in any advertising,
32 promotional, or sales literature without prior written consent from
35 /* Changes for Scheme 48:
36 * - Converted to ANSI.
37 * - Added bitwise operations.
38 * - Added s48 to the beginning of all externally visible names.
39 * - Cached the bignum representations of -1, 0, and 1.
42 /* Changes for Factor:
43 * - Adapt bignumint.h for Factor memory manager
44 * - Add more bignum <-> C type conversions
45 * - Remove unused functions
46 * - Add local variable GC root recording
47 * - Remove s48 prefix from function names
48 * - Various fixes for Win64
64 int factorvm::bignum_equal_p(bignum * x, bignum * y)
69 : ((! (BIGNUM_ZERO_P (y)))
70 && ((BIGNUM_NEGATIVE_P (x))
71 ? (BIGNUM_NEGATIVE_P (y))
72 : (! (BIGNUM_NEGATIVE_P (y))))
73 && (bignum_equal_p_unsigned (x, y))));
76 enum bignum_comparison factorvm::bignum_compare(bignum * x, bignum * y)
80 ? ((BIGNUM_ZERO_P (y))
81 ? bignum_comparison_equal
82 : (BIGNUM_NEGATIVE_P (y))
83 ? bignum_comparison_greater
84 : bignum_comparison_less)
86 ? ((BIGNUM_NEGATIVE_P (x))
87 ? bignum_comparison_less
88 : bignum_comparison_greater)
89 : (BIGNUM_NEGATIVE_P (x))
90 ? ((BIGNUM_NEGATIVE_P (y))
91 ? (bignum_compare_unsigned (y, x))
92 : (bignum_comparison_less))
93 : ((BIGNUM_NEGATIVE_P (y))
94 ? (bignum_comparison_greater)
95 : (bignum_compare_unsigned (x, y))));
98 /* allocates memory */
99 bignum *factorvm::bignum_add(bignum * x, bignum * y)
104 : (BIGNUM_ZERO_P (y))
106 : ((BIGNUM_NEGATIVE_P (x))
107 ? ((BIGNUM_NEGATIVE_P (y))
108 ? (bignum_add_unsigned (x, y, 1))
109 : (bignum_subtract_unsigned (y, x)))
110 : ((BIGNUM_NEGATIVE_P (y))
111 ? (bignum_subtract_unsigned (x, y))
112 : (bignum_add_unsigned (x, y, 0)))));
115 /* allocates memory */
116 bignum *factorvm::bignum_subtract(bignum * x, bignum * y)
120 ? ((BIGNUM_ZERO_P (y))
122 : (bignum_new_sign (y, (! (BIGNUM_NEGATIVE_P (y))))))
123 : ((BIGNUM_ZERO_P (y))
125 : ((BIGNUM_NEGATIVE_P (x))
126 ? ((BIGNUM_NEGATIVE_P (y))
127 ? (bignum_subtract_unsigned (y, x))
128 : (bignum_add_unsigned (x, y, 1)))
129 : ((BIGNUM_NEGATIVE_P (y))
130 ? (bignum_add_unsigned (x, y, 0))
131 : (bignum_subtract_unsigned (x, y))))));
134 /* allocates memory */
135 bignum *factorvm::bignum_multiply(bignum * x, bignum * y)
137 bignum_length_type x_length = (BIGNUM_LENGTH (x));
138 bignum_length_type y_length = (BIGNUM_LENGTH (y));
140 ((BIGNUM_NEGATIVE_P (x))
141 ? (! (BIGNUM_NEGATIVE_P (y)))
142 : (BIGNUM_NEGATIVE_P (y)));
143 if (BIGNUM_ZERO_P (x))
145 if (BIGNUM_ZERO_P (y))
149 bignum_digit_type digit = (BIGNUM_REF (x, 0));
151 return (bignum_maybe_new_sign (y, negative_p));
152 if (digit < BIGNUM_RADIX_ROOT)
153 return (bignum_multiply_unsigned_small_factor (y, digit, negative_p));
157 bignum_digit_type digit = (BIGNUM_REF (y, 0));
159 return (bignum_maybe_new_sign (x, negative_p));
160 if (digit < BIGNUM_RADIX_ROOT)
161 return (bignum_multiply_unsigned_small_factor (x, digit, negative_p));
163 return (bignum_multiply_unsigned (x, y, negative_p));
166 /* allocates memory */
167 void factorvm::bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
169 if (BIGNUM_ZERO_P (denominator))
171 divide_by_zero_error();
174 if (BIGNUM_ZERO_P (numerator))
176 (*quotient) = numerator;
177 (*remainder) = numerator;
181 int r_negative_p = (BIGNUM_NEGATIVE_P (numerator));
183 ((BIGNUM_NEGATIVE_P (denominator)) ? (! r_negative_p) : r_negative_p);
184 switch (bignum_compare_unsigned (numerator, denominator))
186 case bignum_comparison_equal:
188 (*quotient) = (BIGNUM_ONE (q_negative_p));
189 (*remainder) = (BIGNUM_ZERO ());
192 case bignum_comparison_less:
194 (*quotient) = (BIGNUM_ZERO ());
195 (*remainder) = numerator;
198 case bignum_comparison_greater:
200 if ((BIGNUM_LENGTH (denominator)) == 1)
202 bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
206 (bignum_maybe_new_sign (numerator, q_negative_p));
207 (*remainder) = (BIGNUM_ZERO ());
210 else if (digit < BIGNUM_RADIX_ROOT)
212 bignum_divide_unsigned_small_denominator
215 q_negative_p, r_negative_p);
220 bignum_divide_unsigned_medium_denominator
223 q_negative_p, r_negative_p);
227 bignum_divide_unsigned_large_denominator
228 (numerator, denominator,
230 q_negative_p, r_negative_p);
237 /* allocates memory */
238 bignum *factorvm::bignum_quotient(bignum * numerator, bignum * denominator)
240 if (BIGNUM_ZERO_P (denominator))
242 divide_by_zero_error();
243 return (BIGNUM_OUT_OF_BAND);
245 if (BIGNUM_ZERO_P (numerator))
249 ((BIGNUM_NEGATIVE_P (denominator))
250 ? (! (BIGNUM_NEGATIVE_P (numerator)))
251 : (BIGNUM_NEGATIVE_P (numerator)));
252 switch (bignum_compare_unsigned (numerator, denominator))
254 case bignum_comparison_equal:
255 return (BIGNUM_ONE (q_negative_p));
256 case bignum_comparison_less:
257 return (BIGNUM_ZERO ());
258 case bignum_comparison_greater:
259 default: /* to appease gcc -Wall */
262 if ((BIGNUM_LENGTH (denominator)) == 1)
264 bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
266 return (bignum_maybe_new_sign (numerator, q_negative_p));
267 if (digit < BIGNUM_RADIX_ROOT)
268 bignum_divide_unsigned_small_denominator
270 ("ient), ((bignum * *) 0),
273 bignum_divide_unsigned_medium_denominator
275 ("ient), ((bignum * *) 0),
279 bignum_divide_unsigned_large_denominator
280 (numerator, denominator,
281 ("ient), ((bignum * *) 0),
289 /* allocates memory */
290 bignum *factorvm::bignum_remainder(bignum * numerator, bignum * denominator)
292 if (BIGNUM_ZERO_P (denominator))
294 divide_by_zero_error();
295 return (BIGNUM_OUT_OF_BAND);
297 if (BIGNUM_ZERO_P (numerator))
299 switch (bignum_compare_unsigned (numerator, denominator))
301 case bignum_comparison_equal:
302 return (BIGNUM_ZERO ());
303 case bignum_comparison_less:
305 case bignum_comparison_greater:
306 default: /* to appease gcc -Wall */
309 if ((BIGNUM_LENGTH (denominator)) == 1)
311 bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
313 return (BIGNUM_ZERO ());
314 if (digit < BIGNUM_RADIX_ROOT)
316 (bignum_remainder_unsigned_small_denominator
317 (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
318 bignum_divide_unsigned_medium_denominator
320 ((bignum * *) 0), (&remainder),
321 0, (BIGNUM_NEGATIVE_P (numerator)));
324 bignum_divide_unsigned_large_denominator
325 (numerator, denominator,
326 ((bignum * *) 0), (&remainder),
327 0, (BIGNUM_NEGATIVE_P (numerator)));
333 #define FOO_TO_BIGNUM(name,type,utype) \
334 bignum * factorvm::name##_to_bignum(type n) \
337 bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
338 bignum_digit_type * end_digits = result_digits; \
339 /* Special cases win when these small constants are cached. */ \
340 if (n == 0) return (BIGNUM_ZERO ()); \
341 if (n == 1) return (BIGNUM_ONE (0)); \
342 if (n < (type)0 && n == (type)-1) return (BIGNUM_ONE (1)); \
344 utype accumulator = ((negative_p = (n < (type)0)) ? (-n) : n); \
347 (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \
348 accumulator >>= BIGNUM_DIGIT_LENGTH; \
350 while (accumulator != 0); \
354 (allot_bignum ((end_digits - result_digits), negative_p)); \
355 bignum_digit_type * scan_digits = result_digits; \
356 bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
357 while (scan_digits < end_digits) \
358 (*scan_result++) = (*scan_digits++); \
363 /* all below allocate memory */
364 FOO_TO_BIGNUM(cell,cell,cell)
365 FOO_TO_BIGNUM(fixnum,fixnum,cell)
366 FOO_TO_BIGNUM(long_long,s64,u64)
367 FOO_TO_BIGNUM(ulong_long,u64,u64)
369 #define BIGNUM_TO_FOO(name,type,utype) \
370 type factorvm::bignum_to_##name(bignum * bignum) \
372 if (BIGNUM_ZERO_P (bignum)) \
375 utype accumulator = 0; \
376 bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \
377 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \
378 while (start < scan) \
379 accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \
380 return ((BIGNUM_NEGATIVE_P (bignum)) ? (-((type)accumulator)) : accumulator); \
384 /* all of the below allocate memory */
385 BIGNUM_TO_FOO(cell,cell,cell);
386 BIGNUM_TO_FOO(fixnum,fixnum,cell);
387 BIGNUM_TO_FOO(long_long,s64,u64)
388 BIGNUM_TO_FOO(ulong_long,u64,u64)
390 double factorvm::bignum_to_double(bignum * bignum)
392 if (BIGNUM_ZERO_P (bignum))
395 double accumulator = 0;
396 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
397 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
399 accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
400 return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
404 #define DTB_WRITE_DIGIT(factor) \
406 significand *= (factor); \
407 digit = ((bignum_digit_type) significand); \
409 significand -= ((double) digit); \
412 /* allocates memory */
413 #define inf std::numeric_limits<double>::infinity()
415 bignum *factorvm::double_to_bignum(double x)
417 if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
419 double significand = (frexp (x, (&exponent)));
420 if (exponent <= 0) return (BIGNUM_ZERO ());
421 if (exponent == 1) return (BIGNUM_ONE (x < 0));
422 if (significand < 0) significand = (-significand);
424 bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
425 bignum * result = (allot_bignum (length, (x < 0)));
426 bignum_digit_type * start = (BIGNUM_START_PTR (result));
427 bignum_digit_type * scan = (start + length);
428 bignum_digit_type digit;
429 int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
431 DTB_WRITE_DIGIT ((fixnum)1 << odd_bits);
434 if (significand == 0)
440 DTB_WRITE_DIGIT (BIGNUM_RADIX);
446 #undef DTB_WRITE_DIGIT
450 int factorvm::bignum_equal_p_unsigned(bignum * x, bignum * y)
452 bignum_length_type length = (BIGNUM_LENGTH (x));
453 if (length != (BIGNUM_LENGTH (y)))
457 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
458 bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
459 bignum_digit_type * end_x = (scan_x + length);
460 while (scan_x < end_x)
461 if ((*scan_x++) != (*scan_y++))
467 enum bignum_comparison factorvm::bignum_compare_unsigned(bignum * x, bignum * y)
469 bignum_length_type x_length = (BIGNUM_LENGTH (x));
470 bignum_length_type y_length = (BIGNUM_LENGTH (y));
471 if (x_length < y_length)
472 return (bignum_comparison_less);
473 if (x_length > y_length)
474 return (bignum_comparison_greater);
476 bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
477 bignum_digit_type * scan_x = (start_x + x_length);
478 bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
479 while (start_x < scan_x)
481 bignum_digit_type digit_x = (*--scan_x);
482 bignum_digit_type digit_y = (*--scan_y);
483 if (digit_x < digit_y)
484 return (bignum_comparison_less);
485 if (digit_x > digit_y)
486 return (bignum_comparison_greater);
489 return (bignum_comparison_equal);
494 /* allocates memory */
495 bignum *factorvm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
497 GC_BIGNUM(x,this); GC_BIGNUM(y,this);
499 if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
506 bignum_length_type x_length = (BIGNUM_LENGTH (x));
508 bignum * r = (allot_bignum ((x_length + 1), negative_p));
510 bignum_digit_type sum;
511 bignum_digit_type carry = 0;
512 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
513 bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
515 bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
516 bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
517 while (scan_y < end_y)
519 sum = ((*scan_x++) + (*scan_y++) + carry);
520 if (sum < BIGNUM_RADIX)
527 (*scan_r++) = (sum - BIGNUM_RADIX);
533 bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
535 while (scan_x < end_x)
537 sum = ((*scan_x++) + 1);
538 if (sum < BIGNUM_RADIX)
545 (*scan_r++) = (sum - BIGNUM_RADIX);
547 while (scan_x < end_x)
548 (*scan_r++) = (*scan_x++);
555 return (bignum_shorten_length (r, x_length));
561 /* allocates memory */
562 bignum *factorvm::bignum_subtract_unsigned(bignum * x, bignum * y)
564 GC_BIGNUM(x,this); GC_BIGNUM(y,this);
567 switch (bignum_compare_unsigned (x, y))
569 case bignum_comparison_equal:
570 return (BIGNUM_ZERO ());
571 case bignum_comparison_less:
579 case bignum_comparison_greater:
584 bignum_length_type x_length = (BIGNUM_LENGTH (x));
586 bignum * r = (allot_bignum (x_length, negative_p));
588 bignum_digit_type difference;
589 bignum_digit_type borrow = 0;
590 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
591 bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
593 bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
594 bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
595 while (scan_y < end_y)
597 difference = (((*scan_x++) - (*scan_y++)) - borrow);
600 (*scan_r++) = (difference + BIGNUM_RADIX);
605 (*scan_r++) = difference;
611 bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
613 while (scan_x < end_x)
615 difference = ((*scan_x++) - borrow);
617 (*scan_r++) = (difference + BIGNUM_RADIX);
620 (*scan_r++) = difference;
625 BIGNUM_ASSERT (borrow == 0);
626 while (scan_x < end_x)
627 (*scan_r++) = (*scan_x++);
629 return (bignum_trim (r));
634 Maximum value for product_low or product_high:
635 ((R * R) + (R * (R - 2)) + (R - 1))
636 Maximum value for carry: ((R * (R - 1)) + (R - 1))
637 where R == BIGNUM_RADIX_ROOT */
639 /* allocates memory */
640 bignum *factorvm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
642 GC_BIGNUM(x,this); GC_BIGNUM(y,this);
644 if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
651 bignum_digit_type carry;
652 bignum_digit_type y_digit_low;
653 bignum_digit_type y_digit_high;
654 bignum_digit_type x_digit_low;
655 bignum_digit_type x_digit_high;
656 bignum_digit_type product_low;
657 bignum_digit_type * scan_r;
658 bignum_digit_type * scan_y;
659 bignum_length_type x_length = (BIGNUM_LENGTH (x));
660 bignum_length_type y_length = (BIGNUM_LENGTH (y));
663 (allot_bignum_zeroed ((x_length + y_length), negative_p));
665 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
666 bignum_digit_type * end_x = (scan_x + x_length);
667 bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
668 bignum_digit_type * end_y = (start_y + y_length);
669 bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
670 #define x_digit x_digit_high
671 #define y_digit y_digit_high
672 #define product_high carry
673 while (scan_x < end_x)
675 x_digit = (*scan_x++);
676 x_digit_low = (HD_LOW (x_digit));
677 x_digit_high = (HD_HIGH (x_digit));
680 scan_r = (start_r++);
681 while (scan_y < end_y)
683 y_digit = (*scan_y++);
684 y_digit_low = (HD_LOW (y_digit));
685 y_digit_high = (HD_HIGH (y_digit));
688 (x_digit_low * y_digit_low) +
691 ((x_digit_high * y_digit_low) +
692 (x_digit_low * y_digit_high) +
693 (HD_HIGH (product_low)) +
696 (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
698 ((x_digit_high * y_digit_high) +
699 (HD_HIGH (product_high)));
703 return (bignum_trim (r));
710 /* allocates memory */
711 bignum *factorvm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p)
715 bignum_length_type length_x = (BIGNUM_LENGTH (x));
717 bignum * p = (allot_bignum ((length_x + 1), negative_p));
719 bignum_destructive_copy (x, p);
720 (BIGNUM_REF (p, length_x)) = 0;
721 bignum_destructive_scale_up (p, y);
722 return (bignum_trim (p));
725 void factorvm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
727 bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
728 bignum_digit_type digit;
729 digit = ((*scan) + n);
730 if (digit < BIGNUM_RADIX)
735 (*scan++) = (digit - BIGNUM_RADIX);
738 digit = ((*scan) + 1);
739 if (digit < BIGNUM_RADIX)
744 (*scan++) = (digit - BIGNUM_RADIX);
748 void factorvm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
750 bignum_digit_type carry = 0;
751 bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
752 bignum_digit_type two_digits;
753 bignum_digit_type product_low;
754 #define product_high carry
755 bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
756 BIGNUM_ASSERT ((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
759 two_digits = (*scan);
760 product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
762 ((factor * (HD_HIGH (two_digits))) +
763 (HD_HIGH (product_low)) +
765 (*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
766 carry = (HD_HIGH (product_high));
768 /* A carry here would be an overflow, i.e. it would not fit.
769 Hopefully the callers allocate enough space that this will
772 BIGNUM_ASSERT (carry == 0);
779 /* For help understanding this algorithm, see:
780 Knuth, Donald E., "The Art of Computer Programming",
781 volume 2, "Seminumerical Algorithms"
782 section 4.3.1, "Multiple-Precision Arithmetic". */
784 /* allocates memory */
785 void factorvm::bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
787 GC_BIGNUM(numerator,this); GC_BIGNUM(denominator,this);
789 bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
790 bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
793 ((quotient != ((bignum * *) 0))
794 ? (allot_bignum ((length_n - length_d), q_negative_p))
795 : BIGNUM_OUT_OF_BAND);
798 bignum * u = (allot_bignum (length_n, r_negative_p));
802 BIGNUM_ASSERT (length_d > 1);
804 bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
805 while (v1 < (BIGNUM_RADIX / 2))
813 bignum_destructive_copy (numerator, u);
814 (BIGNUM_REF (u, (length_n - 1))) = 0;
815 bignum_divide_unsigned_normalized (u, denominator, q);
819 bignum * v = (allot_bignum (length_d, 0));
821 bignum_destructive_normalization (numerator, u, shift);
822 bignum_destructive_normalization (denominator, v, shift);
823 bignum_divide_unsigned_normalized (u, v, q);
824 if (remainder != ((bignum * *) 0))
825 bignum_destructive_unnormalization (u, shift);
833 if (quotient != ((bignum * *) 0))
836 if (remainder != ((bignum * *) 0))
842 void factorvm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
844 bignum_length_type u_length = (BIGNUM_LENGTH (u));
845 bignum_length_type v_length = (BIGNUM_LENGTH (v));
846 bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
847 bignum_digit_type * u_scan = (u_start + u_length);
848 bignum_digit_type * u_scan_limit = (u_start + v_length);
849 bignum_digit_type * u_scan_start = (u_scan - v_length);
850 bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
851 bignum_digit_type * v_end = (v_start + v_length);
852 bignum_digit_type * q_scan = NULL;
853 bignum_digit_type v1 = (v_end[-1]);
854 bignum_digit_type v2 = (v_end[-2]);
855 bignum_digit_type ph; /* high half of double-digit product */
856 bignum_digit_type pl; /* low half of double-digit product */
857 bignum_digit_type guess;
858 bignum_digit_type gh; /* high half-digit of guess */
859 bignum_digit_type ch; /* high half of double-digit comparand */
860 bignum_digit_type v2l = (HD_LOW (v2));
861 bignum_digit_type v2h = (HD_HIGH (v2));
862 bignum_digit_type cl; /* low half of double-digit comparand */
863 #define gl ph /* low half-digit of guess */
866 bignum_digit_type gm; /* memory loc for reference parameter */
867 if (q != BIGNUM_OUT_OF_BAND)
868 q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
869 while (u_scan_limit < u_scan)
875 (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
876 guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
878 ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
884 ch = ((u_scan[-1]) + v1);
885 guess = (BIGNUM_RADIX - 1);
889 /* product = (guess * v2); */
890 gl = (HD_LOW (guess));
891 gh = (HD_HIGH (guess));
893 ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
894 pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
895 ph = ((v2h * gh) + (HD_HIGH (ph)));
896 /* if (comparand >= product) */
897 if ((ch > ph) || ((ch == ph) && (cl >= pl)))
900 /* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
902 /* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
903 if (ch >= BIGNUM_RADIX)
906 qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
907 if (q != BIGNUM_OUT_OF_BAND)
916 bignum_digit_type factorvm::bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
918 bignum_digit_type * v_scan = v_start;
919 bignum_digit_type * u_scan = u_start;
920 bignum_digit_type carry = 0;
921 if (guess == 0) return (0);
923 bignum_digit_type gl = (HD_LOW (guess));
924 bignum_digit_type gh = (HD_HIGH (guess));
926 bignum_digit_type pl;
927 bignum_digit_type vl;
931 while (v_scan < v_end)
936 pl = ((vl * gl) + (HD_LOW (carry)));
937 ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
938 diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
941 (*u_scan++) = (diff + BIGNUM_RADIX);
942 carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
947 carry = ((vh * gh) + (HD_HIGH (ph)));
952 diff = ((*u_scan) - carry);
954 (*u_scan) = (diff + BIGNUM_RADIX);
964 /* Subtraction generated carry, implying guess is one too large.
965 Add v back in to bring it back down. */
969 while (v_scan < v_end)
971 bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
972 if (sum < BIGNUM_RADIX)
979 (*u_scan++) = (sum - BIGNUM_RADIX);
985 bignum_digit_type sum = ((*u_scan) + carry);
986 (*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
991 /* allocates memory */
992 void factorvm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
994 GC_BIGNUM(numerator,this);
996 bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
997 bignum_length_type length_q;
1002 /* Because `bignum_digit_divide' requires a normalized denominator. */
1003 while (denominator < (BIGNUM_RADIX / 2))
1010 length_q = length_n;
1012 q = (allot_bignum (length_q, q_negative_p));
1013 bignum_destructive_copy (numerator, q);
1017 length_q = (length_n + 1);
1019 q = (allot_bignum (length_q, q_negative_p));
1020 bignum_destructive_normalization (numerator, q, shift);
1023 bignum_digit_type r = 0;
1024 bignum_digit_type * start = (BIGNUM_START_PTR (q));
1025 bignum_digit_type * scan = (start + length_q);
1026 bignum_digit_type qj;
1028 while (start < scan)
1030 r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
1034 q = bignum_trim (q);
1036 if (remainder != ((bignum * *) 0))
1041 (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
1044 if (quotient != ((bignum * *) 0))
1050 void factorvm::bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
1052 bignum_digit_type digit;
1053 bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
1054 bignum_digit_type carry = 0;
1055 bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
1056 bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
1057 bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
1058 int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
1059 bignum_digit_type mask = (((cell)1 << shift_right) - 1);
1060 while (scan_source < end_source)
1062 digit = (*scan_source++);
1063 (*scan_target++) = (((digit & mask) << shift_left) | carry);
1064 carry = (digit >> shift_right);
1066 if (scan_target < end_target)
1067 (*scan_target) = carry;
1069 BIGNUM_ASSERT (carry == 0);
1073 void factorvm::bignum_destructive_unnormalization(bignum * bignum, int shift_right)
1075 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
1076 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
1077 bignum_digit_type digit;
1078 bignum_digit_type carry = 0;
1079 int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
1080 bignum_digit_type mask = (((fixnum)1 << shift_right) - 1);
1081 while (start < scan)
1084 (*scan) = ((digit >> shift_right) | carry);
1085 carry = ((digit & mask) << shift_left);
1087 BIGNUM_ASSERT (carry == 0);
1091 /* This is a reduced version of the division algorithm, applied to the
1092 case of dividing two bignum digits by one bignum digit. It is
1093 assumed that the numerator, denominator are normalized. */
1095 #define BDD_STEP(qn, j) \
1100 uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \
1101 guess = (uj_uj1 / v1); \
1102 comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \
1106 guess = (BIGNUM_RADIX_ROOT - 1); \
1107 comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \
1109 while ((guess * v2) > comparand) \
1112 comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \
1113 if (comparand >= BIGNUM_RADIX) \
1116 qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \
1119 bignum_digit_type factorvm::bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, bignum_digit_type v, bignum_digit_type * q) /* return value */
1121 bignum_digit_type guess;
1122 bignum_digit_type comparand;
1123 bignum_digit_type v1 = (HD_HIGH (v));
1124 bignum_digit_type v2 = (HD_LOW (v));
1125 bignum_digit_type uj;
1126 bignum_digit_type uj_uj1;
1127 bignum_digit_type q1;
1128 bignum_digit_type q2;
1129 bignum_digit_type u [4];
1143 (u[0]) = (HD_HIGH (uh));
1144 (u[1]) = (HD_LOW (uh));
1145 (u[2]) = (HD_HIGH (ul));
1146 (u[3]) = (HD_LOW (ul));
1151 (*q) = (HD_CONS (q1, q2));
1152 return (HD_CONS ((u[2]), (u[3])));
1157 #define BDDS_MULSUB(vn, un, carry_in) \
1159 product = ((vn * guess) + carry_in); \
1160 diff = (un - (HD_LOW (product))); \
1163 un = (diff + BIGNUM_RADIX_ROOT); \
1164 carry = ((HD_HIGH (product)) + 1); \
1169 carry = (HD_HIGH (product)); \
1173 #define BDDS_ADD(vn, un, carry_in) \
1175 sum = (vn + un + carry_in); \
1176 if (sum < BIGNUM_RADIX_ROOT) \
1183 un = (sum - BIGNUM_RADIX_ROOT); \
1188 bignum_digit_type factorvm::bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
1191 bignum_digit_type product;
1192 bignum_digit_type diff;
1193 bignum_digit_type carry;
1194 BDDS_MULSUB (v2, (u[2]), 0);
1195 BDDS_MULSUB (v1, (u[1]), carry);
1198 diff = ((u[0]) - carry);
1200 (u[0]) = (diff + BIGNUM_RADIX);
1208 bignum_digit_type sum;
1209 bignum_digit_type carry;
1210 BDDS_ADD(v2, (u[2]), 0);
1211 BDDS_ADD(v1, (u[1]), carry);
1221 /* allocates memory */
1222 void factorvm::bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
1224 GC_BIGNUM(numerator,this);
1226 bignum * q = (bignum_new_sign (numerator, q_negative_p));
1229 bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
1231 q = (bignum_trim (q));
1233 if (remainder != ((bignum * *) 0))
1234 (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
1241 /* Given (denominator > 1), it is fairly easy to show that
1242 (quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
1243 that all digits are < BIGNUM_RADIX. */
1245 bignum_digit_type factorvm::bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
1247 bignum_digit_type numerator;
1248 bignum_digit_type remainder = 0;
1249 bignum_digit_type two_digits;
1250 #define quotient_high remainder
1251 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
1252 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
1253 BIGNUM_ASSERT ((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
1254 while (start < scan)
1256 two_digits = (*--scan);
1257 numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
1258 quotient_high = (numerator / denominator);
1259 numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
1260 (*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
1261 remainder = (numerator % denominator);
1264 #undef quotient_high
1267 /* allocates memory */
1268 bignum * factorvm::bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
1270 bignum_digit_type two_digits;
1271 bignum_digit_type * start = (BIGNUM_START_PTR (n));
1272 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
1273 bignum_digit_type r = 0;
1274 BIGNUM_ASSERT ((d > 1) && (d < BIGNUM_RADIX_ROOT));
1275 while (start < scan)
1277 two_digits = (*--scan);
1279 ((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
1280 (HD_LOW (two_digits))))
1283 return (bignum_digit_to_bignum (r, negative_p));
1286 /* allocates memory */
1287 bignum *factorvm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
1290 return (BIGNUM_ZERO ());
1293 bignum * result = (allot_bignum (1, negative_p));
1294 (BIGNUM_REF (result, 0)) = digit;
1299 /* allocates memory */
1300 bignum *factorvm::allot_bignum(bignum_length_type length, int negative_p)
1302 BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
1303 bignum * result = allot_array_internal<bignum>(length + 1);
1304 BIGNUM_SET_NEGATIVE_P (result, negative_p);
1308 /* allocates memory */
1309 bignum * factorvm::allot_bignum_zeroed(bignum_length_type length, int negative_p)
1311 bignum * result = allot_bignum(length,negative_p);
1312 bignum_digit_type * scan = (BIGNUM_START_PTR (result));
1313 bignum_digit_type * end = (scan + length);
1319 #define BIGNUM_REDUCE_LENGTH(source, length) \
1320 source = reallot_array(source,length + 1)
1322 /* allocates memory */
1323 bignum *factorvm::bignum_shorten_length(bignum * bignum, bignum_length_type length)
1325 bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
1326 BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
1327 if (length < current_length)
1329 BIGNUM_REDUCE_LENGTH (bignum, length);
1330 BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
1335 /* allocates memory */
1336 bignum *factorvm::bignum_trim(bignum * bignum)
1338 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
1339 bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
1340 bignum_digit_type * scan = end;
1341 while ((start <= scan) && ((*--scan) == 0))
1346 bignum_length_type length = (scan - start);
1347 BIGNUM_REDUCE_LENGTH (bignum, length);
1348 BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
1355 /* allocates memory */
1356 bignum *factorvm::bignum_new_sign(bignum * x, int negative_p)
1359 bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
1361 bignum_destructive_copy (x, result);
1365 /* allocates memory */
1366 bignum *factorvm::bignum_maybe_new_sign(bignum * x, int negative_p)
1368 if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
1373 (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
1374 bignum_destructive_copy (x, result);
1379 void factorvm::bignum_destructive_copy(bignum * source, bignum * target)
1381 bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
1382 bignum_digit_type * end_source =
1383 (scan_source + (BIGNUM_LENGTH (source)));
1384 bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
1385 while (scan_source < end_source)
1386 (*scan_target++) = (*scan_source++);
1391 * Added bitwise operations (and oddp).
1394 /* allocates memory */
1395 bignum *factorvm::bignum_bitwise_not(bignum * x)
1397 return bignum_subtract(BIGNUM_ONE(1), x);
1400 /* allocates memory */
1401 bignum *factorvm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
1403 if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
1404 return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
1406 return bignum_magnitude_ash(arg1, n);
1413 /* allocates memory */
1414 bignum *factorvm::bignum_bitwise_and(bignum * arg1, bignum * arg2)
1417 (BIGNUM_NEGATIVE_P (arg1))
1418 ? (BIGNUM_NEGATIVE_P (arg2))
1419 ? bignum_negneg_bitwise_op(AND_OP, arg1, arg2)
1420 : bignum_posneg_bitwise_op(AND_OP, arg2, arg1)
1421 : (BIGNUM_NEGATIVE_P (arg2))
1422 ? bignum_posneg_bitwise_op(AND_OP, arg1, arg2)
1423 : bignum_pospos_bitwise_op(AND_OP, arg1, arg2)
1427 /* allocates memory */
1428 bignum *factorvm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
1431 (BIGNUM_NEGATIVE_P (arg1))
1432 ? (BIGNUM_NEGATIVE_P (arg2))
1433 ? bignum_negneg_bitwise_op(IOR_OP, arg1, arg2)
1434 : bignum_posneg_bitwise_op(IOR_OP, arg2, arg1)
1435 : (BIGNUM_NEGATIVE_P (arg2))
1436 ? bignum_posneg_bitwise_op(IOR_OP, arg1, arg2)
1437 : bignum_pospos_bitwise_op(IOR_OP, arg1, arg2)
1441 /* allocates memory */
1442 bignum *factorvm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
1445 (BIGNUM_NEGATIVE_P (arg1))
1446 ? (BIGNUM_NEGATIVE_P (arg2))
1447 ? bignum_negneg_bitwise_op(XOR_OP, arg1, arg2)
1448 : bignum_posneg_bitwise_op(XOR_OP, arg2, arg1)
1449 : (BIGNUM_NEGATIVE_P (arg2))
1450 ? bignum_posneg_bitwise_op(XOR_OP, arg1, arg2)
1451 : bignum_pospos_bitwise_op(XOR_OP, arg1, arg2)
1455 /* allocates memory */
1456 /* ash for the magnitude */
1457 /* assume arg1 is a big number, n is a long */
1458 bignum *factorvm::bignum_magnitude_ash(bignum * arg1, fixnum n)
1460 GC_BIGNUM(arg1,this);
1462 bignum * result = NULL;
1463 bignum_digit_type *scan1;
1464 bignum_digit_type *scanr;
1465 bignum_digit_type *end;
1467 fixnum digit_offset,bit_offset;
1469 if (BIGNUM_ZERO_P (arg1)) return (arg1);
1472 digit_offset = n / BIGNUM_DIGIT_LENGTH;
1473 bit_offset = n % BIGNUM_DIGIT_LENGTH;
1475 result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
1476 BIGNUM_NEGATIVE_P(arg1));
1478 scanr = BIGNUM_START_PTR (result) + digit_offset;
1479 scan1 = BIGNUM_START_PTR (arg1);
1480 end = scan1 + BIGNUM_LENGTH (arg1);
1482 while (scan1 < end) {
1483 *scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
1484 *scanr = *scanr & BIGNUM_DIGIT_MASK;
1486 *scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
1487 *scanr = *scanr & BIGNUM_DIGIT_MASK;
1491 && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
1492 result = BIGNUM_ZERO ();
1495 digit_offset = -n / BIGNUM_DIGIT_LENGTH;
1496 bit_offset = -n % BIGNUM_DIGIT_LENGTH;
1498 result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
1499 BIGNUM_NEGATIVE_P(arg1));
1501 scanr = BIGNUM_START_PTR (result);
1502 scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
1503 end = scanr + BIGNUM_LENGTH (result) - 1;
1505 while (scanr < end) {
1506 *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
1508 *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
1511 *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
1513 else if (n == 0) result = arg1;
1515 return (bignum_trim (result));
1518 /* allocates memory */
1519 bignum *factorvm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
1521 GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
1524 bignum_length_type max_length;
1526 bignum_digit_type *scan1, *end1, digit1;
1527 bignum_digit_type *scan2, *end2, digit2;
1528 bignum_digit_type *scanr, *endr;
1530 max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
1531 ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
1533 result = allot_bignum(max_length, 0);
1535 scanr = BIGNUM_START_PTR(result);
1536 scan1 = BIGNUM_START_PTR(arg1);
1537 scan2 = BIGNUM_START_PTR(arg2);
1538 endr = scanr + max_length;
1539 end1 = scan1 + BIGNUM_LENGTH(arg1);
1540 end2 = scan2 + BIGNUM_LENGTH(arg2);
1542 while (scanr < endr) {
1543 digit1 = (scan1 < end1) ? *scan1++ : 0;
1544 digit2 = (scan2 < end2) ? *scan2++ : 0;
1545 *scanr++ = (op == AND_OP) ? digit1 & digit2 :
1546 (op == IOR_OP) ? digit1 | digit2 :
1549 return bignum_trim(result);
1552 /* allocates memory */
1553 bignum *factorvm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
1555 GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
1558 bignum_length_type max_length;
1560 bignum_digit_type *scan1, *end1, digit1;
1561 bignum_digit_type *scan2, *end2, digit2, carry2;
1562 bignum_digit_type *scanr, *endr;
1564 char neg_p = op == IOR_OP || op == XOR_OP;
1566 max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
1567 ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
1569 result = allot_bignum(max_length, neg_p);
1571 scanr = BIGNUM_START_PTR(result);
1572 scan1 = BIGNUM_START_PTR(arg1);
1573 scan2 = BIGNUM_START_PTR(arg2);
1574 endr = scanr + max_length;
1575 end1 = scan1 + BIGNUM_LENGTH(arg1);
1576 end2 = scan2 + BIGNUM_LENGTH(arg2);
1580 while (scanr < endr) {
1581 digit1 = (scan1 < end1) ? *scan1++ : 0;
1582 digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
1585 if (digit2 < BIGNUM_RADIX)
1589 digit2 = (digit2 - BIGNUM_RADIX);
1593 *scanr++ = (op == AND_OP) ? digit1 & digit2 :
1594 (op == IOR_OP) ? digit1 | digit2 :
1599 bignum_negate_magnitude(result);
1601 return bignum_trim(result);
1604 /* allocates memory */
1605 bignum *factorvm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
1607 GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
1610 bignum_length_type max_length;
1612 bignum_digit_type *scan1, *end1, digit1, carry1;
1613 bignum_digit_type *scan2, *end2, digit2, carry2;
1614 bignum_digit_type *scanr, *endr;
1616 char neg_p = op == AND_OP || op == IOR_OP;
1618 max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
1619 ? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
1621 result = allot_bignum(max_length, neg_p);
1623 scanr = BIGNUM_START_PTR(result);
1624 scan1 = BIGNUM_START_PTR(arg1);
1625 scan2 = BIGNUM_START_PTR(arg2);
1626 endr = scanr + max_length;
1627 end1 = scan1 + BIGNUM_LENGTH(arg1);
1628 end2 = scan2 + BIGNUM_LENGTH(arg2);
1633 while (scanr < endr) {
1634 digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
1635 digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
1637 if (digit1 < BIGNUM_RADIX)
1641 digit1 = (digit1 - BIGNUM_RADIX);
1645 if (digit2 < BIGNUM_RADIX)
1649 digit2 = (digit2 - BIGNUM_RADIX);
1653 *scanr++ = (op == AND_OP) ? digit1 & digit2 :
1654 (op == IOR_OP) ? digit1 | digit2 :
1659 bignum_negate_magnitude(result);
1661 return bignum_trim(result);
1664 void factorvm::bignum_negate_magnitude(bignum * arg)
1666 bignum_digit_type *scan;
1667 bignum_digit_type *end;
1668 bignum_digit_type digit;
1669 bignum_digit_type carry;
1671 scan = BIGNUM_START_PTR(arg);
1672 end = scan + BIGNUM_LENGTH(arg);
1676 while (scan < end) {
1677 digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
1679 if (digit < BIGNUM_RADIX)
1683 digit = (digit - BIGNUM_RADIX);
1691 /* Allocates memory */
1692 bignum *factorvm::bignum_integer_length(bignum * x)
1696 bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
1697 bignum_digit_type digit = (BIGNUM_REF (x, index));
1699 bignum * result = (allot_bignum (2, 0));
1701 (BIGNUM_REF (result, 0)) = index;
1702 (BIGNUM_REF (result, 1)) = 0;
1703 bignum_destructive_scale_up (result, BIGNUM_DIGIT_LENGTH);
1706 bignum_destructive_add (result, ((bignum_digit_type) 1));
1709 return (bignum_trim (result));
1712 /* Allocates memory */
1713 int factorvm::bignum_logbitp(int shift, bignum * arg)
1715 return((BIGNUM_NEGATIVE_P (arg))
1716 ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
1717 : bignum_unsigned_logbitp (shift,arg));
1720 int factorvm::bignum_unsigned_logbitp(int shift, bignum * bignum)
1722 bignum_length_type len = (BIGNUM_LENGTH (bignum));
1723 int index = shift / BIGNUM_DIGIT_LENGTH;
1726 bignum_digit_type digit = (BIGNUM_REF (bignum, index));
1727 int p = shift % BIGNUM_DIGIT_LENGTH;
1728 bignum_digit_type mask = ((fixnum)1) << p;
1729 return (digit & mask) ? 1 : 0;
1732 /* Allocates memory */
1733 bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm*), unsigned int radix, int negative_p)
1735 BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
1737 return (BIGNUM_ZERO ());
1740 fixnum digit = ((fixnum) ((*producer) (0,this)));
1741 return (fixnum_to_bignum (negative_p ? (- digit) : digit));
1744 bignum_length_type length;
1746 unsigned int radix_copy = radix;
1747 unsigned int log_radix = 0;
1748 while (radix_copy > 0)
1753 /* This length will be at least as large as needed. */
1754 length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
1757 bignum * result = (allot_bignum_zeroed (length, negative_p));
1758 while ((n_digits--) > 0)
1760 bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
1761 bignum_destructive_add
1762 (result, ((bignum_digit_type) ((*producer) (n_digits,this))));
1764 return (bignum_trim (result));