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"
/* 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);
@ -34,13 +25,13 @@ void primitive_array(void)
{
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);
@ -50,7 +41,7 @@ CELL allot_array_2(CELL v1, CELL v2)
{
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);
@ -64,7 +55,7 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
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);
@ -76,40 +67,6 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
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());

17
vmpp/arrays.hpp
View File

@ -5,14 +5,7 @@ INLINE CELL tag_array(F_ARRAY *array)
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);
@ -20,22 +13,20 @@ CELL allot_array_2(CELL v1, CELL v2);
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;
}

245
vmpp/bignum.cpp
View File

@ -46,6 +46,7 @@ MIT in each case. */
* - Add local variable GC root recording
* - Remove s48 prefix from function names
* - Various fixes for Win64
* - Port to C++
*/
#include "master.hpp"
@ -58,7 +59,7 @@ MIT in each case. */
/* 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))
@ -71,7 +72,7 @@ bignum_equal_p(bignum_type x, bignum_type y)
}
enum bignum_comparison
bignum_compare(bignum_type x, bignum_type y)
bignum_compare(F_BIGNUM * x, F_BIGNUM * y)
{
return
((BIGNUM_ZERO_P (x))
@ -94,8 +95,8 @@ bignum_compare(bignum_type x, bignum_type y)
}
/* 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))
@ -112,8 +113,8 @@ bignum_add(bignum_type x, bignum_type y)
}
/* 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))
@ -132,8 +133,8 @@ bignum_subtract(bignum_type x, bignum_type y)
}
/* 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));
@ -166,8 +167,8 @@ bignum_multiply(bignum_type x, bignum_type 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))
{
@ -238,8 +239,8 @@ bignum_divide(bignum_type numerator, bignum_type 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))
{
@ -262,7 +263,7 @@ bignum_quotient(bignum_type numerator, bignum_type 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));
@ -271,18 +272,18 @@ bignum_quotient(bignum_type numerator, bignum_type denominator)
if (digit < BIGNUM_RADIX_ROOT)
bignum_divide_unsigned_small_denominator
(numerator, digit,
(&quotient), ((bignum_type *) 0),
(&quotient), ((F_BIGNUM * *) 0),
q_negative_p, 0);
else
bignum_divide_unsigned_medium_denominator
(numerator, digit,
(&quotient), ((bignum_type *) 0),
(&quotient), ((F_BIGNUM * *) 0),
q_negative_p, 0);
}
else
bignum_divide_unsigned_large_denominator
(numerator, denominator,
(&quotient), ((bignum_type *) 0),
(&quotient), ((F_BIGNUM * *) 0),
q_negative_p, 0);
return (quotient);
}
@ -291,8 +292,8 @@ bignum_quotient(bignum_type numerator, bignum_type denominator)
}
/* 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))
{
@ -310,7 +311,7 @@ bignum_remainder(bignum_type numerator, bignum_type 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));
@ -322,13 +323,13 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
(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);
}
@ -336,7 +337,7 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
}
#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)]; \
@ -355,7 +356,7 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
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)); \
@ -372,7 +373,7 @@ FOO_TO_BIGNUM(long_long,s64,u64)
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); \
@ -393,7 +394,7 @@ BIGNUM_TO_FOO(long_long,s64,u64)
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);
@ -418,7 +419,7 @@ bignum_to_double(bignum_type bignum)
/* 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 ());
@ -429,7 +430,7 @@ double_to_bignum(double x)
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;
@ -455,7 +456,7 @@ double_to_bignum(double x)
/* 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)))
@ -473,7 +474,7 @@ bignum_equal_p_unsigned(bignum_type x, bignum_type 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));
@ -501,12 +502,12 @@ bignum_compare_unsigned(bignum_type x, bignum_type 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;
}
@ -515,7 +516,7 @@ bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
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);
@ -571,8 +572,8 @@ bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p)
/* 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))
@ -581,7 +582,7 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y)
return (BIGNUM_ZERO ());
case bignum_comparison_less:
{
bignum_type z = x;
F_BIGNUM * z = x;
x = y;
y = z;
}
@ -596,7 +597,7 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y)
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);
@ -652,12 +653,12 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y)
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;
}
@ -675,7 +676,7 @@ bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
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);
@ -726,14 +727,14 @@ bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p)
}
/* 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);
@ -743,7 +744,7 @@ bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y,
}
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;
@ -767,7 +768,7 @@ bignum_destructive_add(bignum_type bignum, bignum_digit_type n)
}
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));
@ -805,10 +806,10 @@ bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor)
/* 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)
{
@ -818,13 +819,13 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
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);
@ -852,7 +853,7 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
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);
@ -861,7 +862,7 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
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);
}
@ -874,17 +875,17 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator,
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));
@ -1039,16 +1040,16 @@ bignum_divide_subtract(bignum_digit_type * v_start,
/* 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))
@ -1090,7 +1091,7 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator,
q = bignum_trim (q);
if (remainder != ((bignum_type *) 0))
if (remainder != ((F_BIGNUM * *) 0))
{
if (shift != 0)
r >>= shift;
@ -1100,14 +1101,14 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator,
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;
@ -1132,7 +1133,7 @@ bignum_destructive_normalization(bignum_type source, bignum_type target,
}
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)));
@ -1287,22 +1288,22 @@ bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
/* 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));
@ -1319,7 +1320,7 @@ bignum_divide_unsigned_small_denominator(bignum_type numerator,
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;
@ -1342,9 +1343,9 @@ bignum_destructive_scale_down(bignum_type bignum, bignum_digit_type denominator)
}
/* 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));
@ -1363,34 +1364,34 @@ bignum_remainder_unsigned_small_denominator(
}
/* 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)
@ -1399,11 +1400,11 @@ allot_bignum_zeroed(bignum_length_type length, int negative_p)
}
#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));
@ -1416,8 +1417,8 @@ bignum_shorten_length(bignum_type bignum, bignum_length_type 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)));
@ -1437,11 +1438,11 @@ bignum_trim(bignum_type 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);
@ -1450,14 +1451,14 @@ bignum_new_sign(bignum_type bignum, int negative_p)
}
/* 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);
@ -1465,7 +1466,7 @@ bignum_maybe_new_sign(bignum_type bignum, int negative_p)
}
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 =
@ -1481,15 +1482,15 @@ bignum_destructive_copy(bignum_type source, bignum_type target)
*/
/* 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));
@ -1502,8 +1503,8 @@ bignum_arithmetic_shift(bignum_type arg1, F_FIXNUM 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))
@ -1517,8 +1518,8 @@ bignum_bitwise_and(bignum_type arg1, bignum_type arg2)
}
/* 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))
@ -1532,8 +1533,8 @@ bignum_bitwise_ior(bignum_type arg1, bignum_type arg2)
}
/* 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))
@ -1549,10 +1550,10 @@ bignum_bitwise_xor(bignum_type arg1, bignum_type arg2)
/* 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;
@ -1613,10 +1614,10 @@ bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n)
}
/* 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;
@ -1650,10 +1651,10 @@ bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
}
/* 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;
@ -1705,10 +1706,10 @@ bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
}
/* 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;
@ -1768,7 +1769,7 @@ bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
}
void
bignum_negate_magnitude(bignum_type arg)
bignum_negate_magnitude(F_BIGNUM * arg)
{
bignum_digit_type *scan;
bignum_digit_type *end;
@ -1796,14 +1797,14 @@ bignum_negate_magnitude(bignum_type arg)
}
/* 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;
@ -1819,7 +1820,7 @@ bignum_integer_length(bignum_type bignum)
/* 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))
@ -1827,7 +1828,7 @@ bignum_logbitp(int shift, bignum_type 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;
@ -1840,7 +1841,7 @@ bignum_unsigned_logbitp(int shift, bignum_type bignum)
}
/* Allocates memory */
bignum_type
F_BIGNUM *
digit_stream_to_bignum(unsigned int n_digits,
unsigned int (*producer)(unsigned int),
unsigned int radix,
@ -1868,7 +1869,7 @@ digit_stream_to_bignum(unsigned int n_digits,
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));

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
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
{
@ -42,86 +41,86 @@ 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);

