GC_API void GC_CALL GC_debug_free(void * p)
{
    ptr_t base;
    if (0 == p) return;

    base = GC_base(p);
    if (base == 0) {
      GC_err_printf("Attempt to free invalid pointer %p\n", p);
      ABORT("Invalid pointer passed to free()");
    }
    if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
      GC_err_printf(
               "GC_debug_free called on pointer %p w/o debugging info\n", p);
    } else {
#     ifndef SHORT_DBG_HDRS
        ptr_t clobbered = GC_check_annotated_obj((oh *)base);
        word sz = GC_size(base);
        if (clobbered != 0) {
          GC_have_errors = TRUE;
          if (((oh *)base) -> oh_sz == sz) {
            GC_print_smashed_obj(
                  "GC_debug_free: found previously deallocated (?) object at",
                  p, clobbered);
            return; /* ignore double free */
          } else {
            GC_print_smashed_obj("GC_debug_free: found smashed location at",
                                 p, clobbered);
          }
        }
        /* Invalidate size (mark the object as deallocated) */
        ((oh *)base) -> oh_sz = sz;
#     endif /* SHORT_DBG_HDRS */
    }
    if (GC_find_leak
#       ifndef SHORT_DBG_HDRS
          && ((ptr_t)p - (ptr_t)base != sizeof(oh) || !GC_findleak_delay_free)
#       endif
        ) {
      GC_free(base);
    } else {
      hdr * hhdr = HDR(p);
      if (hhdr -> hb_obj_kind == UNCOLLECTABLE
#         ifdef ATOMIC_UNCOLLECTABLE
            || hhdr -> hb_obj_kind == AUNCOLLECTABLE
#         endif
          ) {
        GC_free(base);
      } else {
        size_t i;
        size_t obj_sz = BYTES_TO_WORDS(hhdr -> hb_sz - sizeof(oh));

        for (i = 0; i < obj_sz; ++i)
          ((word *)p)[i] = GC_FREED_MEM_MARKER;
        GC_ASSERT((word *)p + i == (word *)(base + hhdr -> hb_sz));
      }
    } /* !GC_find_leak */
}

void GC_debug_free(void * p)
{
    ptr_t base;
    ptr_t clobbered;
    
    if (0 == p) return;
    base = GC_base(p);
    if (base == 0) {
        GC_err_printf("Attempt to free invalid pointer %p\n", p);
        ABORT("free(invalid pointer)");
    }
    if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
        GC_err_printf(
        	  "GC_debug_free called on pointer %p wo debugging info\n", p);
    } else {
#     ifndef SHORT_DBG_HDRS
        clobbered = GC_check_annotated_obj((oh *)base);
        if (clobbered != 0) {
          if (((oh *)base) -> oh_sz == GC_size(base)) {
            GC_err_printf(
                  "GC_debug_free: found previously deallocated (?) object at ");
          } else {
            GC_err_printf("GC_debug_free: found smashed location at ");
          }
          GC_print_smashed_obj(p, clobbered);
        }
        /* Invalidate size */
        ((oh *)base) -> oh_sz = GC_size(base);
#     endif /* SHORT_DBG_HDRS */
    }
    if (GC_find_leak) {
        GC_free(base);
    } else {
	hdr * hhdr = HDR(p);
	GC_bool uncollectable = FALSE;

        if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
	    uncollectable = TRUE;
	}
#	ifdef ATOMIC_UNCOLLECTABLE
	    if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
		    uncollectable = TRUE;
	    }
#	endif
	if (uncollectable) {
	    GC_free(base);
	} else {
	    size_t i;
	    size_t obj_sz = BYTES_TO_WORDS(hhdr -> hb_sz - sizeof(oh));

	    for (i = 0; i < obj_sz; ++i) ((word *)p)[i] = 0xdeadbeef;
	    GC_ASSERT((word *)p + i == (word *)(base + hhdr -> hb_sz));
	}
    } /* !GC_find_leak */
}

void destroy_list(list_p list){
	lnode_p cur = list->first;
	lnode_p next;
	while(cur!=NULL){
		next = cur->next;
		list->destructor(cur->data);
		GC_free(cur);
		cur = next;
	}
	GC_free(list);
}

