char* read_file(char* fname){
  FILE* f;
  char* buf = GC_MALLOC_ATOMIC(8192);
  size_t r;
  str_list_t* sl = sl_create();

  f = fopen(fname, "r");
  DFSCH_UNWIND {
    if (!f){
      dfsch_operating_system_error(dfsch_saprintf("Cannot open file %d",
                                                  fname));
    }
    
    while (!feof(f)){
      r = fread(buf, 1, 8192, f);
      if (r != 0){
        sl_nappend(sl, buf, r);
        buf = GC_MALLOC_ATOMIC(8192);
      } else {
        if (ferror(f)){
          dfsch_operating_system_error(dfsch_saprintf("Error reading file %d",
                                                      fname));
        }
      }
    }
    
  } DFSCH_PROTECT {
    fclose(f);
  } DFSCH_PROTECT_END;
  
  return sl_value(sl);
}

dfsch_strbuf_t* dfsch_port_read_whole(dfsch_object_t* port){
  ssize_t ret;
  char* buf = GC_MALLOC_ATOMIC(1024);
  str_list_t* sl = sl_create();
  while ((ret = dfsch_port_read_buf(port, buf, 1024))){
    sl_nappend(sl, buf, ret);
    buf = GC_MALLOC_ATOMIC(1024);
  }
  return sl_value_strbuf(sl);
}

void env_setsymbol(ENV* env, const char* name, NODE* node)
{
	int i, l, sz;
	
	assert(env != NULL);
	assert(name != NULL);
	NODE_CHECK(node);

	l = strlen(name);
	i= env_getindex(env, name);
	if( i>= 0 )
	{
		//redefine the environment value
		NODE* oldnode;
		
		if( env->names[i] != NULL ) GC_FREE(env->names[i]);
		sz = sizeof(char) * (strlen(name)+1);
		env->names[i] = GC_MALLOC_ATOMIC(sz);
		assert(env->names[i] != NULL);
		memcpy(env->names[i], name, sz);
		env->names[i][sz-1] = '\0';
		NODE_CHECK(node);

		oldnode = env->nodes[i];
		env->nodes[i] = node;

		node_free(oldnode);
		node->refcount++;
	}
	else if( env->count < env->size )
	{
		i = env->count;
		env->count = env->count + 1;
		
		sz = sizeof(char) * (strlen(name)+1);
		env->names[i] = GC_MALLOC_ATOMIC(sizeof(char) * (strlen(name)+1));
		assert(env->names[i] != NULL);
		memcpy(env->names[i], name, sz);
		env->names[i][sz-1] = '\0';
		NODE_CHECK(node);
		
		env->nodes[i] = node;
		node->refcount++;
		//char *tmp = node_tostring(node);
		//printf("env_setsymbol: '%s'(%d) = %s\n", name, strlen(name), tmp);
		//GC_FREE(tmp);
	}
	else
	{
		printf("env_setsymbol: buffer overflow.\n");
		exit(1);
	}

	node->refcount++;
}

void* gcAllocateAtomic(size_t size) {
    void* m = GC_MALLOC_ATOMIC(size);
    if (!m) {
        // Force GC and try again
        GC_gcollect();
        m = GC_MALLOC_ATOMIC(size);
    }
    if (m) {
        memset(m, 0, size);
    }
    return m;
}

char* dfsch_straquote(char *s){
  char *b = GC_MALLOC_ATOMIC(strlen(s)*2+3); // worst case, to lazy to optimize
  char *i = b;

  *i='"';
  i++;

  while (*s){
    switch (*s){
    case '"':
      i[0]='\\';
      i[1]='"';
      i+=2;
    default:
      *i = *s;
      ++i;
    }
    s++;
  }

  *i='"';
  i[1]=0;

  return b;

}

char* dfsch_stracpy(char* x){
  char *b;
  size_t s = strlen(x)+1;
  b = GC_MALLOC_ATOMIC(s);
  strncpy(b,x,s);
  return b;
}

char* dfsch_strancat(char* a, size_t an, char* b, size_t bn){
  char* o = GC_MALLOC_ATOMIC(an + bn + 1);
  memcpy(o, a, an);
  memcpy(o + an, b, bn);
  o[an+bn] = 0;
  return o;
}

