EXTERN value val_callEx( value vthis, value f, value *args, int nargs, value *exc ) {
neko_vm *vm = NEKO_VM();
value old_this = vm->vthis;
value old_env = vm->env;
value ret = val_null;
jmp_buf oldjmp;
if( vthis != NULL )
vm->vthis = vthis;
if( exc ) {
memcpy(&oldjmp,&vm->start,sizeof(jmp_buf));
if( setjmp(vm->start) ) {
*exc = vm->vthis;
neko_process_trap(vm);
vm->vthis = old_this;
vm->env = old_env;
memcpy(&vm->start,&oldjmp,sizeof(jmp_buf));
return val_null;
}
neko_setup_trap(vm);
}
if( (uintptr_t)&vm < (uintptr_t)vm->c_stack_max )
val_throw(alloc_string("C Stack Overflow"));
if( val_is_int(f) )
val_throw(alloc_string("Invalid call"));
if( val_tag(f) == VAL_PRIMITIVE ) {
vm->env = ((vfunction *)f)->env;
if( nargs == ((vfunction*)f)->nargs ) {
if( nargs > CALL_MAX_ARGS )
failure("Too many arguments for a call");
switch( nargs ) {
case 0:
ret = ((c_prim0)((vfunction*)f)->addr)();
break;
case 1:
ret = ((c_prim1)((vfunction*)f)->addr)(args[0]);
break;
case 2:
ret = ((c_prim2)((vfunction*)f)->addr)(args[0],args[1]);
break;
case 3:
ret = ((c_prim3)((vfunction*)f)->addr)(args[0],args[1],args[2]);
break;
case 4:
ret = ((c_prim4)((vfunction*)f)->addr)(args[0],args[1],args[2],args[3]);
break;
case 5:
ret = ((c_prim5)((vfunction*)f)->addr)(args[0],args[1],args[2],args[3],args[4]);
break;
}
} else if( ((vfunction*)f)->nargs == -1 )
ret = (value)((c_primN)((vfunction*)f)->addr)(args,nargs);
else
val_throw(alloc_string("Invalid call"));
if( ret == NULL )
val_throw( (value)((vfunction*)f)->module );
} else if( val_short_tag(f) == VAL_FUNCTION ) {
if( nargs == ((vfunction*)f)->nargs ) {
int n;
if( vm->csp + 4 >= vm->sp - nargs && !neko_stack_expand(vm->sp,vm->csp,vm) ) {
if( exc ) {
neko_process_trap(vm);
memcpy(&vm->start,&oldjmp,sizeof(jmp_buf));
}
failure("Stack Overflow");
} else {
for(n=0;n<nargs;n++)
*--vm->sp = (int_val)args[n];
vm->env = ((vfunction*)f)->env;
if( val_tag(f) == VAL_FUNCTION ) {
*++vm->csp = (int_val)callback_return;
*++vm->csp = 0;
*++vm->csp = 0;
*++vm->csp = 0;
ret = neko_interp(vm,((vfunction*)f)->module,(int_val)val_null,(int_val*)((vfunction*)f)->addr);
} else {
neko_module *m = (neko_module*)((vfunction*)f)->module;
ret = ((jit_prim)jit_boot_seq)(vm,((vfunction*)f)->addr,val_null,m);
}
}
}
else
val_throw(alloc_string("Invalid call"));
} else
val_throw(alloc_string("Invalid call"));
if( exc ) {
neko_process_trap(vm);
memcpy(&vm->start,&oldjmp,sizeof(jmp_buf));
}
vm->vthis = old_this;
vm->env = old_env;
return ret;
}
/**
$istrue : v:any -> bool
<doc>Return true if [v] is not [false], not [null] and not 0</doc>
**/
static value builtin_istrue( value f ) {
return alloc_bool(f != val_false && f != val_null && f != alloc_int(0) && (val_is_int(f) || val_tag(f) != VAL_INT32 || val_int32(f) != 0));
}
/**
$not : any -> bool
<doc>Return true if [v] is [false] or [null] or [0]</doc>
**/
static value builtin_not( value f ) {
return alloc_bool(f == val_false || f == val_null || f == alloc_int(0) || (!val_is_int(f) && val_tag(f) == VAL_INT32 && val_int32(f) == 0));
}
void serialize_rec( sbuffer *b, value o ) {
b->nrec++;
if( b->nrec > 350 )
failure("Serialization stack overflow");
switch( val_type(o) ) {
case VAL_NULL:
write_char(b,'N');
break;
case VAL_BOOL:
if( val_bool(o) )
write_char(b,'T');
else
write_char(b,'F');
break;
case VAL_INT:
write_char(b,'i');
write_int(b,val_int(o));
break;
case VAL_FLOAT:
write_char(b,'f');
write_str(b,sizeof(tfloat),&val_float(o));
break;
case VAL_STRING:
if( !write_ref(b,o,NULL) ) {
write_char(b,'s');
write_int(b,val_strlen(o));
write_str(b,val_strlen(o),val_string(o));
}
break;
case VAL_OBJECT:
{
value s;
if( !write_ref(b,o,&s) ) {
if( s != NULL ) {
// reference was not written
if( !val_is_function(s) || (val_fun_nargs(s) != 0 && val_fun_nargs(s) != VAR_ARGS) )
failure("Invalid __serialize method");
write_char(b,'x');
serialize_rec(b,((neko_module*)((vfunction*)s)->module)->name);
serialize_rec(b,val_ocall0(o,id_serialize));
// put reference back
write_ref(b,o,NULL);
break;
}
write_char(b,'o');
val_iter_fields(o,serialize_fields_rec,b);
write_int(b,0);
o = (value)((vobject*)o)->proto;
if( o == NULL )
write_char(b,'z');
else {
write_char(b,'p');
serialize_rec(b,o);
}
}
}
break;
case VAL_ARRAY:
if( !write_ref(b,o,NULL) ) {
int i;
int n = val_array_size(o);
write_char(b,'a');
write_int(b,n);
for(i=0;i<n;i++)
serialize_rec(b,val_array_ptr(o)[i]);
}
break;
case VAL_FUNCTION:
if( !write_ref(b,o,NULL) ) {
neko_module *m;
if( val_tag(o) == VAL_PRIMITIVE ) {
// assume that alloc_array(0) return a constant array ptr
// we don't want to access custom memory (maybe not a ptr)
if( ((vfunction*)o)->env != alloc_array(0) )
failure("Cannot Serialize Primitive with environment");
write_char(b,'p');
write_int(b,((vfunction*)o)->nargs);
serialize_rec(b,((vfunction*)o)->module);
break;
}
if( val_tag(o) == VAL_JITFUN )
failure("Cannot Serialize JIT method");
write_char(b,'L');
m = (neko_module*)((vfunction*)o)->module;
serialize_rec(b,m->name);
write_int(b,(int)((int_val*)((vfunction*)o)->addr - m->code));
write_int(b,((vfunction*)o)->nargs);
serialize_rec(b,((vfunction*)o)->env);
}
break;
case VAL_INT32:
write_char(b,'I');
write_int(b,val_int32(o));
break;
case VAL_ABSTRACT:
if( val_is_kind(o,k_hash) ) {
int i;
vhash *h = val_hdata(o);
write_char(b,'h');
write_int(b,h->ncells);
write_int(b,h->nitems);
for(i=0;i<h->ncells;i++) {
hcell *c = h->cells[i];
while( c != NULL ) {
write_int(b,c->hkey);
serialize_rec(b,c->key);
serialize_rec(b,c->val);
c = c->next;
}
}
break;
}
default:
failure("Cannot Serialize Abstract");
break;
}
b->nrec--;
}