void FNI_DestroyThreadState(void *cl) {
  struct FNI_Thread_State * env = (struct FNI_Thread_State *) cl;
  if (cl==NULL) return; // death of uninitialized thread.
  // ignore wrapped exception; free localrefs.
#ifdef WITH_REALTIME_JAVA
  RTJ_FREE(env->localrefs_stack);
#elif defined(WITH_PRECISE_GC)
  free(env->localrefs_stack);
#elif defined(BDW_CONSERVATIVE_GC)
  GC_free(env->localrefs_stack);
#else
  free(env->localrefs_stack);
#endif
  env->exception = /* this may point into localrefs_stack, so null it, too */
  env->localrefs_stack = env->localrefs_next = env->localrefs_end = NULL;
#if WITH_HEAVY_THREADS || WITH_PTH_THREADS
  // destroy condition variable & mutex
  pthread_mutex_unlock(&(env->sleep_mutex));
  pthread_mutex_destroy(&(env->sleep_mutex));
  pthread_cond_destroy(&(env->sleep_cond));
#endif
  // now free thread state structure.
#ifdef WITH_REALTIME_JAVA
  RTJ_FREE(env);
#elif WITH_TRANSACTIONS
  /* allocated with GC_malloc; no 'free' necessary. */
#else
  free(env);
#endif
}

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 *talloc_atomic_uncollectable__(size_t size, const char *filename, int linenumber){
	void *ret;

	ret=tracker_alloc__(size,GC_malloc_atomic_uncollectable, filename, linenumber);

	if(ret!=NULL) return ret;

#if 0
	if(tmemoryisused==0){
		tmemoryisused=1;
		GC_free(tmemory);
		tmemory=NULL;
	}

#ifndef DISABLE_BDWGC
 	ret=GC_malloc_atomic_uncollectable(size);
#else
	ret=OS_getmem(size);		// For debugging. (wrong use of GC_malloced memory could be very difficult to trace)
#endif

#endif

        RWarning("Out of memory. I'll try to continue by allocating a different way, but you should save and quit now.\n");
        ret = calloc(1,size);
        
	if(ret!=NULL) return ret;


        RWarning("Didn't succeed. Out of memory. Quitting. (atomic_uncollectable allocator)\n");
	ShutDownYepp();
	return NULL;
}

static void *_thread_internal2(void *arg){
    if(!arg) errquit("_thread_internal2: null arg");
    sinfo_t i = (sinfo_t) arg;
    _init_thread_context(i->tid,i->h);
//	 fprintf(stderr,"\n[%d]si = %p",tcb()->tid,i);
   // install top exception handler and execute thread if there's no exn
   if( _set_top_handler() == NULL ) {
#ifdef __RUNTIME_MEMORY_DEBUG_LOCKOP
            fprintf(stderr,"\n[%d] NEW THREAD.",	
              	 	tcb()->tid); 
#endif
	  (i->thread)((void *) (i+1));
   }
  // finalize thread context	 
//	fprintf(stderr,"\n[%d] fini_thread_context\n",i->tid);
  _fini_thread_context();
  // wake up main thread if I'm the last thread
  if(__sync_fetch_and_add(&all_done,-1) == 1)
   futex_wake((int *)&all_done,1);
  //HACK: generate segfault so as to switch
  //to the backup stack and free the current stack.
  // Mark the last page W/R. so that it can be deallocated
//  if (mprotect((void *) (((char *)i) + i->info.end_offset),1024,3))
//   errquit("__thread_internal2: mprotect failed.");

//  fprintf(stderr,"\n[%d]2 __si = %p",tcb()->tid,i);
  GC_free(i);
//  fprintf(stderr,"\n[%d]2 __si = %p. DONE",tcb()->tid,i);
  //goto_context(_thread_cleanup_stack,__second__stack,BACKUP_STK_SZ);
  //abort(); // should NOT reach this point
  pthread_exit(0); // should NOT reach this point
  return NULL;
}

void operator delete(void* p)
{
#ifdef DONT_COLLECT_STL
  GC_free(p); // Important to call this if you call GC_malloc_uncollectable
  // #else do nothing!
#endif
}

