/**
$varargs : f:function:1 -> function
<doc>
Return a variable argument function that, when called, will callback
[f] with the array of arguments.
</doc>
**/
static value builtin_varargs( value f ) {
value fvar;
val_check_function(f,1);
fvar = alloc_function(varargs_callback,VAR_ARGS,"varargs");
((vfunction*)fvar)->env = f;
return fvar;
}
int neko_execute_self( neko_vm *vm, value mload ) {
value args[] = { alloc_string("std@module_read"), alloc_int(2) };
value args2[] = { alloc_string("std@module_exec"), alloc_int(1) };
value args3[] = { alloc_function(read_bytecode,3,"boot_read_bytecode"), mload };
value exc = NULL;
value module_read, module_exec, module_val;
module_read = val_callEx(mload,val_field(mload,val_id("loadprim")),args,2,&exc);
if( exc != NULL ) {
report(vm,exc,1);
return 1;
}
module_exec = val_callEx(mload,val_field(mload,val_id("loadprim")),args2,2,&exc);
if( exc != NULL ) {
report(vm,exc,1);
return 1;
}
module_val = val_callEx(val_null,module_read,args3,2,&exc);
fclose(self);
if( exc != NULL ) {
report(vm,exc,1);
return 1;
}
alloc_field(val_field(mload,val_id("cache")),val_id("_self"),module_val);
val_callEx(val_null,module_exec,&module_val,1,&exc);
if( exc != NULL ) {
report(vm,exc,1);
return 1;
}
return 0;
}
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;
}
}
EXTERN value neko_default_loader( char **argv, int argc ) {
value o = alloc_object(NULL);
value args = alloc_array(argc);
int i;
for(i=0;i<argc;i++)
val_array_ptr(args)[i] = alloc_string(argv[i]);
alloc_field(o,id_path,init_path(getenv("NEKOPATH")));
alloc_field(o,id_cache,alloc_object(NULL));
alloc_field(o,id_loader_libs,alloc_abstract(k_loader_libs,NULL));
alloc_field(o,val_id("args"),args);
alloc_field(o,val_id("loadprim"),alloc_function(loader_loadprim,2,"loadprim"));
alloc_field(o,val_id("loadmodule"),alloc_function(loader_loadmodule,2,"loadmodule"));
#ifdef NEKO_PROF
alloc_field(o,val_id("dump_prof"),alloc_function(dump_prof,0,"dump_prof"));
#endif
return o;
}
/**
$closure : function -> object -> any* -> function
<doc>Build a closure by applying a given number of arguments to a function</doc>
**/
static value builtin_closure( value *args, int nargs ) {
value f;
value env;
int fargs;
if( nargs <= 1 )
failure("Invalid closure arguments number");
f = args[0];
if( !val_is_function(f) )
neko_error();
fargs = val_fun_nargs(f);
if( fargs != VAR_ARGS && fargs < nargs-2 )
failure("Invalid closure arguments number");
env = alloc_array(nargs);
memcpy(val_array_ptr(env),args,nargs * sizeof(f));
f = alloc_function( closure_callback, VAR_ARGS, "closure_callback" );
((vfunction*)f)->env = env;
return f;
}
static void preload_module( const char *name, server_rec *serv ) {
value exc = NULL;
neko_vm *vm = neko_vm_alloc(NULL);
value mload = neko_default_loader(NULL,0);
value m, read_path, exec;
time_t time = 0;
neko_vm_select(vm);
if( config.use_jit ) neko_vm_jit(vm,1);
if( !exc ) {
value args[] = { alloc_string("std@module_read_path"), alloc_int(3) };
read_path = val_callEx(mload,val_field(mload,val_id("loadprim")),args,2,&exc);
}
if( !exc ) {
value args[] = { alloc_string("std@module_exec"), alloc_int(1) };
exec = val_callEx(mload,val_field(mload,val_id("loadprim")),args,2,&exc);
}
if( !exc ) {
value args[] = { val_null, alloc_string(name), mload };
char *p = strrchr(val_string(args[1]),'.');
if( p != NULL ) *p = 0;
m = val_callEx(mload,read_path,args,3,&exc);
}
if( !exc ) {
struct stat t;
if( stat(name,&t) )
exc = alloc_string("failed to stat()");
else
time = t.st_mtime;
}
if( !exc ) {
value f = alloc_function(init_module,0,"init_module");
value env = alloc_array(2);
val_array_ptr(env)[0] = exec;
val_array_ptr(env)[1] = m;
((vfunction*)f)->env = env;
cache_module(name,time,f);
}
if( exc ) {
buffer b = alloc_buffer(NULL);
val_buffer(b,exc);
ap_log_error(APLOG_MARK,APLOG_WARNING,LOG_SUCCESS serv,"Failed to preload module '%s' : %s",name,val_string(buffer_to_string(b)));
}
neko_vm_select(NULL);
}
void neko_init_builtins() {
neko_builtins = alloc_root(2);
neko_builtins[0] = alloc_object(NULL);
neko_builtins[1] = alloc_function(builtin_print,VAR_ARGS,"$print");
BUILTIN(print,VAR_ARGS);
BUILTIN(array,VAR_ARGS);
BUILTIN(amake,1);
BUILTIN(acopy,1);
BUILTIN(asize,1);
BUILTIN(asub,3);
BUILTIN(ablit,5);
BUILTIN(aconcat,1);
BUILTIN(smake,1);
BUILTIN(ssize,1);
BUILTIN(scopy,1);
BUILTIN(ssub,3);
BUILTIN(sget,2);
BUILTIN(sset,3);
BUILTIN(sblit,5);
BUILTIN(sfind,3);
BUILTIN(new,1);
BUILTIN(objget,2);
BUILTIN(objset,3);
BUILTIN(objcall,3);
BUILTIN(objfield,2);
BUILTIN(objremove,2);
BUILTIN(objfields,1);
BUILTIN(hash,1);
BUILTIN(fasthash,1);
BUILTIN(field,1);
BUILTIN(objsetproto,2);
BUILTIN(objgetproto,1);
BUILTIN(int,1);
BUILTIN(float,1);
BUILTIN(string,1);
BUILTIN(typeof,1);
BUILTIN(closure,VAR_ARGS);
BUILTIN(apply,VAR_ARGS);
BUILTIN(varargs,1);
BUILTIN(compare,2);
BUILTIN(pcompare,2);
BUILTIN(not,1);
BUILTIN(throw,1);
BUILTIN(rethrow,1);
BUILTIN(nargs,1);
BUILTIN(call,3);
BUILTIN(isnan,1);
BUILTIN(isinfinite,1);
BUILTIN(istrue,1);
BUILTIN(getkind,1);
BUILTIN(iskind,2);
BUILTIN(hnew,1);
BUILTIN(hget,3);
BUILTIN(hmem,3);
BUILTIN(hset,4);
BUILTIN(hadd,3);
BUILTIN(hremove,3);
BUILTIN(hresize,2);
BUILTIN(hkey,1);
BUILTIN(hcount,1);
BUILTIN(hsize,1);
BUILTIN(hiter,2);
BUILTIN(iadd,2);
BUILTIN(isub,2);
BUILTIN(imult,2);
BUILTIN(idiv,2);
BUILTIN(excstack,0);
BUILTIN(callstack,0);
BUILTIN(version,0);
BUILTIN(setresolver,1);
}
static value unserialize_rec( sbuffer *b, value loader ) {
switch( read_char(b) ) {
case 'N':
return val_null;
case 'T':
return val_true;
case 'F':
return val_false;
case 'i':
return alloc_int(read_int(b));
case 'I':
return alloc_int32(read_int(b));
case 'f':
{
tfloat d;
read_str(b,sizeof(tfloat),&d);
return alloc_float(d);
}
case 's':
{
int l = read_int(b);
value v;
if( l < 0 || l > max_string_size )
ERROR();
v = alloc_empty_string(l);
add_ref(b,v);
read_str(b,l,(char*)val_string(v));
return v;
}
case 'o':
{
int f;
value o = alloc_object(NULL);
add_ref(b,o);
while( (f = read_int(b)) != 0 ) {
value fval = unserialize_rec(b,loader);
alloc_field(o,(field)f,fval);
}
switch( read_char(b) ) {
case 'p':
{
value v = unserialize_rec(b,loader);
if( !val_is_object(v) )
ERROR();
((vobject*)o)->proto = (vobject*)v;
}
break;
case 'z':
break;
default:
ERROR();
}
return o;
}
case 'r':
{
int n = read_int(b);
if( n < 0 || n >= b->nrefs )
ERROR();
return b->trefs[b->nrefs - n - 1];
}
case 'a':
{
int i;
int n = read_int(b);
value o;
value *t;
if( n < 0 || n > max_array_size )
ERROR();
o = alloc_array(n);
t = val_array_ptr(o);
add_ref(b,o);
for(i=0;i<n;i++)
t[i] = unserialize_rec(b,loader);
return o;
}
case 'p':
{
int nargs = read_int(b);
vfunction *f = (vfunction*)alloc_function((void*)1,nargs,NULL);
vfunction *f2;
value name;
add_ref(b,(value)f);
name = unserialize_rec(b,loader);
f2 = (vfunction*)val_ocall2(loader,id_loadprim,name,alloc_int(nargs));
if( !val_is_function(f2) || val_fun_nargs(f2) != nargs )
failure("Loader returned not-a-function");
f->t = f2->t;
f->addr = f2->addr;
f->module = f2->module;
return (value)f;
}
case 'L':
{
vfunction *f = (vfunction*)alloc_function((void*)1,0,NULL);
value mname;
int pos;
int nargs;
value env;
add_ref(b,(value)f);
mname = unserialize_rec(b,loader);
pos = read_int(b);
nargs = read_int(b);
env = unserialize_rec(b,loader);
if( !val_is_array(env) )
ERROR();
{
value exp = val_ocall2(loader,id_loadmodule,mname,loader);
value mval;
unsigned int i;
int_val *mpos;
neko_module *m;
if( !val_is_object(exp) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," is not an object");
bfailure(b);
}
mval = val_field(exp,id_module);
if( !val_is_kind(mval,neko_kind_module) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," has invalid type");
bfailure(b);
}
m = (neko_module*)val_data(mval);
mpos = m->code + pos;
for(i=0;i<m->nglobals;i++) {
vfunction *g = (vfunction*)m->globals[i];
if( val_is_function(g) && g->addr == mpos && g->module == m && g->nargs == nargs ) {
f->t = VAL_FUNCTION;
f->env = env;
f->addr = mpos;
f->nargs = nargs;
f->module = m;
return (value)f;
}
}
{
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," has been modified");
bfailure(b);
}
}
return val_null;
}
case 'x':
{
value mname = unserialize_rec(b,loader);
value data = unserialize_rec(b,loader);
value exports = val_ocall2(loader,id_loadmodule,mname,loader);
value s;
if( !val_is_object(exports) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," is not an object");
bfailure(b);
}
s = val_field(exports,id_unserialize);
if( !val_is_function(s) || (val_fun_nargs(s) != 1 && val_fun_nargs(s) != VAR_ARGS) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," has invalid __unserialize function");
}
s = val_call1(s,data);
add_ref(b,s);
return s;
}
case 'h':
{
int i;
vhash *h = (vhash*)alloc(sizeof(vhash));
h->ncells = read_int(b);
h->nitems = read_int(b);
h->cells = (hcell**)alloc(sizeof(hcell*)*h->ncells);
for(i=0;i<h->ncells;i++)
h->cells[i] = NULL;
for(i=0;i<h->nitems;i++) {
hcell **p;
hcell *c = (hcell*)alloc(sizeof(hcell));
c->hkey = read_int(b);
c->key = unserialize_rec(b,loader);
c->val = unserialize_rec(b,loader);
c->next = NULL;
p = &h->cells[c->hkey % h->ncells];
while( *p != NULL )
p = &(*p)->next;
*p = c;
}
return alloc_abstract(k_hash,h);
}
default:
ERROR();
return val_null;
}
}
