sexpr cons (sexpr x, sexpr y)
{
sexpr r;
int *p;
int my_extra = extra_count;
stubborn_count++;
r = (sexpr) GC_MALLOC_STUBBORN(sizeof(struct SEXPR) + my_extra);
if (r == 0) {
GC_printf("Out of memory\n");
exit(1);
}
for (p = (int *)r;
((char *)p) < ((char *)r) + my_extra + sizeof(struct SEXPR); p++) {
if (*p) {
GC_printf("Found nonzero at %p - allocator is broken\n", p);
FAIL;
}
*p = (int)((13 << 12) + ((p - (int *)r) & 0xfff));
}
# ifdef AT_END
r = (sexpr)((char *)r + (my_extra & ~7));
# endif
r -> sexpr_car = x;
r -> sexpr_cdr = y;
my_extra++;
if ( my_extra >= 5000 ) {
extra_count = 0;
} else {
extra_count = my_extra;
}
GC_END_STUBBORN_CHANGE((char *)r);
return(r);
}
void * GC_win32_start_inner(struct GC_stack_base *sb, LPVOID arg)
{
void * ret;
thread_args *args = (thread_args *)arg;
# if DEBUG_WIN32_THREADS
GC_printf("thread 0x%x starting...\n", GetCurrentThreadId());
# endif
GC_register_my_thread(sb); /* This waits for an in-progress GC. */
/* Clear the thread entry even if we exit with an exception. */
/* This is probably pointless, since an uncaught exception is */
/* supposed to result in the process being killed. */
#ifndef __GNUC__
__try {
#endif /* __GNUC__ */
ret = (void *)(size_t)args->start (args->param);
#ifndef __GNUC__
} __finally {
#endif /* __GNUC__ */
GC_unregister_my_thread();
GC_free(args);
#ifndef __GNUC__
}
#endif /* __GNUC__ */
# if DEBUG_WIN32_THREADS
GC_printf("thread 0x%x returned from start routine.\n",
GetCurrentThreadId());
# endif
return ret;
}
void GC_dump_finalization(void)
{
struct disappearing_link * curr_dl;
struct finalizable_object * curr_fo;
ptr_t real_ptr, real_link;
int dl_size = (log_dl_table_size == -1 ) ? 0 : (1 << log_dl_table_size);
int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
int i;
GC_printf("Disappearing links:\n");
for (i = 0; i < dl_size; i++) {
for (curr_dl = dl_head[i]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
GC_printf("Object: %p, Link:%p\n", real_ptr, real_link);
}
}
GC_printf("Finalizers:\n");
for (i = 0; i < fo_size; i++) {
for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
GC_printf("Finalizable object: %p\n", real_ptr);
}
}
}
void GC_thread_exit_proc(void *arg)
{
GC_thread me = (GC_thread)arg;
int i;
GC_ASSERT(!GC_win32_dll_threads);
# if DEBUG_CYGWIN_THREADS
GC_printf("thread 0x%x(0x%x) called pthread_exit().\n",
(int)pthread_self(),GetCurrentThreadId());
# endif
# if DEBUG_WIN32_PTHREADS
GC_printf("thread 0x%x(0x%x) called pthread_exit().\n",
(int)(pthread_self()).p,GetCurrentThreadId());
# endif
LOCK();
# if defined(THREAD_LOCAL_ALLOC)
GC_destroy_thread_local(&(me->tlfs));
# endif
if (me -> flags & DETACHED) {
GC_delete_thread(GetCurrentThreadId());
} else {
/* deallocate it as part of join */
me -> flags |= FINISHED;
}
UNLOCK();
}
void * GC_pthread_start_inner(struct GC_stack_base *sb, void * arg)
{
struct start_info * si = arg;
void * result;
void *(*start)(void *);
void *start_arg;
DWORD thread_id = GetCurrentThreadId();
pthread_t pthread_id = pthread_self();
GC_thread me;
GC_bool detached;
int i;
# if DEBUG_CYGWIN_THREADS
GC_printf("thread 0x%x(0x%x) starting...\n",(int)pthread_id,
thread_id);
# endif
# if DEBUG_WIN32_PTHREADS
GC_printf("thread 0x%x(0x%x) starting...\n",(int) pthread_id.p,
thread_id);
# endif
GC_ASSERT(!GC_win32_dll_threads);
/* If a GC occurs before the thread is registered, that GC will */
/* ignore this thread. That's fine, since it will block trying to */
/* acquire the allocation lock, and won't yet hold interesting */
/* pointers. */
LOCK();
/* We register the thread here instead of in the parent, so that */
/* we don't need to hold the allocation lock during pthread_create. */
me = GC_register_my_thread_inner(sb, thread_id);
SET_PTHREAD_MAP_CACHE(pthread_id, thread_id);
UNLOCK();
start = si -> start_routine;
start_arg = si -> arg;
if (si-> detached) me -> flags |= DETACHED;
me -> pthread_id = pthread_id;
GC_free(si); /* was allocated uncollectable */
pthread_cleanup_push(GC_thread_exit_proc, (void *)me);
result = (*start)(start_arg);
me -> status = result;
pthread_cleanup_pop(1);
# if DEBUG_CYGWIN_THREADS
GC_printf("thread 0x%x(0x%x) returned from start routine.\n",
(int)pthread_self(),GetCurrentThreadId());
# endif
# if DEBUG_WIN32_PTHREADS
GC_printf("thread 0x%x(0x%x) returned from start routine.\n",
(int)(pthread_self()).p, GetCurrentThreadId());
# endif
return(result);
}
void GC_print_finalization_stats(void)
{
struct finalizable_object *fo = GC_finalize_now;
size_t ready = 0;
GC_printf("%u finalization table entries; %u disappearing links\n",
GC_fo_entries, GC_dl_entries);
for (; 0 != fo; fo = fo_next(fo)) ++ready;
GC_printf("%u objects are eligible for immediate finalization\n", ready);
}
void GC_print_block_list(void)
{
struct Print_stats pstats;
GC_printf("(kind(0=ptrfree,1=normal,2=unc.):size_in_bytes, #_marks_set)\n");
pstats.number_of_blocks = 0;
pstats.total_bytes = 0;
GC_apply_to_all_blocks(GC_print_block_descr, (word)&pstats);
GC_printf("\nblocks = %lu, bytes = %lu\n",
(unsigned long)pstats.number_of_blocks,
(unsigned long)pstats.total_bytes);
}
void fork_a_thread(void)
{
pthread_t t;
int code;
if ((code = pthread_create(&t, 0, tiny_reverse_test, 0)) != 0) {
GC_printf("Small thread creation failed %d\n", code);
FAIL;
}
if ((code = pthread_join(t, 0)) != 0) {
GC_printf("Small thread join failed %d\n", code);
FAIL;
}
}
/* Not used, but useful for debugging: */
void print_int_list(sexpr x)
{
if (is_nil(x)) {
GC_printf("NIL\n");
} else {
GC_printf("(%d)", SEXPR_TO_INT(car(car(x))));
if (!is_nil(cdr(x))) {
GC_printf(", ");
print_int_list(cdr(x));
} else {
GC_printf("\n");
}
}
}
STATIC void GC_check_blocks(void)
{
word bytes_in_free_blocks = GC_large_free_bytes;
GC_bytes_in_used_blocks = 0;
GC_apply_to_all_blocks(GC_add_block, (word)0);
GC_printf("GC_bytes_in_used_blocks = %lu, bytes_in_free_blocks = %lu ",
(unsigned long)GC_bytes_in_used_blocks,
(unsigned long)bytes_in_free_blocks);
GC_printf("GC_heapsize = %lu\n", (unsigned long)GC_heapsize);
if (GC_bytes_in_used_blocks + bytes_in_free_blocks != GC_heapsize) {
GC_printf("LOST SOME BLOCKS!!\n");
}
}
void check_uncollectable_ints(sexpr list, int low, int up)
{
if (SEXPR_TO_INT(car(car(list))) != low) {
GC_printf("Uncollectable list corrupted - collector is broken\n");
FAIL;
}
if (low == up) {
if (UNCOLLECTABLE_CDR(list) != nil) {
GC_printf("Uncollectable list too long - collector is broken\n");
FAIL;
}
} else {
check_uncollectable_ints(UNCOLLECTABLE_CDR(list), low+1, up);
}
}
int GC_pthread_join(pthread_t pthread_id, void **retval) {
int result;
int i;
GC_thread joinee;
# if DEBUG_CYGWIN_THREADS
GC_printf("thread 0x%x(0x%x) is joining thread 0x%x.\n",
(int)pthread_self(), GetCurrentThreadId(), (int)pthread_id);
# endif
# if DEBUG_WIN32_PTHREADS
GC_printf("thread 0x%x(0x%x) is joining thread 0x%x.\n",
(int)(pthread_self()).p, GetCurrentThreadId(), pthread_id.p);
# endif
if (!parallel_initialized) GC_init_parallel();
/* Thread being joined might not have registered itself yet. */
/* After the join,thread id may have been recycled. */
/* FIXME: It would be better if this worked more like */
/* pthread_support.c. */
#ifndef GC_WIN32_PTHREADS
while ((joinee = GC_lookup_pthread(pthread_id)) == 0) Sleep(10);
#endif
result = pthread_join(pthread_id, retval);
#ifdef GC_WIN32_PTHREADS
/* win32_pthreads id are unique */
joinee = GC_lookup_pthread(pthread_id);
#endif
if (!GC_win32_dll_threads) {
LOCK();
GC_delete_gc_thread(joinee);
UNLOCK();
} /* otherwise dllmain handles it. */
# if DEBUG_CYGWIN_THREADS
GC_printf("thread 0x%x(0x%x) completed join with thread 0x%x.\n",
(int)pthread_self(), GetCurrentThreadId(), (int)pthread_id);
# endif
# if DEBUG_WIN32_PTHREADS
GC_printf("thread 0x%x(0x%x) completed join with thread 0x%x.\n",
(int)(pthread_self()).p, GetCurrentThreadId(), pthread_id.p);
# endif
return result;
}
/* For debugging: */
void GC_print_static_roots(void)
{
int i;
word size;
for (i = 0; i < n_root_sets; i++) {
GC_printf("From %p to %p%s\n",
GC_static_roots[i].r_start, GC_static_roots[i].r_end,
GC_static_roots[i].r_tmp ? " (temporary)" : "");
}
GC_printf("GC_root_size: %lu\n", (unsigned long)GC_root_size);
if ((size = GC_compute_root_size()) != GC_root_size)
GC_err_printf("GC_root_size incorrect!! Should be: %lu\n",
(unsigned long)size);
}
void * GC_mark_thread(void * id)
{
word my_mark_no = 0;
marker_sp[(word)id] = GC_approx_sp();
# ifdef IA64
marker_bsp[(word)id] = GC_save_regs_in_stack();
# endif
for (;; ++my_mark_no) {
/* GC_mark_no is passed only to allow GC_help_marker to terminate */
/* promptly. This is important if it were called from the signal */
/* handler or from the GC lock acquisition code. Under Linux, it's */
/* not safe to call it from a signal handler, since it uses mutexes */
/* and condition variables. Since it is called only here, the */
/* argument is unnecessary. */
if (my_mark_no < GC_mark_no || my_mark_no > GC_mark_no + 2) {
/* resynchronize if we get far off, e.g. because GC_mark_no */
/* wrapped. */
my_mark_no = GC_mark_no;
}
# ifdef DEBUG_THREADS
GC_printf("Starting mark helper for mark number %lu\n", my_mark_no);
# endif
GC_help_marker(my_mark_no);
}
}
void check_ints(sexpr list, int low, int up)
{
if (SEXPR_TO_INT(car(car(list))) != low) {
GC_printf(
"List reversal produced incorrect list - collector is broken\n");
FAIL;
}
if (low == up) {
if (cdr(list) != nil) {
GC_printf("List too long - collector is broken\n");
FAIL;
}
} else {
check_ints(cdr(list), low+1, up);
}
}
/* collections to amortize the collection cost. */
static word min_bytes_allocd(void)
{
int dummy; /* GC_stackbottom is used only for a single-threaded case. */
# ifdef STACK_GROWS_UP
word stack_size = (ptr_t)(&dummy) - GC_stackbottom;
# else
word stack_size = GC_stackbottom - (ptr_t)(&dummy);
# endif
word total_root_size; /* includes double stack size, */
/* since the stack is expensive */
/* to scan. */
word scan_size; /* Estimate of memory to be scanned */
/* during normal GC. */
# ifdef THREADS
if (GC_need_to_lock) {
/* We are multi-threaded... */
stack_size = GC_total_stacksize;
/* For now, we just use the value computed during the latest GC. */
# ifdef DEBUG_THREADS
GC_printf("Total stacks size: %lu\n", (unsigned long)stack_size);
# endif
}
# endif
total_root_size = 2 * stack_size + GC_root_size;
scan_size = 2 * GC_composite_in_use + GC_atomic_in_use / 4
+ total_root_size;
if (GC_incremental) {
return scan_size / (2 * GC_free_space_divisor);
} else {
return scan_size / GC_free_space_divisor;
}
}
void GC_CALLBACK finalizer(void * obj, void * client_data)
{
tn * t = (tn *)obj;
# ifdef PCR
PCR_ThCrSec_EnterSys();
# endif
# if defined(GC_PTHREADS)
static pthread_mutex_t incr_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_mutex_lock(&incr_lock);
# elif defined(GC_WIN32_THREADS)
EnterCriticalSection(&incr_cs);
# endif
if ((int)(GC_word)client_data != t -> level) {
GC_printf("Wrong finalization data - collector is broken\n");
FAIL;
}
finalized_count++;
t -> level = -1; /* detect duplicate finalization immediately */
# ifdef PCR
PCR_ThCrSec_ExitSys();
# endif
# if defined(GC_PTHREADS)
pthread_mutex_unlock(&incr_lock);
# elif defined(GC_WIN32_THREADS)
LeaveCriticalSection(&incr_cs);
# endif
}
/* random heap address. */
GC_INNER void GC_generate_random_backtrace_no_gc(void)
{
void * current;
current = GC_generate_random_valid_address();
GC_printf("\n****Chosen address %p in object\n", current);
GC_print_backtrace(current);
}
void fork_a_thread(void)
{
DWORD thread_id;
HANDLE h;
h = GC_CreateThread(NULL, 0, tiny_reverse_test, 0, 0, &thread_id);
if (h == (HANDLE)NULL) {
GC_printf("Small thread creation failed %d\n",
(int)GetLastError());
FAIL;
}
if (WaitForSingleObject(h, INFINITE) != WAIT_OBJECT_0) {
GC_printf("Small thread wait failed %d\n",
(int)GetLastError());
FAIL;
}
}
/* Should be called immediately after GC_read_dirty and GC_read_changed. */
void GC_check_dirty(void)
{
int index;
unsigned i;
struct hblk *h;
ptr_t start;
GC_check_blocks();
GC_n_dirty_errors = 0;
GC_n_faulted_dirty_errors = 0;
GC_n_changed_errors = 0;
GC_n_clean = 0;
GC_n_dirty = 0;
index = 0;
for (i = 0; i < GC_n_heap_sects; i++) {
start = GC_heap_sects[i].hs_start;
for (h = (struct hblk *)start;
h < (struct hblk *)(start + GC_heap_sects[i].hs_bytes);
h++) {
GC_update_check_page(h, index);
index++;
if (index >= NSUMS) goto out;
}
}
out:
GC_printf("Checked %lu clean and %lu dirty pages\n",
(unsigned long) GC_n_clean, (unsigned long) GC_n_dirty);
if (GC_n_dirty_errors > 0) {
GC_printf("Found %d dirty bit errors (%d were faulted)\n",
GC_n_dirty_errors, GC_n_faulted_dirty_errors);
}
if (GC_n_changed_errors > 0) {
GC_printf("Found %lu changed bit errors\n",
(unsigned long)GC_n_changed_errors);
GC_printf("These may be benign (provoked by nonpointer changes)\n");
# ifdef THREADS
GC_printf(
"Also expect 1 per thread currently allocating a stubborn obj.\n");
# endif
}
for (i = 0; i < GC_n_faulted; ++i) {
GC_faulted[i] = 0; /* Don't expose block pointers to GC */
}
GC_n_faulted = 0;
}
/* Currently for debugger use only: */
void GC_print_free_list(int kind, size_t sz_in_granules)
{
struct obj_kind * ok = &GC_obj_kinds[kind];
ptr_t flh = ok -> ok_freelist[sz_in_granules];
struct hblk *lastBlock = 0;
int n = 0;
while (flh) {
struct hblk *block = HBLKPTR(flh);
if (block != lastBlock) {
GC_printf("\nIn heap block at %p:\n\t", block);
lastBlock = block;
}
GC_printf("%d: %p;", ++n, flh);
flh = obj_link(flh);
}
}
STATIC void GC_print_block_descr_inner(struct hblk *h)
{
hdr * hhdr = HDR(h);
size_t bytes = hhdr -> hb_sz;
unsigned n_marks = GC_n_set_marks(hhdr);
char* pfstr = (hhdr->hb_flags & HAS_PENDING_FREE) ? "pf" : "";
if (hhdr -> hb_n_marks != n_marks) {
GC_printf("(%s:%u:%u,%u!=%u)", pfstr, hhdr -> hb_obj_kind, (unsigned)bytes,
(unsigned)hhdr -> hb_n_marks, n_marks);
} else {
GC_printf("(%s:%u:%u,%u)", pfstr, hhdr -> hb_obj_kind,
(unsigned)bytes, n_marks);
}
}
/* For debugging: */
void GC_print_static_roots(void)
{
int i;
size_t total = 0;
for (i = 0; i < n_root_sets; i++) {
GC_printf("From %p to %p%s\n",
GC_static_roots[i].r_start,
GC_static_roots[i].r_end,
GC_static_roots[i].r_tmp ? " (temporary)" : "");
total += GC_static_roots[i].r_end - GC_static_roots[i].r_start;
}
GC_printf("Total size: %ld\n", (unsigned long) total);
if (GC_root_size != total) {
GC_err_printf("GC_root_size incorrect: %ld!!\n",
(long) GC_root_size);
}
}
/* Cygwin-pthreads calls CreateThread internally, but it's not
* easily interceptible by us..
* so intercept pthread_create instead
*/
int
GC_pthread_create(pthread_t *new_thread,
const pthread_attr_t *attr,
void *(*start_routine)(void *), void *arg) {
int result;
struct start_info * si;
if (!parallel_initialized) GC_init_parallel();
/* make sure GC is initialized (i.e. main thread is attached) */
if (GC_win32_dll_threads) {
return pthread_create(new_thread, attr, start_routine, arg);
}
/* This is otherwise saved only in an area mmapped by the thread */
/* library, which isn't visible to the collector. */
si = GC_malloc_uncollectable(sizeof(struct start_info));
if (0 == si) return(EAGAIN);
si -> start_routine = start_routine;
si -> arg = arg;
if (attr != 0 &&
pthread_attr_getdetachstate(attr, &si->detached)
== PTHREAD_CREATE_DETACHED) {
si->detached = TRUE;
}
# if DEBUG_CYGWIN_THREADS
GC_printf("About to create a thread from 0x%x(0x%x)\n",
(int)pthread_self(), GetCurrentThreadId);
# endif
# if DEBUG_WIN32_PTHREADS
GC_printf("About to create a thread from 0x%x(0x%x)\n",
(int)(pthread_self()).p, GetCurrentThreadId());
# endif
GC_need_to_lock = TRUE;
result = pthread_create(new_thread, attr, GC_pthread_start, si);
if (result) { /* failure */
GC_free(si);
}
return(result);
}
void GC_print_sig_mask(void)
{
sigset_t blocked;
int i;
if (pthread_sigmask(SIG_BLOCK, NULL, &blocked) != 0)
ABORT("pthread_sigmask failed");
for (i = 1; i < NSIG; i++) {
if (sigismember(&blocked, i))
GC_printf("Signal blocked: %d\n", i);
}
}
STATIC void GC_print_block_descr(struct hblk *h,
word /* struct PrintStats */ raw_ps)
{
hdr * hhdr = HDR(h);
size_t bytes = hhdr -> hb_sz;
struct Print_stats *ps;
unsigned n_marks = GC_n_set_marks(hhdr);
if (hhdr -> hb_n_marks != n_marks) {
GC_printf("(%u:%u,%u!=%u)", hhdr -> hb_obj_kind, (unsigned)bytes,
(unsigned)hhdr -> hb_n_marks, n_marks);
} else {
GC_printf("(%u:%u,%u)", hhdr -> hb_obj_kind,
(unsigned)bytes, n_marks);
}
bytes += HBLKSIZE-1;
bytes &= ~(HBLKSIZE-1);
ps = (struct Print_stats *)raw_ps;
ps->total_bytes += bytes;
ps->number_of_blocks++;
}
void GC_dump_finalization(void)
{
struct finalizable_object * curr_fo;
size_t fo_size = log_fo_table_size == -1 ? 0 : 1 << log_fo_table_size;
ptr_t real_ptr;
size_t i;
GC_printf("Disappearing (short) links:\n");
GC_dump_finalization_links(&GC_dl_hashtbl);
# ifndef GC_LONG_REFS_NOT_NEEDED
GC_printf("Disappearing long links:\n");
GC_dump_finalization_links(&GC_ll_hashtbl);
# endif
GC_printf("Finalizers:\n");
for (i = 0; i < fo_size; i++) {
for (curr_fo = GC_fo_head[i]; curr_fo != 0;
curr_fo = fo_next(curr_fo)) {
real_ptr = GC_REVEAL_POINTER(curr_fo -> fo_hidden_base);
GC_printf("Finalizable object: %p\n", real_ptr);
}
}
}
void chktree(tn *t, int n)
{
if (n == 0 && t != 0) {
GC_printf("Clobbered a leaf - collector is broken\n");
FAIL;
}
if (n == 0) return;
if (t -> level != n) {
GC_printf("Lost a node at level %d - collector is broken\n", n);
FAIL;
}
if (counter++ % 373 == 0) {
collectable_count++;
(void) GC_MALLOC(counter%5001);
}
chktree(t -> lchild, n-1);
if (counter++ % 73 == 0) {
collectable_count++;
(void) GC_MALLOC(counter%373);
}
chktree(t -> rchild, n-1);
}
sexpr small_cons_uncollectable (sexpr x, sexpr y)
{
sexpr r;
uncollectable_count++;
r = (sexpr) GC_MALLOC_UNCOLLECTABLE(sizeof(struct SEXPR));
if (r == 0) {
GC_printf("Out of memory\n");
exit(1);
}
r -> sexpr_car = x;
r -> sexpr_cdr = (sexpr)(~(GC_word)y);
return(r);
}
sexpr small_cons (sexpr x, sexpr y)
{
sexpr r;
collectable_count++;
r = (sexpr) GC_MALLOC(sizeof(struct SEXPR));
if (r == 0) {
GC_printf("Out of memory\n");
exit(1);
}
r -> sexpr_car = x;
r -> sexpr_cdr = y;
return(r);
}
