void*
mono_gc_alloc_fixed (size_t size, void *descr)
{
/* To help track down typed allocation bugs */
/*
static int count;
count ++;
if (count == atoi (getenv ("COUNT2")))
printf ("HIT!\n");
if (count > atoi (getenv ("COUNT2")))
return GC_MALLOC (size);
*/
if (descr)
return GC_MALLOC_EXPLICITLY_TYPED (size, (GC_descr)descr);
else
return GC_MALLOC (size);
}
st_func_t* st_func_from_func(const char* name, st_eval_func func,
st_func_homogeneity_t homogeneity,
st_func_constancy_t constancy,
int num_comp)
{
ASSERT(func != NULL);
ASSERT(num_comp > 0);
st_func_t* f = GC_MALLOC(sizeof(st_func_t));
f->name = string_dup(name);
f->context = NULL;
f->vtable.eval = func;
f->homogeneous = (homogeneity == ST_FUNC_HOMOGENEOUS);
f->constant = (constancy == ST_FUNC_CONSTANT);
f->num_comp = num_comp;
memset(f->derivs, 0, sizeof(st_func_t*)*4);
GC_register_finalizer(f, &st_func_free, f, NULL, NULL);
return f;
}
void list_add(list_p list, void* data, int size){
lnode_p node = (lnode_p)GC_MALLOC(sizeof(struct linked_node));
node->data = data;
if(list->first==NULL){
node->prev = NULL;
node->next = NULL;
list->first = node;
list->last = node;
}
else{
list->last->next = node;
node->prev = list->last;
node->next = NULL;
list->last = node;
}
list->length++;
}
// greebo: Checks for a named process, modeled loosely after
// http://developer.apple.com/library/mac/#qa/qa2001/qa1123.html
bool FindProcessByName(const char* processName)
{
int name[4] = { CTL_KERN, KERN_PROC, KERN_PROC_ALL, 0 };
size_t length = 0;
// Call sysctl with a NULL buffer.
int err = sysctl(name, 4, NULL, &length, NULL, 0);
if (err == -1)
{
TraceLog::WriteLine(LOG_ERROR, "Failed to receive buffer size for process list.");
return false;
}
GC_INIT();
kinfo_proc* procList = static_cast<kinfo_proc*>(GC_MALLOC(length));
if (procList == NULL)
{
TraceLog::WriteLine(LOG_ERROR, "Out of Memory trying to allocate process buffer");
return false;
}
// Load process info
sysctl(name, 4, procList, &length, NULL, 0);
size_t procCount = length / sizeof(kinfo_proc);
bool result = false;
for (size_t i = 0; i < procCount; ++i)
{
//TraceLog::WriteLine(LOG_STANDARD, procList[i].kp_proc.p_comm);
if (strcmp(procList[i].kp_proc.p_comm, processName) == 0)
{
result = true;
break;
}
}
GC_FREE(procList);
return result;
}
st_func_t* st_func_from_sp_func(sp_func_t* func)
{
ASSERT(func != NULL);
st_func_t* f = GC_MALLOC(sizeof(st_func_t));
f->name = string_dup(sp_func_name(func));
f->context = func;
f->vtable.eval = eval_sp_func;
f->homogeneous = sp_func_is_homogeneous(func);
f->constant = true;
f->num_comp = sp_func_num_comp(func);
memset(f->derivs, 0, sizeof(st_func_t*)*4);
for (int i = 1; i <= 4; ++i)
{
if (sp_func_has_deriv(func, i))
st_func_register_deriv(f, i, sp_func_deriv_new(func, i));
}
GC_register_finalizer(f, &st_func_free, f, NULL, NULL);
return f;
}
// 文字列を Character レコードの配列に変換する。
// 個々の Character の x 座標は 0 に設定される。
Character *StringToCharacters(const char *text, size_t length, size_t *nchars_return)
{
const char *p;
// 上限値で確保する。
Character *ret = GC_MALLOC(sizeof(Character) * (length + 1));
Character *q = ret;
printf("StringToCharacters... %d bytes\n", (int) length);
for (p = text; p < text + length; p = Utf8AdvanceChar(p)) {
CharacterInitialize(q++, 0, p, Utf8CharBytes(p));
}
*q++ = EOF_CHARACTER;
*nchars_return = q - ret;
// 無駄な部分を解放する。
ret = GC_REALLOC(ret, sizeof(Character) * (q - ret));
puts("Done");
return ret;
}
void test_enumerator_can_filter(void) {
cc_enumerator *e = cc_enumerator_new(cc_enumerable_new(one_to_ten));
e->data = GC_MALLOC(sizeof(int));
*((int *)e->data) = 0;
cc_enumerator *odd_numbers = cc_enumerator_filter(e, odd_filter);
TEST_ASSERT_EQUAL(cc_enumerator_move_next(odd_numbers), true);
TEST_ASSERT_EQUAL(cc_object_int_value(cc_enumerator_current(odd_numbers)), 1);
TEST_ASSERT_EQUAL(cc_enumerator_move_next(odd_numbers), true);
TEST_ASSERT_EQUAL(cc_object_int_value(cc_enumerator_current(odd_numbers)), 3);
TEST_ASSERT_EQUAL(cc_enumerator_move_next(odd_numbers), true);
TEST_ASSERT_EQUAL(cc_object_int_value(cc_enumerator_current(odd_numbers)), 5);
TEST_ASSERT_EQUAL(cc_enumerator_move_next(odd_numbers), true);
TEST_ASSERT_EQUAL(cc_object_int_value(cc_enumerator_current(odd_numbers)), 7);
TEST_ASSERT_EQUAL(cc_enumerator_move_next(odd_numbers), true);
TEST_ASSERT_EQUAL(cc_object_int_value(cc_enumerator_current(odd_numbers)), 9);
TEST_ASSERT_EQUAL(cc_enumerator_move_next(odd_numbers), false);
}
Token *CharactersToTokens(Character text[], size_t nchars, size_t *ntokens_return)
{
assert(text != NULL);
puts("CharactersToTokens...");
// nchars がトークン数の上限である。
Token *res = GC_MALLOC(sizeof(Token) * nchars);
size_t ntokens = 0;
Character *p = text;
while (p < text + nchars) {
p = Tokenize(p, &res[ntokens++]);
}
puts("Done");
res = GC_REALLOC(res, sizeof(Token) * ntokens);
*ntokens_return = ntokens;
return res;
}
static void build_args(dfsch_object_t* list, int* pargc, char*** pargv){
int alloc = 16;
char** argv = GC_MALLOC(sizeof(char*) * alloc);
int argc = 0;
while (DFSCH_PAIR_P(list)){
if (alloc <= argc){
alloc *= 2;
argv = GC_REALLOC(argv, sizeof(char*) * alloc);
}
argv[argc] = convert_arg(DFSCH_FAST_CAR(list));
argc++;
list = DFSCH_FAST_CDR(list);
}
*pargc = argc;
*pargv = argv;
}
OBJECT_PTR app_cont_fn_recur(reg_closure_t *cls, OBJECT_PTR val)
{
OBJECT_PTR exp = cls->closed_vals[0];
unsigned int nof_vals = cls->nof_closed_vals - 1;
OBJECT_PTR *new_vals = (OBJECT_PTR *)GC_MALLOC((nof_vals + 1) * sizeof(OBJECT_PTR));
int i;
for(i=0; i<nof_vals; i++)
new_vals[i] = cls->closed_vals[i+1];
new_vals[nof_vals] = val;
metacont_closure_t *mcls = mcps(first(exp));
return mcls->mfn(mcls,
create_reg_app_closure(cdr(exp), nof_vals+1, new_vals, (reg_closure_t *)cls->data));
}
void nodelist_add(NODELIST* pnodelist, NODE* pnode)
{
NODE** pnewitems;
NODE** polditems = pnodelist->items;
int count = pnodelist->count + 1;
pnewitems = (NODE**)GC_MALLOC(sizeof(NODE*) * count);
if( polditems != NULL )
{
memcpy(pnewitems, polditems, sizeof(NODE*) * (count-1));
GC_FREE(polditems);
polditems = NULL;
}
pnewitems[count-1] = pnode;
pnode->refcount++;
pnodelist->items = pnewitems;
pnodelist->count = count;
}
ussval_t* string_slice(ussval_t* s, ussval_t* c, ussval_t* str) {
int32_t string_start = s->num;
int32_t string_count = c->num;
size_t string_length = strlen(str->str);
if (string_start > string_length) {
return ussval_new_err("string substring start %i is > string length %i", string_start, string_length);
} else if (string_count <= 0) {
return ussval_new_err("string substring %i is <= 0", string_count);
} else if (string_count > string_length) {
return ussval_new_err("string substring is out of bounds %i > %i", string_count, string_length);
}
char* new_str = GC_MALLOC((size_t) string_count);
memcpy(new_str, str->str+string_start, (size_t) string_count);
new_str[string_count] = '\0';
return ussval_new_str(new_str);
}
Cell*
new_cell(const char *src) {
Cell *c;
int alen, len;
if (NULL == src) return new_cell("");
c = (Cell*)GC_MALLOC(sizeof(Cell));
ALLOC_SAFE(c);
len = strlen(src)+1;
alen = cell_get_alloc_size(CELL_INIT_ALLOC, len);
c->length = len-1;
c->allocsize = alen;
c->data = (char*) GC_MALLOC_ATOMIC(alen);
ALLOC_SAFE(c->data);
strncpy(c->data, src, len);
return c;
}
void* sysArrayAlloca(int64_t length, int8_t width, void *inital) {
if (length < 0) {
wprintf(L"Error in allocating array with length < 0 !\n");
exit(1);
}
int64_t dataSize = (length + 1) * width;
int64_t allocaSize = sizeof(int64_t) + sizeof(int8_t) + dataSize;
void *object = GC_MALLOC(allocaSize);
*((int64_t*) object) = length;
*((int8_t*) (object + sizeof(int64_t))) = width;
if (inital != NULL ) {
memset(object + allocaSize - width, 0, width);
memcpy(object + sizeof(int64_t) + sizeof(int8_t), inital,
length * width);
} else if (length > 0) {
memset(object + sizeof(int64_t) + sizeof(int8_t), 0, dataSize);
}
return object;
}
OBJECT_PTR primop_cont_fn_recur(reg_closure_t *cls, OBJECT_PTR val)
{
OBJECT_PTR operator = cls->closed_vals[0];
OBJECT_PTR operands = cls->closed_vals[1];
unsigned int nof_vals = cls->nof_closed_vals - 2;
OBJECT_PTR *new_vals = (OBJECT_PTR *)GC_MALLOC((nof_vals + 1) * sizeof(OBJECT_PTR));
int i;
for(i=0; i<nof_vals; i++)
new_vals[i] = cls->closed_vals[i+2];
new_vals[nof_vals] = val;
metacont_closure_t *mcls = mcps(first(operands));
return mcls->mfn(mcls,
create_reg_primop_closure(operator, cdr(operands), nof_vals+1, new_vals, (reg_closure_t *)cls->data));
}
bool _for_all(
prop const property,
size_t const arglen,
gen const gs[],
print const ps[],
size_t const max_size
) {
size_t i, j;
blob values;
// Because GC_MALLOC will segfault if GC_INIT() is not called beforehand.
if (!QC_INITIALIZED) {
printf("*** Error: Run qc_init() before calling for_all().\n");
return false;
}
values = GC_MALLOC(arglen * max_size);
for (i = 0; i < 100; i++) {
for (j = 0; j < arglen; j++) {
gs[j](values + j * max_size);
}
bool holds = property(values);
if (!holds) {
printf("*** Failed!\n");
for (j = 0; j < arglen; j++) {
ps[j](values + j * max_size);
printf("\n");
}
return false;
}
}
printf("+++ OK, passed 100 tests.\n");
return true;
}
OBJECT_PTR let_cont_fn_recur(reg_closure_t *cls, OBJECT_PTR val)
{
OBJECT_PTR bindings = cls->closed_vals[0];
OBJECT_PTR full_bindings = cls->closed_vals[1];
OBJECT_PTR body = cls->closed_vals[2];
unsigned int nof_vals = cls->nof_closed_vals - 3;
OBJECT_PTR *new_vals = (OBJECT_PTR *)GC_MALLOC((nof_vals + 1) * sizeof(OBJECT_PTR));
int i;
for(i=0; i<nof_vals; i++)
new_vals[i] = cls->closed_vals[i+3];
new_vals[nof_vals] = val;
metacont_closure_t *mcls = mcps(second(first(bindings)));
return mcls->mfn(mcls,
create_reg_let_closure(cdr(bindings), full_bindings, body, nof_vals+1, new_vals, (reg_closure_t *)cls->data));
}
// get a new instance
sarl_ksubset_t* sarl_ksubset_new (sarl_unsigned_int n, sarl_unsigned_int k) {
sarl_unsigned_int i;
// alloc memory
sarl_ksubset_t* s =
(sarl_ksubset_t *) GC_MALLOC(sizeof(sarl_ksubset_t));
// generate array
s->c = sarl_int_array_new(k+2);
// TODO: k+1 is enough, k+2 just for convenience: 1..k,k+1 instead 1..k-1,k
// initialise array
for (i=1; i<=k; i++) {
sarl_int_array_set(s->c, i, i-1);
}
sarl_int_array_set(s->c, k+1, n);
// initialise k and n
s->k = k;
s->n = n;
return s;
}
Token *ExtractTokens(Document *doc, size_t *ntokens_return)
{
size_t ntokens = 0;
for (int i = 0; i < doc->nlines; i++) {
ntokens += doc->lines[i].ntokens;
}
Token *tokens = GC_MALLOC(sizeof(Token) * ntokens);
int k = 0;
for (int i = 0; i < doc->nlines; i++) {
for (int j = 0; j < doc->lines[i].ntokens; j++) {
tokens[k] = doc->lines[i].tokens[j];
k++;
}
}
assert(k == ntokens);
*ntokens_return = ntokens;
return tokens;
}
static Array*
array_realloc(Array* array) {
Toy_Type *orig_array, *new_array;
int alloc_size;
int i;
alloc_size = array->alloc_size * 2;
orig_array = array->array;
new_array = GC_MALLOC(sizeof(Toy_Type) * alloc_size);
ALLOC_SAFE(new_array);
memset(new_array, 0, sizeof(Toy_Type) * alloc_size);
for (i=0; i<array->cur_size; i++) {
new_array[i] = orig_array[i];
}
array->alloc_size = alloc_size;
array->array = new_array;
return array;
}
/*
------------------------------------------------------------------------------
This takes a dllink inp, adds a dllink before it, and places a
pointer to the added dllink in outp
------------------------------------------------------------------------------
*/
void l_add(dllink *inp, /* the next crossing in this string */
word crossings, /* the new crossing number */
dllink **outp) /* out: pointer to the new crossing */
{
dllink *newlink;
newlink = (dllink *)GC_MALLOC(sizeof(dllink));
newlink->c = crossings;
if (inp == 0)
{
newlink->a = newlink;
newlink->z = newlink;
inp = newlink;
}
else
{
newlink->a = inp->a;
newlink->z = inp;
inp->a->z = newlink;
inp->a = newlink;
}
*outp = inp->a;
}
/* Allocate an objects with array data inline */
struct PlofObject *newPlofObjectWithArray(size_t length)
{
struct PlofObject *obj;
struct PlofArrayData *ad;
size_t sz;
/* allocate them */
sz = sizeof(struct PlofObject) +
sizeof(struct PlofArrayData) +
length * sizeof(struct PlofObject *);
obj = (struct PlofObject *) GC_MALLOC(sz);
ad = (struct PlofArrayData *) (obj + 1);
/* set up the object */
obj->data = (struct PlofData *) ad;
/* set up the array */
ad->type = PLOF_DATA_ARRAY;
ad->length = length;
ad->data = (struct PlofObject **) (ad + 1);
return obj;
}
static void
g_hash_table_resize (MonoGHashTable *hash_table)
{
MonoGHashNode **new_nodes;
MonoGHashNode *node;
MonoGHashNode *next;
guint hash_val;
gint new_size;
gint i;
new_size = g_spaced_primes_closest (hash_table->nnodes);
new_size = CLAMP (new_size, HASH_TABLE_MIN_SIZE, HASH_TABLE_MAX_SIZE);
#if HAVE_BOEHM_GC
new_nodes = GC_MALLOC (sizeof (MonoGHashNode*) * new_size);
#else
new_nodes = g_new0 (MonoGHashNode*, new_size);
#endif
for (i = 0; i < hash_table->size; i++)
for (node = hash_table->nodes[i]; node; node = next)
{
next = node->next;
hash_val = (* hash_table->hash_func) (node->key) % new_size;
node->next = new_nodes[hash_val];
new_nodes[hash_val] = node;
}
#if HAVE_BOEHM_GC
#else
g_free (hash_table->nodes);
#endif
hash_table->nodes = new_nodes;
hash_table->size = new_size;
}
GC *create_conservative_gc(pointer_iterator rm,
void *roots,
unsigned int root_size,
unsigned int allocations_per_collection) {
GC_INIT();
/* We need to tell the collector about the root set because it was
not allocated by the garbage collector. */
GC_add_roots(roots, ((char *)roots)+root_size);
/* Inform the collector that we will be registering additional threads. */
GC_allow_register_threads();
GC *g = (GC *) GC_MALLOC(sizeof(GC));
if(g == NULL) return NULL;
g->protect_ptr_count = 0;
g->thread_start = conservative_thread_start;
g->thread_end = conservative_thread_end;
g->enable_gc = conservative_enable_gc;
g->disable_gc = conservative_disable_gc;
g->free_gc = conservative_free_gc;
g->gc_allocate = conservative_allocate;
g->collect_garbage = conservative_collect_garbage;
g->set_gc_default_value = conservative_set_gc_default_value;
g->set_gc_post_collection_callback = conservative_set_gc_post_collection_callback;
g->set_gc_mode = conservative_set_gc_mode;
g->set_gc_work_per_alloc = conservative_set_gc_work_per_alloc;
g->store = conservative_store;
g->protect_ptr = conservative_protect_ptr;
g->unprotect_ptr = conservative_unprotect_ptr;
return g;
}
hashtable_entry_t *hashtable_entries(hashtable_t *tab)
{
hashtable_entry_t **replica = (hashtable_entry_t **)GC_MALLOC(tab->hash_size * sizeof(hashtable_entry_t *));
int i;
for(i=0; i<tab->hash_size; i++)
{
if(tab->entries[i] != NULL)
replica[i] = clone_entries(tab->entries[i]);
else
replica[i] = NULL;
}
hashtable_entry_t *prev = NULL, *t, *ret = NULL;
for(i=0; i< tab->hash_size; i++)
{
if(replica[i])
{
if(!ret)
ret = replica[i];
if(prev)
prev->next = replica[i];
t = replica[i];
while(t->next)
t = t->next;
prev = t;
}
}
return ret;
}
static void trim_slist(SList* sl) {
int i, j;
List* ll;
void** newbuf;
int newminval;
// Find the first bin that isn't empty
for (i = 0; i <= sl->maxval - sl->minval; i++) {
ll = (List*) sl->buf[i];
if (ll != 0 && ll->n > 0) {
break;
}
}
if (i == 0) {
return;
}
newbuf = GC_MALLOC(sizeof(void*) * (sl->maxval - sl->minval + 1 - i));
newminval = sl->minval + i;
for (j = i; j <= sl->maxval - sl->minval; j++) {
newbuf[j-i] = sl->buf[j];
}
sl->buf = newbuf;
sl->minval = newminval;
} // trim_slist()
hashtable_entry_t *hashtable_put(hashtable_t *hashtab, void *ptr, void *value)
{
hashtable_entry_t *np;
unsigned hashval;
if((np = hashtable_get(hashtab, ptr)) == NULL)
{
np = (hashtable_entry_t *) GC_MALLOC(sizeof(*np));
if(np == NULL)
return NULL;
hashval = hash(ptr, hashtab->hash_size);
np->next = hashtab->entries[hashval];
np->ptr = ptr;
np->value = value;
hashtab->entries[hashval] = np;
hashtab->count++;
}
hashtab->an_element = np;
return np;
}
// returns a c string representation for the given LValue
// (be sure to free the string when you're done)
char *l_str(LValue *value) {
char *str;
stringbuf *str2;
switch(value->type) {
case L_NUM_TYPE:
str = mpz_get_str(NULL, 10, value->core.num);
break;
case L_STR_TYPE:
str = GC_MALLOC(sizeof(char) * (value->core.str->length + 1));
strcpy(str, value->core.str->str);
break;
case L_LIST_TYPE:
str2 = make_stringbuf("[");
char *s;
int i, len = value->core.list->length;
for(i=0; i<len; i++) {
s = l_str(l_list_get(value, i));
concat_stringbuf(str2, s);
if(i<len-1) buffer_concat(str2, " ");
}
buffer_concat(str2, "]");
str = GC_MALLOC(sizeof(char) * (str2->length + 1));
strcpy(str, str2->str);
destroy_buffer(str2);
break;
case L_TRUE_TYPE:
str = GC_MALLOC(sizeof(char) * 5);
strcpy(str, "true");
break;
case L_FALSE_TYPE:
str = GC_MALLOC(sizeof(char) * 6);
strcpy(str, "false");
break;
case L_NIL_TYPE:
str = GC_MALLOC(sizeof(char) * 4);
strcpy(str, "nil");
break;
default:
str = GC_MALLOC(sizeof(char) * 1);
strcpy(str, "");
}
return str;
}
void* gcAllocate(jint size) {
return GC_MALLOC(size);
}
static value* valueCreate (valueKind kind, value init) {
value* v = GC_MALLOC(sizeof(value));
*v = init;
v->kind = kind;
return v;
}
