1948 lines
		
	
	
		
			51 KiB
		
	
	
	
		
			C++
		
	
	
		
			Executable File
		
	
			
		
		
	
	
			1948 lines
		
	
	
		
			51 KiB
		
	
	
	
		
			C++
		
	
	
		
			Executable File
		
	
| /*
 | |
|    Copyright (C) 1989-94 Massachusetts Institute of Technology
 | |
|    Portions copyright (C) 2004-2008 Slava Pestov
 | |
| 
 | |
|    This material was developed by the Scheme project at the Massachusetts
 | |
|    Institute of Technology, Department of Electrical Engineering and
 | |
|    Computer Science.  Permission to copy and modify this software, to
 | |
|    redistribute either the original software or a modified version, and
 | |
|    to use this software for any purpose is granted, subject to the
 | |
|    following restrictions and understandings.
 | |
| 
 | |
|    1. Any copy made of this software must include this copyright notice
 | |
|    in full.
 | |
| 
 | |
|    2. Users of this software agree to make their best efforts (a) to
 | |
|    return to the MIT Scheme project any improvements or extensions that
 | |
|    they make, so that these may be included in future releases; and (b)
 | |
|    to inform MIT of noteworthy uses of this software.
 | |
| 
 | |
|    3. All materials developed as a consequence of the use of this
 | |
|    software shall duly acknowledge such use, in accordance with the usual
 | |
|    standards of acknowledging credit in academic research.
 | |
| 
 | |
|    4. MIT has made no warrantee or representation that the operation of
 | |
|    this software will be error-free, and MIT is under no obligation to
 | |
|    provide any services, by way of maintenance, update, or otherwise.
 | |
| 
 | |
|    5. In conjunction with products arising from the use of this material,
 | |
|    there shall be no use of the name of the Massachusetts Institute of
 | |
|    Technology nor of any adaptation thereof in any advertising,
 | |
|    promotional, or sales literature without prior written consent from
 | |
|    MIT in each case. */
 | |
| 
 | |
| /* Changes for Scheme 48:
 | |
|  *  - Converted to ANSI.
 | |
|  *  - Added bitwise operations.
 | |
|  *  - Added s48 to the beginning of all externally visible names.
 | |
|  *  - Cached the bignum representations of -1, 0, and 1.
 | |
|  */
 | |
| 
 | |
| /* Changes for Factor:
 | |
|  *  - Adapt bignumint.h for Factor memory manager
 | |
|  *  - Add more bignum <-> C type conversions
 | |
|  *  - Remove unused functions
 | |
|  *  - Add local variable GC root recording
 | |
|  *  - Remove s48 prefix from function names
 | |
|  *  - Various fixes for Win64
 | |
|  *  - Port to C++
 | |
|  */
 | |
| 
 | |
| #include "master.hpp"
 | |
| 
 | |
| namespace factor
 | |