char* dfsch_stracat(char* a, char* b){
  size_t s = strlen(a)+strlen(b)+1;
  char* o = GC_MALLOC_ATOMIC(s);
  strncpy(o,a,s);
  strncat(o,b,s);
  return o;
}

CORD CORD_from_fn(CORD_fn fn, void * client_data, size_t len)
{
    if (len <= 0) return(0);
    if (len <= SHORT_LIMIT) {
        register char * result;
        register size_t i;
        char buf[SHORT_LIMIT+1];
        register char c;

        for (i = 0; i < len; i++) {
            c = (*fn)(i, client_data);
            if (c == '\0') goto gen_case;
            buf[i] = c;
        }

        result = GC_MALLOC_ATOMIC(len+1);
        if (result == 0) OUT_OF_MEMORY;
        memcpy(result, buf, len);
        result[len] = '\0';
        return((CORD) result);
    }
  gen_case:
    {
        register struct Function * result;

        result = GC_NEW(struct Function);
        if (result == 0) OUT_OF_MEMORY;
        result->header = FN_HDR;
        /* depth is already 0 */
        result->len = len;
        result->fn = fn;
        result->client_data = client_data;
        return((CORD) result);
    }
}

void* gcAllocateAtomic(jint size) {
    void* m = GC_MALLOC_ATOMIC(size);
    if (m) {
        memset(m, 0, size);
    }
    return m;
}

//const char *str_dup( const char *str ) {
// permAlloc default: FALSE
const char *str_dup( const char *str, const bool permAlloc ) {
  if (fBootDb || permAlloc )
    return alloc_perm_string(str); // at boot time, we can safely allocate each string permanently.

  nStrDup++;
  char *str_new;

  if ( str[0] == '\0' ) {
    nStrDupEmpty++;

    return &str_empty[0];
  }

  void* dummy = GC_base((void*)str);

  if ( GC_base((void*)str) != NULL ) { // Since strings in the heap cannot be changed, it is ok just to return the pointer.
    nStrDupGC++;

    return str;
  }
  else {
    nStrDupNoGC++;
    sStrDupNoGC += strlen(str)+1;

    str_new = (char *) GC_MALLOC_ATOMIC( strlen(str) + 1 );
    strcpy( str_new, str );
    return str_new;
  }
}

void *
mono_gc_alloc_array (MonoVTable *vtable, size_t size, uintptr_t max_length, uintptr_t bounds_size)
{
	MonoArray *obj;

	if (!vtable->klass->has_references) {
		obj = GC_MALLOC_ATOMIC (size);

		obj->obj.vtable = vtable;
		obj->obj.synchronisation = NULL;

		memset ((char *) obj + sizeof (MonoObject), 0, size - sizeof (MonoObject));
	} else if (vtable->gc_descr != GC_NO_DESCRIPTOR) {
		obj = GC_GCJ_MALLOC (size, vtable);
	} else {
		obj = GC_MALLOC (size);

		obj->obj.vtable = vtable;
	}

	obj->max_length = max_length;

	if (bounds_size)
		obj->bounds = (MonoArrayBounds *) ((char *) obj + size - bounds_size);

	if (G_UNLIKELY (alloc_events))
		mono_profiler_allocation (&obj->obj);

	return obj;
}

int decrypt_record(char* ibuf, size_t ilen, char**obuf, size_t *olen){
  int i;
  uint8_t keybuf[16];
  uint8_t hmacbuf[32];

  if (ilen < 48){
    return 0;
  }

  calculate_hmac(hmac_key, ibuf, ilen - 32, hmacbuf);
  if (memcmp(hmacbuf, ibuf + ilen - 32, 32) != 0){
    return 0;
  }
  
  *olen = ilen - 48;
  *obuf = GC_MALLOC_ATOMIC((*olen) + 1);

  memcpy(keybuf, ibuf, 16);

  for (i = 0; i < ilen - 48; i++){
    if ((i % 16) == 0){
      aes_encrypt(&aes, keybuf, keybuf);
    }

    (*obuf)[i] = ibuf[i + 16] ^ keybuf[i % 16];
  }
  
  (*obuf)[*olen] = 0;

  return 1;
}

