From b8b44911a75392835d75df2b800fa2aa6081120e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 2 May 2009 04:43:58 -0500 Subject: [PATCH] Clean up VM's array code --- vmpp/arrays.cpp | 55 +-------- vmpp/arrays.hpp | 17 +-- vmpp/bignum.cpp | 245 ++++++++++++++++++++-------------------- vmpp/bignum.hpp | 123 ++++++++++---------- vmpp/bignumint.hpp | 2 +- vmpp/byte_arrays.cpp | 53 +-------- vmpp/byte_arrays.hpp | 18 +-- vmpp/callstack.cpp | 2 +- vmpp/code_block.cpp | 2 +- vmpp/data_heap.cpp | 8 +- vmpp/factor.cpp | 2 +- vmpp/generic_arrays.hpp | 82 ++++++++++++++ vmpp/layouts.hpp | 3 + vmpp/master.hpp | 2 +- vmpp/math.cpp | 24 ++-- vmpp/math.hpp | 6 +- vmpp/run.cpp | 2 +- vmpp/strings.cpp | 2 +- vmpp/tagged.hpp | 32 ++++++ 19 files changed, 346 insertions(+), 334 deletions(-) create mode 100644 vmpp/generic_arrays.hpp create mode 100644 vmpp/tagged.hpp diff --git a/vmpp/arrays.cpp b/vmpp/arrays.cpp index 0bddf04f97..3203da2c99 100644 --- a/vmpp/arrays.cpp +++ b/vmpp/arrays.cpp @@ -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(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(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(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(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()); diff --git a/vmpp/arrays.hpp b/vmpp/arrays.hpp index 6fe8a5464c..15caf3c56f 100644 --- a/vmpp/arrays.hpp +++ b/vmpp/arrays.hpp @@ -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; } diff --git a/vmpp/bignum.cpp b/vmpp/bignum.cpp index b431b6be88..e8920a5ac6 100755 --- a/vmpp/bignum.cpp +++ b/vmpp/bignum.cpp @@ -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, - ("ient), ((bignum_type *) 0), + ("ient), ((F_BIGNUM * *) 0), q_negative_p, 0); else bignum_divide_unsigned_medium_denominator (numerator, digit, - ("ient), ((bignum_type *) 0), + ("ient), ((F_BIGNUM * *) 0), q_negative_p, 0); } else bignum_divide_unsigned_large_denominator (numerator, denominator, - ("ient), ((bignum_type *) 0), + ("ient), ((F_BIGNUM * *) 0), q_negative_p, 0); return (quotient); } @@ -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::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(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)); diff --git a/vmpp/bignum.hpp b/vmpp/bignum.hpp index 02309cad34..23a0dd2142 100644 --- a/vmpp/bignum.hpp +++ b/vmpp/bignum.hpp @@ -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); diff --git a/vmpp/bignumint.hpp b/vmpp/bignumint.hpp index 9a8ff806ef..5e0b799090 100644 --- a/vmpp/bignumint.hpp +++ b/vmpp/bignumint.hpp @@ -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 diff --git a/vmpp/byte_arrays.cpp b/vmpp/byte_arrays.cpp index 3a4b155587..da44fc135b 100644 --- a/vmpp/byte_arrays.cpp +++ b/vmpp/byte_arrays.cpp @@ -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(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(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); } diff --git a/vmpp/byte_arrays.hpp b/vmpp/byte_arrays.hpp index a297eff85d..fe0e5f7acd 100644 --- a/vmpp/byte_arrays.hpp +++ b/vmpp/byte_arrays.hpp @@ -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)); } diff --git a/vmpp/callstack.cpp b/vmpp/callstack.cpp index 325e91ebf6..00f31b9b56 100755 --- a/vmpp/callstack.cpp +++ b/vmpp/callstack.cpp @@ -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(frame_count); UNREGISTER_UNTAGGED(F_CALLSTACK,stack); frame_index = 0; diff --git a/vmpp/code_block.cpp b/vmpp/code_block.cpp index 606eac1d66..7ef365f66b 100644 --- a/vmpp/code_block.cpp +++ b/vmpp/code_block.cpp @@ -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) { diff --git a/vmpp/data_heap.cpp b/vmpp/data_heap.cpp index 21f4124707..c02c1c2a2f 100644 --- a/vmpp/data_heap.cpp +++ b/vmpp/data_heap.cpp @@ -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(array_capacity((F_ARRAY*)pointer)); case TUPLE_TYPE: tuple = untag_tuple_fast(pointer); layout = untag_tuple_layout(tuple->layout); diff --git a/vmpp/factor.cpp b/vmpp/factor.cpp index f2f928190a..2321a7cc1f 100755 --- a/vmpp/factor.cpp +++ b/vmpp/factor.cpp @@ -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++) diff --git a/vmpp/generic_arrays.hpp b/vmpp/generic_arrays.hpp new file mode 100644 index 0000000000..1c505acea1 --- /dev/null +++ b/vmpp/generic_arrays.hpp @@ -0,0 +1,82 @@ +template 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 CELL array_nth(T *array, CELL slot) +{ +#ifdef FACTOR_DEBUG + assert(slot < array_capacity(array)); + assert(untag_header(array->header) == T::type_number); +#endif + return get(AREF(array,slot)); +} + +template void set_array_nth(T *array, CELL slot, CELL value) +{ +#ifdef FACTOR_DEBUG + assert(slot < array_capacity(array)); + assert(untag_header(array->header) == T::type_number); +#endif + put(AREF(array,slot),value); + write_barrier((CELL)array); +} + +template CELL array_size(CELL capacity) +{ + return sizeof(T) + capacity * T::element_size; +} + +template CELL array_size(T *array) +{ + return array_size(array_capacity(array)); +} + +template T *allot_array_internal(CELL capacity) +{ + T *array = (T *)allot_object(T::type_number,array_size(capacity)); + array->capacity = tag_fixnum(capacity); + return array; +} + +template bool reallot_array_in_place_p(T *array, CELL capacity) +{ + return in_zone(&nursery,(CELL)array) && capacity <= array_capacity(array); +} + +template 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(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; + } +} diff --git a/vmpp/layouts.hpp b/vmpp/layouts.hpp index f00cb12622..75f91c41e5 100755 --- a/vmpp/layouts.hpp +++ b/vmpp/layouts.hpp @@ -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; }; diff --git a/vmpp/master.hpp b/vmpp/master.hpp index 22f3be27b7..3ba7b70813 100644 --- a/vmpp/master.hpp +++ b/vmpp/master.hpp @@ -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" diff --git a/vmpp/math.cpp b/vmpp/math.cpp index 7bc27b35c1..eb78bf0f7c 100644 --- a/vmpp/math.cpp +++ b/vmpp/math.cpp @@ -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) { diff --git a/vmpp/math.hpp b/vmpp/math.hpp index dc8218c0c1..2f80cc7732 100644 --- a/vmpp/math.hpp +++ b/vmpp/math.hpp @@ -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)); } diff --git a/vmpp/run.cpp b/vmpp/run.cpp index bb14ea94f3..588caacc74 100755 --- a/vmpp/run.cpp +++ b/vmpp/run.cpp @@ -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(depth / CELLS); memcpy(a + 1,(void*)bottom,depth); dpush(tag_array(a)); return true; diff --git a/vmpp/strings.cpp b/vmpp/strings.cpp index 7864484c54..fcb7dbcf97 100644 --- a/vmpp/strings.cpp +++ b/vmpp/strings.cpp @@ -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( untag_fixnum_fast(string->length) * sizeof(u16)); UNREGISTER_UNTAGGED(F_STRING,string); diff --git a/vmpp/tagged.hpp b/vmpp/tagged.hpp new file mode 100644 index 0000000000..c6ccc66cd9 --- /dev/null +++ b/vmpp/tagged.hpp @@ -0,0 +1,32 @@ +template CELL tag(T *value) +{ + if(T::type_number < HEADER_TYPE) + return RETAG(value,T::type_number); + else + return RETAG(value,OBJECT_TYPE); +} + +template +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 T *untag(CELL value) +{ + return tagged(value).untag(); +} + +template T *untag_fast(CELL value) +{ + return tagged(value).untag_fast(); +}