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
}
char* dfsch_strancpy(char* x, size_t n){
char *b;
size_t s = n+1;
b = GC_MALLOC_ATOMIC(s);
strncpy(b,x,s-1);
b[s-1]=0;
return b;
}
// this is unsafe because others could copy the result. Further modifications would have global changes.
// USE WITH CARE. Change strings only locally.
// (cast to "const char *" before passing to another proc or put in data structures.)
// See "str_dup_capitalize" for an example.
//char *str_dup_unsafe( const char *str) {
// permAlloc default: FALSE
char *str_dup_unsafe( const char *str, const bool permAlloc ) { // permAlloc not used
nStrDupUnsafe++;
sStrDupUnsafe += strlen(str)+1;
char* str_new = (char *) GC_MALLOC_ATOMIC( strlen(str) + 1 );
strcpy( str_new, str );
return str_new;
}
EXTERN_INLINE
void *MMAllocateWrapper(size_t size, void *wrapper, gc_teb_t gc_teb)
{
unused(wrapper);
unused(gc_teb);
return GC_MALLOC_ATOMIC(size);
}
pthread_rwlock_t* dfsch_create_finalized_rwlock(){
pthread_rwlock_t* lock = GC_MALLOC_ATOMIC(sizeof(pthread_rwlock_t));
#ifdef DFSCH_THREADS_FINALIZE
GC_REGISTER_FINALIZER(lock, (GC_finalization_proc)rwlock_finalizer,
NULL, NULL, NULL);
#endif
pthread_rwlock_init(lock, NULL);
return lock;
}
pthread_mutex_t* dfsch_create_finalized_mutex(){
pthread_mutex_t* mutex = GC_MALLOC_ATOMIC(sizeof(pthread_mutex_t));
#ifdef DFSCH_THREADS_FINALIZE
GC_REGISTER_FINALIZER_NO_ORDER(mutex, (GC_finalization_proc)mutex_finalizer,
NULL, NULL, NULL);
#endif
pthread_mutex_init(mutex, NULL);
return mutex;
}
/* Allocate some heap data that doesn't contain any pointers */
TrioletPtr
triolet_alloc_nopointers(uint32_t size)
{
TrioletPtr ptr = GC_MALLOC_ATOMIC(size);
#ifdef CHATTY_ALLOC
fprintf(stderr, "Allocating A %p (%d bytes)\n", ptr, (int)size);
#endif
return ptr;
}
/* Arrange to call CALLBACK asynchronously after each GC. The callback
will be invoked from a finalizer, which may be from an async or from
another thread.
As an implementation detail, the way this works is that we allocate a
fresh object and put the callback in the object. We know that this
object should get collected the next time GC is run, so we attach a
finalizer to it to trigger the callback.
Once the callback runs, we re-attach a finalizer to that fresh object
to prepare for the next GC, and the process repeats indefinitely.
We could use the scm_after_gc_hook, but using a finalizer has the
advantage of potentially running in another thread, decreasing pause
time.
Note that libgc currently has a heuristic that adding 500 finalizable
objects will cause GC to collect rather than expand the heap,
drastically reducing performance on workloads that actually need to
expand the heap. Therefore scm_i_register_async_gc_callback is
inappropriate for using on unbounded numbers of callbacks. */
void
scm_i_register_async_gc_callback (void (*callback) (void))
{
void **obj = GC_MALLOC_ATOMIC (sizeof (void*));
obj[0] = (void*)callback;
scm_i_set_finalizer (obj, async_gc_finalizer, NULL);
}
pthread_cond_t* dfsch_create_finalized_cvar(){
pthread_cond_t* cvar = GC_MALLOC_ATOMIC(sizeof(pthread_cond_t));
#ifdef DFSCH_THREADS_FINALIZE
GC_REGISTER_FINALIZER_NO_ORDER(cvar, (GC_finalization_proc)cvar_finalizer,
NULL, NULL, NULL);
#endif
pthread_cond_init(cvar, NULL);
return cvar;
}
char* dfsch_tcl_quote(char* str){
char* ret;
char* out;
ret = out = GC_MALLOC_ATOMIC(strlen(str)*2+3);
(*out++) = '"';
while (*str){
switch (*str){
case '\\':
(*out++) = '\\';
(*out++) = '\\';
str++;
break;
case ' ':
(*out++) = '\\';
(*out++) = ' ';
str++;
break;
case '"':
(*out++) = '\\';
(*out++) = '"';
str++;
break;
case '\t':
(*out++) = '\\';
(*out++) = 't';
str++;
break;
case '\n':
(*out++) = '\\';
(*out++) = 'n';
str++;
break;
case '$':
(*out++) = '\\';
(*out++) = '$';
str++;
break;
case '[':
(*out++) = '\\';
(*out++) = '[';
str++;
break;
case ']':
(*out++) = '\\';
(*out++) = ']';
str++;
break;
default:
(*out++) = (*str++);
}
}
(*out++) = '"';
(*out) = '\0';
return ret;
}
void hash_record_id(char* type, char* id, uint8_t hash[32]){
size_t type_len = strlen(type);
size_t id_len = strlen(id);
char* buf = GC_MALLOC_ATOMIC(type_len + id_len + 1);
memcpy(buf, type, type_len);
memcpy(buf + type_len + 1, id, id_len);
buf[type_len] = 0;
calculate_hmac(recordid_key, buf, type_len + id_len + 1, hash);
}