2
vmpp/bignumint.hpp
View File

@ -46,7 +46,7 @@ typedef F_FIXNUM bignum_digit_type;
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

53
vmpp/byte_arrays.cpp
View File

@ -1,22 +1,12 @@
#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();
@ -26,45 +16,14 @@ void primitive_byte_array(void)
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)
@ -72,9 +31,9 @@ void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *array, void *elts, CELL l
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);
}

18
vmpp/byte_arrays.hpp
View File

@ -1,28 +1,16 @@
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)
{
@ -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)
{
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);
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;

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;
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)
{

8
vmpp/data_heap.cpp
View File

@ -216,11 +216,11 @@ CELL unaligned_object_size(CELL pointer)
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:
@ -282,7 +282,7 @@ CELL binary_payload_start(CELL pointer)
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);

2
vmpp/factor.cpp
View File

@ -152,7 +152,7 @@ void init_factor(F_PARAMETERS *p)
/* 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++)

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 */
struct F_ARRAY : public F_OBJECT {
static const CELL type_number = ARRAY_TYPE;
static const CELL element_size = CELLS;
/* tagged */
CELL capacity;
};
@ -104,12 +105,14 @@ struct F_TUPLE_LAYOUT : public F_ARRAY {
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;
};

2
vmpp/master.hpp
View File

@ -30,10 +30,10 @@
#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"

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_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)));
}
@ -133,8 +133,8 @@ void primitive_float_to_bignum(void)
}
#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)
{
@ -168,7 +168,7 @@ void primitive_bignum_divint(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));
@ -202,7 +202,7 @@ void primitive_bignum_xor(void)
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)));
}
@ -238,7 +238,7 @@ void primitive_bignum_not(void)
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));
}
@ -256,8 +256,8 @@ unsigned int bignum_producer(unsigned int digit)
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));
}
@ -362,9 +362,9 @@ CELL unbox_array_size(void)
}
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)
{

6
vmpp/math.hpp
View File

@ -21,9 +21,9 @@ extern CELL bignum_zero;
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);
}
@ -106,7 +106,7 @@ INLINE F_FIXNUM float_to_fixnum(CELL 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));
}

2
vmpp/run.cpp
View File

@ -124,7 +124,7 @@ bool stack_to_array(CELL bottom, CELL top)
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;

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
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);

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();
}