void *api_call_method(int numargs, void *obj, void *initptr, va_list vl)
{
    ffi_cif cif;
    ffi_type *args[numargs + 1];
    void *values[numargs + 1];
    void **val_heap = (void**)GC_malloc((numargs + 1) * sizeof(void*)); /*new void*[numargs + 1];*/
    void *rv;
    args[0] = &ffi_type_pointer;
    values[0] = &val_heap[0];
    for (int i = 0; i < numargs; i++)
    {
        args[i + 1] = &ffi_type_pointer;
        values[i + 1] = (void*)&val_heap[i + 1];
    }
    int rc = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, numargs + 1, &ffi_type_pointer, args);
    assert(rc == FFI_OK);
    val_heap[0] = (void*)obj;
    for (int i = 0; i < numargs; i++)
    {
        val_heap[i + 1] = va_arg(vl, void*);
    }
    ffi_call(&cif, (void(*)())initptr, &rv, values);
    va_end(vl);
    GC_free(val_heap);
    /*delete[] val_heap;*/
    return rv;
}

int GC_unregister_disappearing_link(void * * link)
{
    struct disappearing_link *curr_dl, *prev_dl;
    size_t index;
    DCL_LOCK_STATE;
    
    LOCK();
    index = HASH2(link, log_dl_table_size);
    if (((word)link & (ALIGNMENT-1))) goto out;
    prev_dl = 0; curr_dl = dl_head[index];
    while (curr_dl != 0) {
        if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
            if (prev_dl == 0) {
                dl_head[index] = dl_next(curr_dl);
            } else {
                dl_set_next(prev_dl, dl_next(curr_dl));
            }
            GC_dl_entries--;
            UNLOCK();
#	    ifdef DBG_HDRS_ALL
	      dl_set_next(curr_dl, 0);
#	    else
              GC_free((void *)curr_dl);
#	    endif
            return(1);
        }
        prev_dl = curr_dl;
        curr_dl = dl_next(curr_dl);
    }
out:
    UNLOCK();
    return(0);
}

/* Clear both lists.                                                    */
GC_INNER void GC_print_all_errors(void)
{
    static GC_bool printing_errors = FALSE;
    unsigned i;
    DCL_LOCK_STATE;

    LOCK();
    if (printing_errors) {
        UNLOCK();
        return;
    }
    printing_errors = TRUE;
    UNLOCK();
    if (GC_debugging_started) GC_print_all_smashed();
    for (i = 0; i < GC_n_leaked; ++i) {
        ptr_t p = GC_leaked[i];
        if (HDR(p) -> hb_obj_kind == PTRFREE) {
            GC_err_printf("Leaked atomic object at ");
        } else {
            GC_err_printf("Leaked composite object at ");
        }
        GC_print_heap_obj(p);
        GC_err_printf("\n");
        GC_free(p);
        GC_leaked[i] = 0;
    }
    GC_n_leaked = 0;
    printing_errors = FALSE;
}

void pcc_pcre_free(void *ptr)
{
   // the GC should free this for us, but
   // docs say we can free it ourselves and save
   // a collection for possibly faster performance
   GC_free(ptr);
}

void
cuD_ufree_atomic(void *ptr, char const *file, int line)
{
#ifdef CUCONF_HAVE_GC_MALLOC_ATOMIC_UNCOLLECTABLE
    GC_free(ptr);
#else
    free(ptr);
#endif
}

void* list_poll(list_p list){
	lnode_p first = list->first;
	if(first == NULL) return NULL;
	list->first = first->next;
	void* data = first->data;
	first->next->prev = NULL;
	GC_free(first);
	return data;
}

void* list_pop(list_p list){
	lnode_p last = list->last;
	if(last == NULL) return NULL;
	list->last = last->prev;
	void* data = last->data;
	last->prev->next = NULL;
	GC_free(last);
	return data;
}

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

GC_API void *GC_realloc(void *ptr, size_t lbs)
{
  gcheader *hdr= ptr2hdr(ptr);
  void *mem;
  if (lbs <= hdr->size) return ptr;
  mem= GC_malloc(lbs);
  memcpy(mem, ptr, hdr->size);
  ptr2hdr(mem)->atom= hdr->atom;
  GC_free(ptr);
  return mem;
}

