Various VM cleanups, new approach for bignum GC root registration
Slava Pestov
parent
e3592ca8f6
commit
ec28b1ef85
5
Makefile
5
Makefile
|
|
@ -179,6 +179,9 @@ clean:
|
|||
rm -f vm/*.o
|
||||
rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib} Factor.app/Contents/Frameworks/libfactor.dylib
|
||||
|
||||
tags:
|
||||
etags vm/*.{cpp,hpp,mm,S,c}
|
||||
|
||||
vm/resources.o:
|
||||
$(WINDRES) vm/factor.rs vm/resources.o
|
||||
|
||||
|
|
@ -197,6 +200,6 @@ vm/ffi_test.o: vm/ffi_test.c
|
|||
.mm.o:
|
||||
$(CPP) -c $(CFLAGS) -o $@ $<
|
||||
|
||||
.PHONY: factor
|
||||
.PHONY: factor tags clean
|
||||
|
||||
.SUFFIXES: .mm
|
||||
|
|
|
|||
112
vm/bignum.cpp
112
vm/bignum.cpp
|
|
@ -505,6 +505,8 @@ bignum_compare_unsigned(F_BIGNUM * x, F_BIGNUM * y)
|
|||
F_BIGNUM *
|
||||
bignum_add_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
|
||||
{
|
||||
GC_BIGNUM(x); GC_BIGNUM(y);
|
||||
|
||||
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
|
||||
{
|
||||
F_BIGNUM * z = x;
|
||||
|
|
@ -514,11 +516,7 @@ bignum_add_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
|
|||
{
|
||||
bignum_length_type x_length = (BIGNUM_LENGTH (x));
|
||||
|
||||
REGISTER_BIGNUM(x);
|
||||
REGISTER_BIGNUM(y);
|
||||
F_BIGNUM * r = (allot_bignum ((x_length + 1), negative_p));
|
||||
UNREGISTER_BIGNUM(y);
|
||||
UNREGISTER_BIGNUM(x);
|
||||
|
||||
bignum_digit_type sum;
|
||||
bignum_digit_type carry = 0;
|
||||
|
|
@ -575,6 +573,8 @@ bignum_add_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
|
|||
F_BIGNUM *
|
||||
bignum_subtract_unsigned(F_BIGNUM * x, F_BIGNUM * y)
|
||||
{
|
||||
GC_BIGNUM(x); GC_BIGNUM(y);
|
||||
|
||||
int negative_p = 0;
|
||||
switch (bignum_compare_unsigned (x, y))
|
||||
{
|
||||
|
|
@ -595,11 +595,7 @@ bignum_subtract_unsigned(F_BIGNUM * x, F_BIGNUM * y)
|
|||
{
|
||||
bignum_length_type x_length = (BIGNUM_LENGTH (x));
|
||||
|
||||
REGISTER_BIGNUM(x);
|
||||
REGISTER_BIGNUM(y);
|
||||
F_BIGNUM * r = (allot_bignum (x_length, negative_p));
|
||||
UNREGISTER_BIGNUM(y);
|
||||
UNREGISTER_BIGNUM(x);
|
||||
|
||||
bignum_digit_type difference;
|
||||
bignum_digit_type borrow = 0;
|
||||
|
|
@ -656,6 +652,8 @@ bignum_subtract_unsigned(F_BIGNUM * x, F_BIGNUM * y)
|
|||
F_BIGNUM *
|
||||
bignum_multiply_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
|
||||
{
|
||||
GC_BIGNUM(x); GC_BIGNUM(y);
|
||||
|
||||
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
|
||||
{
|
||||
F_BIGNUM * z = x;
|
||||
|
|
@ -674,12 +672,8 @@ bignum_multiply_unsigned(F_BIGNUM * x, F_BIGNUM * y, int negative_p)
|
|||
bignum_length_type x_length = (BIGNUM_LENGTH (x));
|
||||
bignum_length_type y_length = (BIGNUM_LENGTH (y));
|
||||
|
||||
REGISTER_BIGNUM(x);
|
||||
REGISTER_BIGNUM(y);
|
||||
F_BIGNUM * r =
|
||||
(allot_bignum_zeroed ((x_length + y_length), negative_p));
|
||||
UNREGISTER_BIGNUM(y);
|
||||
UNREGISTER_BIGNUM(x);
|
||||
|
||||
bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
|
||||
bignum_digit_type * end_x = (scan_x + x_length);
|
||||
|
|
@ -731,11 +725,11 @@ F_BIGNUM *
|
|||
bignum_multiply_unsigned_small_factor(F_BIGNUM * x, bignum_digit_type y,
|
||||
int negative_p)
|
||||
{
|
||||
GC_BIGNUM(x);
|
||||
|
||||
bignum_length_type length_x = (BIGNUM_LENGTH (x));
|
||||
|
||||
REGISTER_BIGNUM(x);
|
||||
F_BIGNUM * p = (allot_bignum ((length_x + 1), negative_p));
|
||||
UNREGISTER_BIGNUM(x);
|
||||
|
||||
bignum_destructive_copy (x, p);
|
||||
(BIGNUM_REF (p, length_x)) = 0;
|
||||
|
|
@ -813,24 +807,20 @@ bignum_divide_unsigned_large_denominator(F_BIGNUM * numerator,
|
|||
int q_negative_p,
|
||||
int r_negative_p)
|
||||
{
|
||||
GC_BIGNUM(numerator); GC_BIGNUM(denominator);
|
||||
|
||||
bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
|
||||
bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
|
||||
|
||||
REGISTER_BIGNUM(numerator);
|
||||
REGISTER_BIGNUM(denominator);
|
||||
|
||||
F_BIGNUM * q =
|
||||
((quotient != ((F_BIGNUM * *) 0))
|
||||
? (allot_bignum ((length_n - length_d), q_negative_p))
|
||||
: BIGNUM_OUT_OF_BAND);
|
||||
|
||||
REGISTER_BIGNUM(q);
|
||||
GC_BIGNUM(q);
|
||||
|
||||
F_BIGNUM * u = (allot_bignum (length_n, r_negative_p));
|
||||
UNREGISTER_BIGNUM(q);
|
||||
|
||||
UNREGISTER_BIGNUM(denominator);
|
||||
UNREGISTER_BIGNUM(numerator);
|
||||
|
||||
GC_BIGNUM(u);
|
||||
|
||||
int shift = 0;
|
||||
BIGNUM_ASSERT (length_d > 1);
|
||||
{
|
||||
|
|
@ -849,15 +839,7 @@ bignum_divide_unsigned_large_denominator(F_BIGNUM * numerator,
|
|||
}
|
||||
else
|
||||
{
|
||||
REGISTER_BIGNUM(numerator);
|
||||
REGISTER_BIGNUM(denominator);
|
||||
REGISTER_BIGNUM(u);
|
||||
REGISTER_BIGNUM(q);
|
||||
F_BIGNUM * v = (allot_bignum (length_d, 0));
|
||||
UNREGISTER_BIGNUM(q);
|
||||
UNREGISTER_BIGNUM(u);
|
||||
UNREGISTER_BIGNUM(denominator);
|
||||
UNREGISTER_BIGNUM(numerator);
|
||||
|
||||
bignum_destructive_normalization (numerator, u, shift);
|
||||
bignum_destructive_normalization (denominator, v, shift);
|
||||
|
|
@ -866,14 +848,10 @@ bignum_divide_unsigned_large_denominator(F_BIGNUM * numerator,
|
|||
bignum_destructive_unnormalization (u, shift);
|
||||
}
|
||||
|
||||
REGISTER_BIGNUM(u);
|
||||
if(q)
|
||||
q = bignum_trim (q);
|
||||
UNREGISTER_BIGNUM(u);
|
||||
|
||||
REGISTER_BIGNUM(q);
|
||||
u = bignum_trim (u);
|
||||
UNREGISTER_BIGNUM(q);
|
||||
|
||||
if (quotient != ((F_BIGNUM * *) 0))
|
||||
(*quotient) = q;
|
||||
|
|
@ -1047,9 +1025,13 @@ bignum_divide_unsigned_medium_denominator(F_BIGNUM * numerator,
|
|||
int q_negative_p,
|
||||
int r_negative_p)
|
||||
{
|
||||
GC_BIGNUM(numerator);
|
||||
|
||||
bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
|
||||
bignum_length_type length_q;
|
||||
F_BIGNUM * q;
|
||||
F_BIGNUM * q = NULL;
|
||||
GC_BIGNUM(q);
|
||||
|
||||
int shift = 0;
|
||||
/* Because `bignum_digit_divide' requires a normalized denominator. */
|
||||
while (denominator < (BIGNUM_RADIX / 2))
|
||||
|
|
@ -1061,20 +1043,14 @@ bignum_divide_unsigned_medium_denominator(F_BIGNUM * numerator,
|
|||
{
|
||||
length_q = length_n;
|
||||
|
||||
REGISTER_BIGNUM(numerator);
|
||||
q = (allot_bignum (length_q, q_negative_p));
|
||||
UNREGISTER_BIGNUM(numerator);
|
||||
|
||||
bignum_destructive_copy (numerator, q);
|
||||
}
|
||||
else
|
||||
{
|
||||
length_q = (length_n + 1);
|
||||
|
||||
REGISTER_BIGNUM(numerator);
|
||||
q = (allot_bignum (length_q, q_negative_p));
|
||||
UNREGISTER_BIGNUM(numerator);
|
||||
|
||||
bignum_destructive_normalization (numerator, q, shift);
|
||||
}
|
||||
{
|
||||
|
|
@ -1096,9 +1072,7 @@ bignum_divide_unsigned_medium_denominator(F_BIGNUM * numerator,
|
|||
if (shift != 0)
|
||||
r >>= shift;
|
||||
|
||||
REGISTER_BIGNUM(q);
|
||||
(*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
|
||||
UNREGISTER_BIGNUM(q);
|
||||
}
|
||||
|
||||
if (quotient != ((F_BIGNUM * *) 0))
|
||||
|
|
@ -1295,20 +1269,17 @@ bignum_divide_unsigned_small_denominator(F_BIGNUM * numerator,
|
|||
int q_negative_p,
|
||||
int r_negative_p)
|
||||
{
|
||||
REGISTER_BIGNUM(numerator);
|
||||
GC_BIGNUM(numerator);
|
||||
|
||||
F_BIGNUM * q = (bignum_new_sign (numerator, q_negative_p));
|
||||
UNREGISTER_BIGNUM(numerator);
|
||||
GC_BIGNUM(q);
|
||||
|
||||
bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
|
||||
|
||||
q = (bignum_trim (q));
|
||||
|
||||
if (remainder != ((F_BIGNUM * *) 0))
|
||||
{
|
||||
REGISTER_BIGNUM(q);
|
||||
(*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
|
||||
UNREGISTER_BIGNUM(q);
|
||||
}
|
||||
|
||||
(*quotient) = q;
|
||||
|
||||
|
|
@ -1381,6 +1352,7 @@ bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
|
|||
F_BIGNUM *
|
||||
allot_bignum(bignum_length_type length, int negative_p)
|
||||
{
|
||||
gc();
|
||||
BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
|
||||
F_BIGNUM * result = allot_array_internal<F_BIGNUM>(length + 1);
|
||||
BIGNUM_SET_NEGATIVE_P (result, negative_p);
|
||||
|
|
@ -1441,10 +1413,8 @@ bignum_trim(F_BIGNUM * bignum)
|
|||
F_BIGNUM *
|
||||
bignum_new_sign(F_BIGNUM * bignum, int negative_p)
|
||||
{
|
||||
REGISTER_BIGNUM(bignum);
|
||||
F_BIGNUM * result =
|
||||
(allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p));
|
||||
UNREGISTER_BIGNUM(bignum);
|
||||
GC_BIGNUM(bignum);
|
||||
F_BIGNUM * result = (allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p));
|
||||
|
||||
bignum_destructive_copy (bignum, result);
|
||||
return (result);
|
||||
|
|
@ -1553,6 +1523,8 @@ bignum_bitwise_xor(F_BIGNUM * arg1, F_BIGNUM * arg2)
|
|||
F_BIGNUM *
|
||||
bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n)
|
||||
{
|
||||
GC_BIGNUM(arg1);
|
||||
|
||||
F_BIGNUM * result = NULL;
|
||||
bignum_digit_type *scan1;
|
||||
bignum_digit_type *scanr;
|
||||
|
|
@ -1566,10 +1538,8 @@ bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n)
|
|||
digit_offset = n / BIGNUM_DIGIT_LENGTH;
|
||||
bit_offset = n % BIGNUM_DIGIT_LENGTH;
|
||||
|
||||
REGISTER_BIGNUM(arg1);
|
||||
result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
|
||||
BIGNUM_NEGATIVE_P(arg1));
|
||||
UNREGISTER_BIGNUM(arg1);
|
||||
BIGNUM_NEGATIVE_P(arg1));
|
||||
|
||||
scanr = BIGNUM_START_PTR (result) + digit_offset;
|
||||
scan1 = BIGNUM_START_PTR (arg1);
|
||||
|
|
@ -1591,10 +1561,8 @@ bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n)
|
|||
digit_offset = -n / BIGNUM_DIGIT_LENGTH;
|
||||
bit_offset = -n % BIGNUM_DIGIT_LENGTH;
|
||||
|
||||
REGISTER_BIGNUM(arg1);
|
||||
result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
|
||||
BIGNUM_NEGATIVE_P(arg1));
|
||||
UNREGISTER_BIGNUM(arg1);
|
||||
BIGNUM_NEGATIVE_P(arg1));
|
||||
|
||||
scanr = BIGNUM_START_PTR (result);
|
||||
scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
|
||||
|
|
@ -1617,6 +1585,8 @@ bignum_magnitude_ash(F_BIGNUM * arg1, F_FIXNUM n)
|
|||
F_BIGNUM *
|
||||
bignum_pospos_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
||||
{
|
||||
GC_BIGNUM(arg1); GC_BIGNUM(arg2);
|
||||
|
||||
F_BIGNUM * result;
|
||||
bignum_length_type max_length;
|
||||
|
||||
|
|
@ -1627,11 +1597,7 @@ bignum_pospos_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
|||
max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
|
||||
? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
|
||||
|
||||
REGISTER_BIGNUM(arg1);
|
||||
REGISTER_BIGNUM(arg2);
|
||||
result = allot_bignum(max_length, 0);
|
||||
UNREGISTER_BIGNUM(arg2);
|
||||
UNREGISTER_BIGNUM(arg1);
|
||||
|
||||
scanr = BIGNUM_START_PTR(result);
|
||||
scan1 = BIGNUM_START_PTR(arg1);
|
||||
|
|
@ -1654,6 +1620,8 @@ bignum_pospos_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
|||
F_BIGNUM *
|
||||
bignum_posneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
||||
{
|
||||
GC_BIGNUM(arg1); GC_BIGNUM(arg2);
|
||||
|
||||
F_BIGNUM * result;
|
||||
bignum_length_type max_length;
|
||||
|
||||
|
|
@ -1666,11 +1634,7 @@ bignum_posneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
|||
max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
|
||||
? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
|
||||
|
||||
REGISTER_BIGNUM(arg1);
|
||||
REGISTER_BIGNUM(arg2);
|
||||
result = allot_bignum(max_length, neg_p);
|
||||
UNREGISTER_BIGNUM(arg2);
|
||||
UNREGISTER_BIGNUM(arg1);
|
||||
|
||||
scanr = BIGNUM_START_PTR(result);
|
||||
scan1 = BIGNUM_START_PTR(arg1);
|
||||
|
|
@ -1709,6 +1673,8 @@ bignum_posneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
|||
F_BIGNUM *
|
||||
bignum_negneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
||||
{
|
||||
GC_BIGNUM(arg1); GC_BIGNUM(arg2);
|
||||
|
||||
F_BIGNUM * result;
|
||||
bignum_length_type max_length;
|
||||
|
||||
|
|
@ -1721,11 +1687,7 @@ bignum_negneg_bitwise_op(int op, F_BIGNUM * arg1, F_BIGNUM * arg2)
|
|||
max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
|
||||
? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
|
||||
|
||||
REGISTER_BIGNUM(arg1);
|
||||
REGISTER_BIGNUM(arg2);
|
||||
result = allot_bignum(max_length, neg_p);
|
||||
UNREGISTER_BIGNUM(arg2);
|
||||
UNREGISTER_BIGNUM(arg1);
|
||||
|
||||
scanr = BIGNUM_START_PTR(result);
|
||||
scan1 = BIGNUM_START_PTR(arg1);
|
||||
|
|
@ -1800,12 +1762,12 @@ bignum_negate_magnitude(F_BIGNUM * arg)
|
|||
F_BIGNUM *
|
||||
bignum_integer_length(F_BIGNUM * bignum)
|
||||
{
|
||||
GC_BIGNUM(bignum);
|
||||
|
||||
bignum_length_type index = ((BIGNUM_LENGTH (bignum)) - 1);
|
||||
bignum_digit_type digit = (BIGNUM_REF (bignum, index));
|
||||
|
||||
REGISTER_BIGNUM(bignum);
|
||||
F_BIGNUM * result = (allot_bignum (2, 0));
|
||||
UNREGISTER_BIGNUM(bignum);
|
||||
|
||||
(BIGNUM_REF (result, 0)) = index;
|
||||
(BIGNUM_REF (result, 1)) = 0;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
static void check_frame(F_STACK_FRAME *frame)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
check_code_pointer(frame->xt);
|
||||
check_code_pointer((CELL)frame->xt);
|
||||
assert(frame->size != 0);
|
||||
#endif
|
||||
}
|
||||
|
|
@ -20,9 +20,8 @@ void iterate_callstack(CELL top, CELL bottom, CALLSTACK_ITER iterator)
|
|||
|
||||
while((CELL)frame >= top)
|
||||
{
|
||||
F_STACK_FRAME *next = frame_successor(frame);
|
||||
iterator(frame);
|
||||
frame = next;
|
||||
frame = frame_successor(frame);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
275
vm/data_gc.cpp
275
vm/data_gc.cpp
|
|
@ -37,8 +37,109 @@ void init_data_gc(void)
|
|||
collecting_aging_again = false;
|
||||
}
|
||||
|
||||
/* Given a pointer to oldspace, copy it to newspace */
|
||||
static void *copy_untagged_object(void *pointer, CELL size)
|
||||
{
|
||||
if(newspace->here + size >= newspace->end)
|
||||
longjmp(gc_jmp,1);
|
||||
allot_barrier(newspace->here);
|
||||
void *newpointer = allot_zone(newspace,size);
|
||||
|
||||
F_GC_STATS *s = &gc_stats[collecting_gen];
|
||||
s->object_count++;
|
||||
s->bytes_copied += size;
|
||||
|
||||
memcpy(newpointer,pointer,size);
|
||||
return newpointer;
|
||||
}
|
||||
|
||||
static void forward_object(CELL untagged, CELL newpointer)
|
||||
{
|
||||
put(untagged,RETAG(newpointer,GC_COLLECTED));
|
||||
}
|
||||
|
||||
static CELL copy_object_impl(CELL untagged)
|
||||
{
|
||||
CELL newpointer = (CELL)copy_untagged_object(
|
||||
(void*)untagged,
|
||||
untagged_object_size(untagged));
|
||||
forward_object(untagged,newpointer);
|
||||
return newpointer;
|
||||
}
|
||||
|
||||
static bool should_copy_p(CELL untagged)
|
||||
{
|
||||
if(in_zone(newspace,untagged))
|
||||
return false;
|
||||
if(collecting_gen == TENURED)
|
||||
return true;
|
||||
else if(HAVE_AGING_P && collecting_gen == AGING)
|
||||
return !in_zone(&data_heap->generations[TENURED],untagged);
|
||||
else if(collecting_gen == NURSERY)
|
||||
return in_zone(&nursery,untagged);
|
||||
else
|
||||
{
|
||||
critical_error("Bug in should_copy_p",untagged);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
/* Follow a chain of forwarding pointers */
|
||||
static CELL resolve_forwarding(CELL untagged, CELL tag)
|
||||
{
|
||||
check_data_pointer(untagged);
|
||||
|
||||
CELL header = get(untagged);
|
||||
/* another forwarding pointer */
|
||||
if(TAG(header) == GC_COLLECTED)
|
||||
return resolve_forwarding(UNTAG(header),tag);
|
||||
/* we've found the destination */
|
||||
else
|
||||
{
|
||||
check_header(header);
|
||||
CELL pointer = RETAG(untagged,tag);
|
||||
if(should_copy_p(untagged))
|
||||
pointer = RETAG(copy_object_impl(untagged),tag);
|
||||
return pointer;
|
||||
}
|
||||
}
|
||||
|
||||
/* Given a pointer to a tagged pointer to oldspace, copy it to newspace.
|
||||
If the object has already been copied, return the forwarding
|
||||
pointer address without copying anything; otherwise, install
|
||||
a new forwarding pointer. While this preserves the tag, it does
|
||||
not dispatch on it in any way. */
|
||||
static CELL copy_object(CELL pointer)
|
||||
{
|
||||
check_data_pointer(pointer);
|
||||
|
||||
CELL tag = TAG(pointer);
|
||||
CELL untagged = UNTAG(pointer);
|
||||
CELL header = get(untagged);
|
||||
|
||||
if(TAG(header) == GC_COLLECTED)
|
||||
return resolve_forwarding(UNTAG(header),tag);
|
||||
else
|
||||
{
|
||||
check_header(header);
|
||||
return RETAG(copy_object_impl(untagged),tag);
|
||||
}
|
||||
}
|
||||
|
||||
void copy_handle(CELL *handle)
|
||||
{
|
||||
CELL pointer = *handle;
|
||||
|
||||
if(!immediate_p(pointer))
|
||||
{
|
||||
check_data_pointer(pointer);
|
||||
if(should_copy_p(pointer))
|
||||
*handle = copy_object(pointer);
|
||||
}
|
||||
}
|
||||
|
||||
/* Scan all the objects in the card */
|
||||
void copy_card(F_CARD *ptr, CELL gen, CELL here)
|
||||
static void copy_card(F_CARD *ptr, CELL gen, CELL here)
|
||||
{
|
||||
CELL card_scan = (CELL)CARD_TO_ADDR(ptr) + CARD_OFFSET(ptr);
|
||||
CELL card_end = (CELL)CARD_TO_ADDR(ptr + 1);
|
||||
|
|
@ -51,7 +152,7 @@ void copy_card(F_CARD *ptr, CELL gen, CELL here)
|
|||
cards_scanned++;
|
||||
}
|
||||
|
||||
void copy_card_deck(F_DECK *deck, CELL gen, F_CARD mask, F_CARD unmask)
|
||||
static void copy_card_deck(F_DECK *deck, CELL gen, F_CARD mask, F_CARD unmask)
|
||||
{
|
||||
F_CARD *first_card = DECK_TO_CARD(deck);
|
||||
F_CARD *last_card = DECK_TO_CARD(deck + 1);
|
||||
|
|
@ -83,7 +184,7 @@ void copy_card_deck(F_DECK *deck, CELL gen, F_CARD mask, F_CARD unmask)
|
|||
}
|
||||
|
||||
/* Copy all newspace objects referenced from marked cards to the destination */
|
||||
void copy_gen_cards(CELL gen)
|
||||
static void copy_gen_cards(CELL gen)
|
||||
{
|
||||
F_DECK *first_deck = ADDR_TO_DECK(data_heap->generations[gen].start);
|
||||
F_DECK *last_deck = ADDR_TO_DECK(data_heap->generations[gen].end);
|
||||
|
|
@ -150,7 +251,7 @@ void copy_gen_cards(CELL gen)
|
|||
|
||||
/* Scan cards in all generations older than the one being collected, copying
|
||||
old->new references */
|
||||
void copy_cards(void)
|
||||
static void copy_cards(void)
|
||||
{
|
||||
u64 start = current_micros();
|
||||
|
||||
|
|
@ -162,7 +263,7 @@ void copy_cards(void)
|
|||
}
|
||||
|
||||
/* Copy all tagged pointers in a range of memory */
|
||||
void copy_stack_elements(F_SEGMENT *region, CELL top)
|
||||
static void copy_stack_elements(F_SEGMENT *region, CELL top)
|
||||
{
|
||||
CELL ptr = region->start;
|
||||
|
||||
|
|
@ -170,17 +271,38 @@ void copy_stack_elements(F_SEGMENT *region, CELL top)
|
|||
copy_handle((CELL*)ptr);
|
||||
}
|
||||
|
||||
void copy_registered_locals(void)
|
||||
static void copy_registered_locals(void)
|
||||
{
|
||||
CELL ptr = gc_locals_region->start;
|
||||
CELL scan = gc_locals_region->start;
|
||||
|
||||
for(; ptr <= gc_locals; ptr += CELLS)
|
||||
copy_handle(*(CELL **)ptr);
|
||||
for(; scan <= gc_locals; scan += CELLS)
|
||||
copy_handle(*(CELL **)scan);
|
||||
}
|
||||
|
||||
static void copy_registered_bignums(void)
|
||||
{
|
||||
CELL scan = gc_bignums_region->start;
|
||||
|
||||
for(; scan <= gc_bignums; scan += CELLS)
|
||||
{
|
||||
CELL *handle = *(CELL **)scan;
|
||||
CELL pointer = *handle;
|
||||
|
||||
if(pointer)
|
||||
{
|
||||
check_data_pointer(pointer);
|
||||
if(should_copy_p(pointer))
|
||||
*handle = copy_object(pointer);
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(hi_tag(*handle) == BIGNUM_TYPE);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Copy roots over at the start of GC, namely various constants, stacks,
|
||||
the user environment and extra roots registered by local_roots.hpp */
|
||||
void copy_roots(void)
|
||||
static void copy_roots(void)
|
||||
{
|
||||
copy_handle(&T);
|
||||
copy_handle(&bignum_zero);
|
||||
|
|
@ -188,7 +310,7 @@ void copy_roots(void)
|
|||
copy_handle(&bignum_neg_one);
|
||||
|
||||
copy_registered_locals();
|
||||
copy_stack_elements(extra_roots_region,extra_roots);
|
||||
copy_registered_bignums();
|
||||
|
||||
if(!performing_compaction)
|
||||
{
|
||||
|
|
@ -214,107 +336,7 @@ void copy_roots(void)
|
|||
copy_handle(&userenv[i]);
|
||||
}
|
||||
|
||||
/* Given a pointer to oldspace, copy it to newspace */
|
||||
INLINE void *copy_untagged_object(void *pointer, CELL size)
|
||||
{
|
||||
if(newspace->here + size >= newspace->end)
|
||||
longjmp(gc_jmp,1);
|
||||
allot_barrier(newspace->here);
|
||||
void *newpointer = allot_zone(newspace,size);
|
||||
|
||||
F_GC_STATS *s = &gc_stats[collecting_gen];
|
||||
s->object_count++;
|
||||
s->bytes_copied += size;
|
||||
|
||||
memcpy(newpointer,pointer,size);
|
||||
return newpointer;
|
||||
}
|
||||
|
||||
INLINE void forward_object(CELL pointer, CELL newpointer)
|
||||
{
|
||||
if(pointer != newpointer)
|
||||
put(UNTAG(pointer),RETAG(newpointer,GC_COLLECTED));
|
||||
}
|
||||
|
||||
INLINE CELL copy_object_impl(CELL pointer)
|
||||
{
|
||||
CELL newpointer = (CELL)copy_untagged_object(
|
||||
(void*)UNTAG(pointer),
|
||||
object_size(pointer));
|
||||
forward_object(pointer,newpointer);
|
||||
return newpointer;
|
||||
}
|
||||
|
||||
bool should_copy_p(CELL untagged)
|
||||
{
|
||||
if(in_zone(newspace,untagged))
|
||||
return false;
|
||||
if(collecting_gen == TENURED)
|
||||
return true;
|
||||
else if(HAVE_AGING_P && collecting_gen == AGING)
|
||||
return !in_zone(&data_heap->generations[TENURED],untagged);
|
||||
else if(collecting_gen == NURSERY)
|
||||
return in_zone(&nursery,untagged);
|
||||
else
|
||||
{
|
||||
critical_error("Bug in should_copy_p",untagged);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
/* Follow a chain of forwarding pointers */
|
||||
CELL resolve_forwarding(CELL untagged, CELL tag)
|
||||
{
|
||||
check_data_pointer(untagged);
|
||||
|
||||
CELL header = get(untagged);
|
||||
/* another forwarding pointer */
|
||||
if(TAG(header) == GC_COLLECTED)
|
||||
return resolve_forwarding(UNTAG(header),tag);
|
||||
/* we've found the destination */
|
||||
else
|
||||
{
|
||||
check_header(header);
|
||||
CELL pointer = RETAG(untagged,tag);
|
||||
if(should_copy_p(untagged))
|
||||
pointer = RETAG(copy_object_impl(pointer),tag);
|
||||
return pointer;
|
||||
}
|
||||
}
|
||||
|
||||
/* Given a pointer to a tagged pointer to oldspace, copy it to newspace.
|
||||
If the object has already been copied, return the forwarding
|
||||
pointer address without copying anything; otherwise, install
|
||||
a new forwarding pointer. */
|
||||
INLINE CELL copy_object(CELL pointer)
|
||||
{
|
||||
check_data_pointer(pointer);
|
||||
|
||||
CELL tag = TAG(pointer);
|
||||
CELL header = get(UNTAG(pointer));
|
||||
|
||||
if(TAG(header) == GC_COLLECTED)
|
||||
return resolve_forwarding(UNTAG(header),tag);
|
||||
else
|
||||
{
|
||||
check_header(header);
|
||||
return RETAG(copy_object_impl(pointer),tag);
|
||||
}
|
||||
}
|
||||
|
||||
void copy_handle(CELL *handle)
|
||||
{
|
||||
CELL pointer = *handle;
|
||||
|
||||
if(!immediate_p(pointer))
|
||||
{
|
||||
check_data_pointer(pointer);
|
||||
if(should_copy_p(pointer))
|
||||
*handle = copy_object(pointer);
|
||||
}
|
||||
}
|
||||
|
||||
CELL copy_next_from_nursery(CELL scan)
|
||||
static CELL copy_next_from_nursery(CELL scan)
|
||||
{
|
||||
CELL *obj = (CELL *)scan;
|
||||
CELL *end = (CELL *)(scan + binary_payload_start(scan));
|
||||
|
|
@ -342,7 +364,7 @@ CELL copy_next_from_nursery(CELL scan)
|
|||
return scan + untagged_object_size(scan);
|
||||
}
|
||||
|
||||
CELL copy_next_from_aging(CELL scan)
|
||||
static CELL copy_next_from_aging(CELL scan)
|
||||
{
|
||||
CELL *obj = (CELL *)scan;
|
||||
CELL *end = (CELL *)(scan + binary_payload_start(scan));
|
||||
|
|
@ -374,7 +396,7 @@ CELL copy_next_from_aging(CELL scan)
|
|||
return scan + untagged_object_size(scan);
|
||||
}
|
||||
|
||||
CELL copy_next_from_tenured(CELL scan)
|
||||
static CELL copy_next_from_tenured(CELL scan)
|
||||
{
|
||||
CELL *obj = (CELL *)scan;
|
||||
CELL *end = (CELL *)(scan + binary_payload_start(scan));
|
||||
|
|
@ -424,7 +446,7 @@ void copy_reachable_objects(CELL scan, CELL *end)
|
|||
}
|
||||
|
||||
/* Prepare to start copying reachable objects into an unused zone */
|
||||
void begin_gc(CELL requested_bytes)
|
||||
static void begin_gc(CELL requested_bytes)
|
||||
{
|
||||
if(growing_data_heap)
|
||||
{
|
||||
|
|
@ -457,7 +479,7 @@ void begin_gc(CELL requested_bytes)
|
|||
}
|
||||
}
|
||||
|
||||
void end_gc(CELL gc_elapsed)
|
||||
static void end_gc(CELL gc_elapsed)
|
||||
{
|
||||
F_GC_STATS *s = &gc_stats[collecting_gen];
|
||||
|
||||
|
|
@ -604,19 +626,19 @@ void primitive_gc_stats(void)
|
|||
{
|
||||
F_GC_STATS *s = &gc_stats[i];
|
||||
stats.add(allot_cell(s->collections));
|
||||
stats.add(tag_bignum(long_long_to_bignum(s->gc_time)));
|
||||
stats.add(tag_bignum(long_long_to_bignum(s->max_gc_time)));
|
||||
stats.add(tag<F_BIGNUM>(long_long_to_bignum(s->gc_time)));
|
||||
stats.add(tag<F_BIGNUM>(long_long_to_bignum(s->max_gc_time)));
|
||||
stats.add(allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
|
||||
stats.add(allot_cell(s->object_count));
|
||||
stats.add(tag_bignum(long_long_to_bignum(s->bytes_copied)));
|
||||
stats.add(tag<F_BIGNUM>(long_long_to_bignum(s->bytes_copied)));
|
||||
|
||||
total_gc_time += s->gc_time;
|
||||
}
|
||||
|
||||
stats.add(tag_bignum(ulong_long_to_bignum(total_gc_time)));
|
||||
stats.add(tag_bignum(ulong_long_to_bignum(cards_scanned)));
|
||||
stats.add(tag_bignum(ulong_long_to_bignum(decks_scanned)));
|
||||
stats.add(tag_bignum(ulong_long_to_bignum(card_scan_time)));
|
||||
stats.add(tag<F_BIGNUM>(ulong_long_to_bignum(total_gc_time)));
|
||||
stats.add(tag<F_BIGNUM>(ulong_long_to_bignum(cards_scanned)));
|
||||
stats.add(tag<F_BIGNUM>(ulong_long_to_bignum(decks_scanned)));
|
||||
stats.add(tag<F_BIGNUM>(ulong_long_to_bignum(card_scan_time)));
|
||||
stats.add(allot_cell(code_heap_scans));
|
||||
|
||||
stats.trim();
|
||||
|
|
@ -644,8 +666,8 @@ void primitive_clear_gc_stats(void)
|
|||
to coalesce equal but distinct quotations and wrappers. */
|
||||
void primitive_become(void)
|
||||
{
|
||||
F_ARRAY *new_objects = untag_array(dpop());
|
||||
F_ARRAY *old_objects = untag_array(dpop());
|
||||
F_ARRAY *new_objects = untag_check<F_ARRAY>(dpop());
|
||||
F_ARRAY *old_objects = untag_check<F_ARRAY>(dpop());
|
||||
|
||||
CELL capacity = array_capacity(new_objects);
|
||||
if(capacity != array_capacity(old_objects))
|
||||
|
|
@ -658,7 +680,8 @@ void primitive_become(void)
|
|||
CELL old_obj = array_nth(old_objects,i);
|
||||
CELL new_obj = array_nth(new_objects,i);
|
||||
|
||||
forward_object(old_obj,new_obj);
|
||||
if(old_obj != new_obj)
|
||||
forward_object(UNTAG(old_obj),new_obj);
|
||||
}
|
||||
|
||||
gc();
|
||||
|
|
|
|||
159
vm/data_gc.h
159
vm/data_gc.h
|
|
@ -1,159 +0,0 @@
|
|||
void gc(void);
|
||||
DLLEXPORT void minor_gc(void);
|
||||
|
||||
/* used during garbage collection only */
|
||||
|
||||
F_ZONE *newspace;
|
||||
bool performing_gc;
|
||||
bool performing_compaction;
|
||||
CELL collecting_gen;
|
||||
|
||||
/* if true, we collecting AGING space for the second time, so if it is still
|
||||
full, we go on to collect TENURED */
|
||||
bool collecting_aging_again;
|
||||
|
||||
/* in case a generation fills up in the middle of a gc, we jump back
|
||||
up to try collecting the next generation. */
|
||||
jmp_buf gc_jmp;
|
||||
|
||||
/* statistics */
|
||||
typedef struct {
|
||||
CELL collections;
|
||||
u64 gc_time;
|
||||
u64 max_gc_time;
|
||||
CELL object_count;
|
||||
u64 bytes_copied;
|
||||
} F_GC_STATS;
|
||||
|
||||
F_GC_STATS gc_stats[MAX_GEN_COUNT];
|
||||
u64 cards_scanned;
|
||||
u64 decks_scanned;
|
||||
u64 card_scan_time;
|
||||
CELL code_heap_scans;
|
||||
|
||||
/* What generation was being collected when copy_code_heap_roots() was last
|
||||
called? Until the next call to add_code_block(), future
|
||||
collections of younger generations don't have to touch the code
|
||||
heap. */
|
||||
CELL last_code_heap_scan;
|
||||
|
||||
/* sometimes we grow the heap */
|
||||
bool growing_data_heap;
|
||||
F_DATA_HEAP *old_data_heap;
|
||||
|
||||
INLINE bool collecting_accumulation_gen_p(void)
|
||||
{
|
||||
return ((HAVE_AGING_P
|
||||
&& collecting_gen == AGING
|
||||
&& !collecting_aging_again)
|
||||
|| collecting_gen == TENURED);
|
||||
}
|
||||
|
||||
/* test if the pointer is in generation being collected, or a younger one. */
|
||||
INLINE bool should_copy(CELL untagged)
|
||||
{
|
||||
if(in_zone(newspace,untagged))
|
||||
return false;
|
||||
if(collecting_gen == TENURED)
|
||||
return true;
|
||||
else if(HAVE_AGING_P && collecting_gen == AGING)
|
||||
return !in_zone(&data_heap->generations[TENURED],untagged);
|
||||
else if(collecting_gen == NURSERY)
|
||||
return in_zone(&nursery,untagged);
|
||||
else
|
||||
{
|
||||
critical_error("Bug in should_copy",untagged);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
void copy_handle(CELL *handle);
|
||||
|
||||
void garbage_collection(volatile CELL gen,
|
||||
bool growing_data_heap_,
|
||||
CELL requested_bytes);
|
||||
|
||||
/* We leave this many bytes free at the top of the nursery so that inline
|
||||
allocation (which does not call GC because of possible roots in volatile
|
||||
registers) does not run out of memory */
|
||||
#define ALLOT_BUFFER_ZONE 1024
|
||||
|
||||
/* If this is defined, we GC every allocation. This catches missing local roots */
|
||||
|
||||
/*
|
||||
* It is up to the caller to fill in the object's fields in a meaningful
|
||||
* fashion!
|
||||
*/
|
||||
|
||||
INLINE void *allot_object(CELL type, CELL a)
|
||||
{
|
||||
#ifdef GC_DEBUG
|
||||
if(!gc_off)
|
||||
gc();
|
||||
#endif
|
||||
|
||||
CELL *object;
|
||||
|
||||
if(nursery.size - ALLOT_BUFFER_ZONE > a)
|
||||
{
|
||||
/* If there is insufficient room, collect the nursery */
|
||||
if(nursery.here + ALLOT_BUFFER_ZONE + a > nursery.end)
|
||||
garbage_collection(NURSERY,false,0);
|
||||
|
||||
CELL h = nursery.here;
|
||||
nursery.here = h + align8(a);
|
||||
object = (CELL*)h;
|
||||
}
|
||||
/* If the object is bigger than the nursery, allocate it in
|
||||
tenured space */
|
||||
else
|
||||
{
|
||||
F_ZONE *tenured = &data_heap->generations[TENURED];
|
||||
|
||||
/* If tenured space does not have enough room, collect */
|
||||
if(tenured->here + a > tenured->end)
|
||||
{
|
||||
gc();
|
||||
tenured = &data_heap->generations[TENURED];
|
||||
}
|
||||
|
||||
/* If it still won't fit, grow the heap */
|
||||
if(tenured->here + a > tenured->end)
|
||||
{
|
||||
garbage_collection(TENURED,true,a);
|
||||
tenured = &data_heap->generations[TENURED];
|
||||
}
|
||||
|
||||
object = (CELL *)allot_zone(tenured,a);
|
||||
|
||||
/* We have to do this */
|
||||
allot_barrier((CELL)object);
|
||||
|
||||
/* Allows initialization code to store old->new pointers
|
||||
without hitting the write barrier in the common case of
|
||||
a nursery allocation */
|
||||
write_barrier((CELL)object);
|
||||
}
|
||||
|
||||
*object = tag_header(type);
|
||||
return object;
|
||||
}
|
||||
|
||||
void copy_reachable_objects(CELL scan, CELL *end);
|
||||
|
||||
void primitive_gc(void);
|
||||
void primitive_gc_stats(void);
|
||||
void clear_gc_stats(void);
|
||||
void primitive_clear_gc_stats(void);
|
||||
void primitive_become(void);
|
||||
|
||||
INLINE void check_data_pointer(CELL pointer)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!growing_data_heap)
|
||||
{
|
||||
assert(pointer >= data_heap->segment->start
|
||||
&& pointer < data_heap->segment->end);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
|
@ -28,9 +28,6 @@ INLINE bool collecting_accumulation_gen_p(void)
|
|||
|
||||
extern CELL last_code_heap_scan;
|
||||
|
||||
/* test if the pointer is in generation being collected, or a younger one. */
|
||||
bool should_copy_p(CELL untagged);
|
||||
|
||||
void copy_handle(CELL *handle);
|
||||
|
||||
void garbage_collection(volatile CELL gen,
|
||||
|
|
|
|||
|
|
@ -224,7 +224,7 @@ CELL unaligned_object_size(CELL pointer)
|
|||
case STRING_TYPE:
|
||||
return string_size(string_capacity((F_STRING*)pointer));
|
||||
case TUPLE_TYPE:
|
||||
tuple = untag<F_TUPLE>(pointer);
|
||||
tuple = (F_TUPLE *)pointer;
|
||||
layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
|
||||
return tuple_size(layout);
|
||||
case QUOTATION_TYPE:
|
||||
|
|
@ -284,7 +284,7 @@ CELL binary_payload_start(CELL pointer)
|
|||
case ARRAY_TYPE:
|
||||
return array_size<F_ARRAY>(array_capacity((F_ARRAY*)pointer));
|
||||
case TUPLE_TYPE:
|
||||
tuple = untag<F_TUPLE>(pointer);
|
||||
tuple = (F_TUPLE *)pointer;
|
||||
layout = untag<F_TUPLE_LAYOUT>(tuple->layout);
|
||||
return tuple_size(layout);
|
||||
case WRAPPER_TYPE:
|
||||
|
|
|
|||
|
|
@ -113,7 +113,6 @@ void memory_protection_error(CELL addr, F_STACK_FRAME *native_stack)
|
|||
general_error(ERROR_RS_OVERFLOW,F,F,native_stack);
|
||||
else if(in_page(addr, nursery.end, 0, 0))
|
||||
critical_error("allot_object() missed GC check",0);
|
||||
else if(in_page(addr, gc_locals_region->start, 0, -1))
|
||||
else
|
||||
general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,5 +3,5 @@
|
|||
F_SEGMENT *gc_locals_region;
|
||||
CELL gc_locals;
|
||||
|
||||
F_SEGMENT *extra_roots_region;
|
||||
CELL extra_roots;
|
||||
F_SEGMENT *gc_bignums_region;
|
||||
CELL gc_bignums;
|
||||
|
|
|
|||
|
|
@ -20,12 +20,18 @@ struct gc_root : public tagged<T>
|
|||
~gc_root() { CELL old = gc_local_pop(); assert(old == (CELL)this); }
|
||||
};
|
||||
|
||||
/* Extra roots: stores pointers to objects in the heap. Requires extra work
|
||||
(you have to unregister before accessing the object) but more flexible. */
|
||||
extern F_SEGMENT *extra_roots_region;
|
||||
extern CELL extra_roots;
|
||||
/* A similar hack for the bignum implementation */
|
||||
extern F_SEGMENT *gc_bignums_region;
|
||||
extern CELL gc_bignums;
|
||||
|
||||
DEFPUSHPOP(root_,extra_roots)
|
||||
DEFPUSHPOP(gc_bignum_,gc_bignums)
|
||||
|
||||
#define REGISTER_BIGNUM(obj) if(obj) root_push(tag_bignum(obj))
|
||||
#define UNREGISTER_BIGNUM(obj) if(obj) obj = (untag_bignum_fast(root_pop()))
|
||||
struct gc_bignum
|
||||
{
|
||||
F_BIGNUM **addr;
|
||||
|
||||
gc_bignum(F_BIGNUM **addr_) : addr(addr_) { if(*addr_) check_data_pointer((CELL)*addr_); gc_bignum_push((CELL)addr); }
|
||||
~gc_bignum() { assert((CELL)addr == gc_bignum_pop()); }
|
||||
};
|
||||
|
||||
#define GC_BIGNUM(x) gc_bignum x##__gc_root(&x)
|
||||
|
|
|
|||
|
|
@ -51,9 +51,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_BIGNUM *bx = fixnum_to_bignum(x);
|
||||
REGISTER_BIGNUM(bx);
|
||||
GC_BIGNUM(bx);
|
||||
F_BIGNUM *by = fixnum_to_bignum(y);
|
||||
UNREGISTER_BIGNUM(bx);
|
||||
GC_BIGNUM(by);
|
||||
drepl(tag<F_BIGNUM>(bignum_multiply(bx,by)));
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue