static value loader_loadprim( value prim, value nargs ) {
value o = val_this();
value libs;
val_check(o,object);
val_check(prim,string);
val_check(nargs,int);
libs = val_field(o,id_loader_libs);
val_check_kind(libs,k_loader_libs);
if( val_int(nargs) >= 10 || val_int(nargs) < -1 )
neko_error();
{
neko_vm *vm = NEKO_VM();
void *ptr = load_primitive(val_string(prim),val_int(nargs),val_field(o,id_path),(liblist**)(void*)&val_data(libs));
vfunction *f;
if( ptr == NULL ) {
buffer b = alloc_buffer("Primitive not found : ");
val_buffer(b,prim);
buffer_append(b,"(");
val_buffer(b,nargs);
buffer_append(b,")");
bfailure(b);
}
f = (vfunction*)alloc_function(ptr,val_int(nargs),val_string(copy_string(val_string(prim),val_strlen(prim))));
if( vm->pstats && val_int(nargs) <= 6 ) {
value env = alloc_array(2);
val_array_ptr(env)[0] = f->module;
val_array_ptr(env)[1] = (value)(((int_val)f->addr) | 1);
f->addr = stats_proxy;
f->env = env;
}
return (value)f;
}
}
static value apply1( value p1 ) {
value env = NEKO_VM()->env;
value *a = val_array_ptr(env) + 1;
int n = val_array_size(env) - 1;
a[n-1] = p1;
return val_callN(a[-1],a,n);
}
static value varargs_callback( value *args, int nargs ) {
value f = NEKO_VM()->env;
value a = alloc_array(nargs);
int i;
for(i=0;i<nargs;i++)
val_array_ptr(a)[i] = args[i];
return val_call1(f,a);
}
static value apply3( value p1, value p2, value p3 ) {
value env = NEKO_VM()->env;
value *a = val_array_ptr(env) + 1;
int n = val_array_size(env) - 1;
a[n-3] = p1;
a[n-2] = p2;
a[n-1] = p3;
return val_callN(a[-1],a,n);
}
static value stats_proxy( value p1, value p2, value p3, value p4, value p5, value p6 ) {
neko_vm *vm = NEKO_VM();
value env = vm->env;
value ret;
if( vm->pstats ) vm->pstats(vm,val_string(val_array_ptr(env)[0]),1);
ret = ((stats_callback)((int_val)val_array_ptr(vm->env)[1]&~1))(p1,p2,p3,p4,p5,p6);
if( vm->pstats ) vm->pstats(vm,val_string(val_array_ptr(env)[0]),0);
return ret;
}
/**
$setresolver : function:2? -> void
<doc>Set a function to callback with object and field id when an object field is not found.</doc>
**/
static value builtin_setresolver( value f ) {
neko_vm *vm = NEKO_VM();
if( val_is_null(f) )
vm->resolver = NULL;
else {
val_check_function(f,2);
vm->resolver = f;
}
return val_null;
}
/**
$call : f:function -> this:any -> args:array -> any
<doc>Call [f] with [this] context and [args] arguments</doc>
**/
static value builtin_call( value f, value ctx, value args ) {
value old;
value ret;
neko_vm *vm;
val_check(args,array);
vm = NEKO_VM();
old = vm->vthis;
vm->vthis = ctx;
ret = val_callN(f,val_array_ptr(args),val_array_size(args));
vm->vthis = old;
return ret;
}
static value loader_loadmodule( value mname, value vthis ) {
value o = val_this();
value cache;
val_check(o,object);
val_check(mname,string);
val_check(vthis,object);
cache = val_field(o,id_cache);
val_check(cache,object);
{
reader r;
readp p;
neko_module *m;
neko_vm *vm = NEKO_VM();
field mid = val_id(val_string(mname));
value mv = val_field(cache,mid);
if( val_is_kind(mv,neko_kind_module) ) {
m = (neko_module*)val_data(mv);
return m->exports;
}
open_module(val_field(o,id_path),val_string(mname),&r,&p);
if( vm->fstats ) vm->fstats(vm,"neko_read_module",1);
m = neko_read_module(r,p,vthis);
if( vm->fstats ) vm->fstats(vm,"neko_read_module",0);
close_module(p);
if( m == NULL ) {
buffer b = alloc_buffer("Invalid module : ");
val_buffer(b,mname);
bfailure(b);
}
m->name = alloc_string(val_string(mname));
mv = alloc_abstract(neko_kind_module,m);
alloc_field(cache,mid,mv);
if( vm->fstats ) vm->fstats(vm,val_string(mname),1);
neko_vm_execute(neko_vm_current(),m);
if( vm->fstats ) vm->fstats(vm,val_string(mname),0);
return m->exports;
}
}
static value closure_callback( value *args, int nargs ) {
value env = NEKO_VM()->env;
int cargs = val_array_size(env) - 2;
value *a = val_array_ptr(env);
value f = a[0];
value o = a[1];
int fargs = val_fun_nargs(f);
int i;
if( fargs != cargs + nargs && fargs != VAR_ARGS )
return val_null;
if( nargs == 0 )
a = val_array_ptr(env) + 2;
else if( cargs == 0 )
a = args;
else {
a = (value*)alloc(sizeof(value)*(nargs+cargs));
for(i=0;i<cargs;i++)
a[i] = val_array_ptr(env)[i+2];
for(i=0;i<nargs;i++)
a[i+cargs] = args[i];
}
return val_callEx(o,f,a,nargs+cargs,NULL);
}
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;
}
EXTERN value val_this() {
return (value)NEKO_VM()->vthis;
}
EXTERN neko_vm *neko_vm_current() {
return NEKO_VM();
}
/**
$callstack : void -> array
<doc>Return the current callstack. Same format as [$excstack]</doc>
**/
static value builtin_callstack() {
return neko_call_stack(NEKO_VM());
}
/**
$excstack : void -> array
<doc>
Return the stack between the place the last exception was raised and the place it was catched.
The stack is composed of the following items :
<ul>
<li>[null] when it's a C function</li>
<li>a string when it's a module without debug informations</li>
<li>an array of two elements (usually file and line) if debug informations where available</li>
</ul>
</doc>
**/
static value builtin_excstack() {
return NEKO_VM()->exc_stack;
}
