CELL make_func(char *name, void *entry, LABEL receiver, int min_args, int max_args)
{
CELL cell = gc_alloc(FUNC);
FUNC* p = GET_FUNC(cell);
p->name = name;
p->func_entry = entry;
p->receiver = receiver;
p->min_args = min_args;
p->max_args = max_args;
return cell;
}
String *gc_alloc_string(int size) {
String *s;
s = (String *) gc_alloc(sizeof (String) + size + 1);
if(DEBUG) printf("gc allocate string @%p\n",s);
s->header.marked = 1;
memset(s->str, 0, size);
s->header.size = size;
s->name = "String";
gc_add_objects(s);
return s;
}
CELL make_db_connection(void* handle)
{
CELL cell = gc_alloc(DB_CONNECTION);
DB_CONNECTION* p = GET_DB_CONNECTION(cell);
p->pad_reloc = V_EMPTY;
p->next_resource = gc_chain_resource(cell);
p->mark = 0;
p->handle = handle;
return cell;
}
CELL make_db_result(void* handle)
{
CELL cell = gc_alloc(DB_RESULT);
DB_RESULT* p = GET_DB_RESULT(cell);
p->pad_reloc = V_EMPTY;
p->next_resource = gc_chain_resource(cell);
p->mark = 0;
p->handle = handle;
return cell;
}
void obj_startup(void)
{
gc_startup();
/* Globals (), #t and #f are allocated on the GC heap
to simplify tracing. Of course, they are protected! */
_obj_nil = gc_alloc();
_obj_nil->type = TYPE_NIL;
gc_protect(_obj_nil);
_obj_true = gc_alloc();
_obj_true->type = TYPE_BOOL;
INT(_obj_true) = 1;
gc_protect(_obj_true);
_obj_false = gc_alloc();
_obj_false->type = TYPE_BOOL;
INT(_obj_false) = 0;
gc_protect(_obj_false);
}
ref_t make_string(char *s, size_t size) {
if (s != NULL)
size = strlen(s);
struct string *obj = gc_alloc(sizeof(struct string) + size);
obj->tag = OBJ_STRING;
if (s != NULL)
strcpy(obj->bytes, s);
else
memset(obj->bytes, 0, size);
return make_ref(obj, LOWTAG_STRING);
}
static node_t *rotate(ptst_t *ptst, node_t *a, int dir1,
int dir2, node_t **pc, qnode_t *pqn[])
{
node_t *b = FOLLOW(a, dir1), *c = FOLLOW(b, dir2);
node_t *bp = gc_alloc(ptst, gc_id), *cp = gc_alloc(ptst, gc_id);
qnode_t c_qn;
LOCK(c, &c_qn);
memcpy(bp, b, sizeof(*b));
memcpy(cp, c, sizeof(*c));
mcs_init(&bp->lock);
mcs_init(&cp->lock);
LOCK(bp, pqn[3]);
LOCK(cp, pqn[2]);
assert(!IS_BLUE(a));
assert(!IS_BLUE(b));
assert(!IS_BLUE(c));
UPDATE(cp, FLIP(dir2), bp);
UPDATE(bp, dir2, FOLLOW(c, FLIP(dir2)));
UPDATE(a, dir1, cp);
b->p = a;
MK_BLUE(b);
c->p = cp;
MK_BLUE(c);
gc_free(ptst, b, gc_id);
gc_free(ptst, c, gc_id);
UNLOCK(a, pqn[0]);
UNLOCK(b, pqn[1]);
UNLOCK(c, &c_qn);
*pc = bp;
return cp;
}
void basic_test(void)
{
arena_sanity(arena);
gc_t gc = saved_gc;
heap_t e = gc_alloc(gc, NULL, 2, 2);
((void **)e)[0] = e;
((void **)e)[1] = e;
gc[0] = e;
arena_sanity(arena);
gc_perform_gc(gc + 1);
arena_sanity(arena);
}
atom_p syntax_lambda(atom_p args, atom_p env) {
if ( !(args->array.len == 2 && args->array.ptr[0]->type == T_ARRAY && args->array.ptr[1]->type == T_ARRAY) )
return error_atom("lambda: needs exactly 2 args, both have to be arrays");
atom_p atom = gc_alloc(sizeof(atom_t));
atom->type = T_LAMBDA;
atom->lambda.args = args->array.ptr[0];
atom->lambda.body = args->array.ptr[1];
atom->lambda.env = env;
return atom;
}
void* gc_realloc(void* ptr, size_t old_size, size_t new_size) {
if (ptr + old_size == (void*)current_new_segment + current_new_segment->filled && current_new_segment->filled - old_size + new_size <= current_new_segment->size) {
// Special case: ptr is the last memory block in the segment and we have to space to extend it, so do it
current_new_segment->filled = current_new_segment->filled - old_size + new_size;
return ptr;
} else {
// In all other cases do a normal alloc
void* new_ptr = gc_alloc(new_size);
memcpy(new_ptr, ptr, old_size);
return new_ptr;
}
}
EXTERN value alloc_function( void *c_prim, unsigned int nargs, const char *name ) {
vfunction *v;
if( c_prim == NULL || ((int)nargs < 0 && nargs != VAR_ARGS) )
failure("alloc_function");
v = (vfunction*)gc_alloc(sizeof(vfunction));
v->t = VAL_PRIMITIVE;
v->addr = c_prim;
v->nargs = nargs;
v->env = alloc_array(0);
v->module = alloc_string(name);
return (value)v;
}
void *gc_realloc(void *ptr, machine_uint_t n_bytes) {
machine_uint_t n_existing = gc_nbytes(ptr);
if (n_bytes <= n_existing) {
return ptr;
} else {
// TODO check if we can grow inplace
void *ptr2 = gc_alloc(n_bytes);
memcpy(ptr2, ptr, n_existing);
gc_free(ptr);
return ptr2;
}
}
value neko_alloc_module_function( void *m, int_val pos, int nargs ) {
vfunction *v;
if( nargs < 0 && nargs != VAR_ARGS )
failure("alloc_module_function");
v = (vfunction*)gc_alloc(sizeof(vfunction));
v->t = VAL_FUNCTION;
v->addr = (void*)pos;
v->nargs = nargs;
v->env = alloc_array(0);
v->module = m;
return (value)v;
}
void test() {
void* frame[2+1];
frame[0] = (void*)frame_list;
frame[1] = (void*)2;
frame_list = (Frame*)frame;
Object* a = pool(gc_alloc(OBJ_BOXED_ARRAY,sizeof(long)*2));
assert(vm->heap_num==1);
gc_collect();
assert(vm->heap_num==1);
frame_list = frame_list->frame_prev;
}
/* create a new list node */
Node node(GarbageCollector gc, Node next, int value) {
if (!gc)
return NULL;
Node n = gc_alloc(gc);
if (!n) /* ran out of objects */
return NULL;
n->next = next;
n->value = value;
return n;
}
/* Save this label and its location in memory for latter
lookup */
void asm_label(gc_type *gc, buffer_type *buf,
hashtable_type *labels, char *str) {
vm_int *addr = 0;
char *key = 0;
gc_register_root(gc, (void**)&key);
gc_register_root(gc, (void**)&addr);
/* defensively copy the label name */
gc_alloc(gc, 0, strlen(str)+1, (void **)&key);
strcpy(key, str);
/* save location */
gc_alloc(gc, 0, sizeof(vm_int), (void **)&addr);
*addr = buffer_size(buf);
hash_set(labels, key, addr);
gc_unregister_root(gc, (void**)&key);
gc_unregister_root(gc, (void**)&addr);
}
struct GridCell *GridCellCreate(struct World *world)
{
struct GridCell *rtn = NULL;
rtn = gc_alloc(world->gc_ctx, sizeof(*rtn));
rtn->world = world;
rtn->image = ResourcesLoadImage(rtn->world->resources, "images/grass.png");
rtn->blockImage = ResourcesLoadImage(rtn->world->resources, "images/block.png");
rtn->cursorImage = ResourcesLoadImage(rtn->world->resources, "images/cursor.png");
rtn->highlightImage = ResourcesLoadImage(rtn->world->resources, "images/highlight.png");
return rtn;
}
void build_hash() {
/* create a hash table */
hash_create(gc,
&hash_string,
&hash_string_cmp,
&hash);
/* push values into the hash */
for(int i=0; i <10; i++) {
/* an ineffcient means of doing this */
gc_alloc(gc, 0, 40, (void **)&key1);
gc_alloc(gc, 0, 40, (void **)&value);
snprintf(key1, 40, "k%i", i);
snprintf(value, 40, "v%i", i);
hash_set(hash, (void*)key1, (void*)value);
}
}
atom_t* compiled_lambda_atom_alloc(bytecode_t bytecode, atom_list_t literal_table, uint16_t arg_count, uint16_t var_count){
atom_t *atom = atom_alloc(T_COMPILED_LAMBDA);
atom->bytecode = bytecode;
atom->literal_table = literal_table;
atom->comp_data = gc_alloc(sizeof(struct compiler_data));
atom->comp_data->arg_count = arg_count;
atom->comp_data->var_count = var_count;
atom->comp_data->names = NULL;
atom->comp_data->max_frame_offset = 0;
return atom;
}
Object* gc_copy(VM* vm, Object* object) {
ObjectHeader* head = &((ObjectHeader*)object)[-1];
debug("gc copy %p\n",head);
long size;
if (!heap_find(vm, head)) return object;
long* bitmap;
Object* obj;
switch(head->type) {
case OBJ_BOXED_ARRAY:
obj = gc_alloc((ObjectType)head->type, head->size);
size = ((int)head->size) / sizeof(long);
debug("size=%ld\n",size);
for(int i = 0; i < size; i++)
obj->field[i] = gc_copy(vm,object->field[i]);
break;
case OBJ_PAIR:
obj = gc_alloc((ObjectType)head->type, head->size);
obj->fst = gc_copy(vm,object->fst);
obj->snd = gc_copy(vm,object->snd);
break;
case OBJ_UNBOXED_ARRAY:
case OBJ_VM:
obj = gc_alloc((ObjectType)head->type, head->size);
memcpy(obj, object, head->size);
break;
case OBJ_RECORD:
size = ((int)head->size) / sizeof(long);
obj = gc_alloc((ObjectType)head->type, head->size);
memcpy(obj, object, head->size);
bitmap = &object->longs[size];
for(int i = 0; i < size; i++) {
if(bitmap[i/sizeof(long)] & (1 << (i % sizeof(long))))
obj->field[i] = gc_copy(vm,object->field[i]);
}
break;
}
return obj;
}
void asm_jump(gc_type *gc, buffer_type *buf,
yyscan_t *scanner, jump_type **jump_list) {
static int init = 0;
static gc_type_def jump_def = 0;
jump_type *jump = 0;
char *label = 0;
/* TODO: This is a hack */
if(!init) {
init = 1;
jump_def = gc_register_type(gc, sizeof(jump_type));
gc_register_pointer(gc, jump_def, offsetof(jump_type, label));
gc_register_pointer(gc, jump_def, offsetof(jump_type, next));
}
gc_register_root(gc, (void **)&jump);
/* allocate a new jump */
gc_alloc_type(gc, 0, jump_def, (void **)&jump);
/* save location of jump addr field */
jump->addr = buffer_size(buf);
/* save the line number for this jump */
jump->lineno = yyget_lineno(scanner);
/* make sure we have a label */
if(yylex(scanner) != LABEL_TOKEN) {
assert(0);
}
/* save a copy of the label */
label = get_text(scanner);
gc_alloc(gc, 0, strlen(label)+1, (void **)&(jump->label));
strcpy(jump->label, label);
/* put this jump at the head of the
list */
jump->next = *jump_list;
*jump_list = jump;
gc_unregister_root(gc, (void **)&jump);
/* Make sure we have space to write target */
EMIT(buf, INT_64(0),8);
}
CELL make_compiled_lambda(int is_macro, int argc, int rest, int max_slot, int depth, CELL body)
{
gc_root_1("make_compiled_lambda", body);
CELL cell = gc_alloc(COMPILED_LAMBDA);
COMPILED_LAMBDA* p = GET_COMPILED_LAMBDA(cell);
p->is_macro = is_macro;
p->argc = argc;
p->rest = rest;
p->max_slot = max_slot;
p->depth = depth;
p->body = body;
gc_unroot();
return cell;
}
scope_p scope_env_alloc(env_t *env){
scope_p scope = gc_alloc(sizeof(scope_t));
*scope = (scope_t){
.next = NULL,
.arg_count = 0,
.type = SCOPE_ENV,
.env = env
};
return scope;
}
//
// Environment stuff
//
env_t* env_alloc(env_t *parent){
env_t *env = gc_alloc(sizeof(env_t));
env->length = 0;
env->parent = parent;
env->bindings = NULL;
return env;
}
void test() {
void* frame[2];
static void* start_ptr = &&end; goto *start_ptr; start:;
printf("frame[1]=%p\n", frame);
assert(heap_num==0);
frame[0] = gc_alloc(OBJ_BOXED_ARRAY,sizeof(long)*2);
assert(heap_num==1);
gc_collect();
assert(heap_num==1);
return;
end:;
static StackMap f = {3, (void*)test,&&end, NULL};
gc_add_stack_map(&f); start_ptr=&&start; goto start;
}
EXTERN value alloc_object( value cpy ) {
vobject *v;
if( cpy != NULL && !val_is_null(cpy) && !val_is_object(cpy) )
val_throw(alloc_string("$new")); // 'new' opcode simulate $new
v = (vobject*)gc_alloc(sizeof(vobject));
v->t = VAL_OBJECT;
if( cpy == NULL || val_is_null(cpy) ) {
v->proto = NULL;
otable_init(&v->table);
} else {
v->proto = ((vobject*)cpy)->proto;
otable_copy(&((vobject*)cpy)->table,&v->table);
}
return (value)v;
}
value neko_alloc_apply( int nargs, value env ) {
vfunction *v = (vfunction*)gc_alloc(sizeof(vfunction));
v->t = VAL_PRIMITIVE;
switch( nargs ) {
case 1: v->addr = apply1; break;
case 2: v->addr = apply2; break;
case 3: v->addr = apply3; break;
case 4: v->addr = apply4; break;
case 5: v->addr = apply5; break;
default: failure("Too many apply arguments"); break;
}
v->nargs = nargs;
v->env = env;
v->module = *apply_string;
return (value)v;
}
obj_ptr obj_format(cptr fmt, ...)
{
obj_ptr res = gc_alloc();
va_list vp;
res->type = TYPE_STRING;
res->data.as_string.buf = 0;
res->data.as_string.len = 0;
res->data.as_string.size = 0;
va_start(vp, fmt);
string_vformat_append(&res->data.as_string, fmt, vp);
va_end(vp);
return res;
}
/* initialize new node */
static node_t *
alloc_node()
{
node_t *n;
/* crappy lcg rng */
unsigned int r = ptst->rand;
ptst->rand = r * 1103515245 + 12345;
r &= (1u << (NUM_LEVELS - 1)) - 1;
/* uniformly distributed bits => geom. dist. level, p = 0.5 */
int level = __builtin_ctz(r) + 1;
assert(1 <= level && level <= 32);
n = gc_alloc(ptst, gc_id[level - 1]);
n->level = level;
n->inserting = 1;
memset(n->next, 0, level * sizeof(node_t *));
return n;
}
static Vector_Handle vm_anewarray_resolved_array_type(Class *arr_clss, int length)
{
#ifdef VM_STATS
UNSAFE_REGION_START
VM_Statistics::get_vm_stats().num_anewarray++;
UNSAFE_REGION_END
#endif
ASSERT_RAISE_AREA;
assert(!hythread_is_suspend_enabled());
assert(!arr_clss->is_array_of_primitives());
unsigned sz = arr_clss->calculate_array_size(length);
if (sz == 0) {
tmn_suspend_enable();
if (length < 0) {
exn_raise_by_name("java/lang/NegativeArraySizeException");
} else {
exn_raise_by_name("java/lang/OutOfMemoryError",
"VM doesn't support arrays of the requested size");
}
tmn_suspend_disable();
return NULL;
}
assert((sz & NEXT_TO_HIGH_BIT_SET_MASK) == 0);
Vector_Handle object_array = (Vector_Handle )gc_alloc(sz,
arr_clss->get_allocation_handle(), vm_get_gc_thread_local());
#ifdef VM_STATS
arr_clss->instance_allocated(sz);
#endif //VM_STATS
if (NULL == object_array) {
exn_raise_object(
VM_Global_State::loader_env->java_lang_OutOfMemoryError);
return NULL;
}
set_vector_length(object_array, length);
assert(get_vector_vtable(object_array) == arr_clss->get_vtable());
return object_array;
} //vm_anewarray_resolved_array_type
setval_t set_update(set_t *s, setkey_t k, setval_t v, int overwrite)
{
node_t *f, *w;
qnode_t f_qn, w_qn;
int dir;
setval_t ov = NULL;
ptst_t *ptst;
k = CALLER_TO_INTERNAL_KEY(k);
ptst = critical_enter();
retry:
f = find(&s->root, k, &f_qn, &dir);
if ( (w = FOLLOW(f, dir)) != NULL )
{
/* Protected by parent lock. */
assert(!IS_BLUE(w));
ov = w->v;
if ( overwrite || (ov == NULL) ) w->v = v;
}
else
{
w = gc_alloc(ptst, gc_id);
w->l = NULL;
w->r = NULL;
w->v = v;
w->k = k;
mcs_init(&w->lock);
UPDATE(f, dir, w);
}
UNLOCK(f, &f_qn);
critical_exit(ptst);
return ov;
}
