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))));
77 enum bignum_comparison factorvm::bignum_compare(bignum * x, bignum * y)
81 ? ((BIGNUM_ZERO_P (y))
82 ? bignum_comparison_equal
83 : (BIGNUM_NEGATIVE_P (y))
84 ? bignum_comparison_greater
85 : bignum_comparison_less)
87 ? ((BIGNUM_NEGATIVE_P (x))
88 ? bignum_comparison_less
89 : bignum_comparison_greater)
90 : (BIGNUM_NEGATIVE_P (x))
91 ? ((BIGNUM_NEGATIVE_P (y))
92 ? (bignum_compare_unsigned (y, x))
93 : (bignum_comparison_less))
94 : ((BIGNUM_NEGATIVE_P (y))
95 ? (bignum_comparison_greater)
96 : (bignum_compare_unsigned (x, y))));
100 /* allocates memory */
101 bignum *factorvm::bignum_add(bignum * x, bignum * y)
106 : (BIGNUM_ZERO_P (y))
108 : ((BIGNUM_NEGATIVE_P (x))
109 ? ((BIGNUM_NEGATIVE_P (y))
110 ? (bignum_add_unsigned (x, y, 1))
111 : (bignum_subtract_unsigned (y, x)))
112 : ((BIGNUM_NEGATIVE_P (y))
113 ? (bignum_subtract_unsigned (x, y))
114 : (bignum_add_unsigned (x, y, 0)))));
117 /* allocates memory */
118 bignum *factorvm::bignum_subtract(bignum * x, bignum * y)
122 ? ((BIGNUM_ZERO_P (y))
124 : (bignum_new_sign (y, (! (BIGNUM_NEGATIVE_P (y))))))
125 : ((BIGNUM_ZERO_P (y))
127 : ((BIGNUM_NEGATIVE_P (x))
128 ? ((BIGNUM_NEGATIVE_P (y))
129 ? (bignum_subtract_unsigned (y, x))
130 : (bignum_add_unsigned (x, y, 1)))
131 : ((BIGNUM_NEGATIVE_P (y))
132 ? (bignum_add_unsigned (x, y, 0))
133 : (bignum_subtract_unsigned (x, y))))));
137 /* allocates memory */
138 bignum *factorvm::bignum_multiply(bignum * x, bignum * y)
140 bignum_length_type x_length = (BIGNUM_LENGTH (x));
141 bignum_length_type y_length = (BIGNUM_LENGTH (y));
143 ((BIGNUM_NEGATIVE_P (x))
144 ? (! (BIGNUM_NEGATIVE_P (y)))
145 : (BIGNUM_NEGATIVE_P (y)));
146 if (BIGNUM_ZERO_P (x))
148 if (BIGNUM_ZERO_P (y))
152 bignum_digit_type digit = (BIGNUM_REF (x, 0));
154 return (bignum_maybe_new_sign (y, negative_p));
155 if (digit < BIGNUM_RADIX_ROOT)
156 return (bignum_multiply_unsigned_small_factor (y, digit, negative_p));
160 bignum_digit_type digit = (BIGNUM_REF (y, 0));
162 return (bignum_maybe_new_sign (x, negative_p));
163 if (digit < BIGNUM_RADIX_ROOT)
164 return (bignum_multiply_unsigned_small_factor (x, digit, negative_p));
166 return (bignum_multiply_unsigned (x, y, negative_p));
170 /* allocates memory */
171 void factorvm::bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
173 if (BIGNUM_ZERO_P (denominator))
175 divide_by_zero_error();
178 if (BIGNUM_ZERO_P (numerator))
180 (*quotient) = numerator;
181 (*remainder) = numerator;
185 int r_negative_p = (BIGNUM_NEGATIVE_P (numerator));
187 ((BIGNUM_NEGATIVE_P (denominator)) ? (! r_negative_p) : r_negative_p);
188 switch (bignum_compare_unsigned (numerator, denominator))
190 case bignum_comparison_equal:
192 (*quotient) = (BIGNUM_ONE (q_negative_p));
193 (*remainder) = (BIGNUM_ZERO ());
196 case bignum_comparison_less:
198 (*quotient) = (BIGNUM_ZERO ());
199 (*remainder) = numerator;
202 case bignum_comparison_greater:
204 if ((BIGNUM_LENGTH (denominator)) == 1)
206 bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
210 (bignum_maybe_new_sign (numerator, q_negative_p));
211 (*remainder) = (BIGNUM_ZERO ());
214 else if (digit < BIGNUM_RADIX_ROOT)
216 bignum_divide_unsigned_small_denominator
219 q_negative_p, r_negative_p);
224 bignum_divide_unsigned_medium_denominator
227 q_negative_p, r_negative_p);
231 bignum_divide_unsigned_large_denominator
232 (numerator, denominator,
234 q_negative_p, r_negative_p);
242 /* allocates memory */
243 bignum *factorvm::bignum_quotient(bignum * numerator, bignum * denominator)
245 if (BIGNUM_ZERO_P (denominator))
247 divide_by_zero_error();
248 return (BIGNUM_OUT_OF_BAND);
250 if (BIGNUM_ZERO_P (numerator))
254 ((BIGNUM_NEGATIVE_P (denominator))
255 ? (! (BIGNUM_NEGATIVE_P (numerator)))
256 : (BIGNUM_NEGATIVE_P (numerator)));
257 switch (bignum_compare_unsigned (numerator, denominator))
259 case bignum_comparison_equal:
260 return (BIGNUM_ONE (q_negative_p));
261 case bignum_comparison_less:
262 return (BIGNUM_ZERO ());
263 case bignum_comparison_greater:
264 default: /* to appease gcc -Wall */
267 if ((BIGNUM_LENGTH (denominator)) == 1)
269 bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
271 return (bignum_maybe_new_sign (numerator, q_negative_p));
272 if (digit < BIGNUM_RADIX_ROOT)
273 bignum_divide_unsigned_small_denominator
275 ("ient), ((bignum * *) 0),
278 bignum_divide_unsigned_medium_denominator
280 ("ient), ((bignum * *) 0),
284 bignum_divide_unsigned_large_denominator
285 (numerator, denominator,
286 ("ient), ((bignum * *) 0),
295 /* allocates memory */
296 bignum *factorvm::bignum_remainder(bignum * numerator, bignum * denominator)
298 if (BIGNUM_ZERO_P (denominator))
300 divide_by_zero_error();
301 return (BIGNUM_OUT_OF_BAND);
303 if (BIGNUM_ZERO_P (numerator))
305 switch (bignum_compare_unsigned (numerator, denominator))
307 case bignum_comparison_equal:
308 return (BIGNUM_ZERO ());
309 case bignum_comparison_less:
311 case bignum_comparison_greater:
312 default: /* to appease gcc -Wall */
315 if ((BIGNUM_LENGTH (denominator)) == 1)
317 bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
319 return (BIGNUM_ZERO ());
320 if (digit < BIGNUM_RADIX_ROOT)
322 (bignum_remainder_unsigned_small_denominator
323 (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
324 bignum_divide_unsigned_medium_denominator
326 ((bignum * *) 0), (&remainder),
327 0, (BIGNUM_NEGATIVE_P (numerator)));
330 bignum_divide_unsigned_large_denominator
331 (numerator, denominator,
332 ((bignum * *) 0), (&remainder),
333 0, (BIGNUM_NEGATIVE_P (numerator)));
340 #define FOO_TO_BIGNUM(name,type,utype) \
341 bignum * factorvm::name##_to_bignum(type n) \
344 bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
345 bignum_digit_type * end_digits = result_digits; \
346 /* Special cases win when these small constants are cached. */ \
347 if (n == 0) return (BIGNUM_ZERO ()); \
348 if (n == 1) return (BIGNUM_ONE (0)); \
349 if (n < (type)0 && n == (type)-1) return (BIGNUM_ONE (1)); \
351 utype accumulator = ((negative_p = (n < (type)0)) ? (-n) : n); \
354 (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \
355 accumulator >>= BIGNUM_DIGIT_LENGTH; \
357 while (accumulator != 0); \
361 (allot_bignum ((end_digits - result_digits), negative_p)); \
362 bignum_digit_type * scan_digits = result_digits; \
363 bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
364 while (scan_digits < end_digits) \
365 (*scan_result++) = (*scan_digits++); \
370 /* all below allocate memory */
371 FOO_TO_BIGNUM(cell,cell,cell)
372 FOO_TO_BIGNUM(fixnum,fixnum,cell)
373 FOO_TO_BIGNUM(long_long,s64,u64)
374 FOO_TO_BIGNUM(ulong_long,u64,u64)
376 #define BIGNUM_TO_FOO(name,type,utype) \
377 type factorvm::bignum_to_##name(bignum * bignum) \
379 if (BIGNUM_ZERO_P (bignum)) \
382 utype accumulator = 0; \
383 bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \
384 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \
385 while (start < scan) \
386 accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \
387 return ((BIGNUM_NEGATIVE_P (bignum)) ? (-((type)accumulator)) : accumulator); \
391 /* all of the below allocate memory */
392 BIGNUM_TO_FOO(cell,cell,cell);
393 BIGNUM_TO_FOO(fixnum,fixnum,cell);
394 BIGNUM_TO_FOO(long_long,s64,u64)
395 BIGNUM_TO_FOO(ulong_long,u64,u64)
397 double factorvm::bignum_to_double(bignum * bignum)
399 if (BIGNUM_ZERO_P (bignum))
402 double accumulator = 0;
403 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
404 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
406 accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
407 return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
412 #define DTB_WRITE_DIGIT(factor) \
414 significand *= (factor); \
415 digit = ((bignum_digit_type) significand); \
417 significand -= ((double) digit); \
420 /* allocates memory */
421 #define inf std::numeric_limits<double>::infinity()
423 bignum *factorvm::double_to_bignum(double x)
425 if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
427 double significand = (frexp (x, (&exponent)));
428 if (exponent <= 0) return (BIGNUM_ZERO ());
429 if (exponent == 1) return (BIGNUM_ONE (x < 0));
430 if (significand < 0) significand = (-significand);
432 bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
433 bignum * result = (allot_bignum (length, (x < 0)));
434 bignum_digit_type * start = (BIGNUM_START_PTR (result));
435 bignum_digit_type * scan = (start + length);
436 bignum_digit_type digit;
437 int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
439 DTB_WRITE_DIGIT ((fixnum)1 << odd_bits);
442 if (significand == 0)
448 DTB_WRITE_DIGIT (BIGNUM_RADIX);
455 #undef DTB_WRITE_DIGIT
459 int factorvm::bignum_equal_p_unsigned(bignum * x, bignum * y)
461 bignum_length_type length = (BIGNUM_LENGTH (x));
462 if (length != (BIGNUM_LENGTH (y)))
466 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
467 bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
468 bignum_digit_type * end_x = (scan_x + length);
469 while (scan_x < end_x)
470 if ((*scan_x++) != (*scan_y++))
477 enum bignum_comparison factorvm::bignum_compare_unsigned(bignum * x, bignum * y)
479 bignum_length_type x_length = (BIGNUM_LENGTH (x));
480 bignum_length_type y_length = (BIGNUM_LENGTH (y));
481 if (x_length < y_length)
482 return (bignum_comparison_less);
483 if (x_length > y_length)
484 return (bignum_comparison_greater);
486 bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
487 bignum_digit_type * scan_x = (start_x + x_length);
488 bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
489 while (start_x < scan_x)
491 bignum_digit_type digit_x = (*--scan_x);
492 bignum_digit_type digit_y = (*--scan_y);
493 if (digit_x < digit_y)
494 return (bignum_comparison_less);
495 if (digit_x > digit_y)
496 return (bignum_comparison_greater);
499 return (bignum_comparison_equal);
505 /* allocates memory */
506 bignum *factorvm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
508 GC_BIGNUM(x,this); GC_BIGNUM(y,this);
510 if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
517 bignum_length_type x_length = (BIGNUM_LENGTH (x));
519 bignum * r = (allot_bignum ((x_length + 1), negative_p));
521 bignum_digit_type sum;
522 bignum_digit_type carry = 0;
523 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
524 bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
526 bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
527 bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
528 while (scan_y < end_y)
530 sum = ((*scan_x++) + (*scan_y++) + carry);
531 if (sum < BIGNUM_RADIX)
538 (*scan_r++) = (sum - BIGNUM_RADIX);
544 bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
546 while (scan_x < end_x)
548 sum = ((*scan_x++) + 1);
549 if (sum < BIGNUM_RADIX)
556 (*scan_r++) = (sum - BIGNUM_RADIX);
558 while (scan_x < end_x)
559 (*scan_r++) = (*scan_x++);
566 return (bignum_shorten_length (r, x_length));
573 /* allocates memory */
574 bignum *factorvm::bignum_subtract_unsigned(bignum * x, bignum * y)
576 GC_BIGNUM(x,this); GC_BIGNUM(y,this);
579 switch (bignum_compare_unsigned (x, y))
581 case bignum_comparison_equal:
582 return (BIGNUM_ZERO ());
583 case bignum_comparison_less:
591 case bignum_comparison_greater:
596 bignum_length_type x_length = (BIGNUM_LENGTH (x));
598 bignum * r = (allot_bignum (x_length, negative_p));
600 bignum_digit_type difference;
601 bignum_digit_type borrow = 0;
602 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
603 bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
605 bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
606 bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
607 while (scan_y < end_y)
609 difference = (((*scan_x++) - (*scan_y++)) - borrow);
612 (*scan_r++) = (difference + BIGNUM_RADIX);
617 (*scan_r++) = difference;
623 bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
625 while (scan_x < end_x)
627 difference = ((*scan_x++) - borrow);
629 (*scan_r++) = (difference + BIGNUM_RADIX);
632 (*scan_r++) = difference;
637 BIGNUM_ASSERT (borrow == 0);
638 while (scan_x < end_x)
639 (*scan_r++) = (*scan_x++);
641 return (bignum_trim (r));
647 Maximum value for product_low or product_high:
648 ((R * R) + (R * (R - 2)) + (R - 1))
649 Maximum value for carry: ((R * (R - 1)) + (R - 1))
650 where R == BIGNUM_RADIX_ROOT */
652 /* allocates memory */
653 bignum *factorvm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
655 GC_BIGNUM(x,this); GC_BIGNUM(y,this);
657 if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
664 bignum_digit_type carry;
665 bignum_digit_type y_digit_low;
666 bignum_digit_type y_digit_high;
667 bignum_digit_type x_digit_low;
668 bignum_digit_type x_digit_high;
669 bignum_digit_type product_low;
670 bignum_digit_type * scan_r;
671 bignum_digit_type * scan_y;
672 bignum_length_type x_length = (BIGNUM_LENGTH (x));
673 bignum_length_type y_length = (BIGNUM_LENGTH (y));
676 (allot_bignum_zeroed ((x_length + y_length), negative_p));
678 bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
679 bignum_digit_type * end_x = (scan_x + x_length);
680 bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
681 bignum_digit_type * end_y = (start_y + y_length);
682 bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
683 #define x_digit x_digit_high
684 #define y_digit y_digit_high
685 #define product_high carry
686 while (scan_x < end_x)
688 x_digit = (*scan_x++);
689 x_digit_low = (HD_LOW (x_digit));
690 x_digit_high = (HD_HIGH (x_digit));
693 scan_r = (start_r++);
694 while (scan_y < end_y)
696 y_digit = (*scan_y++);
697 y_digit_low = (HD_LOW (y_digit));
698 y_digit_high = (HD_HIGH (y_digit));
701 (x_digit_low * y_digit_low) +
704 ((x_digit_high * y_digit_low) +
705 (x_digit_low * y_digit_high) +
706 (HD_HIGH (product_low)) +
709 (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
711 ((x_digit_high * y_digit_high) +
712 (HD_HIGH (product_high)));
716 return (bignum_trim (r));
724 /* allocates memory */
725 bignum *factorvm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p)
729 bignum_length_type length_x = (BIGNUM_LENGTH (x));
731 bignum * p = (allot_bignum ((length_x + 1), negative_p));
733 bignum_destructive_copy (x, p);
734 (BIGNUM_REF (p, length_x)) = 0;
735 bignum_destructive_scale_up (p, y);
736 return (bignum_trim (p));
740 void factorvm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
742 bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
743 bignum_digit_type digit;
744 digit = ((*scan) + n);
745 if (digit < BIGNUM_RADIX)
750 (*scan++) = (digit - BIGNUM_RADIX);
753 digit = ((*scan) + 1);
754 if (digit < BIGNUM_RADIX)
759 (*scan++) = (digit - BIGNUM_RADIX);
764 void factorvm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
766 bignum_digit_type carry = 0;
767 bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
768 bignum_digit_type two_digits;
769 bignum_digit_type product_low;
770 #define product_high carry
771 bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
772 BIGNUM_ASSERT ((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
775 two_digits = (*scan);
776 product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
778 ((factor * (HD_HIGH (two_digits))) +
779 (HD_HIGH (product_low)) +
781 (*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
782 carry = (HD_HIGH (product_high));
784 /* A carry here would be an overflow, i.e. it would not fit.
785 Hopefully the callers allocate enough space that this will
788 BIGNUM_ASSERT (carry == 0);
796 /* For help understanding this algorithm, see:
797 Knuth, Donald E., "The Art of Computer Programming",
798 volume 2, "Seminumerical Algorithms"
799 section 4.3.1, "Multiple-Precision Arithmetic". */
801 /* allocates memory */
802 void factorvm::bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
804 GC_BIGNUM(numerator,this); GC_BIGNUM(denominator,this);
806 bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
807 bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
810 ((quotient != ((bignum * *) 0))
811 ? (allot_bignum ((length_n - length_d), q_negative_p))
812 : BIGNUM_OUT_OF_BAND);
815 bignum * u = (allot_bignum (length_n, r_negative_p));
819 BIGNUM_ASSERT (length_d > 1);
821 bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
822 while (v1 < (BIGNUM_RADIX / 2))
830 bignum_destructive_copy (numerator, u);
831 (BIGNUM_REF (u, (length_n - 1))) = 0;
832 bignum_divide_unsigned_normalized (u, denominator, q);
836 bignum * v = (allot_bignum (length_d, 0));
838 bignum_destructive_normalization (numerator, u, shift);
839 bignum_destructive_normalization (denominator, v, shift);
840 bignum_divide_unsigned_normalized (u, v, q);
841 if (remainder != ((bignum * *) 0))
842 bignum_destructive_unnormalization (u, shift);
850 if (quotient != ((bignum * *) 0))
853 if (remainder != ((bignum * *) 0))
860 void factorvm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
862 bignum_length_type u_length = (BIGNUM_LENGTH (u));
863 bignum_length_type v_length = (BIGNUM_LENGTH (v));
864 bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
865 bignum_digit_type * u_scan = (u_start + u_length);
866 bignum_digit_type * u_scan_limit = (u_start + v_length);
867 bignum_digit_type * u_scan_start = (u_scan - v_length);
868 bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
869 bignum_digit_type * v_end = (v_start + v_length);
870 bignum_digit_type * q_scan = NULL;
871 bignum_digit_type v1 = (v_end[-1]);
872 bignum_digit_type v2 = (v_end[-2]);
873 bignum_digit_type ph; /* high half of double-digit product */
874 bignum_digit_type pl; /* low half of double-digit product */
875 bignum_digit_type guess;
876 bignum_digit_type gh; /* high half-digit of guess */
877 bignum_digit_type ch; /* high half of double-digit comparand */
878 bignum_digit_type v2l = (HD_LOW (v2));
879 bignum_digit_type v2h = (HD_HIGH (v2));
880 bignum_digit_type cl; /* low half of double-digit comparand */
881 #define gl ph /* low half-digit of guess */
884 bignum_digit_type gm; /* memory loc for reference parameter */
885 if (q != BIGNUM_OUT_OF_BAND)
886 q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
887 while (u_scan_limit < u_scan)
893 (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
894 guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
896 ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
902 ch = ((u_scan[-1]) + v1);
903 guess = (BIGNUM_RADIX - 1);
907 /* product = (guess * v2); */
908 gl = (HD_LOW (guess));
909 gh = (HD_HIGH (guess));
911 ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
912 pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
913 ph = ((v2h * gh) + (HD_HIGH (ph)));
914 /* if (comparand >= product) */
915 if ((ch > ph) || ((ch == ph) && (cl >= pl)))
918 /* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
920 /* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
921 if (ch >= BIGNUM_RADIX)
924 qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
925 if (q != BIGNUM_OUT_OF_BAND)
935 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)
937 bignum_digit_type * v_scan = v_start;
938 bignum_digit_type * u_scan = u_start;
939 bignum_digit_type carry = 0;
940 if (guess == 0) return (0);
942 bignum_digit_type gl = (HD_LOW (guess));
943 bignum_digit_type gh = (HD_HIGH (guess));
945 bignum_digit_type pl;
946 bignum_digit_type vl;
950 while (v_scan < v_end)
955 pl = ((vl * gl) + (HD_LOW (carry)));
956 ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
957 diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
960 (*u_scan++) = (diff + BIGNUM_RADIX);
961 carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
966 carry = ((vh * gh) + (HD_HIGH (ph)));
971 diff = ((*u_scan) - carry);
973 (*u_scan) = (diff + BIGNUM_RADIX);
983 /* Subtraction generated carry, implying guess is one too large.
984 Add v back in to bring it back down. */
988 while (v_scan < v_end)
990 bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
991 if (sum < BIGNUM_RADIX)
998 (*u_scan++) = (sum - BIGNUM_RADIX);
1004 bignum_digit_type sum = ((*u_scan) + carry);
1005 (*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
1011 /* allocates memory */
1012 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)
1014 GC_BIGNUM(numerator,this);
1016 bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
1017 bignum_length_type length_q;
1022 /* Because `bignum_digit_divide' requires a normalized denominator. */
1023 while (denominator < (BIGNUM_RADIX / 2))
1030 length_q = length_n;
1032 q = (allot_bignum (length_q, q_negative_p));
1033 bignum_destructive_copy (numerator, q);
1037 length_q = (length_n + 1);
1039 q = (allot_bignum (length_q, q_negative_p));
1040 bignum_destructive_normalization (numerator, q, shift);
1043 bignum_digit_type r = 0;
1044 bignum_digit_type * start = (BIGNUM_START_PTR (q));
1045 bignum_digit_type * scan = (start + length_q);
1046 bignum_digit_type qj;
1048 while (start < scan)
1050 r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
1054 q = bignum_trim (q);
1056 if (remainder != ((bignum * *) 0))
1061 (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
1064 if (quotient != ((bignum * *) 0))
1071 void factorvm::bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
1073 bignum_digit_type digit;
1074 bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
1075 bignum_digit_type carry = 0;
1076 bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
1077 bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
1078 bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
1079 int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
1080 bignum_digit_type mask = (((cell)1 << shift_right) - 1);
1081 while (scan_source < end_source)
1083 digit = (*scan_source++);
1084 (*scan_target++) = (((digit & mask) << shift_left) | carry);
1085 carry = (digit >> shift_right);
1087 if (scan_target < end_target)
1088 (*scan_target) = carry;
1090 BIGNUM_ASSERT (carry == 0);
1095 void factorvm::bignum_destructive_unnormalization(bignum * bignum, int shift_right)
1097 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
1098 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
1099 bignum_digit_type digit;
1100 bignum_digit_type carry = 0;
1101 int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
1102 bignum_digit_type mask = (((fixnum)1 << shift_right) - 1);
1103 while (start < scan)
1106 (*scan) = ((digit >> shift_right) | carry);
1107 carry = ((digit & mask) << shift_left);
1109 BIGNUM_ASSERT (carry == 0);
1114 /* This is a reduced version of the division algorithm, applied to the
1115 case of dividing two bignum digits by one bignum digit. It is
1116 assumed that the numerator, denominator are normalized. */
1118 #define BDD_STEP(qn, j) \
1123 uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \
1124 guess = (uj_uj1 / v1); \
1125 comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \
1129 guess = (BIGNUM_RADIX_ROOT - 1); \
1130 comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \
1132 while ((guess * v2) > comparand) \
1135 comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \
1136 if (comparand >= BIGNUM_RADIX) \
1139 qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \
1142 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 */
1144 bignum_digit_type guess;
1145 bignum_digit_type comparand;
1146 bignum_digit_type v1 = (HD_HIGH (v));
1147 bignum_digit_type v2 = (HD_LOW (v));
1148 bignum_digit_type uj;
1149 bignum_digit_type uj_uj1;
1150 bignum_digit_type q1;
1151 bignum_digit_type q2;
1152 bignum_digit_type u [4];
1166 (u[0]) = (HD_HIGH (uh));
1167 (u[1]) = (HD_LOW (uh));
1168 (u[2]) = (HD_HIGH (ul));
1169 (u[3]) = (HD_LOW (ul));
1174 (*q) = (HD_CONS (q1, q2));
1175 return (HD_CONS ((u[2]), (u[3])));
1181 #define BDDS_MULSUB(vn, un, carry_in) \
1183 product = ((vn * guess) + carry_in); \
1184 diff = (un - (HD_LOW (product))); \
1187 un = (diff + BIGNUM_RADIX_ROOT); \
1188 carry = ((HD_HIGH (product)) + 1); \
1193 carry = (HD_HIGH (product)); \
1197 #define BDDS_ADD(vn, un, carry_in) \
1199 sum = (vn + un + carry_in); \
1200 if (sum < BIGNUM_RADIX_ROOT) \
1207 un = (sum - BIGNUM_RADIX_ROOT); \
1212 bignum_digit_type factorvm::bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
1215 bignum_digit_type product;
1216 bignum_digit_type diff;
1217 bignum_digit_type carry;
1218 BDDS_MULSUB (v2, (u[2]), 0);
1219 BDDS_MULSUB (v1, (u[1]), carry);
1222 diff = ((u[0]) - carry);
1224 (u[0]) = (diff + BIGNUM_RADIX);
1232 bignum_digit_type sum;
1233 bignum_digit_type carry;
1234 BDDS_ADD(v2, (u[2]), 0);
1235 BDDS_ADD(v1, (u[1]), carry);
1246 /* allocates memory */
1247 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)
1249 GC_BIGNUM(numerator,this);
1251 bignum * q = (bignum_new_sign (numerator, q_negative_p));
1254 bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
1256 q = (bignum_trim (q));
1258 if (remainder != ((bignum * *) 0))
1259 (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
1267 /* Given (denominator > 1), it is fairly easy to show that
1268 (quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
1269 that all digits are < BIGNUM_RADIX. */
1271 bignum_digit_type factorvm::bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
1273 bignum_digit_type numerator;
1274 bignum_digit_type remainder = 0;
1275 bignum_digit_type two_digits;
1276 #define quotient_high remainder
1277 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
1278 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
1279 BIGNUM_ASSERT ((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
1280 while (start < scan)
1282 two_digits = (*--scan);
1283 numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
1284 quotient_high = (numerator / denominator);
1285 numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
1286 (*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
1287 remainder = (numerator % denominator);
1290 #undef quotient_high
1294 /* allocates memory */
1295 bignum * factorvm::bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
1297 bignum_digit_type two_digits;
1298 bignum_digit_type * start = (BIGNUM_START_PTR (n));
1299 bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
1300 bignum_digit_type r = 0;
1301 BIGNUM_ASSERT ((d > 1) && (d < BIGNUM_RADIX_ROOT));
1302 while (start < scan)
1304 two_digits = (*--scan);
1306 ((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
1307 (HD_LOW (two_digits))))
1310 return (bignum_digit_to_bignum (r, negative_p));
1314 /* allocates memory */
1315 bignum *factorvm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
1318 return (BIGNUM_ZERO ());
1321 bignum * result = (allot_bignum (1, negative_p));
1322 (BIGNUM_REF (result, 0)) = digit;
1328 /* allocates memory */
1329 bignum *factorvm::allot_bignum(bignum_length_type length, int negative_p)
1331 BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
1332 bignum * result = allot_array_internal<bignum>(length + 1);
1333 BIGNUM_SET_NEGATIVE_P (result, negative_p);
1338 /* allocates memory */
1339 bignum * factorvm::allot_bignum_zeroed(bignum_length_type length, int negative_p)
1341 bignum * result = allot_bignum(length,negative_p);
1342 bignum_digit_type * scan = (BIGNUM_START_PTR (result));
1343 bignum_digit_type * end = (scan + length);
1350 #define BIGNUM_REDUCE_LENGTH(source, length) \
1351 source = reallot_array(source,length + 1)
1353 /* allocates memory */
1354 bignum *factorvm::bignum_shorten_length(bignum * bignum, bignum_length_type length)
1356 bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
1357 BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
1358 if (length < current_length)
1360 BIGNUM_REDUCE_LENGTH (bignum, length);
1361 BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
1367 /* allocates memory */
1368 bignum *factorvm::bignum_trim(bignum * bignum)
1370 bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
1371 bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
1372 bignum_digit_type * scan = end;
1373 while ((start <= scan) && ((*--scan) == 0))
1378 bignum_length_type length = (scan - start);
1379 BIGNUM_REDUCE_LENGTH (bignum, length);
1380 BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
1388 /* allocates memory */
1389 bignum *factorvm::bignum_new_sign(bignum * x, int negative_p)
1392 bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
1394 bignum_destructive_copy (x, result);
1399 /* allocates memory */
1400 bignum *factorvm::bignum_maybe_new_sign(bignum * x, int negative_p)
1402 if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
1407 (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
1408 bignum_destructive_copy (x, result);
1414 void factorvm::bignum_destructive_copy(bignum * source, bignum * target)
1416 bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
1417 bignum_digit_type * end_source =
1418 (scan_source + (BIGNUM_LENGTH (source)));
1419 bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
1420 while (scan_source < end_source)
1421 (*scan_target++) = (*scan_source++);
1427 * Added bitwise operations (and oddp).
1430 /* allocates memory */
1431 bignum *factorvm::bignum_bitwise_not(bignum * x)
1433 return bignum_subtract(BIGNUM_ONE(1), x);
1437 /* allocates memory */
1438 bignum *factorvm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
1440 if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
1441 return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
1443 return bignum_magnitude_ash(arg1, n);
1451 /* allocates memory */
1452 bignum *factorvm::bignum_bitwise_and(bignum * arg1, bignum * arg2)
1455 (BIGNUM_NEGATIVE_P (arg1))
1456 ? (BIGNUM_NEGATIVE_P (arg2))
1457 ? bignum_negneg_bitwise_op(AND_OP, arg1, arg2)
1458 : bignum_posneg_bitwise_op(AND_OP, arg2, arg1)
1459 : (BIGNUM_NEGATIVE_P (arg2))
1460 ? bignum_posneg_bitwise_op(AND_OP, arg1, arg2)
1461 : bignum_pospos_bitwise_op(AND_OP, arg1, arg2)
1466 /* allocates memory */
1467 bignum *factorvm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
1470 (BIGNUM_NEGATIVE_P (arg1))
1471 ? (BIGNUM_NEGATIVE_P (arg2))
1472 ? bignum_negneg_bitwise_op(IOR_OP, arg1, arg2)
1473 : bignum_posneg_bitwise_op(IOR_OP, arg2, arg1)
1474 : (BIGNUM_NEGATIVE_P (arg2))
1475 ? bignum_posneg_bitwise_op(IOR_OP, arg1, arg2)
1476 : bignum_pospos_bitwise_op(IOR_OP, arg1, arg2)
1481 /* allocates memory */
1482 bignum *factorvm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
1485 (BIGNUM_NEGATIVE_P (arg1))
1486 ? (BIGNUM_NEGATIVE_P (arg2))
1487 ? bignum_negneg_bitwise_op(XOR_OP, arg1, arg2)
1488 : bignum_posneg_bitwise_op(XOR_OP, arg2, arg1)
1489 : (BIGNUM_NEGATIVE_P (arg2))
1490 ? bignum_posneg_bitwise_op(XOR_OP, arg1, arg2)
1491 : bignum_pospos_bitwise_op(XOR_OP, arg1, arg2)
1496 /* allocates memory */
1497 /* ash for the magnitude */
1498 /* assume arg1 is a big number, n is a long */
1499 bignum *factorvm::bignum_magnitude_ash(bignum * arg1, fixnum n)
1501 GC_BIGNUM(arg1,this);
1503 bignum * result = NULL;
1504 bignum_digit_type *scan1;
1505 bignum_digit_type *scanr;
1506 bignum_digit_type *end;
1508 fixnum digit_offset,bit_offset;
1510 if (BIGNUM_ZERO_P (arg1)) return (arg1);
1513 digit_offset = n / BIGNUM_DIGIT_LENGTH;
1514 bit_offset = n % BIGNUM_DIGIT_LENGTH;
1516 result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
1517 BIGNUM_NEGATIVE_P(arg1));
1519 scanr = BIGNUM_START_PTR (result) + digit_offset;
1520 scan1 = BIGNUM_START_PTR (arg1);
1521 end = scan1 + BIGNUM_LENGTH (arg1);
1523 while (scan1 < end) {
1524 *scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
1525 *scanr = *scanr & BIGNUM_DIGIT_MASK;
1527 *scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
1528 *scanr = *scanr & BIGNUM_DIGIT_MASK;
1532 && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
1533 result = BIGNUM_ZERO ();
1536 digit_offset = -n / BIGNUM_DIGIT_LENGTH;
1537 bit_offset = -n % BIGNUM_DIGIT_LENGTH;
1539 result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
1540 BIGNUM_NEGATIVE_P(arg1));
1542 scanr = BIGNUM_START_PTR (result);
1543 scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
1544 end = scanr + BIGNUM_LENGTH (result) - 1;
1546 while (scanr < end) {
1547 *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
1549 *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
1552 *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
1554 else if (n == 0) result = arg1;
1556 return (bignum_trim (result));
1560 /* allocates memory */
1561 bignum *factorvm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
1563 GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
1566 bignum_length_type max_length;
1568 bignum_digit_type *scan1, *end1, digit1;
1569 bignum_digit_type *scan2, *end2, digit2;
1570 bignum_digit_type *scanr, *endr;
1572 max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
1573 ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
1575 result = allot_bignum(max_length, 0);
1577 scanr = BIGNUM_START_PTR(result);
1578 scan1 = BIGNUM_START_PTR(arg1);
1579 scan2 = BIGNUM_START_PTR(arg2);
1580 endr = scanr + max_length;
1581 end1 = scan1 + BIGNUM_LENGTH(arg1);
1582 end2 = scan2 + BIGNUM_LENGTH(arg2);
1584 while (scanr < endr) {
1585 digit1 = (scan1 < end1) ? *scan1++ : 0;
1586 digit2 = (scan2 < end2) ? *scan2++ : 0;
1587 *scanr++ = (op == AND_OP) ? digit1 & digit2 :
1588 (op == IOR_OP) ? digit1 | digit2 :
1591 return bignum_trim(result);
1595 /* allocates memory */
1596 bignum *factorvm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
1598 GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
1601 bignum_length_type max_length;
1603 bignum_digit_type *scan1, *end1, digit1;
1604 bignum_digit_type *scan2, *end2, digit2, carry2;
1605 bignum_digit_type *scanr, *endr;
1607 char neg_p = op == IOR_OP || op == XOR_OP;
1609 max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
1610 ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
1612 result = allot_bignum(max_length, neg_p);
1614 scanr = BIGNUM_START_PTR(result);
1615 scan1 = BIGNUM_START_PTR(arg1);
1616 scan2 = BIGNUM_START_PTR(arg2);
1617 endr = scanr + max_length;
1618 end1 = scan1 + BIGNUM_LENGTH(arg1);
1619 end2 = scan2 + BIGNUM_LENGTH(arg2);
1623 while (scanr < endr) {
1624 digit1 = (scan1 < end1) ? *scan1++ : 0;
1625 digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
1628 if (digit2 < BIGNUM_RADIX)
1632 digit2 = (digit2 - BIGNUM_RADIX);
1636 *scanr++ = (op == AND_OP) ? digit1 & digit2 :
1637 (op == IOR_OP) ? digit1 | digit2 :
1642 bignum_negate_magnitude(result);
1644 return bignum_trim(result);
1648 /* allocates memory */
1649 bignum *factorvm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
1651 GC_BIGNUM(arg1,this); GC_BIGNUM(arg2,this);
1654 bignum_length_type max_length;
1656 bignum_digit_type *scan1, *end1, digit1, carry1;
1657 bignum_digit_type *scan2, *end2, digit2, carry2;
1658 bignum_digit_type *scanr, *endr;
1660 char neg_p = op == AND_OP || op == IOR_OP;
1662 max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
1663 ? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
1665 result = allot_bignum(max_length, neg_p);
1667 scanr = BIGNUM_START_PTR(result);
1668 scan1 = BIGNUM_START_PTR(arg1);
1669 scan2 = BIGNUM_START_PTR(arg2);
1670 endr = scanr + max_length;
1671 end1 = scan1 + BIGNUM_LENGTH(arg1);
1672 end2 = scan2 + BIGNUM_LENGTH(arg2);
1677 while (scanr < endr) {
1678 digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
1679 digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
1681 if (digit1 < BIGNUM_RADIX)
1685 digit1 = (digit1 - BIGNUM_RADIX);
1689 if (digit2 < BIGNUM_RADIX)
1693 digit2 = (digit2 - BIGNUM_RADIX);
1697 *scanr++ = (op == AND_OP) ? digit1 & digit2 :
1698 (op == IOR_OP) ? digit1 | digit2 :
1703 bignum_negate_magnitude(result);
1705 return bignum_trim(result);
1709 void factorvm::bignum_negate_magnitude(bignum * arg)
1711 bignum_digit_type *scan;
1712 bignum_digit_type *end;
1713 bignum_digit_type digit;
1714 bignum_digit_type carry;
1716 scan = BIGNUM_START_PTR(arg);
1717 end = scan + BIGNUM_LENGTH(arg);
1721 while (scan < end) {
1722 digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
1724 if (digit < BIGNUM_RADIX)
1728 digit = (digit - BIGNUM_RADIX);
1737 /* Allocates memory */
1738 bignum *factorvm::bignum_integer_length(bignum * x)
1742 bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
1743 bignum_digit_type digit = (BIGNUM_REF (x, index));
1745 bignum * result = (allot_bignum (2, 0));
1747 (BIGNUM_REF (result, 0)) = index;
1748 (BIGNUM_REF (result, 1)) = 0;
1749 bignum_destructive_scale_up (result, BIGNUM_DIGIT_LENGTH);
1752 bignum_destructive_add (result, ((bignum_digit_type) 1));
1755 return (bignum_trim (result));
1759 /* Allocates memory */
1760 int factorvm::bignum_logbitp(int shift, bignum * arg)
1762 return((BIGNUM_NEGATIVE_P (arg))
1763 ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
1764 : bignum_unsigned_logbitp (shift,arg));
1768 int factorvm::bignum_unsigned_logbitp(int shift, bignum * bignum)
1770 bignum_length_type len = (BIGNUM_LENGTH (bignum));
1771 int index = shift / BIGNUM_DIGIT_LENGTH;
1774 bignum_digit_type digit = (BIGNUM_REF (bignum, index));
1775 int p = shift % BIGNUM_DIGIT_LENGTH;
1776 bignum_digit_type mask = ((fixnum)1) << p;
1777 return (digit & mask) ? 1 : 0;
1781 /* Allocates memory */
1782 bignum *factorvm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factorvm*), unsigned int radix, int negative_p)
1784 BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
1786 return (BIGNUM_ZERO ());
1789 fixnum digit = ((fixnum) ((*producer) (0,this)));
1790 return (fixnum_to_bignum (negative_p ? (- digit) : digit));
1793 bignum_length_type length;
1795 unsigned int radix_copy = radix;
1796 unsigned int log_radix = 0;
1797 while (radix_copy > 0)
1802 /* This length will be at least as large as needed. */
1803 length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
1806 bignum * result = (allot_bignum_zeroed (length, negative_p));
1807 while ((n_digits--) > 0)
1809 bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
1810 bignum_destructive_add
1811 (result, ((bignum_digit_type) ((*producer) (n_digits,this))));
1813 return (bignum_trim (result));