static CordRep *CORD_from_fn_inner(CORD_fn fn, void * client_data, size_t len)
{
    if (len == 0) return(0);
    if (len <= SHORT_LIMIT) {
        char * result;
        size_t i;
        char buf[SHORT_LIMIT+1];

        for (i = 0; i < len; i++) {
            char c = (*fn)(i, client_data);

            if (c == '\0') goto gen_case;
            buf[i] = c;
        }

        result = (char *)GC_MALLOC_ATOMIC(len + 1);
        if (result == 0) OUT_OF_MEMORY;
        memcpy(result, buf, len);
        result[len] = '\0';
        return (CordRep *)result;
    }
  gen_case:
    {
        struct Function * result = GC_NEW(struct Function);

        if (NULL == result) OUT_OF_MEMORY;
        result->header = FN_HDR;
        /* depth is already 0 */
        result->len = (word)len;
        result->fn = fn;
        GC_PTR_STORE_AND_DIRTY(&result->client_data, client_data);
        return (CordRep *)result;
    }
}

void *
mono_gc_alloc_obj (MonoVTable *vtable, size_t size)
{
	MonoObject *obj;

	if (!vtable->klass->has_references) {
		obj = GC_MALLOC_ATOMIC (size);

		obj->vtable = vtable;
		obj->synchronisation = NULL;

		memset ((char *) obj + sizeof (MonoObject), 0, size - sizeof (MonoObject));
	} else if (vtable->gc_descr != GC_NO_DESCRIPTOR) {
		obj = GC_GCJ_MALLOC (size, vtable);
	} else {
		obj = GC_MALLOC (size);

		obj->vtable = vtable;
	}

	if (G_UNLIKELY (alloc_events))
		mono_profiler_allocation (obj);

	return obj;
}

char* function_node_toenvstring(FUNCTION_NODE* fnode)
{
	int i, nparam;
	int isbin;
	char* buf, *tmp;
	const char *namestr;

	namestr = function_node_getnamestr(fnode);
	buf = (char*)GC_MALLOC_ATOMIC(sizeof(char*) * 255);
	nparam = fnode->node.parents->count;
    isbin = function_node_isbinary(fnode);
	if( isbin )
	{
		if( nparam > 1 )
		{
			sprintf(buf, "(%s %s %s)", 
				node_toenvstring(fnode->node.parents->items[0]),
				namestr,
				node_toenvstring(fnode->node.parents->items[1])
			);
		}
		else
		{
			sprintf(buf, "%s %s", 
				node_toenvstring(fnode->node.parents->items[0]),
				namestr
			);
		}
	}
	else if( fnode->name == F_MEAN  )
	{
		ARRAY_NODE* array = (ARRAY_NODE*)fnode->node.parents->items[0];
		sprintf(buf, "env_mean(%s, %d)", 
			array_node_toenvstring(array),
			array_node_getsize(array)
		);
		return buf;
	}
	else if( fnode->name == F_ILOGIT  )
	{
		char* tpl = "1.0 / (1.0+exp(-(%s)))";
		char* val = node_toenvstring(fnode->node.parents->items[0]);
		sprintf(buf, tpl, val);
		return buf;
	}
	else
	{
		sprintf(buf, "env_%s(", namestr);
        for( i = 0 ; i < nparam ; i++ )
        {
			tmp = node_toenvstring(fnode->node.parents->items[i]);
            strcat(buf, tmp);
            if( i < nparam-1 )
				strcat(buf, ",");
        }
	}

	return buf;	
}

void* xmalloc_atomic(size_t s) {
    void *ptr = GC_MALLOC_ATOMIC(s);
    if (!ptr) {
        perror("xmalloc_atomic");
        exit(1);
    }
    return ptr;
}

struct treenode * mktree(int i) {
  struct treenode * r = GC_MALLOC(sizeof(struct treenode));
  if (0 == i) return 0;
  if (1 == i) r = GC_MALLOC_ATOMIC(sizeof(struct treenode));
  r -> x = mktree(i-1);
  r -> y = mktree(i-1);
  return r;
}

char* regex_get_error(int errcode, const regex_t *preg){
  size_t len;
  char* buf;
  len = regerror(errcode, preg, NULL, 0);
  buf = GC_MALLOC_ATOMIC(len);
  regerror(errcode, preg, buf, len);
  return buf;
}

value duck_malloc_atomic(size_t n)
{
#ifdef USE_BOEHM
    return GC_MALLOC_ATOMIC(n);
#else
	return malloc(n);
#endif
}