modelica_metatype boxptr_listDelete(threadData_t *threadData, modelica_metatype lst, modelica_metatype iix)
{
  /* TODO: If we assume the index exists we can do this in a much better way */
  int ix = mmc_unbox_integer(iix);
  modelica_metatype *tmpArr = NULL;
  int i = 0;

  if (ix <= 0) {
    MMC_THROW_INTERNAL();
  }

  tmpArr = (modelica_metatype *) GC_malloc(sizeof(modelica_metatype)*(ix-1)); /* We know the size of the first part of the list */
  if (tmpArr == NULL) {
    fprintf(stderr, "%s:%d: malloc failed", __FILE__, __LINE__);
    EXIT(1);
  }

  for (i=0; i<ix-1; i++) {
    if (listEmpty(lst)) {
      if (tmpArr) {
        GC_free(tmpArr);
      }
      MMC_THROW_INTERNAL();
    }
    tmpArr[i] = MMC_CAR(lst);
    lst = MMC_CDR(lst);
  }

  if (listEmpty(lst)) {
    GC_free(tmpArr);
    MMC_THROW_INTERNAL();
  }
  lst = MMC_CDR(lst);

  for (i=ix-2; i>=0; i--) {
    lst = mmc_mk_cons(tmpArr[i], lst);
  }
  GC_free(tmpArr);

  return lst;
}

/* Clear both lists.  Called without the allocation lock held.          */
GC_INNER void GC_print_all_errors(void)
{
    static GC_bool printing_errors = FALSE;
    GC_bool have_errors;
    unsigned i, n_leaked;
    ptr_t leaked[MAX_LEAKED];
    DCL_LOCK_STATE;

    LOCK();
    if (printing_errors) {
        UNLOCK();
        return;
    }
    have_errors = GC_have_errors;
    printing_errors = TRUE;
    n_leaked = GC_n_leaked;
    GC_ASSERT(n_leaked <= MAX_LEAKED);
    BCOPY(GC_leaked, leaked, n_leaked * sizeof(ptr_t));
    GC_n_leaked = 0;
    BZERO(GC_leaked, n_leaked * sizeof(ptr_t));
    UNLOCK();

    if (GC_debugging_started) {
      GC_print_all_smashed();
    } else {
      have_errors = FALSE;
    }

    for (i = 0; i < n_leaked; i++) {
        ptr_t p = leaked[i];
        if (HDR(p) -> hb_obj_kind == PTRFREE) {
            GC_err_printf("Leaked atomic object at ");
        } else {
            GC_err_printf("Leaked composite object at ");
        }
        GC_print_heap_obj(p);
        GC_err_printf("\n");
        GC_free(p);
        have_errors = TRUE;
    }

    if (have_errors
#       ifndef GC_ABORT_ON_LEAK
          && GETENV("GC_ABORT_ON_LEAK") != NULL
#       endif
        ) {
      ABORT("Leaked or smashed objects encountered");
    }

    LOCK();
    printing_errors = FALSE;
    UNLOCK();
}

/* Should be called without allocation lock.				*/
int GC_invoke_finalizers()
{
    static int doing = 0; /* PLTSCHEME */
    struct finalizable_object * curr_fo;
    int count = 0;
    word bytes_freed_before = 0;
    DCL_LOCK_STATE;

    /* PLTSCHEME: don't allow nested finalizations */
    if (doing)
      return 0;
    doing++;
    
    while (GC_finalize_now != 0) {
#	ifdef THREADS
	    LOCK();
#	endif
	if (count == 0) {
	    bytes_freed_before = GC_bytes_freed;
            /* Don't do this outside, since we need the lock. */
	}
    	curr_fo = GC_finalize_now;
#	ifdef THREADS
 	    if (curr_fo != 0) GC_finalize_now = fo_next(curr_fo);
	    UNLOCK();
	    if (curr_fo == 0) break;
#	else
	    GC_finalize_now = fo_next(curr_fo);
#	endif
 	fo_set_next(curr_fo, 0);
    	(*(curr_fo -> fo_fn))((ptr_t)(curr_fo -> fo_hidden_base),
    			      curr_fo -> fo_client_data);
    	curr_fo -> fo_client_data = 0;
	++count;
#	ifdef UNDEFINED
	    /* This is probably a bad idea.  It throws off accounting if */
	    /* nearly all objects are finalizable.  O.w. it shouldn't	 */
	    /* matter.							 */
    	    GC_free((void *)curr_fo);
#	endif
    }

    doing--; /* PLTSCHEME */

    /* bytes_freed_before is initialized whenever count != 0 */
    if (count != 0 && bytes_freed_before != GC_bytes_freed) {
        LOCK();
	GC_finalizer_bytes_freed += (GC_bytes_freed - bytes_freed_before);
	UNLOCK();
    }
    return count;
}