| {
 | |
| 
 | |
| /* Exports */
 | |
| 
 | |
| int factor_vm::bignum_equal_p(bignum * x, bignum * y)
 | |
| {
 | |
| 	return
 | |
| 		((BIGNUM_ZERO_P (x))
 | |
| 		 ? (BIGNUM_ZERO_P (y))
 | |
| 		 : ((! (BIGNUM_ZERO_P (y)))
 | |
| 			&& ((BIGNUM_NEGATIVE_P (x))
 | |
| 				? (BIGNUM_NEGATIVE_P (y))
 | |
| 				: (! (BIGNUM_NEGATIVE_P (y))))
 | |
| 			&& (bignum_equal_p_unsigned (x, y))));
 | |
| }
 | |
| 
 | |
| enum bignum_comparison factor_vm::bignum_compare(bignum * x, bignum * y)
 | |
| {
 | |
| 	return
 | |
| 		((BIGNUM_ZERO_P (x))
 | |
| 		 ? ((BIGNUM_ZERO_P (y))
 | |
| 			? bignum_comparison_equal
 | |
| 			: (BIGNUM_NEGATIVE_P (y))
 | |
| 			? bignum_comparison_greater
 | |
| 			: bignum_comparison_less)
 | |
| 		 : (BIGNUM_ZERO_P (y))
 | |
| 		 ? ((BIGNUM_NEGATIVE_P (x))
 | |
| 			? bignum_comparison_less
 | |
| 			: bignum_comparison_greater)
 | |
| 		 : (BIGNUM_NEGATIVE_P (x))
 | |
| 		 ? ((BIGNUM_NEGATIVE_P (y))
 | |
| 			? (bignum_compare_unsigned (y, x))
 | |
| 			: (bignum_comparison_less))
 | |
| 		 : ((BIGNUM_NEGATIVE_P (y))
 | |
| 			? (bignum_comparison_greater)
 | |
| 			: (bignum_compare_unsigned (x, y))));
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_add(bignum * x, bignum * y)
 | |
| {
 | |
| 	return
 | |
| 		((BIGNUM_ZERO_P (x))
 | |
| 		 ? (y)
 | |
| 		 : (BIGNUM_ZERO_P (y))
 | |
| 		 ? (x)
 | |
| 		 : ((BIGNUM_NEGATIVE_P (x))
 | |
| 			? ((BIGNUM_NEGATIVE_P (y))
 | |
| 			   ? (bignum_add_unsigned (x, y, 1))
 | |
| 			   : (bignum_subtract_unsigned (y, x)))
 | |
| 			: ((BIGNUM_NEGATIVE_P (y))
 | |
| 			   ? (bignum_subtract_unsigned (x, y))
 | |
| 			   : (bignum_add_unsigned (x, y, 0)))));
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_subtract(bignum * x, bignum * y)
 | |
| {
 | |
| 	return
 | |
| 		((BIGNUM_ZERO_P (x))
 | |
| 		 ? ((BIGNUM_ZERO_P (y))
 | |
| 			? (y)
 | |
| 			: (bignum_new_sign (y, (! (BIGNUM_NEGATIVE_P (y))))))
 | |
| 		 : ((BIGNUM_ZERO_P (y))
 | |
| 			? (x)
 | |
| 			: ((BIGNUM_NEGATIVE_P (x))
 | |
| 			   ? ((BIGNUM_NEGATIVE_P (y))
 | |
| 				  ? (bignum_subtract_unsigned (y, x))
 | |
| 				  : (bignum_add_unsigned (x, y, 1)))
 | |
| 			   : ((BIGNUM_NEGATIVE_P (y))
 | |
| 				  ? (bignum_add_unsigned (x, y, 0))
 | |
| 				  : (bignum_subtract_unsigned (x, y))))));
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_multiply(bignum * x, bignum * y)
 | |
| {
 | |
| 	bignum_length_type x_length = (BIGNUM_LENGTH (x));
 | |
| 	bignum_length_type y_length = (BIGNUM_LENGTH (y));
 | |
| 	int negative_p =
 | |
| 		((BIGNUM_NEGATIVE_P (x))
 | |
| 		 ? (! (BIGNUM_NEGATIVE_P (y)))
 | |
| 		 : (BIGNUM_NEGATIVE_P (y)));
 | |
| 	if (BIGNUM_ZERO_P (x))
 | |
| 		return (x);
 | |
| 	if (BIGNUM_ZERO_P (y))
 | |
| 		return (y);
 | |
| 	if (x_length == 1)
 | |
| 	{
 | |
| 		bignum_digit_type digit = (BIGNUM_REF (x, 0));
 | |
| 		if (digit == 1)
 | |
| 			return (bignum_maybe_new_sign (y, negative_p));
 | |
| 		if (digit < BIGNUM_RADIX_ROOT)
 | |
| 			return (bignum_multiply_unsigned_small_factor (y, digit, negative_p));
 | |
| 	}
 | |
| 	if (y_length == 1)
 | |
| 	{
 | |
| 		bignum_digit_type digit = (BIGNUM_REF (y, 0));
 | |
| 		if (digit == 1)
 | |
| 			return (bignum_maybe_new_sign (x, negative_p));
 | |
| 		if (digit < BIGNUM_RADIX_ROOT)
 | |
| 			return (bignum_multiply_unsigned_small_factor (x, digit, negative_p));
 | |
| 	}
 | |
| 	return (bignum_multiply_unsigned (x, y, negative_p));
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| void factor_vm::bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
 | |
| {
 | |
| 	if (BIGNUM_ZERO_P (denominator))
 | |
| 	{
 | |
| 		divide_by_zero_error();
 | |
| 		return;
 | |
| 	}
 | |
| 	if (BIGNUM_ZERO_P (numerator))
 | |
| 	{
 | |
| 		(*quotient) = numerator;
 | |
| 		(*remainder) = numerator;
 | |
| 	}
 | |
| 	else
 | |
| 	{
 | |
| 		int r_negative_p = (BIGNUM_NEGATIVE_P (numerator));
 | |
| 		int q_negative_p =
 | |
| 			((BIGNUM_NEGATIVE_P (denominator)) ? (! r_negative_p) : r_negative_p);
 | |
| 		switch (bignum_compare_unsigned (numerator, denominator))
 | |
| 		{
 | |
| 		case bignum_comparison_equal:
 | |
| 			{
 | |
| 				(*quotient) = (BIGNUM_ONE (q_negative_p));
 | |
| 				(*remainder) = (BIGNUM_ZERO ());
 | |
| 				break;
 | |
| 			}
 | |
| 		case bignum_comparison_less:
 | |
| 			{
 | |
| 				(*quotient) = (BIGNUM_ZERO ());
 | |
| 				(*remainder) = numerator;
 | |
| 				break;
 | |
| 			}
 | |
| 		case bignum_comparison_greater:
 | |
| 			{
 | |
| 				if ((BIGNUM_LENGTH (denominator)) == 1)
 | |
| 				{
 | |
| 					bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
 | |
| 					if (digit == 1)
 | |
| 					{
 | |
| 						(*quotient) =
 | |
| 							(bignum_maybe_new_sign (numerator, q_negative_p));
 | |
| 						(*remainder) = (BIGNUM_ZERO ());
 | |
| 						break;
 | |
| 					}
 | |
| 					else if (digit < BIGNUM_RADIX_ROOT)
 | |
| 					{
 | |
| 						bignum_divide_unsigned_small_denominator
 | |
| 							(numerator, digit,
 | |
| 							 quotient, remainder,
 | |
| 							 q_negative_p, r_negative_p);
 | |
| 						break;
 | |
| 					}
 | |
| 					else
 | |
| 					{
 | |
| 						bignum_divide_unsigned_medium_denominator
 | |
| 							(numerator, digit,
 | |
| 							 quotient, remainder,
 | |
| 							 q_negative_p, r_negative_p);
 | |
| 						break;
 | |
| 					}
 | |
| 				}
 | |
| 				bignum_divide_unsigned_large_denominator
 | |
| 					(numerator, denominator,
 | |
| 					 quotient, remainder,
 | |
| 					 q_negative_p, r_negative_p);
 | |
| 				break;
 | |
| 			}
 | |
| 		}
 | |
| 	}
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_quotient(bignum * numerator, bignum * denominator)
 | |
| {
 | |
| 	if (BIGNUM_ZERO_P (denominator))
 | |
| 	{
 | |
| 		divide_by_zero_error();
 | |
| 		return (BIGNUM_OUT_OF_BAND);
 | |
| 	}
 | |
| 	if (BIGNUM_ZERO_P (numerator))
 | |
| 		return numerator;
 | |
| 	{
 | |
| 		int q_negative_p =
 | |
| 			((BIGNUM_NEGATIVE_P (denominator))
 | |
| 			 ? (! (BIGNUM_NEGATIVE_P (numerator)))
 | |
| 			 : (BIGNUM_NEGATIVE_P (numerator)));
 | |
| 		switch (bignum_compare_unsigned (numerator, denominator))
 | |
| 		{
 | |
| 		case bignum_comparison_equal:
 | |
| 			return (BIGNUM_ONE (q_negative_p));
 | |
| 		case bignum_comparison_less:
 | |
| 			return (BIGNUM_ZERO ());
 | |
| 		case bignum_comparison_greater:
 | |
| 		default:                                        /* to appease gcc -Wall */
 | |
| 			{
 | |
| 				bignum * quotient;
 | |
| 				if ((BIGNUM_LENGTH (denominator)) == 1)
 | |
| 				{
 | |
| 					bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
 | |
| 					if (digit == 1)
 | |
| 						return (bignum_maybe_new_sign (numerator, q_negative_p));
 | |
| 					if (digit < BIGNUM_RADIX_ROOT)
 | |
| 						bignum_divide_unsigned_small_denominator
 | |
| 							(numerator, digit,
 | |
| 							 ("ient), ((bignum * *) 0),
 | |
| 							 q_negative_p, 0);
 | |
| 					else
 | |
| 						bignum_divide_unsigned_medium_denominator
 | |
| 							(numerator, digit,
 | |
| 							 ("ient), ((bignum * *) 0),
 | |
| 							 q_negative_p, 0);
 | |
| 				}
 | |
| 				else
 | |
| 					bignum_divide_unsigned_large_denominator
 | |
| 						(numerator, denominator,
 | |
| 						 ("ient), ((bignum * *) 0),
 | |
| 						 q_negative_p, 0);
 | |
| 				return (quotient);
 | |
| 			}
 | |
| 		}
 | |
| 	}
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_remainder(bignum * numerator, bignum * denominator)
 | |
| {
 | |
| 	if (BIGNUM_ZERO_P (denominator))
 | |
| 		{
 | |
| 			divide_by_zero_error();
 | |
| 			return (BIGNUM_OUT_OF_BAND);
 | |
| 		}
 | |
| 	if (BIGNUM_ZERO_P (numerator))
 | |
| 		return numerator;
 | |
| 	switch (bignum_compare_unsigned (numerator, denominator))
 | |
| 		{
 | |
| 		case bignum_comparison_equal:
 | |
| 			return (BIGNUM_ZERO ());
 | |
| 		case bignum_comparison_less:
 | |
| 			return numerator;
 | |
| 		case bignum_comparison_greater:
 | |
| 		default:                                        /* to appease gcc -Wall */
 | |
| 			{
 | |
| 				bignum * remainder;
 | |
| 				if ((BIGNUM_LENGTH (denominator)) == 1)
 | |
| 					{
 | |
| 						bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
 | |
| 						if (digit == 1)
 | |
| 							return (BIGNUM_ZERO ());
 | |
| 						if (digit < BIGNUM_RADIX_ROOT)
 | |
| 							return
 | |
| 								(bignum_remainder_unsigned_small_denominator
 | |
| 								 (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
 | |
| 						bignum_divide_unsigned_medium_denominator
 | |
| 							(numerator, digit,
 | |
| 							 ((bignum * *) 0), (&remainder),
 | |
| 							 0, (BIGNUM_NEGATIVE_P (numerator)));
 | |
| 					}
 | |
| 				else
 | |
| 					bignum_divide_unsigned_large_denominator
 | |
| 						(numerator, denominator,
 | |
| 						 ((bignum * *) 0), (&remainder),
 | |
| 						 0, (BIGNUM_NEGATIVE_P (numerator)));
 | |
| 				return (remainder);
 | |
| 			}
 | |
| 		}
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| #define FOO_TO_BIGNUM(name,type,stype,utype)				\
 | |
| bignum * factor_vm::name##_to_bignum(type n)				\
 | |
| {									\
 | |
| 	int negative_p;							\
 | |
| 	bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)];	\
 | |
| 	bignum_digit_type * end_digits = result_digits;			\
 | |
| 	/* Special cases win when these small constants are cached. */	\
 | |
| 	if (n == 0) return (BIGNUM_ZERO ());				\
 | |
| 	if (n == 1) return (BIGNUM_ONE (0));				\
 | |
| 	if (n < (type)0 && n == (type)-1) return (BIGNUM_ONE (1));	\
 | |
| 	{								\
 | |
| 		utype accumulator = ((negative_p = (n < (type)0)) ? ((type)(-(stype)n)) : n); \
 | |
| 		do							\
 | |
| 		{							\
 | |
| 			(*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \
 | |
| 			accumulator >>= BIGNUM_DIGIT_LENGTH;		\
 | |
| 		}							\
 | |
| 		while (accumulator != 0);				\
 | |
| 	}								\
 | |
| 	{								\
 | |
| 		bignum * result =					\
 | |
| 			(allot_bignum ((end_digits - result_digits), negative_p)); \
 | |
| 		bignum_digit_type * scan_digits = result_digits;	\
 | |
| 		bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
 | |
| 		while (scan_digits < end_digits)			\
 | |
| 			(*scan_result++) = (*scan_digits++);		\
 | |
| 		return (result);					\
 | |
| 	}								\
 | |
| }
 | |
| 
 | |
| FOO_TO_BIGNUM(cell,cell,fixnum,cell)
 | |
| FOO_TO_BIGNUM(fixnum,fixnum,fixnum,cell)
 | |
| FOO_TO_BIGNUM(long_long,s64,s64,u64)
 | |
| FOO_TO_BIGNUM(ulong_long,u64,s64,u64)
 | |
| 
 | |
| /* cannot allocate memory */
 | |
| #define BIGNUM_TO_FOO(name,type,stype,utype)				\
 | |
| 	type factor_vm::bignum_to_##name(bignum * bignum)		\
 | |
| 	{								\
 | |
| 		if (BIGNUM_ZERO_P (bignum))				\
 | |
| 			return (0);					\
 | |
| 		{							\
 | |
| 			utype accumulator = 0;				\
 | |
| 			bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \
 | |
| 			bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \
 | |
| 			while (start < scan)				\
 | |
| 				accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \
 | |
| 			return ((BIGNUM_NEGATIVE_P (bignum)) ? ((type)(-(stype)accumulator)) : accumulator); \
 | |
| 		}							\
 | |
| 	}
 | |
| 
 | |
| BIGNUM_TO_FOO(cell,cell,fixnum,cell)
 | |
| BIGNUM_TO_FOO(fixnum,fixnum,fixnum,cell)
 | |
| BIGNUM_TO_FOO(long_long,s64,s64,u64)
 | |
| BIGNUM_TO_FOO(ulong_long,u64,s64,u64)
 | |
| 
 | |
| #define DTB_WRITE_DIGIT(factor)						\
 | |
| {									\
 | |
| 	significand *= (factor);					\
 | |
| 	digit = ((bignum_digit_type) significand);			\
 | |
| 	(*--scan) = digit;						\
 | |
| 	significand -= ((double) digit);				\
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| #define inf std::numeric_limits<double>::infinity()
 | |
| 
 | |
| bignum *factor_vm::double_to_bignum(double x)
 | |
| {
 | |
| 	if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
 | |
| 	int exponent;
 | |
| 	double significand = (frexp (x, (&exponent)));
 | |
| 	if (exponent <= 0) return (BIGNUM_ZERO ());
 | |
| 	if (exponent == 1) return (BIGNUM_ONE (x < 0));
 | |
| 	if (significand < 0) significand = (-significand);
 | |
| 	{
 | |
| 		bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
 | |
| 		bignum * result = (allot_bignum (length, (x < 0)));
 | |
| 		bignum_digit_type * start = (BIGNUM_START_PTR (result));
 | |
| 		bignum_digit_type * scan = (start + length);
 | |
| 		bignum_digit_type digit;
 | |
| 		int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
 | |
| 		if (odd_bits > 0)
 | |
| 			DTB_WRITE_DIGIT ((fixnum)1 << odd_bits);
 | |
| 		while (start < scan)
 | |
| 		{
 | |
| 			if (significand == 0)
 | |
| 			{
 | |
| 				while (start < scan)
 | |
| 					(*--scan) = 0;
 | |
| 				break;
 | |
| 			}
 | |
| 			DTB_WRITE_DIGIT (BIGNUM_RADIX);
 | |
| 		}
 | |
| 		return (result);
 | |
| 	}
 | |
| }
 | |
| 
 | |
| #undef DTB_WRITE_DIGIT
 | |
| 
 | |
| /* Comparisons */
 | |
| 
 | |
| int factor_vm::bignum_equal_p_unsigned(bignum * x, bignum * y)
 | |
| {
 | |
| 	bignum_length_type length = (BIGNUM_LENGTH (x));
 | |
| 	if (length != (BIGNUM_LENGTH (y)))
 | |
| 		return (0);
 | |
| 	else
 | |
| 	{
 | |
| 		bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
 | |
| 		bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
 | |
| 		bignum_digit_type * end_x = (scan_x + length);
 | |
| 		while (scan_x < end_x)
 | |
| 			if ((*scan_x++) != (*scan_y++))
 | |
| 				return (0);
 | |
| 		return (1);
 | |
| 	}
 | |
| }
 | |
| 
 | |
| enum bignum_comparison factor_vm::bignum_compare_unsigned(bignum * x, bignum * y)
 | |
| {
 | |
| 	bignum_length_type x_length = (BIGNUM_LENGTH (x));
 | |
| 	bignum_length_type y_length = (BIGNUM_LENGTH (y));
 | |
| 	if (x_length < y_length)
 | |
| 		return (bignum_comparison_less);
 | |
| 	if (x_length > y_length)
 | |
| 		return (bignum_comparison_greater);
 | |
| 	{
 | |
| 		bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
 | |
| 		bignum_digit_type * scan_x = (start_x + x_length);
 | |
| 		bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
 | |
| 		while (start_x < scan_x)
 | |
| 		{
 | |
| 			bignum_digit_type digit_x = (*--scan_x);
 | |
| 			bignum_digit_type digit_y = (*--scan_y);
 | |
| 			if (digit_x < digit_y)
 | |
| 				return (bignum_comparison_less);
 | |
| 			if (digit_x > digit_y)
 | |
| 				return (bignum_comparison_greater);
 | |
| 		}
 | |
| 	}
 | |
| 	return (bignum_comparison_equal);
 | |
| }
 | |
| 
 | |
| /* Addition */
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
 | |
| {
 | |
| 	GC_BIGNUM(x); GC_BIGNUM(y);
 | |
| 
 | |
| 	if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
 | |
| 	{
 | |
| 		bignum * z = x;
 | |
| 		x = y;
 | |
| 		y = z;
 | |
| 	}
 | |
| 	{
 | |
| 		bignum_length_type x_length = (BIGNUM_LENGTH (x));
 | |
| 	
 | |
| 		bignum * r = (allot_bignum ((x_length + 1), negative_p));
 | |
| 
 | |
| 		bignum_digit_type sum;
 | |
| 		bignum_digit_type carry = 0;
 | |
| 		bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
 | |
| 		bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
 | |
| 		{
 | |
| 			bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
 | |
| 			bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
 | |
| 			while (scan_y < end_y)
 | |
| 				{
 | |
| 					sum = ((*scan_x++) + (*scan_y++) + carry);
 | |
| 					if (sum < BIGNUM_RADIX)
 | |
| 						{
 | |
| 							(*scan_r++) = sum;
 | |
| 							carry = 0;
 | |
| 						}
 | |
| 					else
 | |
| 						{
 | |
| 							(*scan_r++) = (sum - BIGNUM_RADIX);
 | |
| 							carry = 1;
 | |
| 						}
 | |
| 				}
 | |
| 		}
 | |
| 		{
 | |
| 			bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
 | |
| 			if (carry != 0)
 | |
| 				while (scan_x < end_x)
 | |
| 				{
 | |
| 					sum = ((*scan_x++) + 1);
 | |
| 					if (sum < BIGNUM_RADIX)
 | |
| 					{
 | |
| 						(*scan_r++) = sum;
 | |
| 						carry = 0;
 | |
| 						break;
 | |
| 					}
 | |
| 					else
 | |
| 						(*scan_r++) = (sum - BIGNUM_RADIX);
 | |
| 				}
 | |
| 			while (scan_x < end_x)
 | |
| 				(*scan_r++) = (*scan_x++);
 | |
| 		}
 | |
| 		if (carry != 0)
 | |
| 		{
 | |
| 			(*scan_r) = 1;
 | |
| 			return (r);
 | |
| 		}
 | |
| 		return (bignum_shorten_length (r, x_length));
 | |
| 	}
 | |
| }
 | |
| 
 | |
| /* Subtraction */
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_subtract_unsigned(bignum * x, bignum * y)
 | |
| {
 | |
| 	GC_BIGNUM(x); GC_BIGNUM(y);
 | |
|   
 | |
| 	int negative_p = 0;
 | |
| 	switch (bignum_compare_unsigned (x, y))
 | |
| 	{
 | |
| 	case bignum_comparison_equal:
 | |
| 		return (BIGNUM_ZERO ());
 | |
| 	case bignum_comparison_less:
 | |
| 		{
 | |
| 			bignum * z = x;
 | |
| 			x = y;
 | |
| 			y = z;
 | |
| 		}
 | |
| 		negative_p = 1;
 | |
| 		break;
 | |
| 	case bignum_comparison_greater:
 | |
| 		negative_p = 0;
 | |
| 		break;
 | |
| 	}
 | |
| 	{
 | |
| 		bignum_length_type x_length = (BIGNUM_LENGTH (x));
 | |
| 	
 | |
| 		bignum * r = (allot_bignum (x_length, negative_p));
 | |
| 
 | |
| 		bignum_digit_type difference;
 | |
| 		bignum_digit_type borrow = 0;
 | |
| 		bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
 | |
| 		bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
 | |
| 		{
 | |
| 			bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
 | |
| 			bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
 | |
| 			while (scan_y < end_y)
 | |
| 			{
 | |
| 				difference = (((*scan_x++) - (*scan_y++)) - borrow);
 | |
| 				if (difference < 0)
 | |
| 				{
 | |
| 					(*scan_r++) = (difference + BIGNUM_RADIX);
 | |
| 					borrow = 1;
 | |
| 				}
 | |
| 				else
 | |
| 				{
 | |
| 					(*scan_r++) = difference;
 | |
| 					borrow = 0;
 | |
| 				}
 | |
| 			}
 | |
| 		}
 | |
| 		{
 | |
| 			bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
 | |
| 			if (borrow != 0)
 | |
| 				while (scan_x < end_x)
 | |
| 				{
 | |
| 					difference = ((*scan_x++) - borrow);
 | |
| 					if (difference < 0)
 | |
| 						(*scan_r++) = (difference + BIGNUM_RADIX);
 | |
| 					else
 | |
| 					{
 | |
| 						(*scan_r++) = difference;
 | |
| 						borrow = 0;
 | |
| 						break;
 | |
| 					}
 | |
| 				}
 | |
| 			BIGNUM_ASSERT (borrow == 0);
 | |
| 			while (scan_x < end_x)
 | |
| 				(*scan_r++) = (*scan_x++);
 | |
| 		}
 | |
| 		return (bignum_trim (r));
 | |
| 	}
 | |
| }
 | |
| 
 | |
| /* Multiplication
 | |
|    Maximum value for product_low or product_high:
 | |
|    ((R * R) + (R * (R - 2)) + (R - 1))
 | |
|    Maximum value for carry: ((R * (R - 1)) + (R - 1))
 | |
|    where R == BIGNUM_RADIX_ROOT */
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
 | |
| {
 | |
| 	GC_BIGNUM(x); GC_BIGNUM(y);
 | |
| 
 | |
| 	if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
 | |
| 	{
 | |
| 		bignum * z = x;
 | |
| 		x = y;
 | |
| 		y = z;
 | |
| 	}
 | |
| 	{
 | |
| 		bignum_digit_type carry;
 | |
| 		bignum_digit_type y_digit_low;
 | |
| 		bignum_digit_type y_digit_high;
 | |
| 		bignum_digit_type x_digit_low;
 | |
| 		bignum_digit_type x_digit_high;
 | |
| 		bignum_digit_type product_low;
 | |
| 		bignum_digit_type * scan_r;
 | |
| 		bignum_digit_type * scan_y;
 | |
| 		bignum_length_type x_length = (BIGNUM_LENGTH (x));
 | |
| 		bignum_length_type y_length = (BIGNUM_LENGTH (y));
 | |
| 
 | |
| 		bignum * r =
 | |
| 			(allot_bignum_zeroed ((x_length + y_length), negative_p));
 | |
| 
 | |
| 		bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
 | |
| 		bignum_digit_type * end_x = (scan_x + x_length);
 | |
| 		bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
 | |
| 		bignum_digit_type * end_y = (start_y + y_length);
 | |
| 		bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
 | |
| #define x_digit x_digit_high
 | |
| #define y_digit y_digit_high
 | |
| #define product_high carry
 | |
| 		while (scan_x < end_x)
 | |
| 		{
 | |
| 			x_digit = (*scan_x++);
 | |
| 			x_digit_low = (HD_LOW (x_digit));
 | |
| 			x_digit_high = (HD_HIGH (x_digit));
 | |
| 			carry = 0;
 | |
| 			scan_y = start_y;
 | |
| 			scan_r = (start_r++);
 | |
| 			while (scan_y < end_y)
 | |
| 			{
 | |
| 				y_digit = (*scan_y++);
 | |
| 				y_digit_low = (HD_LOW (y_digit));
 | |
| 				y_digit_high = (HD_HIGH (y_digit));
 | |
| 				product_low =
 | |
| 					((*scan_r) +
 | |
| 					 (x_digit_low * y_digit_low) +
 | |
| 					 (HD_LOW (carry)));
 | |
| 				product_high =
 | |
| 					((x_digit_high * y_digit_low) +
 | |
| 					 (x_digit_low * y_digit_high) +
 | |
| 					 (HD_HIGH (product_low)) +
 | |
| 					 (HD_HIGH (carry)));
 | |
| 				(*scan_r++) =
 | |
| 					(HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
 | |
| 				carry =
 | |
| 					((x_digit_high * y_digit_high) +
 | |
| 					 (HD_HIGH (product_high)));
 | |
| 			}
 | |
| 			(*scan_r) += carry;
 | |
| 		}
 | |
| 		return (bignum_trim (r));
 | |
| #undef x_digit
 | |
| #undef y_digit
 | |
| #undef product_high
 | |
| 	}
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y, int negative_p)
 | |
| {
 | |
| 	GC_BIGNUM(x);
 | |
|   
 | |
| 	bignum_length_type length_x = (BIGNUM_LENGTH (x));
 | |
| 
 | |
| 	bignum * p = (allot_bignum ((length_x + 1), negative_p));
 | |
| 
 | |
| 	bignum_destructive_copy (x, p);
 | |
| 	(BIGNUM_REF (p, length_x)) = 0;
 | |
| 	bignum_destructive_scale_up (p, y);
 | |
| 	return (bignum_trim (p));
 | |
| }
 | |
| 
 | |
| void factor_vm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
 | |
| {
 | |
| 	bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
 | |
| 	bignum_digit_type digit;
 | |
| 	digit = ((*scan) + n);
 | |
| 	if (digit < BIGNUM_RADIX)
 | |
| 	{
 | |
| 		(*scan) = digit;
 | |
| 		return;
 | |
| 	}
 | |
| 	(*scan++) = (digit - BIGNUM_RADIX);
 | |
| 	while (1)
 | |
| 	{
 | |
| 		digit = ((*scan) + 1);
 | |
| 		if (digit < BIGNUM_RADIX)
 | |
| 		{
 | |
| 			(*scan) = digit;
 | |
| 			return;
 | |
| 		}
 | |
| 		(*scan++) = (digit - BIGNUM_RADIX);
 | |
| 	}
 | |
| }
 | |
| 
 | |
| void factor_vm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
 | |
| {
 | |
| 	bignum_digit_type carry = 0;
 | |
| 	bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
 | |
| 	bignum_digit_type two_digits;
 | |
| 	bignum_digit_type product_low;
 | |
| #define product_high carry
 | |
| 	bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
 | |
| 	BIGNUM_ASSERT ((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
 | |
| 	while (scan < end)
 | |
| 	{
 | |
| 		two_digits = (*scan);
 | |
| 		product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
 | |
| 		product_high =
 | |
| 			((factor * (HD_HIGH (two_digits))) +
 | |
| 			 (HD_HIGH (product_low)) +
 | |
| 			 (HD_HIGH (carry)));
 | |
| 		(*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
 | |
| 		carry = (HD_HIGH (product_high));
 | |
| 	}
 | |
| 	/* A carry here would be an overflow, i.e. it would not fit.
 | |
| 	   Hopefully the callers allocate enough space that this will
 | |
| 	   never happen.
 | |
| 	*/
 | |
| 	BIGNUM_ASSERT (carry == 0);
 | |
| 	return;
 | |
| #undef product_high
 | |
| }
 | |
| 
 | |
| /* Division */
 | |
| 
 | |
| /* For help understanding this algorithm, see:
 | |
|    Knuth, Donald E., "The Art of Computer Programming",
 | |
|    volume 2, "Seminumerical Algorithms"
 | |
|    section 4.3.1, "Multiple-Precision Arithmetic". */
 | |
| 
 | |
| /* allocates memory */
 | |
| void factor_vm::bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
 | |
| {
 | |
| 	GC_BIGNUM(numerator); GC_BIGNUM(denominator);
 | |
|   
 | |
| 	bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
 | |
| 	bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
 | |
| 
 | |
| 	bignum * q =
 | |
| 		((quotient != ((bignum * *) 0))
 | |
| 		 ? (allot_bignum ((length_n - length_d), q_negative_p))
 | |
| 		 : BIGNUM_OUT_OF_BAND);
 | |
| 	GC_BIGNUM(q);
 | |
|   
 | |
| 	bignum * u = (allot_bignum (length_n, r_negative_p));
 | |
| 	GC_BIGNUM(u);
 | |
|   
 | |
| 	int shift = 0;
 | |
| 	BIGNUM_ASSERT (length_d > 1);
 | |
| 	{
 | |
| 		bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
 | |
| 		while (v1 < (BIGNUM_RADIX / 2))
 | |
| 		{
 | |
| 			v1 <<= 1;
 | |
| 			shift += 1;
 | |
| 		}
 | |
| 	}
 | |
| 	if (shift == 0)
 | |
| 	{
 | |
| 		bignum_destructive_copy (numerator, u);
 | |
| 		(BIGNUM_REF (u, (length_n - 1))) = 0;
 | |
| 		bignum_divide_unsigned_normalized (u, denominator, q);
 | |
| 	}
 | |
| 	else
 | |
| 	{
 | |
| 		bignum * v = (allot_bignum (length_d, 0));
 | |
| 
 | |
| 		bignum_destructive_normalization (numerator, u, shift);
 | |
| 		bignum_destructive_normalization (denominator, v, shift);
 | |
| 		bignum_divide_unsigned_normalized (u, v, q);
 | |
| 		if (remainder != ((bignum * *) 0))
 | |
| 			bignum_destructive_unnormalization (u, shift);
 | |
| 	}
 | |
| 
 | |
| 	if(q)
 | |
| 		q = bignum_trim (q);
 | |
| 
 | |
| 	u = bignum_trim (u);
 | |
| 
 | |
| 	if (quotient != ((bignum * *) 0))
 | |
| 		(*quotient) = q;
 | |
| 
 | |
| 	if (remainder != ((bignum * *) 0))
 | |
| 		(*remainder) = u;
 | |
| 
 | |
| 	return;
 | |
| }
 | |
| 
 | |
| void factor_vm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
 | |
| {
 | |
| 	bignum_length_type u_length = (BIGNUM_LENGTH (u));
 | |
| 	bignum_length_type v_length = (BIGNUM_LENGTH (v));
 | |
| 	bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
 | |
| 	bignum_digit_type * u_scan = (u_start + u_length);
 | |
| 	bignum_digit_type * u_scan_limit = (u_start + v_length);
 | |
| 	bignum_digit_type * u_scan_start = (u_scan - v_length);
 | |
| 	bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
 | |
| 	bignum_digit_type * v_end = (v_start + v_length);
 | |
| 	bignum_digit_type * q_scan = NULL;
 | |
| 	bignum_digit_type v1 = (v_end[-1]);
 | |
| 	bignum_digit_type v2 = (v_end[-2]);
 | |
| 	bignum_digit_type ph;		/* high half of double-digit product */
 | |
| 	bignum_digit_type pl;		/* low half of double-digit product */
 | |
| 	bignum_digit_type guess;
 | |
| 	bignum_digit_type gh;		/* high half-digit of guess */
 | |
| 	bignum_digit_type ch;		/* high half of double-digit comparand */
 | |
| 	bignum_digit_type v2l = (HD_LOW (v2));
 | |
| 	bignum_digit_type v2h = (HD_HIGH (v2));
 | |
| 	bignum_digit_type cl;		/* low half of double-digit comparand */
 | |
| #define gl ph						/* low half-digit of guess */
 | |
| #define uj pl
 | |
| #define qj ph
 | |
| 	bignum_digit_type gm;				/* memory loc for reference parameter */
 | |
| 	if (q != BIGNUM_OUT_OF_BAND)
 | |
| 		q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
 | |
| 	while (u_scan_limit < u_scan)
 | |
| 	{
 | |
| 		uj = (*--u_scan);
 | |
| 		if (uj != v1)
 | |
| 		{
 | |
| 			/* comparand =
 | |
| 			   (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
 | |
| 			   guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
 | |
| 			cl = (u_scan[-2]);
 | |
| 			ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
 | |
| 			guess = gm;
 | |
| 		}
 | |
| 		else
 | |
| 		{
 | |
| 			cl = (u_scan[-2]);
 | |
| 			ch = ((u_scan[-1]) + v1);
 | |
| 			guess = (BIGNUM_RADIX - 1);
 | |
| 		}
 | |
| 		while (1)
 | |
| 		{
 | |
| 			/* product = (guess * v2); */
 | |
| 			gl = (HD_LOW (guess));
 | |
| 			gh = (HD_HIGH (guess));
 | |
| 			pl = (v2l * gl);
 | |
| 			ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
 | |
| 			pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
 | |
| 			ph = ((v2h * gh) + (HD_HIGH (ph)));
 | |
| 			/* if (comparand >= product) */
 | |
| 			if ((ch > ph) || ((ch == ph) && (cl >= pl)))
 | |
| 				break;
 | |
| 			guess -= 1;
 | |
| 			/* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
 | |
| 			ch += v1;
 | |
| 			/* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
 | |
| 			if (ch >= BIGNUM_RADIX)
 | |
| 				break;
 | |
| 		}
 | |
| 		qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
 | |
| 		if (q != BIGNUM_OUT_OF_BAND)
 | |
| 			(*--q_scan) = qj;
 | |
| 	}
 | |
| 	return;
 | |
| #undef gl
 | |
| #undef uj
 | |
| #undef qj
 | |
| }
 | |
| 
 | |
| bignum_digit_type factor_vm::bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
 | |
| {
 | |
| 	bignum_digit_type * v_scan = v_start;
 | |
| 	bignum_digit_type * u_scan = u_start;
 | |
| 	bignum_digit_type carry = 0;
 | |
| 	if (guess == 0) return (0);
 | |
| 	{
 | |
| 		bignum_digit_type gl = (HD_LOW (guess));
 | |
| 		bignum_digit_type gh = (HD_HIGH (guess));
 | |
| 		bignum_digit_type v;
 | |
| 		bignum_digit_type pl;
 | |
| 		bignum_digit_type vl;
 | |
| #define vh v
 | |
| #define ph carry
 | |
| #define diff pl
 | |
| 		while (v_scan < v_end)
 | |
| 		{
 | |
| 			v = (*v_scan++);
 | |
| 			vl = (HD_LOW (v));
 | |
| 			vh = (HD_HIGH (v));
 | |
| 			pl = ((vl * gl) + (HD_LOW (carry)));
 | |
| 			ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
 | |
| 			diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
 | |
| 			if (diff < 0)
 | |
| 			{
 | |
| 				(*u_scan++) = (diff + BIGNUM_RADIX);
 | |
| 				carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
 | |
| 			}
 | |
| 			else
 | |
| 			{
 | |
| 				(*u_scan++) = diff;
 | |
| 				carry = ((vh * gh) + (HD_HIGH (ph)));
 | |
| 			}
 | |
| 		}
 | |
| 		if (carry == 0)
 | |
| 			return (guess);
 | |
| 		diff = ((*u_scan) - carry);
 | |
| 		if (diff < 0)
 | |
| 			(*u_scan) = (diff + BIGNUM_RADIX);
 | |
| 		else
 | |
| 		{
 | |
| 			(*u_scan) = diff;
 | |
| 			return (guess);
 | |
| 		}
 | |
| #undef vh
 | |
| #undef ph
 | |
| #undef diff
 | |
| 	}
 | |
| 	/* Subtraction generated carry, implying guess is one too large.
 | |
| 	   Add v back in to bring it back down. */
 | |
| 	v_scan = v_start;
 | |
| 	u_scan = u_start;
 | |
| 	carry = 0;
 | |
| 	while (v_scan < v_end)
 | |
| 	{
 | |
| 		bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
 | |
| 		if (sum < BIGNUM_RADIX)
 | |
| 		{
 | |
| 			(*u_scan++) = sum;
 | |
| 			carry = 0;
 | |
| 		}
 | |
| 		else
 | |
| 		{
 | |
| 			(*u_scan++) = (sum - BIGNUM_RADIX);
 | |
| 			carry = 1;
 | |
| 		}
 | |
| 	}
 | |
| 	if (carry == 1)
 | |
| 	{
 | |
| 		bignum_digit_type sum = ((*u_scan) + carry);
 | |
| 		(*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
 | |
| 	}
 | |
| 	return (guess - 1);
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| void factor_vm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
 | |
| {
 | |
| 	GC_BIGNUM(numerator);
 | |
|   
 | |
| 	bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
 | |
| 	bignum_length_type length_q;
 | |
| 	bignum * q = NULL;
 | |
| 	GC_BIGNUM(q);
 | |
|   
 | |
| 	int shift = 0;
 | |
| 	/* Because `bignum_digit_divide' requires a normalized denominator. */
 | |
| 	while (denominator < (BIGNUM_RADIX / 2))
 | |
| 	{
 | |
| 		denominator <<= 1;
 | |
| 		shift += 1;
 | |
| 	}
 | |
| 	if (shift == 0)
 | |
| 	{
 | |
| 		length_q = length_n;
 | |
| 
 | |
| 		q = (allot_bignum (length_q, q_negative_p));
 | |
| 		bignum_destructive_copy (numerator, q);
 | |
| 	}
 | |
| 	else
 | |
| 	{
 | |
| 		length_q = (length_n + 1);
 | |
| 
 | |
| 		q = (allot_bignum (length_q, q_negative_p));
 | |
| 		bignum_destructive_normalization (numerator, q, shift);
 | |
| 	}
 | |
| 	{
 | |
| 		bignum_digit_type r = 0;
 | |
| 		bignum_digit_type * start = (BIGNUM_START_PTR (q));
 | |
| 		bignum_digit_type * scan = (start + length_q);
 | |
| 		bignum_digit_type qj;
 | |
| 
 | |
| 		while (start < scan)
 | |
| 		{
 | |
| 			r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
 | |
| 			(*scan) = qj;
 | |
| 		}
 | |
| 
 | |
| 		q = bignum_trim (q);
 | |
| 
 | |
| 		if (remainder != ((bignum * *) 0))
 | |
| 		{
 | |
| 			if (shift != 0)
 | |
| 				r >>= shift;
 | |
| 
 | |
| 			(*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
 | |
| 		}
 | |
| 
 | |
| 		if (quotient != ((bignum * *) 0))
 | |
| 			(*quotient) = q;
 | |
| 	}
 | |
| 	return;
 | |
| }
 | |
| 
 | |
| void factor_vm::bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
 | |
| {
 | |
| 	bignum_digit_type digit;
 | |
| 	bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
 | |
| 	bignum_digit_type carry = 0;
 | |
| 	bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
 | |
| 	bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
 | |
| 	bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
 | |
| 	int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
 | |
| 	bignum_digit_type mask = (((cell)1 << shift_right) - 1);
 | |
| 	while (scan_source < end_source)
 | |
| 	{
 | |
| 		digit = (*scan_source++);
 | |
| 		(*scan_target++) = (((digit & mask) << shift_left) | carry);
 | |
| 		carry = (digit >> shift_right);
 | |
| 	}
 | |
| 	if (scan_target < end_target)
 | |
| 		(*scan_target) = carry;
 | |
| 	else
 | |
| 		BIGNUM_ASSERT (carry == 0);
 | |
| 	return;
 | |
| }
 | |
| 
 | |
| void factor_vm::bignum_destructive_unnormalization(bignum * bignum, int shift_right)
 | |
| {
 | |
| 	bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
 | |
| 	bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
 | |
| 	bignum_digit_type digit;
 | |
| 	bignum_digit_type carry = 0;
 | |
| 	int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
 | |
| 	bignum_digit_type mask = (((fixnum)1 << shift_right) - 1);
 | |
| 	while (start < scan)
 | |
| 	{
 | |
| 		digit = (*--scan);
 | |
| 		(*scan) = ((digit >> shift_right) | carry);
 | |
| 		carry = ((digit & mask) << shift_left);
 | |
| 	}
 | |
| 	BIGNUM_ASSERT (carry == 0);
 | |
| 	return;
 | |
| }
 | |
| 
 | |
| /* This is a reduced version of the division algorithm, applied to the
 | |
|    case of dividing two bignum digits by one bignum digit.  It is
 | |
|    assumed that the numerator, denominator are normalized. */
 | |
| 
 | |
| #define BDD_STEP(qn, j)							\
 | |
| {									\
 | |
| 	uj = (u[j]);							\
 | |
| 	if (uj != v1)							\
 | |
| 	{								\
 | |
| 		uj_uj1 = (HD_CONS (uj, (u[j + 1])));			\
 | |
| 		guess = (uj_uj1 / v1);					\
 | |
| 		comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2])));	\
 | |
| 	}								\
 | |
| 	else								\
 | |
| 	{								\
 | |
| 		guess = (BIGNUM_RADIX_ROOT - 1);			\
 | |
| 		comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2])));	\
 | |
| 	}								\
 | |
| 	while ((guess * v2) > comparand)				\
 | |
| 	{								\
 | |
| 		guess -= 1;						\
 | |
| 		comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH);		\
 | |
| 		if (comparand >= BIGNUM_RADIX)				\
 | |
| 			break;						\
 | |
| 	}								\
 | |
| 	qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j])));	\
 | |
| }
 | |
| 
 | |
| bignum_digit_type factor_vm::bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, bignum_digit_type v, bignum_digit_type * q) /* return value */
 | |
| {
 | |
| 	bignum_digit_type guess;
 | |
| 	bignum_digit_type comparand;
 | |
| 	bignum_digit_type v1 = (HD_HIGH (v));
 | |
| 	bignum_digit_type v2 = (HD_LOW (v));
 | |
| 	bignum_digit_type uj;
 | |
| 	bignum_digit_type uj_uj1;
 | |
| 	bignum_digit_type q1;
 | |
| 	bignum_digit_type q2;
 | |
| 	bignum_digit_type u [4];
 | |
| 	if (uh == 0)
 | |
| 	{
 | |
| 		if (ul < v)
 | |
| 		{
 | |
| 			(*q) = 0;
 | |
| 			return (ul);
 | |
| 		}
 | |
| 		else if (ul == v)
 | |
| 		{
 | |
| 			(*q) = 1;
 | |
| 			return (0);
 | |
| 		}
 | |
| 	}
 | |
| 	(u[0]) = (HD_HIGH (uh));
 | |
| 	(u[1]) = (HD_LOW (uh));
 | |
| 	(u[2]) = (HD_HIGH (ul));
 | |
| 	(u[3]) = (HD_LOW (ul));
 | |
| 	v1 = (HD_HIGH (v));
 | |
| 	v2 = (HD_LOW (v));
 | |
| 	BDD_STEP (q1, 0);
 | |
| 	BDD_STEP (q2, 1);
 | |
| 	(*q) = (HD_CONS (q1, q2));
 | |
| 	return (HD_CONS ((u[2]), (u[3])));
 | |
| }
 | |
| 
 | |
| #undef BDD_STEP
 | |
| 
 | |
| #define BDDS_MULSUB(vn, un, carry_in)				\
 | |
| {								\
 | |
| 	product = ((vn * guess) + carry_in);			\
 | |
| 	diff = (un - (HD_LOW (product)));			\
 | |
| 	if (diff < 0)						\
 | |
| 	{							\
 | |
| 			un = (diff + BIGNUM_RADIX_ROOT);	\
 | |
| 			carry = ((HD_HIGH (product)) + 1);	\
 | |
| 	}							\
 | |
| 	else							\
 | |
| 	{							\
 | |
| 			un = diff;				\
 | |
| 			carry = (HD_HIGH (product));		\
 | |
| 	}							\
 | |
| }
 | |
| 
 | |
| #define BDDS_ADD(vn, un, carry_in)				\
 | |
| {								\
 | |
| 	sum = (vn + un + carry_in);				\
 | |
| 	if (sum < BIGNUM_RADIX_ROOT)				\
 | |
| 	{							\
 | |
| 			un = sum;				\
 | |
| 			carry = 0;				\
 | |
| 	}							\
 | |
| 	else							\
 | |
| 	{							\
 | |
| 			un = (sum - BIGNUM_RADIX_ROOT);		\
 | |
| 			carry = 1;				\
 | |
| 	}							\
 | |
| }
 | |
| 
 | |
| bignum_digit_type factor_vm::bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
 | |
| {
 | |
| 	{
 | |
| 		bignum_digit_type product;
 | |
| 		bignum_digit_type diff;
 | |
| 		bignum_digit_type carry;
 | |
| 		BDDS_MULSUB (v2, (u[2]), 0);
 | |
| 		BDDS_MULSUB (v1, (u[1]), carry);
 | |
| 		if (carry == 0)
 | |
| 			return (guess);
 | |
| 		diff = ((u[0]) - carry);
 | |
| 		if (diff < 0)
 | |
| 			(u[0]) = (diff + BIGNUM_RADIX);
 | |
| 		else
 | |
| 		{
 | |
| 			(u[0]) = diff;
 | |
| 			return (guess);
 | |
| 		}
 | |
| 	}
 | |
| 	{
 | |
| 		bignum_digit_type sum;
 | |
| 		bignum_digit_type carry;
 | |
| 		BDDS_ADD(v2, (u[2]), 0);
 | |
| 		BDDS_ADD(v1, (u[1]), carry);
 | |
| 		if (carry == 1)
 | |
| 			(u[0]) += 1;
 | |
| 	}
 | |
| 	return (guess - 1);
 | |
| }
 | |
| 
 | |
| #undef BDDS_MULSUB
 | |
| #undef BDDS_ADD
 | |
| 
 | |
| /* allocates memory */
 | |
| void factor_vm::bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
 | |
| {
 | |
| 	GC_BIGNUM(numerator);
 | |
|   
 | |
| 	bignum * q = (bignum_new_sign (numerator, q_negative_p));
 | |
| 	GC_BIGNUM(q);
 | |
| 
 | |
| 	bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
 | |
| 
 | |
| 	q = (bignum_trim (q));
 | |
| 
 | |
| 	if (remainder != ((bignum * *) 0))
 | |
| 		(*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
 | |
| 
 | |
| 	(*quotient) = q;
 | |
| 
 | |
| 	return;
 | |
| }
 | |
| 
 | |
| /* Given (denominator > 1), it is fairly easy to show that
 | |
|    (quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
 | |
|    that all digits are < BIGNUM_RADIX. */
 | |
| 
 | |
| bignum_digit_type factor_vm::bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
 | |
| {
 | |
| 	bignum_digit_type numerator;
 | |
| 	bignum_digit_type remainder = 0;
 | |
| 	bignum_digit_type two_digits;
 | |
| #define quotient_high remainder
 | |
| 	bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
 | |
| 	bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
 | |
| 	BIGNUM_ASSERT ((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
 | |
| 	while (start < scan)
 | |
| 	{
 | |
| 		two_digits = (*--scan);
 | |
| 		numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
 | |
| 		quotient_high = (numerator / denominator);
 | |
| 		numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
 | |
| 		(*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
 | |
| 		remainder = (numerator % denominator);
 | |
| 	}
 | |
| 	return (remainder);
 | |
| #undef quotient_high
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum * factor_vm::bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
 | |
| {
 | |
| 	bignum_digit_type two_digits;
 | |
| 	bignum_digit_type * start = (BIGNUM_START_PTR (n));
 | |
| 	bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
 | |
| 	bignum_digit_type r = 0;
 | |
| 	BIGNUM_ASSERT ((d > 1) && (d < BIGNUM_RADIX_ROOT));
 | |
| 	while (start < scan)
 | |
| 	{
 | |
| 		two_digits = (*--scan);
 | |
| 		r =
 | |
| 			((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
 | |
| 					   (HD_LOW (two_digits))))
 | |
| 			 % d);
 | |
| 	}
 | |
| 	return (bignum_digit_to_bignum (r, negative_p));
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
 | |
| {
 | |
| 	if (digit == 0)
 | |
| 		return (BIGNUM_ZERO ());
 | |
| 	else
 | |
| 	{
 | |
| 		bignum * result = (allot_bignum (1, negative_p));
 | |
| 		(BIGNUM_REF (result, 0)) = digit;
 | |
| 		return (result);
 | |
| 	}
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::allot_bignum(bignum_length_type length, int negative_p)
 | |
| {
 | |
| 	BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
 | |
| 	bignum * result = allot_uninitialized_array<bignum>(length + 1);
 | |
| 	BIGNUM_SET_NEGATIVE_P (result, negative_p);
 | |
| 	return (result);
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum * factor_vm::allot_bignum_zeroed(bignum_length_type length, int negative_p)
 | |
| {
 | |
| 	bignum * result = allot_bignum(length,negative_p);
 | |
| 	bignum_digit_type * scan = (BIGNUM_START_PTR (result));
 | |
| 	bignum_digit_type * end = (scan + length);
 | |
| 	while (scan < end)
 | |
| 		(*scan++) = 0;
 | |
| 	return (result);
 | |
| }
 | |
| 
 | |
| #define BIGNUM_REDUCE_LENGTH(source, length)	\
 | |
| source = reallot_array(source,length + 1)
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_shorten_length(bignum * bignum, bignum_length_type length)
 | |
| {
 | |
| 	bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
 | |
| 	BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
 | |
| 	if (length < current_length)
 | |
| 	{
 | |
| 		BIGNUM_REDUCE_LENGTH (bignum, length);
 | |
| 		BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
 | |
| 	}
 | |
| 	return (bignum);
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_trim(bignum * bignum)
 | |
| {
 | |
| 	bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
 | |
| 	bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
 | |
| 	bignum_digit_type * scan = end;
 | |
| 	while ((start <= scan) && ((*--scan) == 0))
 | |
| 		;
 | |
| 	scan += 1;
 | |
| 	if (scan < end)
 | |
| 	{
 | |
| 		bignum_length_type length = (scan - start);
 | |
| 		BIGNUM_REDUCE_LENGTH (bignum, length);
 | |
| 		BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
 | |
| 	}
 | |
| 	return (bignum);
 | |
| }
 | |
| 
 | |
| /* Copying */
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_new_sign(bignum * x, int negative_p)
 | |
| {
 | |
| 	GC_BIGNUM(x);
 | |
| 	bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
 | |
| 
 | |
| 	bignum_destructive_copy (x, result);
 | |
| 	return (result);
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_maybe_new_sign(bignum * x, int negative_p)
 | |
| {
 | |
| 	if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
 | |
| 		return (x);
 | |
| 	else
 | |
| 	{
 | |
| 		bignum * result =
 | |
| 			(allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
 | |
| 		bignum_destructive_copy (x, result);
 | |
| 		return (result);
 | |
| 	}
 | |
| }
 | |
| 
 | |
| void factor_vm::bignum_destructive_copy(bignum * source, bignum * target)
 | |
| {
 | |
| 	bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
 | |
| 	bignum_digit_type * end_source =
 | |
| 		(scan_source + (BIGNUM_LENGTH (source)));
 | |
| 	bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
 | |
| 	while (scan_source < end_source)
 | |
| 		(*scan_target++) = (*scan_source++);
 | |
| 	return;
 | |
| }
 | |
| 
 | |
| /*
 | |
|  * Added bitwise operations (and oddp).
 | |
|  */
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_bitwise_not(bignum * x)
 | |
| {
 | |
| 	return bignum_subtract(BIGNUM_ONE(1), x);
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
 | |
| {
 | |
| 	if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
 | |
| 		return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
 | |
| 	else
 | |
| 		return bignum_magnitude_ash(arg1, n);
 | |
| }
 | |
| 
 | |
| #define AND_OP 0
 | |
| #define IOR_OP 1
 | |
| #define XOR_OP 2
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_bitwise_and(bignum * arg1, bignum * arg2)
 | |
| {
 | |
| 	return(
 | |
| 		   (BIGNUM_NEGATIVE_P (arg1))
 | |
| 		   ? (BIGNUM_NEGATIVE_P (arg2))
 | |
| 		   ? bignum_negneg_bitwise_op(AND_OP, arg1, arg2)
 | |
| 		   : bignum_posneg_bitwise_op(AND_OP, arg2, arg1)
 | |
| 		   : (BIGNUM_NEGATIVE_P (arg2))
 | |
| 		   ? bignum_posneg_bitwise_op(AND_OP, arg1, arg2)
 | |
| 		   : bignum_pospos_bitwise_op(AND_OP, arg1, arg2)
 | |
| 		   );
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
 | |
| {
 | |
| 	return(
 | |
| 		   (BIGNUM_NEGATIVE_P (arg1))
 | |
| 		   ? (BIGNUM_NEGATIVE_P (arg2))
 | |
| 		   ? bignum_negneg_bitwise_op(IOR_OP, arg1, arg2)
 | |
| 		   : bignum_posneg_bitwise_op(IOR_OP, arg2, arg1)
 | |
| 		   : (BIGNUM_NEGATIVE_P (arg2))
 | |
| 		   ? bignum_posneg_bitwise_op(IOR_OP, arg1, arg2)
 | |
| 		   : bignum_pospos_bitwise_op(IOR_OP, arg1, arg2)
 | |
| 		   );
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
 | |
| {
 | |
| 	return(
 | |
| 		   (BIGNUM_NEGATIVE_P (arg1))
 | |
| 		   ? (BIGNUM_NEGATIVE_P (arg2))
 | |
| 		   ? bignum_negneg_bitwise_op(XOR_OP, arg1, arg2)
 | |
| 		   : bignum_posneg_bitwise_op(XOR_OP, arg2, arg1)
 | |
| 		   : (BIGNUM_NEGATIVE_P (arg2))
 | |
| 		   ? bignum_posneg_bitwise_op(XOR_OP, arg1, arg2)
 | |
| 		   : bignum_pospos_bitwise_op(XOR_OP, arg1, arg2)
 | |
| 		   );
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| /* ash for the magnitude */
 | |
| /* assume arg1 is a big number, n is a long */
 | |
| bignum *factor_vm::bignum_magnitude_ash(bignum * arg1, fixnum n)
 | |
| {
 | |
| 	GC_BIGNUM(arg1);
 | |
|   
 | |
| 	bignum * result = NULL;
 | |
| 	bignum_digit_type *scan1;
 | |
| 	bignum_digit_type *scanr;
 | |
| 	bignum_digit_type *end;
 | |
| 
 | |
| 	fixnum digit_offset,bit_offset;
 | |
| 
 | |
| 	if (BIGNUM_ZERO_P (arg1)) return (arg1);
 | |
| 
 | |
| 	if (n > 0) {
 | |
| 		digit_offset = n / BIGNUM_DIGIT_LENGTH;
 | |
| 		bit_offset =   n % BIGNUM_DIGIT_LENGTH;
 | |
| 
 | |
| 		result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
 | |
| 									  BIGNUM_NEGATIVE_P(arg1));
 | |
| 
 | |
| 		scanr = BIGNUM_START_PTR (result) + digit_offset;
 | |
| 		scan1 = BIGNUM_START_PTR (arg1);
 | |
| 		end = scan1 + BIGNUM_LENGTH (arg1);
 | |
| 	
 | |
| 		while (scan1 < end) {
 | |
| 			*scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
 | |
| 			*scanr = *scanr & BIGNUM_DIGIT_MASK;
 | |
| 			scanr++;
 | |
| 			*scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
 | |
| 			*scanr = *scanr & BIGNUM_DIGIT_MASK;
 | |
| 		}
 | |
| 	}
 | |
| 	else if (n < 0
 | |
| 			 && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
 | |
| 		result = BIGNUM_ZERO ();
 | |
| 
 | |
| 	else if (n < 0) {
 | |
| 		digit_offset = -n / BIGNUM_DIGIT_LENGTH;
 | |
| 		bit_offset =   -n % BIGNUM_DIGIT_LENGTH;
 | |
| 	
 | |
| 		result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
 | |
| 									  BIGNUM_NEGATIVE_P(arg1));
 | |
| 	
 | |
| 		scanr = BIGNUM_START_PTR (result);
 | |
| 		scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
 | |
| 		end = scanr + BIGNUM_LENGTH (result) - 1;
 | |
| 	
 | |
| 		while (scanr < end) {
 | |
| 			*scanr =  (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
 | |
| 			*scanr = (*scanr | 
 | |
| 					  *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
 | |
| 			scanr++;
 | |
| 		}
 | |
| 		*scanr =  (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
 | |
| 	}
 | |
| 	else if (n == 0) result = arg1;
 | |
|   
 | |
| 	return (bignum_trim (result));
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
 | |
| {
 | |
| 	GC_BIGNUM(arg1); GC_BIGNUM(arg2);
 | |
|   
 | |
| 	bignum * result;
 | |
| 	bignum_length_type max_length;
 | |
| 
 | |
| 	bignum_digit_type *scan1, *end1, digit1;
 | |
| 	bignum_digit_type *scan2, *end2, digit2;
 | |
| 	bignum_digit_type *scanr, *endr;
 | |
| 
 | |
| 	max_length =  (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
 | |
| 		? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
 | |
| 
 | |
| 	result = allot_bignum(max_length, 0);
 | |
| 
 | |
| 	scanr = BIGNUM_START_PTR(result);
 | |
| 	scan1 = BIGNUM_START_PTR(arg1);
 | |
| 	scan2 = BIGNUM_START_PTR(arg2);
 | |
| 	endr = scanr + max_length;
 | |
| 	end1 = scan1 + BIGNUM_LENGTH(arg1);
 | |
| 	end2 = scan2 + BIGNUM_LENGTH(arg2);
 | |
| 
 | |
| 	while (scanr < endr) {
 | |
| 		digit1 = (scan1 < end1) ? *scan1++ : 0;
 | |
| 		digit2 = (scan2 < end2) ? *scan2++ : 0;
 | |
| 		*scanr++ = (op == AND_OP) ? digit1 & digit2 :
 | |
| 			(op == IOR_OP) ? digit1 | digit2 :
 | |
| 			digit1 ^ digit2;
 | |
| 	}
 | |
| 	return bignum_trim(result);
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
 | |
| {
 | |
| 	GC_BIGNUM(arg1); GC_BIGNUM(arg2);
 | |
|   
 | |
| 	bignum * result;
 | |
| 	bignum_length_type max_length;
 | |
| 
 | |
| 	bignum_digit_type *scan1, *end1, digit1;
 | |
| 	bignum_digit_type *scan2, *end2, digit2, carry2;
 | |
| 	bignum_digit_type *scanr, *endr;
 | |
| 
 | |
| 	char neg_p = op == IOR_OP || op == XOR_OP;
 | |
| 
 | |
| 	max_length =  (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
 | |
| 		? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
 | |
| 
 | |
| 	result = allot_bignum(max_length, neg_p);
 | |
| 
 | |
| 	scanr = BIGNUM_START_PTR(result);
 | |
| 	scan1 = BIGNUM_START_PTR(arg1);
 | |
| 	scan2 = BIGNUM_START_PTR(arg2);
 | |
| 	endr = scanr + max_length;
 | |
| 	end1 = scan1 + BIGNUM_LENGTH(arg1);
 | |
| 	end2 = scan2 + BIGNUM_LENGTH(arg2);
 | |
| 
 | |
| 	carry2 = 1;
 | |
| 
 | |
| 	while (scanr < endr) {
 | |
| 		digit1 = (scan1 < end1) ? *scan1++ : 0;
 | |
| 		digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
 | |
| 			+ carry2;
 | |
| 
 | |
| 		if (digit2 < BIGNUM_RADIX)
 | |
| 			carry2 = 0;
 | |
| 		else
 | |
| 		{
 | |
| 			digit2 = (digit2 - BIGNUM_RADIX);
 | |
| 			carry2 = 1;
 | |
| 		}
 | |
| 	
 | |
| 		*scanr++ = (op == AND_OP) ? digit1 & digit2 :
 | |
| 			(op == IOR_OP) ? digit1 | digit2 :
 | |
| 			digit1 ^ digit2;
 | |
| 	}
 | |
|   
 | |
| 	if (neg_p)
 | |
| 		bignum_negate_magnitude(result);
 | |
| 
 | |
| 	return bignum_trim(result);
 | |
| }
 | |
| 
 | |
| /* allocates memory */
 | |
| bignum *factor_vm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
 | |
| {
 | |
| 	GC_BIGNUM(arg1); GC_BIGNUM(arg2);
 | |
|   
 | |
| 	bignum * result;
 | |
| 	bignum_length_type max_length;
 | |
| 
 | |
| 	bignum_digit_type *scan1, *end1, digit1, carry1;
 | |
| 	bignum_digit_type *scan2, *end2, digit2, carry2;
 | |
| 	bignum_digit_type *scanr, *endr;
 | |
| 
 | |
| 	char neg_p = op == AND_OP || op == IOR_OP;
 | |
| 
 | |
| 	max_length =  (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
 | |
| 		? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
 | |
| 
 | |
| 	result = allot_bignum(max_length, neg_p);
 | |
| 
 | |
| 	scanr = BIGNUM_START_PTR(result);
 | |
| 	scan1 = BIGNUM_START_PTR(arg1);
 | |
| 	scan2 = BIGNUM_START_PTR(arg2);
 | |
| 	endr = scanr + max_length;
 | |
| 	end1 = scan1 + BIGNUM_LENGTH(arg1);
 | |
| 	end2 = scan2 + BIGNUM_LENGTH(arg2);
 | |
| 
 | |
| 	carry1 = 1;
 | |
| 	carry2 = 1;
 | |
| 
 | |
| 	while (scanr < endr) {
 | |
| 		digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
 | |
| 		digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
 | |
| 
 | |
| 		if (digit1 < BIGNUM_RADIX)
 | |
| 			carry1 = 0;
 | |
| 		else
 | |
| 		{
 | |
| 			digit1 = (digit1 - BIGNUM_RADIX);
 | |
| 			carry1 = 1;
 | |
| 		}
 | |
| 	
 | |
| 		if (digit2 < BIGNUM_RADIX)
 | |
| 			carry2 = 0;
 | |
| 		else
 | |
| 		{
 | |
| 			digit2 = (digit2 - BIGNUM_RADIX);
 | |
| 			carry2 = 1;
 | |
| 		}
 | |
| 	
 | |
| 		*scanr++ = (op == AND_OP) ? digit1 & digit2 :
 | |
| 			(op == IOR_OP) ? digit1 | digit2 :
 | |
| 			digit1 ^ digit2;
 | |
| 	}
 | |
| 
 | |
| 	if (neg_p)
 | |
| 		bignum_negate_magnitude(result);
 | |
| 
 | |
| 	return bignum_trim(result);
 | |
| }
 | |
| 
 | |
| void factor_vm::bignum_negate_magnitude(bignum * arg)
 | |
| {
 | |
| 	bignum_digit_type *scan;
 | |
| 	bignum_digit_type *end;
 | |
| 	bignum_digit_type digit;
 | |
| 	bignum_digit_type carry;
 | |
| 
 | |
| 	scan = BIGNUM_START_PTR(arg);
 | |
| 	end = scan + BIGNUM_LENGTH(arg);
 | |
| 
 | |
| 	carry = 1;
 | |
| 
 | |
| 	while (scan < end) {
 | |
| 		digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
 | |
| 
 | |
| 		if (digit < BIGNUM_RADIX)
 | |
| 			carry = 0;
 | |
| 		else
 | |
| 		{
 | |
| 			digit = (digit - BIGNUM_RADIX);
 | |
| 			carry = 1;
 | |
| 		}
 | |
| 	
 | |
| 		*scan++ = digit;
 | |
| 	}
 | |
| }
 | |
| 
 | |
| /* Allocates memory */
 | |
| bignum *factor_vm::bignum_integer_length(bignum * x)
 | |
| {
 | |
| 	GC_BIGNUM(x);
 | |
|   
 | |
| 	bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
 | |
| 	bignum_digit_type digit = (BIGNUM_REF (x, index));
 | |
|   
 | |
| 	bignum * result = (allot_bignum (2, 0));
 | |
|   
 | |
| 	(BIGNUM_REF (result, 0)) = index;
 | |
| 	(BIGNUM_REF (result, 1)) = 0;
 | |
| 	bignum_destructive_scale_up (result, BIGNUM_DIGIT_LENGTH);
 | |
| 	while (digit > 1)
 | |
| 	{
 | |
| 		bignum_destructive_add (result, ((bignum_digit_type) 1));
 | |
| 		digit >>= 1;
 | |
| 	}
 | |
| 	return (bignum_trim (result));
 | |
| }
 | |
| 
 | |
| /* Allocates memory */
 | |
| int factor_vm::bignum_logbitp(int shift, bignum * arg)
 | |
| {
 | |
| 	return((BIGNUM_NEGATIVE_P (arg)) 
 | |
| 		   ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
 | |
| 		   : bignum_unsigned_logbitp (shift,arg));
 | |
| }
 | |
| 
 | |
| int factor_vm::bignum_unsigned_logbitp(int shift, bignum * bignum)
 | |
| {
 | |
| 	bignum_length_type len = (BIGNUM_LENGTH (bignum));
 | |
| 	int index = shift / BIGNUM_DIGIT_LENGTH;
 | |
| 	if (index >= len)
 | |
| 		return 0;
 | |
| 	bignum_digit_type digit = (BIGNUM_REF (bignum, index));
 | |
| 	int p = shift % BIGNUM_DIGIT_LENGTH;
 | |
| 	bignum_digit_type mask = ((fixnum)1) << p;
 | |
| 	return (digit & mask) ? 1 : 0;
 | |
| }
 | |
| 
 | |
| 
 | |
| #ifdef _WIN64
 | |
| /* Allocates memory */
 | |
| bignum * factor_vm::bignum_gcd(bignum * a, bignum * b)
 | |
| {
 | |
|     GC_BIGNUM(a);
 | |
|     GC_BIGNUM(b);
 | |
|     bignum * d;
 | |
|     bignum_length_type size_a, size_b;
 | |
|     bignum_digit_type * scan_a, * scan_b, * scan_d, * a_end, * b_end;
 | |
| 
 | |
|     if (BIGNUM_NEGATIVE_P (a)) {
 | |
|         scan_a = BIGNUM_START_PTR (a);
 | |
|         size_a = BIGNUM_LENGTH (a);
 | |
|         a_end = scan_a + size_a;
 | |
|         d = allot_bignum (size_a, 0);
 | |
|         GC_BIGNUM(d);
 | |
|         scan_d = BIGNUM_START_PTR (d);
 | |
|         while (scan_a < a_end)
 | |
|             (*scan_d++) = (*scan_a++);
 | |
|         a = d;
 | |
|     }
 | |
| 
 | |
|     if (BIGNUM_NEGATIVE_P (b)) {
 | |
|         scan_b = BIGNUM_START_PTR (b);
 | |
|         size_b = BIGNUM_LENGTH (b);
 | |
|         b_end = scan_b + size_b;
 | |
|         d = allot_bignum (size_b, 0);
 | |
|         GC_BIGNUM(d);
 | |
|         scan_d = BIGNUM_START_PTR (d);
 | |
|         while (scan_b < b_end)
 | |
|             (*scan_d++) = (*scan_b++);
 | |
|         b = d;
 | |
|     }
 | |
| 
 | |
|     if (bignum_compare(a, b) == bignum_comparison_less) {
 | |
|         d = a;
 | |
|         a = b;
 | |
|         b = d;
 | |
|     }
 | |
| 
 | |
|     while (BIGNUM_LENGTH (b) != 0) {
 | |
|         d = bignum_remainder (a, b);
 | |
|         GC_BIGNUM(d);
 | |
|         if (d == BIGNUM_OUT_OF_BAND) {
 | |
|             return d;
 | |
|         }
 | |
|         a = b;
 | |
|         b = d;
 | |
|     }
 | |
| 
 | |
|     return a;
 | |
| }
 | |
| #else
 | |
| /* Allocates memory */
 | |
| bignum * factor_vm::bignum_gcd(bignum * a, bignum * b)
 | |
| {
 | |
|     GC_BIGNUM(a);
 | |
|     GC_BIGNUM(b);
 | |
|     bignum *c, *d, *e, *f;
 | |
|     bignum_twodigit_type x, y, q, s, t, A, B, C, D;
 | |
|     int nbits, k;
 | |
|     bignum_length_type size_a, size_b, size_c;
 | |
|     bignum_digit_type *scan_a, *scan_b, *scan_c, *scan_d;
 | |
|     bignum_digit_type *a_end, *b_end, *c_end;
 | |
| 
 | |
|     /* clone the bignums so we can modify them in-place */
 | |
|     scan_a = BIGNUM_START_PTR (a);
 | |
|     size_a = BIGNUM_LENGTH (a);
 | |
|     a_end = scan_a + size_a;
 | |
|     c = allot_bignum (size_a, 0);
 | |
|     GC_BIGNUM(c);
 | |
|     scan_c = BIGNUM_START_PTR (c);
 | |
|     while (scan_a < a_end)
 | |
|         (*scan_c++) = (*scan_a++);
 | |
|     a = c;
 | |
|     scan_b = BIGNUM_START_PTR (b);
 | |
|     size_b = BIGNUM_LENGTH (b);
 | |
|     b_end = scan_b + size_b;
 | |
|     d = allot_bignum (size_b, 0);
 | |
|     GC_BIGNUM(d);
 | |
|     scan_d = BIGNUM_START_PTR (d);
 | |
|     while (scan_b < b_end)
 | |
|         (*scan_d++) = (*scan_b++);
 | |
|     b = d;
 | |
| 
 | |
|     /* Initial reduction: make sure that 0 <= b <= a. */
 | |
|     if (bignum_compare(a, b) == bignum_comparison_less) {
 | |
|         c = a;
 | |
|         size_c = size_a;
 | |
|         a = b;
 | |
|         size_a = size_b;
 | |
|         b = c;
 | |
|         size_b = size_c;
 | |
|     }
 | |
| 
 | |
|     while (size_a > 1) {
 | |
|         nbits = log2 (BIGNUM_REF (a, size_a-1));
 | |
|         x = ((BIGNUM_REF (a, size_a-1) << (BIGNUM_DIGIT_LENGTH - nbits)) |
 | |
|              (BIGNUM_REF (a, size_a-2) >> nbits));
 | |
|         y = ((size_b >= size_a - 1 ? BIGNUM_REF (b, size_a-2) >> nbits : 0) |
 | |
|              (size_b >= size_a ? BIGNUM_REF (b, size_a-1) << (BIGNUM_DIGIT_LENGTH - nbits) : 0));
 | |
| 
 | |
|         /* inner loop of Lehmer's algorithm; */
 | |
|         A = 1; B = 0; C = 0; D = 1;
 | |
|         for (k=0 ;; k++) {
 | |
|             if (y - C == 0)
 | |
|                 break;
 | |
| 
 | |
|             q = (x + (A - 1)) / (y - C);
 | |
| 
 | |
|             s = B + (q * D);
 | |
|             t = x - (q * y);
 | |
| 
 | |
|             if (s > t)
 | |
|                 break;
 | |
| 
 | |
|             x = y;
 | |
|             y = t;
 | |
| 
 | |
|             t = A + (q * C);
 | |
| 
 | |
|             A = D; B = C; C = s; D = t;
 | |
|         }
 | |
| 
 | |
|         if (k == 0) {
 | |
|             /* no progress; do a Euclidean step */
 | |
|             if (size_b == 0) {
 | |
|                 return bignum_trim (a);
 | |
|             }
 | |
|             e = bignum_trim (a);
 | |
|             GC_BIGNUM(e);
 | |
|             f = bignum_trim (b);
 | |
|             GC_BIGNUM(f);
 | |
|             c = bignum_remainder (e, f);
 | |
|             GC_BIGNUM (c);
 | |
|             if (c == BIGNUM_OUT_OF_BAND) {
 | |
|                 return c;
 | |
|             }
 | |
| 
 | |
|             // copy 'b' to 'a'
 | |
|             scan_a = BIGNUM_START_PTR (a);
 | |
|             scan_b = BIGNUM_START_PTR (b);
 | |
|             a_end = scan_a + size_a;
 | |
|             b_end = scan_b + size_b;
 | |
|             while (scan_b < b_end) *(scan_a++) = *(scan_b++);
 | |
|             while (scan_a < a_end) *(scan_a++) = 0;
 | |
|             size_a = size_b;
 | |
| 
 | |
|             // copy 'c' to 'b'
 | |
|             scan_b = BIGNUM_START_PTR (b);
 | |
|             scan_c = BIGNUM_START_PTR (c);
 | |
|             size_c = BIGNUM_LENGTH (c);
 | |
|             c_end = scan_c + size_c;
 | |
|             while (scan_c < c_end) *(scan_b++) = *(scan_c++);
 | |
|             while (scan_b < b_end) *(scan_b++) = 0;
 | |
|             size_b = size_c;
 | |
| 
 | |
|             continue;
 | |
|         }
 | |
| 
 | |
|         /*
 | |
|           a, b = A*b - B*a, D*a - C*b if k is odd
 | |
|           a, b = A*a - B*b, D*b - C*a if k is even
 | |
|         */
 | |
|         scan_a = BIGNUM_START_PTR (a);
 | |
|         scan_b = BIGNUM_START_PTR (b);
 | |
|         scan_c = scan_a;
 | |
|         scan_d = scan_b;
 | |
|         a_end = scan_a + size_a;
 | |
|         b_end = scan_b + size_b;
 | |
|         s = 0;
 | |
|         t = 0;
 | |
|         if (k & 1) {
 | |
|             while (scan_b < b_end) {
 | |
|                 s += (A * *scan_b) - (B * *scan_a);
 | |
|                 t += (D * *scan_a++) - (C * *scan_b++);
 | |
|                 *scan_c++ = (bignum_digit_type) (s & BIGNUM_DIGIT_MASK);
 | |
|                 *scan_d++ = (bignum_digit_type) (t & BIGNUM_DIGIT_MASK);
 | |
|                 s >>= BIGNUM_DIGIT_LENGTH;
 | |
|                 t >>= BIGNUM_DIGIT_LENGTH;
 | |
|             }
 | |
|             while (scan_a < a_end) {
 | |
|                 s -= (B * *scan_a);
 | |
|                 t += (D * *scan_a++);
 | |
|                 *scan_c++ = (bignum_digit_type) (s & BIGNUM_DIGIT_MASK);
 | |
|                 //*scan_d++ = (bignum_digit_type) (t & BIGNUM_DIGIT_MASK);
 | |
|                 s >>= BIGNUM_DIGIT_LENGTH;
 | |
|                 t >>= BIGNUM_DIGIT_LENGTH;
 | |
|             }
 | |
|         }
 | |
|         else {
 | |
|             while (scan_b < b_end) {
 | |
|                 s += (A * *scan_a) - (B * *scan_b);
 | |
|                 t += (D * *scan_b++) - (C * *scan_a++);
 | |
|                 *scan_c++ = (bignum_digit_type) (s & BIGNUM_DIGIT_MASK);
 | |
|                 *scan_d++ = (bignum_digit_type) (t & BIGNUM_DIGIT_MASK);
 | |
|                 s >>= BIGNUM_DIGIT_LENGTH;
 | |
|                 t >>= BIGNUM_DIGIT_LENGTH;
 | |
|             }
 | |
|             while (scan_a < a_end) {
 | |
|                 s += (A * *scan_a);
 | |
|                 t -= (C * *scan_a++);
 | |
|                 *scan_c++ = (bignum_digit_type) (s & BIGNUM_DIGIT_MASK);
 | |
|                 //*scan_d++ = (bignum_digit_type) (t & BIGNUM_DIGIT_MASK);
 | |
|                 s >>= BIGNUM_DIGIT_LENGTH;
 | |
|                 t >>= BIGNUM_DIGIT_LENGTH;
 | |
|             }
 | |
|         }
 | |
|         BIGNUM_ASSERT (s == 0);
 | |
|         BIGNUM_ASSERT (t == 0);
 | |
| 
 | |
|         // update size_a and size_b to remove any zeros at end
 | |
|         while (size_a > 0 && *(--scan_a) == 0) size_a--;
 | |
|         while (size_b > 0 && *(--scan_b) == 0) size_b--;
 | |
| 
 | |
|         BIGNUM_ASSERT (size_a >= size_b);
 | |
|     }
 | |
| 
 | |
|     /* a fits into a fixnum, so b must too */
 | |
|     fixnum xx = bignum_to_fixnum (a);
 | |
|     fixnum yy = bignum_to_fixnum (b);
 | |
|     fixnum tt;
 | |
| 
 | |
|     /* usual Euclidean algorithm for longs */
 | |
|     while (yy != 0) {
 | |
|         tt = yy;
 | |
|         yy = xx % yy;
 | |
|         xx = tt;
 | |
|     }
 | |
| 
 | |
|     return fixnum_to_bignum (xx);
 | |
| }
 | |
| #endif
 | |
| 
 | |
| }
 |