steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up VM's array code

db4
Slava Pestov 2009-05-02 04:43:58 -05:00
parent c3a88ce57b
commit b8b44911a7
19 changed files with 346 additions and 334 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
vmpp/arrays.cpp
View File

@ -1,19 +1,10 @@
#include "master.hpp" #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 */ /* 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); REGISTER_ROOT(fill);
F_ARRAY* array = allot_array_internal(type, capacity); F_ARRAY* array = allot_array_internal<F_ARRAY>(capacity);
UNREGISTER_ROOT(fill); UNREGISTER_ROOT(fill);
if(fill == 0) if(fill == 0)
memset((void*)AREF(array,0),'\0',capacity * CELLS); memset((void*)AREF(array,0),'\0',capacity * CELLS);
@ -34,13 +25,13 @@ void primitive_array(void)
{ {
CELL initial = dpop(); CELL initial = dpop();
CELL size = unbox_array_size(); 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) CELL allot_array_1(CELL obj)
{ {
REGISTER_ROOT(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); UNREGISTER_ROOT(obj);
set_array_nth(a,0,obj); set_array_nth(a,0,obj);
return tag_array(a); return tag_array(a);
@ -50,7 +41,7 @@ CELL allot_array_2(CELL v1, CELL v2)
{ {
REGISTER_ROOT(v1); REGISTER_ROOT(v1);
REGISTER_ROOT(v2); 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(v2);
UNREGISTER_ROOT(v1); UNREGISTER_ROOT(v1);
set_array_nth(a,0,v1); set_array_nth(a,0,v1);
@ -64,7 +55,7 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
REGISTER_ROOT(v2); REGISTER_ROOT(v2);
REGISTER_ROOT(v3); REGISTER_ROOT(v3);
REGISTER_ROOT(v4); 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(v4);
UNREGISTER_ROOT(v3); UNREGISTER_ROOT(v3);
UNREGISTER_ROOT(v2); UNREGISTER_ROOT(v2);
@ -76,40 +67,6 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
return tag_array(a); 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) void primitive_resize_array(void)
{ {
F_ARRAY* array = untag_array(dpop()); F_ARRAY* array = untag_array(dpop());

17
vmpp/arrays.hpp
View File

@ -5,14 +5,7 @@ INLINE CELL tag_array(F_ARRAY *array)
return RETAG(array,ARRAY_TYPE); return RETAG(array,ARRAY_TYPE);
} }
/* Inline functions */ F_ARRAY *allot_array(CELL capacity, CELL fill);
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_BYTE_ARRAY *allot_byte_array(CELL size); F_BYTE_ARRAY *allot_byte_array(CELL size);
CELL allot_array_1(CELL obj); CELL allot_array_1(CELL obj);
@ -20,22 +13,20 @@ CELL allot_array_2(CELL v1, CELL v2);
CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4); CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4);
void primitive_array(void); void primitive_array(void);
F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity);
void primitive_resize_array(void); void primitive_resize_array(void);
/* Macros to simulate a vector in C */ /* Macros to simulate a vector in C */
typedef struct { struct F_GROWABLE_ARRAY {
CELL count; CELL count;
CELL array; CELL array;
} F_GROWABLE_ARRAY; };
/* Allocates memory */ /* Allocates memory */
INLINE F_GROWABLE_ARRAY make_growable_array(void) INLINE F_GROWABLE_ARRAY make_growable_array(void)
{ {
F_GROWABLE_ARRAY result; F_GROWABLE_ARRAY result;
result.count = 0; result.count = 0;
result.array = tag_array(allot_array(ARRAY_TYPE,2,F)); result.array = tag_array(allot_array(2,F));
return result; return result;
} }

245
vmpp/bignum.cpp
View File

@ -46,6 +46,7 @@ MIT in each case. */
* - Add local variable GC root recording * - Add local variable GC root recording
* - Remove s48 prefix from function names * - Remove s48 prefix from function names
* - Various fixes for Win64 * - Various fixes for Win64
* - Port to C++
*/ */
#include "master.hpp" #include "master.hpp"
@ -58,7 +59,7 @@ MIT in each case. */
/* Exports */ /* Exports */
int int
bignum_equal_p(bignum_type x, bignum_type y) bignum_equal_p(F_BIGNUM * x, F_BIGNUM * y)
{ {
return return
((BIGNUM_ZERO_P (x)) ((BIGNUM_ZERO_P (x))
@ -71,7 +72,7 @@ bignum_equal_p(bignum_type x, bignum_type y)
} }
enum bignum_comparison enum bignum_comparison
bignum_compare(bignum_type x, bignum_type y) bignum_compare(F_BIGNUM * x, F_BIGNUM * y)
{ {
return return
((BIGNUM_ZERO_P (x)) ((BIGNUM_ZERO_P (x))
@ -94,8 +95,8 @@ bignum_compare(bignum_type x, bignum_type y)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_add(bignum_type x, bignum_type y) bignum_add(F_BIGNUM * x, F_BIGNUM * y)
{ {
return return
((BIGNUM_ZERO_P (x)) ((BIGNUM_ZERO_P (x))
@ -112,8 +113,8 @@ bignum_add(bignum_type x, bignum_type y)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_subtract(bignum_type x, bignum_type y) bignum_subtract(F_BIGNUM * x, F_BIGNUM * y)
{ {
return return
((BIGNUM_ZERO_P (x)) ((BIGNUM_ZERO_P (x))
@ -132,8 +133,8 @@ bignum_subtract(bignum_type x, bignum_type y)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_multiply(bignum_type x, bignum_type y) bignum_multiply(F_BIGNUM * x, F_BIGNUM * y)
{ {
bignum_length_type x_length = (BIGNUM_LENGTH (x)); bignum_length_type x_length = (BIGNUM_LENGTH (x));
bignum_length_type y_length = (BIGNUM_LENGTH (y)); bignum_length_type y_length = (BIGNUM_LENGTH (y));
@ -166,8 +167,8 @@ bignum_multiply(bignum_type x, bignum_type y)
/* allocates memory */ /* allocates memory */
void void
bignum_divide(bignum_type numerator, bignum_type denominator, bignum_divide(F_BIGNUM * numerator, F_BIGNUM * denominator,
bignum_type * quotient, bignum_type * remainder) F_BIGNUM * * quotient, F_BIGNUM * * remainder)
{ {
if (BIGNUM_ZERO_P (denominator)) if (BIGNUM_ZERO_P (denominator))
{ {
@ -238,8 +239,8 @@ bignum_divide(bignum_type numerator, bignum_type denominator,
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_quotient(bignum_type numerator, bignum_type denominator) bignum_quotient(F_BIGNUM * numerator, F_BIGNUM * denominator)
{ {
if (BIGNUM_ZERO_P (denominator)) if (BIGNUM_ZERO_P (denominator))
{ {
@ -262,7 +263,7 @@ bignum_quotient(bignum_type numerator, bignum_type denominator)
case bignum_comparison_greater: case bignum_comparison_greater:
default: /* to appease gcc -Wall */ default: /* to appease gcc -Wall */
{ {
bignum_type quotient; F_BIGNUM * quotient;
if ((BIGNUM_LENGTH (denominator)) == 1) if ((BIGNUM_LENGTH (denominator)) == 1)
{ {
bignum_digit_type digit = (BIGNUM_REF (denominator, 0)); bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
@ -271,18 +272,18 @@ bignum_quotient(bignum_type numerator, bignum_type denominator)
if (digit < BIGNUM_RADIX_ROOT) if (digit < BIGNUM_RADIX_ROOT)
bignum_divide_unsigned_small_denominator bignum_divide_unsigned_small_denominator
(numerator, digit, (numerator, digit,
(&quotient), ((bignum_type *) 0), (&quotient), ((F_BIGNUM * *) 0),
q_negative_p, 0); q_negative_p, 0);
else else
bignum_divide_unsigned_medium_denominator bignum_divide_unsigned_medium_denominator
(numerator, digit, (numerator, digit,
(&quotient), ((bignum_type *) 0), (&quotient), ((F_BIGNUM * *) 0),
q_negative_p, 0); q_negative_p, 0);
} }
else else
bignum_divide_unsigned_large_denominator bignum_divide_unsigned_large_denominator
(numerator, denominator, (numerator, denominator,
(&quotient), ((bignum_type *) 0), (&quotient), ((F_BIGNUM * *) 0),
q_negative_p, 0); q_negative_p, 0);
return (quotient); return (quotient);
} }
@ -291,8 +292,8 @@ bignum_quotient(bignum_type numerator, bignum_type denominator)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_remainder(bignum_type numerator, bignum_type denominator) bignum_remainder(F_BIGNUM * numerator, F_BIGNUM * denominator)
{ {
if (BIGNUM_ZERO_P (denominator)) if (BIGNUM_ZERO_P (denominator))
{ {
@ -310,7 +311,7 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
case bignum_comparison_greater: case bignum_comparison_greater:
default: /* to appease gcc -Wall */ default: /* to appease gcc -Wall */
{ {
bignum_type remainder; F_BIGNUM * remainder;
if ((BIGNUM_LENGTH (denominator)) == 1) if ((BIGNUM_LENGTH (denominator)) == 1)
{ {
bignum_digit_type digit = (BIGNUM_REF (denominator, 0)); bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
@ -322,13 +323,13 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
(numerator, digit, (BIGNUM_NEGATIVE_P (numerator)))); (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
bignum_divide_unsigned_medium_denominator bignum_divide_unsigned_medium_denominator
(numerator, digit, (numerator, digit,
((bignum_type *) 0), (&remainder), ((F_BIGNUM * *) 0), (&remainder),
0, (BIGNUM_NEGATIVE_P (numerator))); 0, (BIGNUM_NEGATIVE_P (numerator)));
} }
else else
bignum_divide_unsigned_large_denominator bignum_divide_unsigned_large_denominator
(numerator, denominator, (numerator, denominator,
((bignum_type *) 0), (&remainder), ((F_BIGNUM * *) 0), (&remainder),
0, (BIGNUM_NEGATIVE_P (numerator))); 0, (BIGNUM_NEGATIVE_P (numerator)));
return (remainder); return (remainder);
} }
@ -336,7 +337,7 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
} }
#define FOO_TO_BIGNUM(name,type,utype) \ #define FOO_TO_BIGNUM(name,type,utype) \
bignum_type name##_to_bignum(type n) \ F_BIGNUM * name##_to_bignum(type n) \
{ \ { \
int negative_p; \ int negative_p; \
bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \ bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
@ -355,7 +356,7 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
while (accumulator != 0); \ while (accumulator != 0); \
} \ } \
{ \ { \
bignum_type result = \ F_BIGNUM * result = \
(allot_bignum ((end_digits - result_digits), negative_p)); \ (allot_bignum ((end_digits - result_digits), negative_p)); \
bignum_digit_type * scan_digits = result_digits; \ bignum_digit_type * scan_digits = result_digits; \
bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \ bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
@ -372,7 +373,7 @@ FOO_TO_BIGNUM(long_long,s64,u64)
FOO_TO_BIGNUM(ulong_long,u64,u64) FOO_TO_BIGNUM(ulong_long,u64,u64)
#define BIGNUM_TO_FOO(name,type,utype) \ #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)) \ if (BIGNUM_ZERO_P (bignum)) \
return (0); \ return (0); \
@ -393,7 +394,7 @@ BIGNUM_TO_FOO(long_long,s64,u64)
BIGNUM_TO_FOO(ulong_long,u64,u64) BIGNUM_TO_FOO(ulong_long,u64,u64)
double double
bignum_to_double(bignum_type bignum) bignum_to_double(F_BIGNUM * bignum)
{ {
if (BIGNUM_ZERO_P (bignum)) if (BIGNUM_ZERO_P (bignum))
return (0); return (0);
@ -418,7 +419,7 @@ bignum_to_double(bignum_type bignum)
/* allocates memory */ /* allocates memory */
#define inf std::numeric_limits<double>::infinity() #define inf std::numeric_limits<double>::infinity()
bignum_type F_BIGNUM *
double_to_bignum(double x) double_to_bignum(double x)
{ {
if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ()); if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
@ -429,7 +430,7 @@ double_to_bignum(double x)
if (significand < 0) significand = (-significand); if (significand < 0) significand = (-significand);
{ {
bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent)); 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 * start = (BIGNUM_START_PTR (result));
bignum_digit_type * scan = (start + length); bignum_digit_type * scan = (start + length);
bignum_digit_type digit; bignum_digit_type digit;
@ -455,7 +456,7 @@ double_to_bignum(double x)
/* Comparisons */ /* Comparisons */
int 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)); bignum_length_type length = (BIGNUM_LENGTH (x));
if (length != (BIGNUM_LENGTH (y))) if (length != (BIGNUM_LENGTH (y)))
@ -473,7 +474,7 @@ bignum_equal_p_unsigned(bignum_type x, bignum_type y)
} }
enum bignum_comparison 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 x_length = (BIGNUM_LENGTH (x));
bignum_length_type y_length = (BIGNUM_LENGTH (y)); bignum_length_type y_length = (BIGNUM_LENGTH (y));
@ -501,12 +502,12 @@ bignum_compare_unsigned(bignum_type x, bignum_type y)
/* Addition */ /* Addition */
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p) bignum_add_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
{ {
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x))) if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{ {
bignum_type z = x; F_BIGNUM * z = x;
x = y; x = y;
y = z; y = z;
} }
@ -515,7 +516,7 @@ bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
REGISTER_BIGNUM(x); REGISTER_BIGNUM(x);
REGISTER_BIGNUM(y); 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(y);
UNREGISTER_BIGNUM(x); UNREGISTER_BIGNUM(x);
@ -571,8 +572,8 @@ bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
/* Subtraction */ /* Subtraction */
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_subtract_unsigned(bignum_type x, bignum_type y) bignum_subtract_unsigned(F_BIGNUM * x, F_BIGNUM * y)
{ {
int negative_p = 0; int negative_p = 0;
switch (bignum_compare_unsigned (x, y)) switch (bignum_compare_unsigned (x, y))
@ -581,7 +582,7 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y)
return (BIGNUM_ZERO ()); return (BIGNUM_ZERO ());
case bignum_comparison_less: case bignum_comparison_less:
{ {
bignum_type z = x; F_BIGNUM * z = x;
x = y; x = y;
y = z; y = z;
} }
@ -596,7 +597,7 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y)
REGISTER_BIGNUM(x); REGISTER_BIGNUM(x);
REGISTER_BIGNUM(y); 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(y);
UNREGISTER_BIGNUM(x); UNREGISTER_BIGNUM(x);
@ -652,12 +653,12 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y)
where R == BIGNUM_RADIX_ROOT */ where R == BIGNUM_RADIX_ROOT */
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p) bignum_multiply_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
{ {
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x))) if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{ {
bignum_type z = x; F_BIGNUM * z = x;
x = y; x = y;
y = z; y = z;
} }
@ -675,7 +676,7 @@ bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
REGISTER_BIGNUM(x); REGISTER_BIGNUM(x);
REGISTER_BIGNUM(y); REGISTER_BIGNUM(y);
bignum_type r = F_BIGNUM * r =
(allot_bignum_zeroed ((x_length + y_length), negative_p)); (allot_bignum_zeroed ((x_length + y_length), negative_p));
UNREGISTER_BIGNUM(y); UNREGISTER_BIGNUM(y);
UNREGISTER_BIGNUM(x); UNREGISTER_BIGNUM(x);
@ -726,14 +727,14 @@ bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y, bignum_multiply_unsigned_small_factor(F_BIGNUM * x, bignum_digit_type y,
int negative_p) int negative_p)
{ {
bignum_length_type length_x = (BIGNUM_LENGTH (x)); bignum_length_type length_x = (BIGNUM_LENGTH (x));
REGISTER_BIGNUM(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); UNREGISTER_BIGNUM(x);
bignum_destructive_copy (x, p); bignum_destructive_copy (x, p);
@ -743,7 +744,7 @@ bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y,
} }
void 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 * scan = (BIGNUM_START_PTR (bignum));
bignum_digit_type digit; bignum_digit_type digit;
@ -767,7 +768,7 @@ bignum_destructive_add(bignum_type bignum, bignum_digit_type n)
} }
void 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 carry = 0;
bignum_digit_type * scan = (BIGNUM_START_PTR (bignum)); bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
@ -805,10 +806,10 @@ bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor)
/* allocates memory */ /* allocates memory */
void void
bignum_divide_unsigned_large_denominator(bignum_type numerator, bignum_divide_unsigned_large_denominator(F_BIGNUM * numerator,
bignum_type denominator, F_BIGNUM * denominator,
bignum_type * quotient, F_BIGNUM * * quotient,
bignum_type * remainder, F_BIGNUM * * remainder,
int q_negative_p, int q_negative_p,
int r_negative_p) int r_negative_p)
{ {
@ -818,13 +819,13 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
REGISTER_BIGNUM(numerator); REGISTER_BIGNUM(numerator);
REGISTER_BIGNUM(denominator); REGISTER_BIGNUM(denominator);
bignum_type q = F_BIGNUM * q =
((quotient != ((bignum_type *) 0)) ((quotient != ((F_BIGNUM * *) 0))
? (allot_bignum ((length_n - length_d), q_negative_p)) ? (allot_bignum ((length_n - length_d), q_negative_p))
: BIGNUM_OUT_OF_BAND); : BIGNUM_OUT_OF_BAND);
REGISTER_BIGNUM(q); 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(q);
UNREGISTER_BIGNUM(denominator); UNREGISTER_BIGNUM(denominator);
@ -852,7 +853,7 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
REGISTER_BIGNUM(denominator); REGISTER_BIGNUM(denominator);
REGISTER_BIGNUM(u); REGISTER_BIGNUM(u);
REGISTER_BIGNUM(q); REGISTER_BIGNUM(q);
bignum_type v = (allot_bignum (length_d, 0)); F_BIGNUM * v = (allot_bignum (length_d, 0));
UNREGISTER_BIGNUM(q); UNREGISTER_BIGNUM(q);
UNREGISTER_BIGNUM(u); UNREGISTER_BIGNUM(u);
UNREGISTER_BIGNUM(denominator); UNREGISTER_BIGNUM(denominator);
@ -861,7 +862,7 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
bignum_destructive_normalization (numerator, u, shift); bignum_destructive_normalization (numerator, u, shift);
bignum_destructive_normalization (denominator, v, shift); bignum_destructive_normalization (denominator, v, shift);
bignum_divide_unsigned_normalized (u, v, q); bignum_divide_unsigned_normalized (u, v, q);
if (remainder != ((bignum_type *) 0)) if (remainder != ((F_BIGNUM * *) 0))
bignum_destructive_unnormalization (u, shift); bignum_destructive_unnormalization (u, shift);
} }
@ -874,17 +875,17 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
u = bignum_trim (u); u = bignum_trim (u);
UNREGISTER_BIGNUM(q); UNREGISTER_BIGNUM(q);
if (quotient != ((bignum_type *) 0)) if (quotient != ((F_BIGNUM * *) 0))
(*quotient) = q; (*quotient) = q;
if (remainder != ((bignum_type *) 0)) if (remainder != ((F_BIGNUM * *) 0))
(*remainder) = u; (*remainder) = u;
return; return;
} }
void 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 u_length = (BIGNUM_LENGTH (u));
bignum_length_type v_length = (BIGNUM_LENGTH (v)); bignum_length_type v_length = (BIGNUM_LENGTH (v));
@ -1039,16 +1040,16 @@ bignum_divide_subtract(bignum_digit_type * v_start,
/* allocates memory */ /* allocates memory */
void void
bignum_divide_unsigned_medium_denominator(bignum_type numerator, bignum_divide_unsigned_medium_denominator(F_BIGNUM * numerator,
bignum_digit_type denominator, bignum_digit_type denominator,
bignum_type * quotient, F_BIGNUM * * quotient,
bignum_type * remainder, F_BIGNUM * * remainder,
int q_negative_p, int q_negative_p,
int r_negative_p) int r_negative_p)
{ {
bignum_length_type length_n = (BIGNUM_LENGTH (numerator)); bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
bignum_length_type length_q; bignum_length_type length_q;
bignum_type q; F_BIGNUM * q;
int shift = 0; int shift = 0;
/* Because `bignum_digit_divide' requires a normalized denominator. */ /* Because `bignum_digit_divide' requires a normalized denominator. */
while (denominator < (BIGNUM_RADIX / 2)) while (denominator < (BIGNUM_RADIX / 2))
@ -1090,7 +1091,7 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator,
q = bignum_trim (q); q = bignum_trim (q);
if (remainder != ((bignum_type *) 0)) if (remainder != ((F_BIGNUM * *) 0))
{ {
if (shift != 0) if (shift != 0)
r >>= shift; r >>= shift;
@ -1100,14 +1101,14 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator,
UNREGISTER_BIGNUM(q); UNREGISTER_BIGNUM(q);
} }
if (quotient != ((bignum_type *) 0)) if (quotient != ((F_BIGNUM * *) 0))
(*quotient) = q; (*quotient) = q;
} }
return; return;
} }
void void
bignum_destructive_normalization(bignum_type source, bignum_type target, bignum_destructive_normalization(F_BIGNUM * source, F_BIGNUM * target,
int shift_left) int shift_left)
{ {
bignum_digit_type digit; bignum_digit_type digit;
@ -1132,7 +1133,7 @@ bignum_destructive_normalization(bignum_type source, bignum_type target,
} }
void 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 * start = (BIGNUM_START_PTR (bignum));
bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
@ -1287,22 +1288,22 @@ bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
/* allocates memory */ /* allocates memory */
void void
bignum_divide_unsigned_small_denominator(bignum_type numerator, bignum_divide_unsigned_small_denominator(F_BIGNUM * numerator,
bignum_digit_type denominator, bignum_digit_type denominator,
bignum_type * quotient, F_BIGNUM * * quotient,
bignum_type * remainder, F_BIGNUM * * remainder,
int q_negative_p, int q_negative_p,
int r_negative_p) int r_negative_p)
{ {
REGISTER_BIGNUM(numerator); 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); UNREGISTER_BIGNUM(numerator);
bignum_digit_type r = (bignum_destructive_scale_down (q, denominator)); bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
q = (bignum_trim (q)); q = (bignum_trim (q));
if (remainder != ((bignum_type *) 0)) if (remainder != ((F_BIGNUM * *) 0))
{ {
REGISTER_BIGNUM(q); REGISTER_BIGNUM(q);
(*remainder) = (bignum_digit_to_bignum (r, r_negative_p)); (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
@ -1319,7 +1320,7 @@ bignum_divide_unsigned_small_denominator(bignum_type numerator,
that all digits are < BIGNUM_RADIX. */ that all digits are < BIGNUM_RADIX. */
bignum_digit_type 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 numerator;
bignum_digit_type remainder = 0; bignum_digit_type remainder = 0;
@ -1342,9 +1343,9 @@ bignum_destructive_scale_down(bignum_type bignum, bignum_digit_type denominator)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_remainder_unsigned_small_denominator( 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 two_digits;
bignum_digit_type * start = (BIGNUM_START_PTR (n)); bignum_digit_type * start = (BIGNUM_START_PTR (n));
@ -1363,34 +1364,34 @@ bignum_remainder_unsigned_small_denominator(
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_digit_to_bignum(bignum_digit_type digit, int negative_p) bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
{ {
if (digit == 0) if (digit == 0)
return (BIGNUM_ZERO ()); return (BIGNUM_ZERO ());
else else
{ {
bignum_type result = (allot_bignum (1, negative_p)); F_BIGNUM * result = (allot_bignum (1, negative_p));
(BIGNUM_REF (result, 0)) = digit; (BIGNUM_REF (result, 0)) = digit;
return (result); return (result);
} }
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
allot_bignum(bignum_length_type length, int negative_p) allot_bignum(bignum_length_type length, int negative_p)
{ {
BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX)); 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); BIGNUM_SET_NEGATIVE_P (result, negative_p);
return (result); return (result);
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
allot_bignum_zeroed(bignum_length_type length, int negative_p) 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 * scan = (BIGNUM_START_PTR (result));
bignum_digit_type * end = (scan + length); bignum_digit_type * end = (scan + length);
while (scan < end) while (scan < end)
@ -1399,11 +1400,11 @@ allot_bignum_zeroed(bignum_length_type length, int negative_p)
} }
#define BIGNUM_REDUCE_LENGTH(source, length) \ #define BIGNUM_REDUCE_LENGTH(source, length) \
source = reallot_array(source,length + 1) source = reallot_array(source,length + 1)
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_shorten_length(bignum_type bignum, bignum_length_type length) bignum_shorten_length(F_BIGNUM * bignum, bignum_length_type length)
{ {
bignum_length_type current_length = (BIGNUM_LENGTH (bignum)); bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
BIGNUM_ASSERT ((length >= 0) || (length <= current_length)); BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
@ -1416,8 +1417,8 @@ bignum_shorten_length(bignum_type bignum, bignum_length_type length)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_trim(bignum_type bignum) bignum_trim(F_BIGNUM * bignum)
{ {
bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum))); bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
@ -1437,11 +1438,11 @@ bignum_trim(bignum_type bignum)
/* Copying */ /* Copying */
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_new_sign(bignum_type bignum, int negative_p) bignum_new_sign(F_BIGNUM * bignum, int negative_p)
{ {
REGISTER_BIGNUM(bignum); REGISTER_BIGNUM(bignum);
bignum_type result = F_BIGNUM * result =
(allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p)); (allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p));
UNREGISTER_BIGNUM(bignum); UNREGISTER_BIGNUM(bignum);
@ -1450,14 +1451,14 @@ bignum_new_sign(bignum_type bignum, int negative_p)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_maybe_new_sign(bignum_type bignum, int negative_p) bignum_maybe_new_sign(F_BIGNUM * bignum, int negative_p)
{ {
if ((BIGNUM_NEGATIVE_P (bignum)) ? negative_p : (! negative_p)) if ((BIGNUM_NEGATIVE_P (bignum)) ? negative_p : (! negative_p))
return (bignum); return (bignum);
else else
{ {
bignum_type result = F_BIGNUM * result =
(allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p)); (allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p));
bignum_destructive_copy (bignum, result); bignum_destructive_copy (bignum, result);
return (result); return (result);
@ -1465,7 +1466,7 @@ bignum_maybe_new_sign(bignum_type bignum, int negative_p)
} }
void 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 * scan_source = (BIGNUM_START_PTR (source));
bignum_digit_type * end_source = bignum_digit_type * end_source =
@ -1481,15 +1482,15 @@ bignum_destructive_copy(bignum_type source, bignum_type target)
*/ */
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_bitwise_not(bignum_type x) bignum_bitwise_not(F_BIGNUM * x)
{ {
return bignum_subtract(BIGNUM_ONE(1), x); return bignum_subtract(BIGNUM_ONE(1), x);
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_arithmetic_shift(bignum_type arg1, F_FIXNUM n) bignum_arithmetic_shift(F_BIGNUM * arg1, F_FIXNUM n)
{ {
if (BIGNUM_NEGATIVE_P(arg1) && n < 0) if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n)); return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
@ -1502,8 +1503,8 @@ bignum_arithmetic_shift(bignum_type arg1, F_FIXNUM n)
#define XOR_OP 2 #define XOR_OP 2
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_bitwise_and(bignum_type arg1, bignum_type arg2) bignum_bitwise_and(F_BIGNUM * arg1, F_BIGNUM * arg2)
{ {
return( return(
(BIGNUM_NEGATIVE_P (arg1)) (BIGNUM_NEGATIVE_P (arg1))
@ -1517,8 +1518,8 @@ bignum_bitwise_and(bignum_type arg1, bignum_type arg2)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_bitwise_ior(bignum_type arg1, bignum_type arg2) bignum_bitwise_ior(F_BIGNUM * arg1, F_BIGNUM * arg2)
{ {
return( return(
(BIGNUM_NEGATIVE_P (arg1)) (BIGNUM_NEGATIVE_P (arg1))
@ -1532,8 +1533,8 @@ bignum_bitwise_ior(bignum_type arg1, bignum_type arg2)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_bitwise_xor(bignum_type arg1, bignum_type arg2) bignum_bitwise_xor(F_BIGNUM * arg1, F_BIGNUM * arg2)
{ {
return( return(
(BIGNUM_NEGATIVE_P (arg1)) (BIGNUM_NEGATIVE_P (arg1))
@ -1549,10 +1550,10 @@ bignum_bitwise_xor(bignum_type arg1, bignum_type arg2)
/* allocates memory */ /* allocates memory */
/* ash for the magnitude */ /* ash for the magnitude */
/* assume arg1 is a big number, n is a long */ /* assume arg1 is a big number, n is a long */
bignum_type F_BIGNUM *
bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n) bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n)
{ {
bignum_type result = NULL; F_BIGNUM * result = NULL;
bignum_digit_type *scan1; bignum_digit_type *scan1;
bignum_digit_type *scanr; bignum_digit_type *scanr;
bignum_digit_type *end; bignum_digit_type *end;
@ -1613,10 +1614,10 @@ bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2) bignum_pospos_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
{ {
bignum_type result; F_BIGNUM * result;
bignum_length_type max_length; bignum_length_type max_length;
bignum_digit_type *scan1, *end1, digit1; bignum_digit_type *scan1, *end1, digit1;
@ -1650,10 +1651,10 @@ bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2) bignum_posneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
{ {
bignum_type result; F_BIGNUM * result;
bignum_length_type max_length; bignum_length_type max_length;
bignum_digit_type *scan1, *end1, digit1; bignum_digit_type *scan1, *end1, digit1;
@ -1705,10 +1706,10 @@ bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
} }
/* allocates memory */ /* allocates memory */
bignum_type F_BIGNUM *
bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2) bignum_negneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
{ {
bignum_type result; F_BIGNUM * result;
bignum_length_type max_length; bignum_length_type max_length;
bignum_digit_type *scan1, *end1, digit1, carry1; bignum_digit_type *scan1, *end1, digit1, carry1;
@ -1768,7 +1769,7 @@ bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
} }
void void
bignum_negate_magnitude(bignum_type arg) bignum_negate_magnitude(F_BIGNUM * arg)
{ {
bignum_digit_type *scan; bignum_digit_type *scan;
bignum_digit_type *end; bignum_digit_type *end;
@ -1796,14 +1797,14 @@ bignum_negate_magnitude(bignum_type arg)
} }
/* Allocates memory */ /* Allocates memory */
bignum_type F_BIGNUM *
bignum_integer_length(bignum_type bignum) bignum_integer_length(F_BIGNUM * bignum)
{ {
bignum_length_type index = ((BIGNUM_LENGTH (bignum)) - 1); bignum_length_type index = ((BIGNUM_LENGTH (bignum)) - 1);
bignum_digit_type digit = (BIGNUM_REF (bignum, index)); bignum_digit_type digit = (BIGNUM_REF (bignum, index));
REGISTER_BIGNUM(bignum); REGISTER_BIGNUM(bignum);
bignum_type result = (allot_bignum (2, 0)); F_BIGNUM * result = (allot_bignum (2, 0));
UNREGISTER_BIGNUM(bignum); UNREGISTER_BIGNUM(bignum);
(BIGNUM_REF (result, 0)) = index; (BIGNUM_REF (result, 0)) = index;
@ -1819,7 +1820,7 @@ bignum_integer_length(bignum_type bignum)
/* Allocates memory */ /* Allocates memory */
int int
bignum_logbitp(int shift, bignum_type arg) bignum_logbitp(int shift, F_BIGNUM * arg)
{ {
return((BIGNUM_NEGATIVE_P (arg)) return((BIGNUM_NEGATIVE_P (arg))
? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg)) ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
@ -1827,7 +1828,7 @@ bignum_logbitp(int shift, bignum_type arg)
} }
int int
bignum_unsigned_logbitp(int shift, bignum_type bignum) bignum_unsigned_logbitp(int shift, F_BIGNUM * bignum)
{ {
bignum_length_type len = (BIGNUM_LENGTH (bignum)); bignum_length_type len = (BIGNUM_LENGTH (bignum));
int index = shift / BIGNUM_DIGIT_LENGTH; int index = shift / BIGNUM_DIGIT_LENGTH;
@ -1840,7 +1841,7 @@ bignum_unsigned_logbitp(int shift, bignum_type bignum)
} }
/* Allocates memory */ /* Allocates memory */
bignum_type F_BIGNUM *
digit_stream_to_bignum(unsigned int n_digits, digit_stream_to_bignum(unsigned int n_digits,
unsigned int (*producer)(unsigned int), unsigned int (*producer)(unsigned int),
unsigned int radix, unsigned int radix,
@ -1868,7 +1869,7 @@ digit_stream_to_bignum(unsigned int n_digits,
length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_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) while ((n_digits--) > 0)
{ {
bignum_destructive_scale_up (result, ((bignum_digit_type) radix)); bignum_destructive_scale_up (result, ((bignum_digit_type) radix));

123
vmpp/bignum.hpp
View File

@ -32,8 +32,7 @@ Technology nor of any adaptation thereof in any advertising,
promotional, or sales literature without prior written consent from promotional, or sales literature without prior written consent from
MIT in each case. */ MIT in each case. */
typedef F_ARRAY * bignum_type; #define BIGNUM_OUT_OF_BAND ((F_BIGNUM *) 0)
#define BIGNUM_OUT_OF_BAND ((bignum_type) 0)
enum bignum_comparison enum bignum_comparison
{ {
@ -42,86 +41,86 @@ enum bignum_comparison
bignum_comparison_greater = 1 bignum_comparison_greater = 1
}; };
int bignum_equal_p(bignum_type, bignum_type); int bignum_equal_p(F_BIGNUM *, F_BIGNUM *);
enum bignum_comparison bignum_compare(bignum_type, bignum_type); enum bignum_comparison bignum_compare(F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_add(bignum_type, bignum_type); F_BIGNUM * bignum_add(F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_subtract(bignum_type, bignum_type); F_BIGNUM * bignum_subtract(F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_negate(bignum_type); F_BIGNUM * bignum_negate(F_BIGNUM *);
bignum_type bignum_multiply(bignum_type, bignum_type); F_BIGNUM * bignum_multiply(F_BIGNUM *, F_BIGNUM *);
void void
bignum_divide(bignum_type numerator, bignum_type denominator, bignum_divide(F_BIGNUM * numerator, F_BIGNUM * denominator,
bignum_type * quotient, bignum_type * remainder); F_BIGNUM * * quotient, F_BIGNUM * * remainder);
bignum_type bignum_quotient(bignum_type, bignum_type); F_BIGNUM * bignum_quotient(F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_remainder(bignum_type, bignum_type); F_BIGNUM * bignum_remainder(F_BIGNUM *, F_BIGNUM *);
DLLEXPORT bignum_type fixnum_to_bignum(F_FIXNUM); F_BIGNUM * fixnum_to_bignum(F_FIXNUM);
DLLEXPORT bignum_type cell_to_bignum(CELL); F_BIGNUM * cell_to_bignum(CELL);
DLLEXPORT bignum_type long_long_to_bignum(s64 n); F_BIGNUM * long_long_to_bignum(s64 n);
DLLEXPORT bignum_type ulong_long_to_bignum(u64 n); F_BIGNUM * ulong_long_to_bignum(u64 n);
F_FIXNUM bignum_to_fixnum(bignum_type); F_FIXNUM bignum_to_fixnum(F_BIGNUM *);
CELL bignum_to_cell(bignum_type); CELL bignum_to_cell(F_BIGNUM *);
s64 bignum_to_long_long(bignum_type); s64 bignum_to_long_long(F_BIGNUM *);
u64 bignum_to_ulong_long(bignum_type); u64 bignum_to_ulong_long(F_BIGNUM *);
bignum_type double_to_bignum(double); F_BIGNUM * double_to_bignum(double);
double bignum_to_double(bignum_type); double bignum_to_double(F_BIGNUM *);
/* Added bitwise operators. */ /* Added bitwise operators. */
DLLEXPORT bignum_type bignum_bitwise_not(bignum_type), F_BIGNUM * bignum_bitwise_not(F_BIGNUM *);
bignum_arithmetic_shift(bignum_type, F_FIXNUM), F_BIGNUM * bignum_arithmetic_shift(F_BIGNUM *, F_FIXNUM);
bignum_bitwise_and(bignum_type, bignum_type), F_BIGNUM * bignum_bitwise_and(F_BIGNUM *, F_BIGNUM *);
bignum_bitwise_ior(bignum_type, bignum_type), F_BIGNUM * bignum_bitwise_ior(F_BIGNUM *, F_BIGNUM *);
bignum_bitwise_xor(bignum_type, bignum_type); F_BIGNUM * bignum_bitwise_xor(F_BIGNUM *, F_BIGNUM *);
/* Forward references */ /* Forward references */
int bignum_equal_p_unsigned(bignum_type, bignum_type); int bignum_equal_p_unsigned(F_BIGNUM *, F_BIGNUM *);
enum bignum_comparison bignum_compare_unsigned(bignum_type, bignum_type); enum bignum_comparison bignum_compare_unsigned(F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_add_unsigned(bignum_type, bignum_type, int); F_BIGNUM * bignum_add_unsigned(F_BIGNUM *, F_BIGNUM *, int);
bignum_type bignum_subtract_unsigned(bignum_type, bignum_type); F_BIGNUM * bignum_subtract_unsigned(F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_multiply_unsigned(bignum_type, bignum_type, int); F_BIGNUM * bignum_multiply_unsigned(F_BIGNUM *, F_BIGNUM *, int);
bignum_type bignum_multiply_unsigned_small_factor F_BIGNUM * bignum_multiply_unsigned_small_factor
(bignum_type, bignum_digit_type, int); (F_BIGNUM *, bignum_digit_type, int);
void bignum_destructive_scale_up(bignum_type, bignum_digit_type); void bignum_destructive_scale_up(F_BIGNUM *, bignum_digit_type);
void bignum_destructive_add(bignum_type, bignum_digit_type); void bignum_destructive_add(F_BIGNUM *, bignum_digit_type);
void bignum_divide_unsigned_large_denominator void bignum_divide_unsigned_large_denominator
(bignum_type, bignum_type, bignum_type *, bignum_type *, int, int); (F_BIGNUM *, F_BIGNUM *, F_BIGNUM * *, F_BIGNUM * *, int, int);
void bignum_destructive_normalization(bignum_type, bignum_type, int); void bignum_destructive_normalization(F_BIGNUM *, F_BIGNUM *, int);
void bignum_destructive_unnormalization(bignum_type, int); void bignum_destructive_unnormalization(F_BIGNUM *, int);
void bignum_divide_unsigned_normalized(bignum_type, bignum_type, bignum_type); void bignum_divide_unsigned_normalized(F_BIGNUM *, F_BIGNUM *, F_BIGNUM *);
bignum_digit_type bignum_divide_subtract bignum_digit_type bignum_divide_subtract
(bignum_digit_type *, bignum_digit_type *, bignum_digit_type, (bignum_digit_type *, bignum_digit_type *, bignum_digit_type,
bignum_digit_type *); bignum_digit_type *);
void bignum_divide_unsigned_medium_denominator 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_divide
(bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *); (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
bignum_digit_type bignum_digit_divide_subtract bignum_digit_type bignum_digit_divide_subtract
(bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *); (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
void bignum_divide_unsigned_small_denominator 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_digit_type bignum_destructive_scale_down
(bignum_type, bignum_digit_type); (F_BIGNUM *, bignum_digit_type);
bignum_type bignum_remainder_unsigned_small_denominator F_BIGNUM * bignum_remainder_unsigned_small_denominator
(bignum_type, bignum_digit_type, int); (F_BIGNUM *, bignum_digit_type, int);
bignum_type bignum_digit_to_bignum(bignum_digit_type, int); F_BIGNUM * bignum_digit_to_bignum(bignum_digit_type, int);
bignum_type allot_bignum(bignum_length_type, int); F_BIGNUM * allot_bignum(bignum_length_type, int);
bignum_type allot_bignum_zeroed(bignum_length_type, int); F_BIGNUM * allot_bignum_zeroed(bignum_length_type, int);
bignum_type bignum_shorten_length(bignum_type, bignum_length_type); F_BIGNUM * bignum_shorten_length(F_BIGNUM *, bignum_length_type);
bignum_type bignum_trim(bignum_type); F_BIGNUM * bignum_trim(F_BIGNUM *);
bignum_type bignum_new_sign(bignum_type, int); F_BIGNUM * bignum_new_sign(F_BIGNUM *, int);
bignum_type bignum_maybe_new_sign(bignum_type, int); F_BIGNUM * bignum_maybe_new_sign(F_BIGNUM *, int);
void bignum_destructive_copy(bignum_type, bignum_type); void bignum_destructive_copy(F_BIGNUM *, F_BIGNUM *);
/* Added for bitwise operations. */ /* Added for bitwise operations. */
bignum_type bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n); F_BIGNUM * bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n);
bignum_type bignum_pospos_bitwise_op(int op, bignum_type, bignum_type); F_BIGNUM * bignum_pospos_bitwise_op(int op, F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_posneg_bitwise_op(int op, bignum_type, bignum_type); F_BIGNUM * bignum_posneg_bitwise_op(int op, F_BIGNUM *, F_BIGNUM *);
bignum_type bignum_negneg_bitwise_op(int op, bignum_type, bignum_type); F_BIGNUM * bignum_negneg_bitwise_op(int op, F_BIGNUM *, F_BIGNUM *);
void bignum_negate_magnitude(bignum_type); void bignum_negate_magnitude(F_BIGNUM *);
bignum_type bignum_integer_length(bignum_type arg1); F_BIGNUM * bignum_integer_length(F_BIGNUM * arg1);
int bignum_unsigned_logbitp(int shift, bignum_type bignum); int bignum_unsigned_logbitp(int shift, F_BIGNUM * bignum);
int bignum_logbitp(int shift, bignum_type arg); int bignum_logbitp(int shift, F_BIGNUM * arg);
bignum_type digit_stream_to_bignum(unsigned int n_digits, F_BIGNUM * digit_stream_to_bignum(unsigned int n_digits,
unsigned int (*producer)(unsigned int), unsigned int (*producer)(unsigned int),
unsigned int radix, unsigned int radix,
int negative_p); int negative_p);

2
vmpp/bignumint.hpp
View File

@ -46,7 +46,7 @@ typedef F_FIXNUM bignum_digit_type;
typedef F_FIXNUM bignum_length_type; typedef F_FIXNUM bignum_length_type;
/* BIGNUM_TO_POINTER casts a bignum object to a digit array pointer. */ /* 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. */ /* BIGNUM_EXCEPTION is invoked to handle assertion violations. */
#define BIGNUM_EXCEPTION abort #define BIGNUM_EXCEPTION abort

53
vmpp/byte_arrays.cpp
View File

@ -1,22 +1,12 @@
#include "master.hpp" #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 *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); memset(array + 1,0,size);
return array; return array;
} }
/* push a new byte array on the stack */
void primitive_byte_array(void) void primitive_byte_array(void)
{ {
CELL size = unbox_array_size(); CELL size = unbox_array_size();
@ -26,45 +16,14 @@ void primitive_byte_array(void)
void primitive_uninitialized_byte_array(void) void primitive_uninitialized_byte_array(void)
{ {
CELL size = unbox_array_size(); CELL size = unbox_array_size();
dpush(tag_object(allot_byte_array_internal(size))); dpush(tag_object(allot_array_internal<F_BYTE_ARRAY>(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;
}
} }
void primitive_resize_byte_array(void) 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(); 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) void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *array, void *elts, CELL len)
@ -72,9 +31,9 @@ void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *array, void *elts, CELL l
CELL new_size = array->count + len; CELL new_size = array->count + len;
F_BYTE_ARRAY *underlying = untag_byte_array_fast(array->array); 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); array->array = tag_object(underlying);
} }

18
vmpp/byte_arrays.hpp
View File

@ -1,28 +1,16 @@
DEFINE_UNTAG(F_BYTE_ARRAY,BYTE_ARRAY_TYPE,byte_array) 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(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_byte_array(void);
void primitive_uninitialized_byte_array(void); void primitive_uninitialized_byte_array(void);
void primitive_resize_byte_array(void); void primitive_resize_byte_array(void);
/* Macros to simulate a byte vector in C */ /* Macros to simulate a byte vector in C */
typedef struct { struct F_GROWABLE_BYTE_ARRAY {
CELL count; CELL count;
CELL array; CELL array;
} F_GROWABLE_BYTE_ARRAY; };
INLINE F_GROWABLE_BYTE_ARRAY make_growable_byte_array(void) INLINE F_GROWABLE_BYTE_ARRAY make_growable_byte_array(void)
{ {
@ -36,5 +24,5 @@ void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *result, void *elts, CELL
INLINE void growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array) 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));
} }

2
vmpp/callstack.cpp
View File

@ -164,7 +164,7 @@ void primitive_callstack_to_array(void)
iterate_callstack_object(stack,count_stack_frame); iterate_callstack_object(stack,count_stack_frame);
REGISTER_UNTAGGED(stack); REGISTER_UNTAGGED(stack);
array = allot_array_internal(ARRAY_TYPE,frame_count); array = allot_array_internal<F_ARRAY>(frame_count);
UNREGISTER_UNTAGGED(F_CALLSTACK,stack); UNREGISTER_UNTAGGED(F_CALLSTACK,stack);
frame_index = 0; frame_index = 0;

2
vmpp/code_block.cpp
View File

@ -14,7 +14,7 @@ void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter)
CELL index = stack_traces_p() ? 1 : 0; CELL index = stack_traces_p() ? 1 : 0;
F_REL *rel = (F_REL *)(relocation + 1); 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) while(rel < rel_end)
{ {

8
vmpp/data_heap.cpp
View File

@ -216,11 +216,11 @@ CELL unaligned_object_size(CELL pointer)
switch(untag_header(get(pointer))) switch(untag_header(get(pointer)))
{ {
case ARRAY_TYPE: case ARRAY_TYPE:
return array_size((F_ARRAY*)pointer);
case BIGNUM_TYPE: case BIGNUM_TYPE:
return array_size(array_capacity((F_ARRAY*)pointer)); return array_size((F_BIGNUM*)pointer);
case BYTE_ARRAY_TYPE: case BYTE_ARRAY_TYPE:
return byte_array_size( return array_size((F_BYTE_ARRAY*)pointer);
byte_array_capacity((F_BYTE_ARRAY*)pointer));
case STRING_TYPE: case STRING_TYPE:
return string_size(string_capacity((F_STRING*)pointer)); return string_size(string_capacity((F_STRING*)pointer));
case TUPLE_TYPE: case TUPLE_TYPE:
@ -282,7 +282,7 @@ CELL binary_payload_start(CELL pointer)
return sizeof(F_STRING); return sizeof(F_STRING);
/* everything else consists entirely of pointers */ /* everything else consists entirely of pointers */
case ARRAY_TYPE: case ARRAY_TYPE:
return array_size(array_capacity((F_ARRAY*)pointer)); return array_size<F_ARRAY>(array_capacity((F_ARRAY*)pointer));
case TUPLE_TYPE: case TUPLE_TYPE:
tuple = untag_tuple_fast(pointer); tuple = untag_tuple_fast(pointer);
layout = untag_tuple_layout(tuple->layout); layout = untag_tuple_layout(tuple->layout);

2
vmpp/factor.cpp
View File

@ -152,7 +152,7 @@ void init_factor(F_PARAMETERS *p)
/* May allocate memory */ /* May allocate memory */
void pass_args_to_factor(int argc, F_CHAR **argv) 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; int i;
for(i = 1; i < argc; i++) for(i = 1; i < argc; i++)

82
vmpp/generic_arrays.hpp Normal file
View File

@ -0,0 +1,82 @@
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;
}
}

3
vmpp/layouts.hpp
View File

@ -87,6 +87,7 @@ struct F_OBJECT {
/* Assembly code makes assumptions about the layout of this struct */ /* Assembly code makes assumptions about the layout of this struct */
struct F_ARRAY : public F_OBJECT { struct F_ARRAY : public F_OBJECT {
static const CELL type_number = ARRAY_TYPE; static const CELL type_number = ARRAY_TYPE;
static const CELL element_size = CELLS;
/* tagged */ /* tagged */
CELL capacity; CELL capacity;
}; };
@ -104,12 +105,14 @@ struct F_TUPLE_LAYOUT : public F_ARRAY {
struct F_BIGNUM : public F_OBJECT { struct F_BIGNUM : public F_OBJECT {
static const CELL type_number = BIGNUM_TYPE; static const CELL type_number = BIGNUM_TYPE;
static const CELL element_size = CELLS;
/* tagged */ /* tagged */
CELL capacity; CELL capacity;
}; };
struct F_BYTE_ARRAY : public F_OBJECT { struct F_BYTE_ARRAY : public F_OBJECT {
static const CELL type_number = BYTE_ARRAY_TYPE; static const CELL type_number = BYTE_ARRAY_TYPE;
static const CELL element_size = 1;
/* tagged */ /* tagged */
CELL capacity; CELL capacity;
}; };

2
vmpp/master.hpp
View File

@ -30,10 +30,10 @@
#include "bignumint.hpp" #include "bignumint.hpp"
#include "bignum.hpp" #include "bignum.hpp"
#include "write_barrier.hpp" #include "write_barrier.hpp"
#include "generic_arrays.hpp"
#include "data_heap.hpp" #include "data_heap.hpp"
#include "data_gc.hpp" #include "data_gc.hpp"
#include "local_roots.hpp" #include "local_roots.hpp"
#include "generic_arrays.hpp"
#include "debug.hpp" #include "debug.hpp"
#include "arrays.hpp" #include "arrays.hpp"
#include "strings.hpp" #include "strings.hpp"

24
vmpp/math.cpp
View File

@ -50,9 +50,9 @@ F_FASTCALL void overflow_fixnum_subtract(F_FIXNUM x, F_FIXNUM y)
F_FASTCALL void overflow_fixnum_multiply(F_FIXNUM x, F_FIXNUM y) 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); REGISTER_BIGNUM(bx);
F_ARRAY *by = fixnum_to_bignum(y); F_BIGNUM *by = fixnum_to_bignum(y);
UNREGISTER_BIGNUM(bx); UNREGISTER_BIGNUM(bx);
drepl(tag_bignum(bignum_multiply(bx,by))); drepl(tag_bignum(bignum_multiply(bx,by)));
} }
@ -133,8 +133,8 @@ void primitive_float_to_bignum(void)
} }
#define POP_BIGNUMS(x,y) \ #define POP_BIGNUMS(x,y) \
bignum_type y = untag_bignum_fast(dpop()); \ F_BIGNUM * y = untag_bignum_fast(dpop()); \
bignum_type x = untag_bignum_fast(dpop()); F_BIGNUM * x = untag_bignum_fast(dpop());
void primitive_bignum_eq(void) void primitive_bignum_eq(void)
{ {
@ -168,7 +168,7 @@ void primitive_bignum_divint(void)
void primitive_bignum_divmod(void) void primitive_bignum_divmod(void)
{ {
F_ARRAY *q, *r; F_BIGNUM *q, *r;
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
bignum_divide(x,y,&q,&r); bignum_divide(x,y,&q,&r);
dpush(tag_bignum(q)); dpush(tag_bignum(q));
@ -202,7 +202,7 @@ void primitive_bignum_xor(void)
void primitive_bignum_shift(void) void primitive_bignum_shift(void)
{ {
F_FIXNUM y = untag_fixnum_fast(dpop()); 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))); dpush(tag_bignum(bignum_arithmetic_shift(x,y)));
} }
@ -238,7 +238,7 @@ void primitive_bignum_not(void)
void primitive_bignum_bitp(void) void primitive_bignum_bitp(void)
{ {
F_FIXNUM bit = to_fixnum(dpop()); 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)); box_boolean(bignum_logbitp(bit,x));
} }
@ -256,8 +256,8 @@ unsigned int bignum_producer(unsigned int digit)
void primitive_byte_array_to_bignum(void) void primitive_byte_array_to_bignum(void)
{ {
type_check(BYTE_ARRAY_TYPE,dpeek()); type_check(BYTE_ARRAY_TYPE,dpeek());
CELL n_digits = array_capacity(untag_bignum_fast(dpeek())); CELL n_digits = array_capacity(untag_byte_array_fast(dpeek())) / CELLS;
bignum_type bignum = digit_stream_to_bignum( F_BIGNUM * bignum = digit_stream_to_bignum(
n_digits,bignum_producer,0x100,0); n_digits,bignum_producer,0x100,0);
drepl(tag_bignum(bignum)); drepl(tag_bignum(bignum));
} }
@ -362,9 +362,9 @@ CELL unbox_array_size(void)
} }
case BIGNUM_TYPE: case BIGNUM_TYPE:
{ {
bignum_type zero = untag_bignum_fast(bignum_zero); F_BIGNUM * zero = untag_bignum_fast(bignum_zero);
bignum_type max = cell_to_bignum(ARRAY_SIZE_MAX); F_BIGNUM * max = cell_to_bignum(ARRAY_SIZE_MAX);
bignum_type n = untag_bignum_fast(dpeek()); F_BIGNUM * n = untag_bignum_fast(dpeek());
if(bignum_compare(n,zero) != bignum_comparison_less if(bignum_compare(n,zero) != bignum_comparison_less
&& bignum_compare(n,max) == bignum_comparison_less) && bignum_compare(n,max) == bignum_comparison_less)
{ {

6
vmpp/math.hpp
View File

@ -21,9 +21,9 @@ extern CELL bignum_zero;
extern CELL bignum_pos_one; extern CELL bignum_pos_one;
extern CELL bignum_neg_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 RETAG(bignum,BIGNUM_TYPE);
} }
@ -106,7 +106,7 @@ INLINE F_FIXNUM float_to_fixnum(CELL tagged)
return (F_FIXNUM)untag_float_fast(tagged); 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 double_to_bignum(untag_float_fast(tagged));
} }

2
vmpp/run.cpp
View File

@ -124,7 +124,7 @@ bool stack_to_array(CELL bottom, CELL top)
return false; return false;
else 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); memcpy(a + 1,(void*)bottom,depth);
dpush(tag_array(a)); dpush(tag_array(a));
return true; return true;

2
vmpp/strings.cpp
View File

@ -37,7 +37,7 @@ void set_string_nth_slow(F_STRING* string, CELL index, CELL ch)
if the most significant bit of a if the most significant bit of a
character is set. Initially all of character is set. Initially all of
the bits are clear. */ the bits are clear. */
aux = allot_byte_array_internal( aux = allot_array_internal<F_BYTE_ARRAY>(
untag_fixnum_fast(string->length) untag_fixnum_fast(string->length)
* sizeof(u16)); * sizeof(u16));
UNREGISTER_UNTAGGED(F_STRING,string); UNREGISTER_UNTAGGED(F_STRING,string);

32
vmpp/tagged.hpp Normal file
View File

@ -0,0 +1,32 @@
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();
}