#include "master.hpp"
-/* the array is full of undefined data, and must be correctly filled before the
-next GC. size is in cells */
-F_ARRAY *allot_array_internal(CELL type, CELL capacity)
-{
- F_ARRAY *array = (F_ARRAY *)allot_object(type,array_size(capacity));
- array->capacity = tag_fixnum(capacity);
- return array;
-}
-
/* make a new array with an initial element */
-F_ARRAY *allot_array(CELL type, CELL capacity, CELL fill)
+F_ARRAY *allot_array(CELL capacity, CELL fill)
{
REGISTER_ROOT(fill);
- F_ARRAY* array = allot_array_internal(type, capacity);
+ F_ARRAY* array = allot_array_internal<F_ARRAY>(capacity);
UNREGISTER_ROOT(fill);
if(fill == 0)
memset((void*)AREF(array,0),'\0',capacity * CELLS);
{
CELL initial = dpop();
CELL size = unbox_array_size();
- dpush(tag_array(allot_array(ARRAY_TYPE,size,initial)));
+ dpush(tag_array(allot_array(size,initial)));
}
CELL allot_array_1(CELL obj)
{
REGISTER_ROOT(obj);
- F_ARRAY *a = allot_array_internal(ARRAY_TYPE,1);
+ F_ARRAY *a = allot_array_internal<F_ARRAY>(1);
UNREGISTER_ROOT(obj);
set_array_nth(a,0,obj);
return tag_array(a);
{
REGISTER_ROOT(v1);
REGISTER_ROOT(v2);
- F_ARRAY *a = allot_array_internal(ARRAY_TYPE,2);
+ F_ARRAY *a = allot_array_internal<F_ARRAY>(2);
UNREGISTER_ROOT(v2);
UNREGISTER_ROOT(v1);
set_array_nth(a,0,v1);
REGISTER_ROOT(v2);
REGISTER_ROOT(v3);
REGISTER_ROOT(v4);
- F_ARRAY *a = allot_array_internal(ARRAY_TYPE,4);
+ F_ARRAY *a = allot_array_internal<F_ARRAY>(4);
UNREGISTER_ROOT(v4);
UNREGISTER_ROOT(v3);
UNREGISTER_ROOT(v2);
return tag_array(a);
}
-static bool reallot_array_in_place_p(F_ARRAY *array, CELL capacity)
-{
- return in_zone(&nursery,(CELL)array) && capacity <= array_capacity(array);
-}
-
-F_ARRAY *reallot_array(F_ARRAY *array, CELL capacity)
-{
-#ifdef FACTOR_DEBUG
- CELL header = untag_header(array->header);
- assert(header == ARRAY_TYPE || header == BIGNUM_TYPE);
-#endif
-
- if(reallot_array_in_place_p(array,capacity))
- {
- array->capacity = tag_fixnum(capacity);
- return array;
- }
- else
- {
- CELL to_copy = array_capacity(array);
- if(capacity < to_copy)
- to_copy = capacity;
-
- REGISTER_UNTAGGED(array);
- F_ARRAY* new_array = allot_array_internal(untag_header(array->header),capacity);
- UNREGISTER_UNTAGGED(F_ARRAY,array);
-
- memcpy(new_array + 1,array + 1,to_copy * CELLS);
- memset((char *)AREF(new_array,to_copy),'\0',(capacity - to_copy) * CELLS);
-
- return new_array;
- }
-}
-
void primitive_resize_array(void)
{
F_ARRAY* array = untag_array(dpop());
return RETAG(array,ARRAY_TYPE);
}
-/* Inline functions */
-INLINE CELL array_size(CELL size)
-{
- return sizeof(F_ARRAY) + size * CELLS;
-}
-
-F_ARRAY *allot_array_internal(CELL type, CELL capacity);
-F_ARRAY *allot_array(CELL type, CELL capacity, CELL fill);
+F_ARRAY *allot_array(CELL capacity, CELL fill);
F_BYTE_ARRAY *allot_byte_array(CELL size);
CELL allot_array_1(CELL obj);
CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4);
void primitive_array(void);
-
-F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity);
void primitive_resize_array(void);
/* Macros to simulate a vector in C */
-typedef struct {
+struct F_GROWABLE_ARRAY {
CELL count;
CELL array;
-} F_GROWABLE_ARRAY;
+};
/* Allocates memory */
INLINE F_GROWABLE_ARRAY make_growable_array(void)
{
F_GROWABLE_ARRAY result;
result.count = 0;
- result.array = tag_array(allot_array(ARRAY_TYPE,2,F));
+ result.array = tag_array(allot_array(2,F));
return result;
}
* - Add local variable GC root recording
* - Remove s48 prefix from function names
* - Various fixes for Win64
+ * - Port to C++
*/
#include "master.hpp"
/* Exports */
int
-bignum_equal_p(bignum_type x, bignum_type y)
+bignum_equal_p(F_BIGNUM * x, F_BIGNUM * y)
{
return
((BIGNUM_ZERO_P (x))
}
enum bignum_comparison
-bignum_compare(bignum_type x, bignum_type y)
+bignum_compare(F_BIGNUM * x, F_BIGNUM * y)
{
return
((BIGNUM_ZERO_P (x))
}
/* allocates memory */
-bignum_type
-bignum_add(bignum_type x, bignum_type y)
+F_BIGNUM *
+bignum_add(F_BIGNUM * x, F_BIGNUM * y)
{
return
((BIGNUM_ZERO_P (x))
}
/* allocates memory */
-bignum_type
-bignum_subtract(bignum_type x, bignum_type y)
+F_BIGNUM *
+bignum_subtract(F_BIGNUM * x, F_BIGNUM * y)
{
return
((BIGNUM_ZERO_P (x))
}
/* allocates memory */
-bignum_type
-bignum_multiply(bignum_type x, bignum_type y)
+F_BIGNUM *
+bignum_multiply(F_BIGNUM * x, F_BIGNUM * y)
{
bignum_length_type x_length = (BIGNUM_LENGTH (x));
bignum_length_type y_length = (BIGNUM_LENGTH (y));
/* allocates memory */
void
-bignum_divide(bignum_type numerator, bignum_type denominator,
- bignum_type * quotient, bignum_type * remainder)
+bignum_divide(F_BIGNUM * numerator, F_BIGNUM * denominator,
+ F_BIGNUM * * quotient, F_BIGNUM * * remainder)
{
if (BIGNUM_ZERO_P (denominator))
{
}
/* allocates memory */
-bignum_type
-bignum_quotient(bignum_type numerator, bignum_type denominator)
+F_BIGNUM *
+bignum_quotient(F_BIGNUM * numerator, F_BIGNUM * denominator)
{
if (BIGNUM_ZERO_P (denominator))
{
case bignum_comparison_greater:
default: /* to appease gcc -Wall */
{
- bignum_type quotient;
+ F_BIGNUM * quotient;
if ((BIGNUM_LENGTH (denominator)) == 1)
{
bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
if (digit < BIGNUM_RADIX_ROOT)
bignum_divide_unsigned_small_denominator
(numerator, digit,
- ("ient), ((bignum_type *) 0),
+ ("ient), ((F_BIGNUM * *) 0),
q_negative_p, 0);
else
bignum_divide_unsigned_medium_denominator
(numerator, digit,
- ("ient), ((bignum_type *) 0),
+ ("ient), ((F_BIGNUM * *) 0),
q_negative_p, 0);
}
else
bignum_divide_unsigned_large_denominator
(numerator, denominator,
- ("ient), ((bignum_type *) 0),
+ ("ient), ((F_BIGNUM * *) 0),
q_negative_p, 0);
return (quotient);
}
}
/* allocates memory */
-bignum_type
-bignum_remainder(bignum_type numerator, bignum_type denominator)
+F_BIGNUM *
+bignum_remainder(F_BIGNUM * numerator, F_BIGNUM * denominator)
{
if (BIGNUM_ZERO_P (denominator))
{
case bignum_comparison_greater:
default: /* to appease gcc -Wall */
{
- bignum_type remainder;
+ F_BIGNUM * remainder;
if ((BIGNUM_LENGTH (denominator)) == 1)
{
bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
(numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
bignum_divide_unsigned_medium_denominator
(numerator, digit,
- ((bignum_type *) 0), (&remainder),
+ ((F_BIGNUM * *) 0), (&remainder),
0, (BIGNUM_NEGATIVE_P (numerator)));
}
else
bignum_divide_unsigned_large_denominator
(numerator, denominator,
- ((bignum_type *) 0), (&remainder),
+ ((F_BIGNUM * *) 0), (&remainder),
0, (BIGNUM_NEGATIVE_P (numerator)));
return (remainder);
}
}
#define FOO_TO_BIGNUM(name,type,utype) \
- bignum_type name##_to_bignum(type n) \
+ F_BIGNUM * name##_to_bignum(type n) \
{ \
int negative_p; \
bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
while (accumulator != 0); \
} \
{ \
- bignum_type result = \
+ F_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)); \
FOO_TO_BIGNUM(ulong_long,u64,u64)
#define BIGNUM_TO_FOO(name,type,utype) \
- type bignum_to_##name(bignum_type bignum) \
+ type bignum_to_##name(F_BIGNUM * bignum) \
{ \
if (BIGNUM_ZERO_P (bignum)) \
return (0); \
BIGNUM_TO_FOO(ulong_long,u64,u64)
double
-bignum_to_double(bignum_type bignum)
+bignum_to_double(F_BIGNUM * bignum)
{
if (BIGNUM_ZERO_P (bignum))
return (0);
/* allocates memory */
#define inf std::numeric_limits<double>::infinity()
-bignum_type
+F_BIGNUM *
double_to_bignum(double x)
{
if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
if (significand < 0) significand = (-significand);
{
bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
- bignum_type result = (allot_bignum (length, (x < 0)));
+ F_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;
/* Comparisons */
int
-bignum_equal_p_unsigned(bignum_type x, bignum_type y)
+bignum_equal_p_unsigned(F_BIGNUM * x, F_BIGNUM * y)
{
bignum_length_type length = (BIGNUM_LENGTH (x));
if (length != (BIGNUM_LENGTH (y)))
}
enum bignum_comparison
-bignum_compare_unsigned(bignum_type x, bignum_type y)
+bignum_compare_unsigned(F_BIGNUM * x, F_BIGNUM * y)
{
bignum_length_type x_length = (BIGNUM_LENGTH (x));
bignum_length_type y_length = (BIGNUM_LENGTH (y));
/* Addition */
/* allocates memory */
-bignum_type
-bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
+F_BIGNUM *
+bignum_add_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
{
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{
- bignum_type z = x;
+ F_BIGNUM * z = x;
x = y;
y = z;
}
REGISTER_BIGNUM(x);
REGISTER_BIGNUM(y);
- bignum_type r = (allot_bignum ((x_length + 1), negative_p));
+ F_BIGNUM * r = (allot_bignum ((x_length + 1), negative_p));
UNREGISTER_BIGNUM(y);
UNREGISTER_BIGNUM(x);
/* Subtraction */
/* allocates memory */
-bignum_type
-bignum_subtract_unsigned(bignum_type x, bignum_type y)
+F_BIGNUM *
+bignum_subtract_unsigned(F_BIGNUM * x, F_BIGNUM * y)
{
int negative_p = 0;
switch (bignum_compare_unsigned (x, y))
return (BIGNUM_ZERO ());
case bignum_comparison_less:
{
- bignum_type z = x;
+ F_BIGNUM * z = x;
x = y;
y = z;
}
REGISTER_BIGNUM(x);
REGISTER_BIGNUM(y);
- bignum_type r = (allot_bignum (x_length, negative_p));
+ F_BIGNUM * r = (allot_bignum (x_length, negative_p));
UNREGISTER_BIGNUM(y);
UNREGISTER_BIGNUM(x);
where R == BIGNUM_RADIX_ROOT */
/* allocates memory */
-bignum_type
-bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
+F_BIGNUM *
+bignum_multiply_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
{
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{
- bignum_type z = x;
+ F_BIGNUM * z = x;
x = y;
y = z;
}
REGISTER_BIGNUM(x);
REGISTER_BIGNUM(y);
- bignum_type r =
+ F_BIGNUM * r =
(allot_bignum_zeroed ((x_length + y_length), negative_p));
UNREGISTER_BIGNUM(y);
UNREGISTER_BIGNUM(x);
}
/* allocates memory */
-bignum_type
-bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y,
+F_BIGNUM *
+bignum_multiply_unsigned_small_factor(F_BIGNUM * x, bignum_digit_type y,
int negative_p)
{
bignum_length_type length_x = (BIGNUM_LENGTH (x));
REGISTER_BIGNUM(x);
- bignum_type p = (allot_bignum ((length_x + 1), negative_p));
+ F_BIGNUM * p = (allot_bignum ((length_x + 1), negative_p));
UNREGISTER_BIGNUM(x);
bignum_destructive_copy (x, p);
}
void
-bignum_destructive_add(bignum_type bignum, bignum_digit_type n)
+bignum_destructive_add(F_BIGNUM * bignum, bignum_digit_type n)
{
bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
bignum_digit_type digit;
}
void
-bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor)
+bignum_destructive_scale_up(F_BIGNUM * bignum, bignum_digit_type factor)
{
bignum_digit_type carry = 0;
bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
/* allocates memory */
void
-bignum_divide_unsigned_large_denominator(bignum_type numerator,
- bignum_type denominator,
- bignum_type * quotient,
- bignum_type * remainder,
+bignum_divide_unsigned_large_denominator(F_BIGNUM * numerator,
+ F_BIGNUM * denominator,
+ F_BIGNUM * * quotient,
+ F_BIGNUM * * remainder,
int q_negative_p,
int r_negative_p)
{
REGISTER_BIGNUM(numerator);
REGISTER_BIGNUM(denominator);
- bignum_type q =
- ((quotient != ((bignum_type *) 0))
+ F_BIGNUM * q =
+ ((quotient != ((F_BIGNUM * *) 0))
? (allot_bignum ((length_n - length_d), q_negative_p))
: BIGNUM_OUT_OF_BAND);
REGISTER_BIGNUM(q);
- bignum_type u = (allot_bignum (length_n, r_negative_p));
+ F_BIGNUM * u = (allot_bignum (length_n, r_negative_p));
UNREGISTER_BIGNUM(q);
UNREGISTER_BIGNUM(denominator);
REGISTER_BIGNUM(denominator);
REGISTER_BIGNUM(u);
REGISTER_BIGNUM(q);
- bignum_type v = (allot_bignum (length_d, 0));
+ F_BIGNUM * v = (allot_bignum (length_d, 0));
UNREGISTER_BIGNUM(q);
UNREGISTER_BIGNUM(u);
UNREGISTER_BIGNUM(denominator);
bignum_destructive_normalization (numerator, u, shift);
bignum_destructive_normalization (denominator, v, shift);
bignum_divide_unsigned_normalized (u, v, q);
- if (remainder != ((bignum_type *) 0))
+ if (remainder != ((F_BIGNUM * *) 0))
bignum_destructive_unnormalization (u, shift);
}
u = bignum_trim (u);
UNREGISTER_BIGNUM(q);
- if (quotient != ((bignum_type *) 0))
+ if (quotient != ((F_BIGNUM * *) 0))
(*quotient) = q;
- if (remainder != ((bignum_type *) 0))
+ if (remainder != ((F_BIGNUM * *) 0))
(*remainder) = u;
return;
}
void
-bignum_divide_unsigned_normalized(bignum_type u, bignum_type v, bignum_type q)
+bignum_divide_unsigned_normalized(F_BIGNUM * u, F_BIGNUM * v, F_BIGNUM * q)
{
bignum_length_type u_length = (BIGNUM_LENGTH (u));
bignum_length_type v_length = (BIGNUM_LENGTH (v));
/* allocates memory */
void
-bignum_divide_unsigned_medium_denominator(bignum_type numerator,
+bignum_divide_unsigned_medium_denominator(F_BIGNUM * numerator,
bignum_digit_type denominator,
- bignum_type * quotient,
- bignum_type * remainder,
+ F_BIGNUM * * quotient,
+ F_BIGNUM * * remainder,
int q_negative_p,
int r_negative_p)
{
bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
bignum_length_type length_q;
- bignum_type q;
+ F_BIGNUM * q;
int shift = 0;
/* Because `bignum_digit_divide' requires a normalized denominator. */
while (denominator < (BIGNUM_RADIX / 2))
q = bignum_trim (q);
- if (remainder != ((bignum_type *) 0))
+ if (remainder != ((F_BIGNUM * *) 0))
{
if (shift != 0)
r >>= shift;
UNREGISTER_BIGNUM(q);
}
- if (quotient != ((bignum_type *) 0))
+ if (quotient != ((F_BIGNUM * *) 0))
(*quotient) = q;
}
return;
}
void
-bignum_destructive_normalization(bignum_type source, bignum_type target,
+bignum_destructive_normalization(F_BIGNUM * source, F_BIGNUM * target,
int shift_left)
{
bignum_digit_type digit;
}
void
-bignum_destructive_unnormalization(bignum_type bignum, int shift_right)
+bignum_destructive_unnormalization(F_BIGNUM * bignum, int shift_right)
{
bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
/* allocates memory */
void
-bignum_divide_unsigned_small_denominator(bignum_type numerator,
+bignum_divide_unsigned_small_denominator(F_BIGNUM * numerator,
bignum_digit_type denominator,
- bignum_type * quotient,
- bignum_type * remainder,
+ F_BIGNUM * * quotient,
+ F_BIGNUM * * remainder,
int q_negative_p,
int r_negative_p)
{
REGISTER_BIGNUM(numerator);
- bignum_type q = (bignum_new_sign (numerator, q_negative_p));
+ F_BIGNUM * q = (bignum_new_sign (numerator, q_negative_p));
UNREGISTER_BIGNUM(numerator);
bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
q = (bignum_trim (q));
- if (remainder != ((bignum_type *) 0))
+ if (remainder != ((F_BIGNUM * *) 0))
{
REGISTER_BIGNUM(q);
(*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
that all digits are < BIGNUM_RADIX. */
bignum_digit_type
-bignum_destructive_scale_down(bignum_type bignum, bignum_digit_type denominator)
+bignum_destructive_scale_down(F_BIGNUM * bignum, bignum_digit_type denominator)
{
bignum_digit_type numerator;
bignum_digit_type remainder = 0;
}
/* allocates memory */
-bignum_type
+F_BIGNUM *
bignum_remainder_unsigned_small_denominator(
- bignum_type n, bignum_digit_type d, int negative_p)
+ F_BIGNUM * n, bignum_digit_type d, int negative_p)
{
bignum_digit_type two_digits;
bignum_digit_type * start = (BIGNUM_START_PTR (n));
}
/* allocates memory */
-bignum_type
+F_BIGNUM *
bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
{
if (digit == 0)
return (BIGNUM_ZERO ());
else
{
- bignum_type result = (allot_bignum (1, negative_p));
+ F_BIGNUM * result = (allot_bignum (1, negative_p));
(BIGNUM_REF (result, 0)) = digit;
return (result);
}
}
/* allocates memory */
-bignum_type
+F_BIGNUM *
allot_bignum(bignum_length_type length, int negative_p)
{
BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
- bignum_type result = allot_array_internal(BIGNUM_TYPE,length + 1);
+ F_BIGNUM * result = allot_array_internal<F_BIGNUM>(length + 1);
BIGNUM_SET_NEGATIVE_P (result, negative_p);
return (result);
}
/* allocates memory */
-bignum_type
+F_BIGNUM *
allot_bignum_zeroed(bignum_length_type length, int negative_p)
{
- bignum_type result = allot_bignum(length,negative_p);
+ F_BIGNUM * result = allot_bignum(length,negative_p);
bignum_digit_type * scan = (BIGNUM_START_PTR (result));
bignum_digit_type * end = (scan + length);
while (scan < end)
}
#define BIGNUM_REDUCE_LENGTH(source, length) \
- source = reallot_array(source,length + 1)
+ source = reallot_array(source,length + 1)
/* allocates memory */
-bignum_type
-bignum_shorten_length(bignum_type bignum, bignum_length_type length)
+F_BIGNUM *
+bignum_shorten_length(F_BIGNUM * bignum, bignum_length_type length)
{
bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
}
/* allocates memory */
-bignum_type
-bignum_trim(bignum_type bignum)
+F_BIGNUM *
+bignum_trim(F_BIGNUM * bignum)
{
bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
/* Copying */
/* allocates memory */
-bignum_type
-bignum_new_sign(bignum_type bignum, int negative_p)
+F_BIGNUM *
+bignum_new_sign(F_BIGNUM * bignum, int negative_p)
{
REGISTER_BIGNUM(bignum);
- bignum_type result =
+ F_BIGNUM * result =
(allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p));
UNREGISTER_BIGNUM(bignum);
}
/* allocates memory */
-bignum_type
-bignum_maybe_new_sign(bignum_type bignum, int negative_p)
+F_BIGNUM *
+bignum_maybe_new_sign(F_BIGNUM * bignum, int negative_p)
{
if ((BIGNUM_NEGATIVE_P (bignum)) ? negative_p : (! negative_p))
return (bignum);
else
{
- bignum_type result =
+ F_BIGNUM * result =
(allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p));
bignum_destructive_copy (bignum, result);
return (result);
}
void
-bignum_destructive_copy(bignum_type source, bignum_type target)
+bignum_destructive_copy(F_BIGNUM * source, F_BIGNUM * target)
{
bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
bignum_digit_type * end_source =
*/
/* allocates memory */
-bignum_type
-bignum_bitwise_not(bignum_type x)
+F_BIGNUM *
+bignum_bitwise_not(F_BIGNUM * x)
{
return bignum_subtract(BIGNUM_ONE(1), x);
}
/* allocates memory */
-bignum_type
-bignum_arithmetic_shift(bignum_type arg1, F_FIXNUM n)
+F_BIGNUM *
+bignum_arithmetic_shift(F_BIGNUM * arg1, F_FIXNUM n)
{
if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
#define XOR_OP 2
/* allocates memory */
-bignum_type
-bignum_bitwise_and(bignum_type arg1, bignum_type arg2)
+F_BIGNUM *
+bignum_bitwise_and(F_BIGNUM * arg1, F_BIGNUM * arg2)
{
return(
(BIGNUM_NEGATIVE_P (arg1))
}
/* allocates memory */
-bignum_type
-bignum_bitwise_ior(bignum_type arg1, bignum_type arg2)
+F_BIGNUM *
+bignum_bitwise_ior(F_BIGNUM * arg1, F_BIGNUM * arg2)
{
return(
(BIGNUM_NEGATIVE_P (arg1))
}
/* allocates memory */
-bignum_type
-bignum_bitwise_xor(bignum_type arg1, bignum_type arg2)
+F_BIGNUM *
+bignum_bitwise_xor(F_BIGNUM * arg1, F_BIGNUM * arg2)
{
return(
(BIGNUM_NEGATIVE_P (arg1))
/* allocates memory */
/* ash for the magnitude */
/* assume arg1 is a big number, n is a long */
-bignum_type
-bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n)
+F_BIGNUM *
+bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n)
{
- bignum_type result = NULL;
+ F_BIGNUM * result = NULL;
bignum_digit_type *scan1;
bignum_digit_type *scanr;
bignum_digit_type *end;
}
/* allocates memory */
-bignum_type
-bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
+F_BIGNUM *
+bignum_pospos_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
{
- bignum_type result;
+ F_BIGNUM * result;
bignum_length_type max_length;
bignum_digit_type *scan1, *end1, digit1;
}
/* allocates memory */
-bignum_type
-bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
+F_BIGNUM *
+bignum_posneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
{
- bignum_type result;
+ F_BIGNUM * result;
bignum_length_type max_length;
bignum_digit_type *scan1, *end1, digit1;
}
/* allocates memory */
-bignum_type
-bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
+F_BIGNUM *
+bignum_negneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
{
- bignum_type result;
+ F_BIGNUM * result;
bignum_length_type max_length;
bignum_digit_type *scan1, *end1, digit1, carry1;
}
void
-bignum_negate_magnitude(bignum_type arg)
+bignum_negate_magnitude(F_BIGNUM * arg)
{
bignum_digit_type *scan;
bignum_digit_type *end;
}
/* Allocates memory */
-bignum_type
-bignum_integer_length(bignum_type bignum)
+F_BIGNUM *
+bignum_integer_length(F_BIGNUM * bignum)
{
bignum_length_type index = ((BIGNUM_LENGTH (bignum)) - 1);
bignum_digit_type digit = (BIGNUM_REF (bignum, index));
REGISTER_BIGNUM(bignum);
- bignum_type result = (allot_bignum (2, 0));
+ F_BIGNUM * result = (allot_bignum (2, 0));
UNREGISTER_BIGNUM(bignum);
(BIGNUM_REF (result, 0)) = index;
/* Allocates memory */
int
-bignum_logbitp(int shift, bignum_type arg)
+bignum_logbitp(int shift, F_BIGNUM * arg)
{
return((BIGNUM_NEGATIVE_P (arg))
? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
}
int
-bignum_unsigned_logbitp(int shift, bignum_type bignum)
+bignum_unsigned_logbitp(int shift, F_BIGNUM * bignum)
{
bignum_length_type len = (BIGNUM_LENGTH (bignum));
int index = shift / BIGNUM_DIGIT_LENGTH;
}
/* Allocates memory */
-bignum_type
+F_BIGNUM *
digit_stream_to_bignum(unsigned int n_digits,
unsigned int (*producer)(unsigned int),
unsigned int radix,
length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
}
{
- bignum_type result = (allot_bignum_zeroed (length, negative_p));
+ F_BIGNUM * result = (allot_bignum_zeroed (length, negative_p));
while ((n_digits--) > 0)
{
bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
promotional, or sales literature without prior written consent from
MIT in each case. */
-typedef F_ARRAY * bignum_type;
-#define BIGNUM_OUT_OF_BAND ((bignum_type) 0)
+#define BIGNUM_OUT_OF_BAND ((F_BIGNUM *) 0)
enum bignum_comparison
{
bignum_comparison_greater = 1
};
-int bignum_equal_p(bignum_type, bignum_type);
-enum bignum_comparison bignum_compare(bignum_type, bignum_type);
-bignum_type bignum_add(bignum_type, bignum_type);
-bignum_type bignum_subtract(bignum_type, bignum_type);
-bignum_type bignum_negate(bignum_type);
-bignum_type bignum_multiply(bignum_type, bignum_type);
+int bignum_equal_p(F_BIGNUM *, F_BIGNUM *);
+enum bignum_comparison bignum_compare(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_add(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_subtract(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_negate(F_BIGNUM *);
+F_BIGNUM * bignum_multiply(F_BIGNUM *, F_BIGNUM *);
void
-bignum_divide(bignum_type numerator, bignum_type denominator,
- bignum_type * quotient, bignum_type * remainder);
-bignum_type bignum_quotient(bignum_type, bignum_type);
-bignum_type bignum_remainder(bignum_type, bignum_type);
-DLLEXPORT bignum_type fixnum_to_bignum(F_FIXNUM);
-DLLEXPORT bignum_type cell_to_bignum(CELL);
-DLLEXPORT bignum_type long_long_to_bignum(s64 n);
-DLLEXPORT bignum_type ulong_long_to_bignum(u64 n);
-F_FIXNUM bignum_to_fixnum(bignum_type);
-CELL bignum_to_cell(bignum_type);
-s64 bignum_to_long_long(bignum_type);
-u64 bignum_to_ulong_long(bignum_type);
-bignum_type double_to_bignum(double);
-double bignum_to_double(bignum_type);
+bignum_divide(F_BIGNUM * numerator, F_BIGNUM * denominator,
+ F_BIGNUM * * quotient, F_BIGNUM * * remainder);
+F_BIGNUM * bignum_quotient(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_remainder(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * fixnum_to_bignum(F_FIXNUM);
+F_BIGNUM * cell_to_bignum(CELL);
+F_BIGNUM * long_long_to_bignum(s64 n);
+F_BIGNUM * ulong_long_to_bignum(u64 n);
+F_FIXNUM bignum_to_fixnum(F_BIGNUM *);
+CELL bignum_to_cell(F_BIGNUM *);
+s64 bignum_to_long_long(F_BIGNUM *);
+u64 bignum_to_ulong_long(F_BIGNUM *);
+F_BIGNUM * double_to_bignum(double);
+double bignum_to_double(F_BIGNUM *);
/* Added bitwise operators. */
-DLLEXPORT bignum_type bignum_bitwise_not(bignum_type),
- bignum_arithmetic_shift(bignum_type, F_FIXNUM),
- bignum_bitwise_and(bignum_type, bignum_type),
- bignum_bitwise_ior(bignum_type, bignum_type),
- bignum_bitwise_xor(bignum_type, bignum_type);
+F_BIGNUM * bignum_bitwise_not(F_BIGNUM *);
+F_BIGNUM * bignum_arithmetic_shift(F_BIGNUM *, F_FIXNUM);
+F_BIGNUM * bignum_bitwise_and(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_bitwise_ior(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_bitwise_xor(F_BIGNUM *, F_BIGNUM *);
/* Forward references */
-int bignum_equal_p_unsigned(bignum_type, bignum_type);
-enum bignum_comparison bignum_compare_unsigned(bignum_type, bignum_type);
-bignum_type bignum_add_unsigned(bignum_type, bignum_type, int);
-bignum_type bignum_subtract_unsigned(bignum_type, bignum_type);
-bignum_type bignum_multiply_unsigned(bignum_type, bignum_type, int);
-bignum_type bignum_multiply_unsigned_small_factor
- (bignum_type, bignum_digit_type, int);
-void bignum_destructive_scale_up(bignum_type, bignum_digit_type);
-void bignum_destructive_add(bignum_type, bignum_digit_type);
+int bignum_equal_p_unsigned(F_BIGNUM *, F_BIGNUM *);
+enum bignum_comparison bignum_compare_unsigned(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_add_unsigned(F_BIGNUM *, F_BIGNUM *, int);
+F_BIGNUM * bignum_subtract_unsigned(F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_multiply_unsigned(F_BIGNUM *, F_BIGNUM *, int);
+F_BIGNUM * bignum_multiply_unsigned_small_factor
+ (F_BIGNUM *, bignum_digit_type, int);
+void bignum_destructive_scale_up(F_BIGNUM *, bignum_digit_type);
+void bignum_destructive_add(F_BIGNUM *, bignum_digit_type);
void bignum_divide_unsigned_large_denominator
- (bignum_type, bignum_type, bignum_type *, bignum_type *, int, int);
-void bignum_destructive_normalization(bignum_type, bignum_type, int);
-void bignum_destructive_unnormalization(bignum_type, int);
-void bignum_divide_unsigned_normalized(bignum_type, bignum_type, bignum_type);
+ (F_BIGNUM *, F_BIGNUM *, F_BIGNUM * *, F_BIGNUM * *, int, int);
+void bignum_destructive_normalization(F_BIGNUM *, F_BIGNUM *, int);
+void bignum_destructive_unnormalization(F_BIGNUM *, int);
+void bignum_divide_unsigned_normalized(F_BIGNUM *, F_BIGNUM *, F_BIGNUM *);
bignum_digit_type bignum_divide_subtract
(bignum_digit_type *, bignum_digit_type *, bignum_digit_type,
bignum_digit_type *);
void bignum_divide_unsigned_medium_denominator
- (bignum_type, bignum_digit_type, bignum_type *, bignum_type *, int, int);
+ (F_BIGNUM *, bignum_digit_type, F_BIGNUM * *, F_BIGNUM * *, int, int);
bignum_digit_type bignum_digit_divide
(bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
bignum_digit_type bignum_digit_divide_subtract
(bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
void bignum_divide_unsigned_small_denominator
- (bignum_type, bignum_digit_type, bignum_type *, bignum_type *, int, int);
+ (F_BIGNUM *, bignum_digit_type, F_BIGNUM * *, F_BIGNUM * *, int, int);
bignum_digit_type bignum_destructive_scale_down
- (bignum_type, bignum_digit_type);
-bignum_type bignum_remainder_unsigned_small_denominator
- (bignum_type, bignum_digit_type, int);
-bignum_type bignum_digit_to_bignum(bignum_digit_type, int);
-bignum_type allot_bignum(bignum_length_type, int);
-bignum_type allot_bignum_zeroed(bignum_length_type, int);
-bignum_type bignum_shorten_length(bignum_type, bignum_length_type);
-bignum_type bignum_trim(bignum_type);
-bignum_type bignum_new_sign(bignum_type, int);
-bignum_type bignum_maybe_new_sign(bignum_type, int);
-void bignum_destructive_copy(bignum_type, bignum_type);
+ (F_BIGNUM *, bignum_digit_type);
+F_BIGNUM * bignum_remainder_unsigned_small_denominator
+ (F_BIGNUM *, bignum_digit_type, int);
+F_BIGNUM * bignum_digit_to_bignum(bignum_digit_type, int);
+F_BIGNUM * allot_bignum(bignum_length_type, int);
+F_BIGNUM * allot_bignum_zeroed(bignum_length_type, int);
+F_BIGNUM * bignum_shorten_length(F_BIGNUM *, bignum_length_type);
+F_BIGNUM * bignum_trim(F_BIGNUM *);
+F_BIGNUM * bignum_new_sign(F_BIGNUM *, int);
+F_BIGNUM * bignum_maybe_new_sign(F_BIGNUM *, int);
+void bignum_destructive_copy(F_BIGNUM *, F_BIGNUM *);
/* Added for bitwise operations. */
-bignum_type bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n);
-bignum_type bignum_pospos_bitwise_op(int op, bignum_type, bignum_type);
-bignum_type bignum_posneg_bitwise_op(int op, bignum_type, bignum_type);
-bignum_type bignum_negneg_bitwise_op(int op, bignum_type, bignum_type);
-void bignum_negate_magnitude(bignum_type);
+F_BIGNUM * bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n);
+F_BIGNUM * bignum_pospos_bitwise_op(int op, F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_posneg_bitwise_op(int op, F_BIGNUM *, F_BIGNUM *);
+F_BIGNUM * bignum_negneg_bitwise_op(int op, F_BIGNUM *, F_BIGNUM *);
+void bignum_negate_magnitude(F_BIGNUM *);
-bignum_type bignum_integer_length(bignum_type arg1);
-int bignum_unsigned_logbitp(int shift, bignum_type bignum);
-int bignum_logbitp(int shift, bignum_type arg);
-bignum_type digit_stream_to_bignum(unsigned int n_digits,
+F_BIGNUM * bignum_integer_length(F_BIGNUM * arg1);
+int bignum_unsigned_logbitp(int shift, F_BIGNUM * bignum);
+int bignum_logbitp(int shift, F_BIGNUM * arg);
+F_BIGNUM * digit_stream_to_bignum(unsigned int n_digits,
unsigned int (*producer)(unsigned int),
unsigned int radix,
int negative_p);
typedef F_FIXNUM bignum_length_type;
/* BIGNUM_TO_POINTER casts a bignum object to a digit array pointer. */
-#define BIGNUM_TO_POINTER(bignum) ((bignum_digit_type *)AREF(bignum,0))
+#define BIGNUM_TO_POINTER(bignum) ((bignum_digit_type *)(bignum + 1))
/* BIGNUM_EXCEPTION is invoked to handle assertion violations. */
#define BIGNUM_EXCEPTION abort
#include "master.hpp"
-/* must fill out array before next GC */
-F_BYTE_ARRAY *allot_byte_array_internal(CELL size)
-{
- F_BYTE_ARRAY *array = (F_BYTE_ARRAY *)allot_object(BYTE_ARRAY_TYPE,byte_array_size(size));
- array->capacity = tag_fixnum(size);
- return array;
-}
-
-/* size is in bytes this time */
F_BYTE_ARRAY *allot_byte_array(CELL size)
{
- F_BYTE_ARRAY *array = allot_byte_array_internal(size);
+ F_BYTE_ARRAY *array = allot_array_internal<F_BYTE_ARRAY>(size);
memset(array + 1,0,size);
return array;
}
-/* push a new byte array on the stack */
void primitive_byte_array(void)
{
CELL size = unbox_array_size();
void primitive_uninitialized_byte_array(void)
{
CELL size = unbox_array_size();
- dpush(tag_object(allot_byte_array_internal(size)));
-}
-
-static bool reallot_byte_array_in_place_p(F_BYTE_ARRAY *array, CELL capacity)
-{
- return in_zone(&nursery,(CELL)array) && capacity <= array_capacity(array);
-}
-
-F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity)
-{
-#ifdef FACTOR_DEBUG
- assert(untag_header(array->header) == BYTE_ARRAY_TYPE);
-#endif
- if(reallot_byte_array_in_place_p(array,capacity))
- {
- array->capacity = tag_fixnum(capacity);
- return array;
- }
- else
- {
- CELL to_copy = array_capacity(array);
- if(capacity < to_copy)
- to_copy = capacity;
-
- REGISTER_UNTAGGED(array);
- F_BYTE_ARRAY *new_array = allot_byte_array_internal(capacity);
- UNREGISTER_UNTAGGED(F_BYTE_ARRAY,array);
-
- memcpy(new_array + 1,array + 1,to_copy);
-
- return new_array;
- }
+ dpush(tag_object(allot_array_internal<F_BYTE_ARRAY>(size)));
}
void primitive_resize_byte_array(void)
{
- F_BYTE_ARRAY* array = untag_byte_array(dpop());
+ F_BYTE_ARRAY *array = untag_byte_array(dpop());
CELL capacity = unbox_array_size();
- dpush(tag_object(reallot_byte_array(array,capacity)));
+ dpush(tag_object(reallot_array(array,capacity)));
}
void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *array, void *elts, CELL len)
CELL new_size = array->count + len;
F_BYTE_ARRAY *underlying = untag_byte_array_fast(array->array);
- if(new_size >= byte_array_capacity(underlying))
+ if(new_size >= array_capacity(underlying))
{
- underlying = reallot_byte_array(underlying,new_size * 2);
+ underlying = reallot_array(underlying,new_size * 2);
array->array = tag_object(underlying);
}
DEFINE_UNTAG(F_BYTE_ARRAY,BYTE_ARRAY_TYPE,byte_array)
-INLINE CELL byte_array_capacity(F_BYTE_ARRAY *array)
-{
- return untag_fixnum_fast(array->capacity);
-}
-
-INLINE CELL byte_array_size(CELL size)
-{
- return sizeof(F_BYTE_ARRAY) + size;
-}
-
F_BYTE_ARRAY *allot_byte_array(CELL size);
-F_BYTE_ARRAY *allot_byte_array_internal(CELL size);
-F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity);
void primitive_byte_array(void);
void primitive_uninitialized_byte_array(void);
void primitive_resize_byte_array(void);
/* Macros to simulate a byte vector in C */
-typedef struct {
+struct F_GROWABLE_BYTE_ARRAY {
CELL count;
CELL array;
-} F_GROWABLE_BYTE_ARRAY;
+};
INLINE F_GROWABLE_BYTE_ARRAY make_growable_byte_array(void)
{
INLINE void growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array)
{
- byte_array->array = tag_object(reallot_byte_array(untag_byte_array_fast(byte_array->array),byte_array->count));
+ byte_array->array = tag_object(reallot_array(untag_byte_array_fast(byte_array->array),byte_array->count));
}
iterate_callstack_object(stack,count_stack_frame);
REGISTER_UNTAGGED(stack);
- array = allot_array_internal(ARRAY_TYPE,frame_count);
+ array = allot_array_internal<F_ARRAY>(frame_count);
UNREGISTER_UNTAGGED(F_CALLSTACK,stack);
frame_index = 0;
CELL index = stack_traces_p() ? 1 : 0;
F_REL *rel = (F_REL *)(relocation + 1);
- F_REL *rel_end = (F_REL *)((char *)rel + byte_array_capacity(relocation));
+ F_REL *rel_end = (F_REL *)((char *)rel + array_capacity(relocation));
while(rel < rel_end)
{
switch(untag_header(get(pointer)))
{
case ARRAY_TYPE:
+ return array_size((F_ARRAY*)pointer);
case BIGNUM_TYPE:
- return array_size(array_capacity((F_ARRAY*)pointer));
+ return array_size((F_BIGNUM*)pointer);
case BYTE_ARRAY_TYPE:
- return byte_array_size(
- byte_array_capacity((F_BYTE_ARRAY*)pointer));
+ return array_size((F_BYTE_ARRAY*)pointer);
case STRING_TYPE:
return string_size(string_capacity((F_STRING*)pointer));
case TUPLE_TYPE:
return sizeof(F_STRING);
/* everything else consists entirely of pointers */
case ARRAY_TYPE:
- return array_size(array_capacity((F_ARRAY*)pointer));
+ return array_size<F_ARRAY>(array_capacity((F_ARRAY*)pointer));
case TUPLE_TYPE:
tuple = untag_tuple_fast(pointer);
layout = untag_tuple_layout(tuple->layout);
/* May allocate memory */
void pass_args_to_factor(int argc, F_CHAR **argv)
{
- F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);
+ F_ARRAY *args = allot_array(argc,F);
int i;
for(i = 1; i < argc; i++)
--- /dev/null
+template<typename T> CELL array_capacity(T *array)
+{
+#ifdef FACTOR_DEBUG
+ CELL header = untag_header(array->header);
+ assert(header == T::type_number);
+#endif
+ return array->capacity >> TAG_BITS;
+}
+
+#define AREF(array,index) ((CELL)(array) + sizeof(F_ARRAY) + (index) * CELLS)
+#define UNAREF(array,ptr) (((CELL)(ptr)-(CELL)(array)-sizeof(F_ARRAY)) / CELLS)
+
+template <typename T> CELL array_nth(T *array, CELL slot)
+{
+#ifdef FACTOR_DEBUG
+ assert(slot < array_capacity<T>(array));
+ assert(untag_header(array->header) == T::type_number);
+#endif
+ return get(AREF(array,slot));
+}
+
+template <typename T> void set_array_nth(T *array, CELL slot, CELL value)
+{
+#ifdef FACTOR_DEBUG
+ assert(slot < array_capacity<T>(array));
+ assert(untag_header(array->header) == T::type_number);
+#endif
+ put(AREF(array,slot),value);
+ write_barrier((CELL)array);
+}
+
+template <typename T> CELL array_size(CELL capacity)
+{
+ return sizeof(T) + capacity * T::element_size;
+}
+
+template <typename T> CELL array_size(T *array)
+{
+ return array_size<T>(array_capacity(array));
+}
+
+template <typename T> T *allot_array_internal(CELL capacity)
+{
+ T *array = (T *)allot_object(T::type_number,array_size<T>(capacity));
+ array->capacity = tag_fixnum(capacity);
+ return array;
+}
+
+template <typename T> bool reallot_array_in_place_p(T *array, CELL capacity)
+{
+ return in_zone(&nursery,(CELL)array) && capacity <= array_capacity(array);
+}
+
+template <typename T> T *reallot_array(T *array, CELL capacity)
+{
+#ifdef FACTOR_DEBUG
+ CELL header = untag_header(array->header);
+ assert(header == T::type_number);
+#endif
+
+ if(reallot_array_in_place_p(array,capacity))
+ {
+ array->capacity = tag_fixnum(capacity);
+ return array;
+ }
+ else
+ {
+ CELL to_copy = array_capacity(array);
+ if(capacity < to_copy)
+ to_copy = capacity;
+
+ REGISTER_UNTAGGED(array);
+ T *new_array = allot_array_internal<T>(capacity);
+ UNREGISTER_UNTAGGED(T,array);
+
+ memcpy(new_array + 1,array + 1,to_copy * T::element_size);
+ memset((char *)(new_array + 1) + to_copy * T::element_size,
+ 0,(capacity - to_copy) * T::element_size);
+
+ return new_array;
+ }
+}
/* Assembly code makes assumptions about the layout of this struct */
struct F_ARRAY : public F_OBJECT {
static const CELL type_number = ARRAY_TYPE;
+ static const CELL element_size = CELLS;
/* tagged */
CELL capacity;
};
struct F_BIGNUM : public F_OBJECT {
static const CELL type_number = BIGNUM_TYPE;
+ static const CELL element_size = CELLS;
/* tagged */
CELL capacity;
};
struct F_BYTE_ARRAY : public F_OBJECT {
static const CELL type_number = BYTE_ARRAY_TYPE;
+ static const CELL element_size = 1;
/* tagged */
CELL capacity;
};
#include "bignumint.hpp"
#include "bignum.hpp"
#include "write_barrier.hpp"
-#include "generic_arrays.hpp"
#include "data_heap.hpp"
#include "data_gc.hpp"
#include "local_roots.hpp"
+#include "generic_arrays.hpp"
#include "debug.hpp"
#include "arrays.hpp"
#include "strings.hpp"
F_FASTCALL void overflow_fixnum_multiply(F_FIXNUM x, F_FIXNUM y)
{
- F_ARRAY *bx = fixnum_to_bignum(x);
+ F_BIGNUM *bx = fixnum_to_bignum(x);
REGISTER_BIGNUM(bx);
- F_ARRAY *by = fixnum_to_bignum(y);
+ F_BIGNUM *by = fixnum_to_bignum(y);
UNREGISTER_BIGNUM(bx);
drepl(tag_bignum(bignum_multiply(bx,by)));
}
}
#define POP_BIGNUMS(x,y) \
- bignum_type y = untag_bignum_fast(dpop()); \
- bignum_type x = untag_bignum_fast(dpop());
+ F_BIGNUM * y = untag_bignum_fast(dpop()); \
+ F_BIGNUM * x = untag_bignum_fast(dpop());
void primitive_bignum_eq(void)
{
void primitive_bignum_divmod(void)
{
- F_ARRAY *q, *r;
+ F_BIGNUM *q, *r;
POP_BIGNUMS(x,y);
bignum_divide(x,y,&q,&r);
dpush(tag_bignum(q));
void primitive_bignum_shift(void)
{
F_FIXNUM y = untag_fixnum_fast(dpop());
- F_ARRAY* x = untag_bignum_fast(dpop());
+ F_BIGNUM* x = untag_bignum_fast(dpop());
dpush(tag_bignum(bignum_arithmetic_shift(x,y)));
}
void primitive_bignum_bitp(void)
{
F_FIXNUM bit = to_fixnum(dpop());
- F_ARRAY *x = untag_bignum_fast(dpop());
+ F_BIGNUM *x = untag_bignum_fast(dpop());
box_boolean(bignum_logbitp(bit,x));
}
void primitive_byte_array_to_bignum(void)
{
type_check(BYTE_ARRAY_TYPE,dpeek());
- CELL n_digits = array_capacity(untag_bignum_fast(dpeek()));
- bignum_type bignum = digit_stream_to_bignum(
+ CELL n_digits = array_capacity(untag_byte_array_fast(dpeek())) / CELLS;
+ F_BIGNUM * bignum = digit_stream_to_bignum(
n_digits,bignum_producer,0x100,0);
drepl(tag_bignum(bignum));
}
}
case BIGNUM_TYPE:
{
- bignum_type zero = untag_bignum_fast(bignum_zero);
- bignum_type max = cell_to_bignum(ARRAY_SIZE_MAX);
- bignum_type n = untag_bignum_fast(dpeek());
+ F_BIGNUM * zero = untag_bignum_fast(bignum_zero);
+ F_BIGNUM * max = cell_to_bignum(ARRAY_SIZE_MAX);
+ F_BIGNUM * n = untag_bignum_fast(dpeek());
if(bignum_compare(n,zero) != bignum_comparison_less
&& bignum_compare(n,max) == bignum_comparison_less)
{
extern CELL bignum_pos_one;
extern CELL bignum_neg_one;
-DEFINE_UNTAG(F_ARRAY,BIGNUM_TYPE,bignum);
+DEFINE_UNTAG(F_BIGNUM,BIGNUM_TYPE,bignum);
-INLINE CELL tag_bignum(F_ARRAY* bignum)
+INLINE CELL tag_bignum(F_BIGNUM* bignum)
{
return RETAG(bignum,BIGNUM_TYPE);
}
return (F_FIXNUM)untag_float_fast(tagged);
}
-INLINE F_ARRAY *float_to_bignum(CELL tagged)
+INLINE F_BIGNUM *float_to_bignum(CELL tagged)
{
return double_to_bignum(untag_float_fast(tagged));
}
return false;
else
{
- F_ARRAY *a = allot_array_internal(ARRAY_TYPE,depth / CELLS);
+ F_ARRAY *a = allot_array_internal<F_ARRAY>(depth / CELLS);
memcpy(a + 1,(void*)bottom,depth);
dpush(tag_array(a));
return true;
if the most significant bit of a
character is set. Initially all of
the bits are clear. */
- aux = allot_byte_array_internal(
+ aux = allot_array_internal<F_BYTE_ARRAY>(
untag_fixnum_fast(string->length)
* sizeof(u16));
UNREGISTER_UNTAGGED(F_STRING,string);
--- /dev/null
+template <typename T> CELL tag(T *value)
+{
+ if(T::type_number < HEADER_TYPE)
+ return RETAG(value,T::type_number);
+ else
+ return RETAG(value,OBJECT_TYPE);
+}
+
+template <typename T>
+class tagged
+{
+ CELL value;
+public:
+ explicit tagged(CELL tagged) : value(tagged) {}
+ explicit tagged(T *untagged) : value(::tag(untagged)) {}
+
+ CELL tag() const { return value; }
+ T *untag() const { type_check(T::type_number,value); }
+ T *untag_fast() const { return (T *)(UNTAG(value)); }
+ T *operator->() const { return untag_fast(); }
+ CELL *operator&() const { return &value; }
+};
+
+template <typename T> T *untag(CELL value)
+{
+ return tagged<T>(value).untag();
+}
+
+template <typename T> T *untag_fast(CELL value)
+{
+ return tagged<T>(value).untag_fast();
+}
projects / factor.git / commitdiff