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
.mm.o:
$(CPP) -c $(CFLAGS) -o $@ $<
-.PHONY: factor
+.PHONY: factor tags clean
.SUFFIXES: .mm
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;
{
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;
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))
{
{
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;
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;
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);
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;
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);
{
}
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);
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;
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))
{
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);
}
{
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))
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;
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);
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);
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;
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);
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;
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;
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);
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;
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);
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;
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);
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;
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
}
while((CELL)frame >= top)
{
- F_STACK_FRAME *next = frame_successor(frame);
iterator(frame);
- frame = next;
+ frame = frame_successor(frame);
}
}
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);
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);
}
/* 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);
/* 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();
}
/* 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;
copy_handle((CELL*)ptr);
}
-void copy_registered_locals(void)
+static void copy_registered_locals(void)
+{
+ CELL scan = gc_locals_region->start;
+
+ for(; scan <= gc_locals; scan += CELLS)
+ copy_handle(*(CELL **)scan);
+}
+
+static void copy_registered_bignums(void)
{
- CELL ptr = gc_locals_region->start;
+ CELL scan = gc_bignums_region->start;
- for(; ptr <= gc_locals; ptr += CELLS)
- copy_handle(*(CELL **)ptr);
+ 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);
copy_handle(&bignum_neg_one);
copy_registered_locals();
- copy_stack_elements(extra_roots_region,extra_roots);
+ copy_registered_bignums();
if(!performing_compaction)
{
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));
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));
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));
}
/* 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)
{
}
}
-void end_gc(CELL gc_elapsed)
+static void end_gc(CELL gc_elapsed)
{
F_GC_STATS *s = &gc_stats[collecting_gen];
{
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();
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))
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();
+++ /dev/null
-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
-}
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,
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:
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:
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);
}
F_SEGMENT *gc_locals_region;
CELL gc_locals;
-F_SEGMENT *extra_roots_region;
-CELL extra_roots;
+F_SEGMENT *gc_bignums_region;
+CELL gc_bignums;
~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)
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)));
}
projects / factor.git / commitdiff