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

/* 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);
    }
}