/**
socket_select : read : 'socket array -> write : 'socket array -> others : 'socket array -> timeout:number? -> 'socket array array
<doc>Perform the [select] operation. Timeout is in seconds or [null] if infinite</doc>
**/
static value socket_select( value rs, value ws, value es, value timeout ) {
struct timeval tval;
struct timeval *tt;
SOCKET n = 0;
fd_set rx, wx, ex;
fd_set *ra, *wa, *ea;
value r;
POSIX_LABEL(select_again);
ra = make_socket_array(rs,val_array_size(rs),&rx,&n);
wa = make_socket_array(ws,val_array_size(ws),&wx,&n);
ea = make_socket_array(es,val_array_size(es),&ex,&n);
if( ra == &INVALID || wa == &INVALID || ea == &INVALID )
neko_error();
if( val_is_null(timeout) )
tt = NULL;
else {
val_check(timeout,number);
tt = &tval;
init_timeval(val_number(timeout),tt);
}
if( select((int)(n+1),ra,wa,ea,tt) == SOCKET_ERROR ) {
HANDLE_EINTR(select_again);
neko_error();
}
r = alloc_array(3);
val_array_ptr(r)[0] = make_array_result(rs,ra);
val_array_ptr(r)[1] = make_array_result(ws,wa);
val_array_ptr(r)[2] = make_array_result(es,ea);
return r;
}
static void report( neko_vm *vm, value exc, int isexc ) {
int i;
buffer b = alloc_buffer(NULL);
value st = neko_exc_stack(vm);
for(i=0;i<val_array_size(st);i++) {
value s = val_array_ptr(st)[i];
buffer_append(b,"Called from ");
if( val_is_null(s) )
buffer_append(b,"a C function");
else if( val_is_string(s) ) {
buffer_append(b,val_string(s));
buffer_append(b," (no debug available)");
} else if( val_is_array(s) && val_array_size(s) == 2 && val_is_string(val_array_ptr(s)[0]) && val_is_int(val_array_ptr(s)[1]) ) {
val_buffer(b,val_array_ptr(s)[0]);
buffer_append(b," line ");
val_buffer(b,val_array_ptr(s)[1]);
} else
val_buffer(b,s);
buffer_append_char(b,'\n');
}
if( isexc )
buffer_append(b,"Uncaught exception - ");
val_buffer(b,exc);
# ifdef NEKO_STANDALONE
neko_standalone_error(val_string(buffer_to_string(b)));
# else
fprintf(stderr,"%s\n",val_string(buffer_to_string(b)));
# endif
}
/**
socket_epoll_register : 'epoll -> 'socket -> int
<doc>Register a socket with an epoll instance to be notified of events. Returns the socket's fd.</doc>
**/
static value socket_epoll_register(value e, value s, value events) {
SOCKET sock;
int event_types;
epolldata *ep;
val_check_kind(e,k_epoll);
val_check_kind(s,k_socket);
val_check(events,int);
sock = val_sock(s);
event_types = val_int(events);
ep = val_epoll(e);
#ifndef HAS_EPOLL
if (sock >= FD_SETSIZE)
val_throw(alloc_string("Can't register file descriptor >= FD_SETSIZE"));
if (event_types & EPOLLIN) {
if (ep->rcount >= FD_SETSIZE)
val_throw(alloc_string("Too many sockets (on non-Linux platforms, 'epoll' uses select)"));
val_array_ptr(ep->read)[ep->rcount++] = s;
}
if (event_types & EPOLLOUT) {
if (ep->wcount >= FD_SETSIZE)
val_throw(alloc_string("Too many sockets (on non-Linux platforms, 'epoll' uses select)"));
val_array_ptr(ep->write)[ep->wcount++] = s;
}
#else
struct epoll_event ev;
ev.events = event_types;
ev.data.fd = sock;
int ret = epoll_ctl(ep->epollfd, EPOLL_CTL_ADD, sock, &ev);
if (ret == -1)
val_throw(alloc_int(errno));
#endif
return alloc_int(sock);
}
static void parse_get( value *p, const char *args ) {
char *aand, *aeq, *asep;
value tmp;
while( true ) {
aand = strchr(args,'&');
if( aand == NULL ) {
asep = strchr(args,';');
aand = asep;
} else {
asep = strchr(args,';');
if( asep != NULL && asep < aand )
aand = asep;
}
if( aand != NULL )
*aand = 0;
aeq = strchr(args,'=');
if( aeq != NULL ) {
*aeq = 0;
tmp = alloc_array(3);
val_array_ptr(tmp)[0] = url_decode(args,(int)(aeq-args));
val_array_ptr(tmp)[1] = url_decode(aeq+1,(int)strlen(aeq+1));
val_array_ptr(tmp)[2] = *p;
*p = tmp;
*aeq = '=';
}
if( aand == NULL )
break;
*aand = (aand == asep)?';':'&';
args = aand+1;
}
}
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;
}
}
/**
$apply : function -> any* -> any
<doc>
Apply the function to several arguments.
Return a function asking for more arguments or the function result if more args needed.
</doc>
**/
static value builtin_apply( value *args, int nargs ) {
value f, env;
int fargs;
int i;
nargs--;
args++;
if( nargs < 0 )
neko_error();
f = args[-1];
if( !val_is_function(f) )
neko_error();
if( nargs == 0 )
return f;
fargs = val_fun_nargs(f);
if( fargs == nargs || fargs == VAR_ARGS )
return val_callN(f,args,nargs);
if( nargs > fargs )
neko_error();
env = alloc_array(fargs + 1);
val_array_ptr(env)[0] = f;
for(i=0;i<nargs;i++)
val_array_ptr(env)[i+1] = args[i];
while( i++ < fargs )
val_array_ptr(env)[i] = val_null;
return neko_alloc_apply(fargs-nargs,env);
}
EXTERN value neko_select_file( value path, const char *file, const char *ext ) {
struct stat s;
value ff;
buffer b = alloc_buffer(file);
buffer_append(b,ext);
ff = buffer_to_string(b);
if( stat(val_string(ff),&s) == 0 ) {
char *p = strchr(file,'/');
if( p == NULL )
p = strchr(file,'\\');
if( p != NULL )
return ff;
b = alloc_buffer("./");
buffer_append(b,file);
buffer_append(b,ext);
return buffer_to_string(b);
}
while( val_is_array(path) && val_array_size(path) == 2 ) {
value p = val_array_ptr(path)[0];
buffer b = alloc_buffer(NULL);
path = val_array_ptr(path)[1];
val_buffer(b,p);
val_buffer(b,ff);
p = buffer_to_string(b);
if( stat(val_string(p),&s) == 0 )
return p;
}
return ff;
}
/**
socket_poll_alloc : int -> 'poll
<doc>Allocate memory to perform polling on a given number of sockets</doc>
**/
static value socket_poll_alloc( value nsocks ) {
polldata *p;
int i;
val_check(nsocks,int);
p = (polldata*)alloc(sizeof(polldata));
p->max = val_int(nsocks);
if( p->max < 0 || p->max > 1000000 )
neko_error();
# ifdef NEKO_WINDOWS
{
p->fdr = (fd_set*)alloc_private(FDSIZE(p->max));
p->fdw = (fd_set*)alloc_private(FDSIZE(p->max));
p->outr = (fd_set*)alloc_private(FDSIZE(p->max));
p->outw = (fd_set*)alloc_private(FDSIZE(p->max));
p->fdr->fd_count = 0;
p->fdw->fd_count = 0;
}
# else
p->fds = (struct pollfd*)alloc_private(sizeof(struct pollfd) * p->max);
p->rcount = 0;
p->wcount = 0;
# endif
p->ridx = alloc_array(p->max+1);
p->widx = alloc_array(p->max+1);
for(i=0;i<=p->max;i++) {
val_array_ptr(p->ridx)[i] = alloc_int(-1);
val_array_ptr(p->widx)[i] = alloc_int(-1);
}
return alloc_abstract(k_poll, p);
}
/**
sys_env : void -> #list
<doc>Return all the (key,value) pairs in the environment as a chained list</doc>
**/
static value sys_env() {
value h = val_null;
value cur = NULL, tmp, key;
char **e = environ;
while( *e ) {
char *x = strchr(*e,'=');
if( x == NULL ) {
e++;
continue;
}
tmp = alloc_array(3);
key = alloc_empty_string((int)(x - *e));
memcpy(val_string(key),*e,(int)(x - *e));
val_array_ptr(tmp)[0] = key;
val_array_ptr(tmp)[1] = alloc_string(x+1);
val_array_ptr(tmp)[2] = val_null;
if( cur )
val_array_ptr(cur)[2] = tmp;
else
h = tmp;
cur = tmp;
e++;
}
return h;
}
static value init_path( const char *path ) {
value l = val_null, tmp;
char *p, *p2;
char *allocated = NULL;
#ifdef NEKO_WINDOWS
char exe_path[MAX_PATH];
if( path == NULL ) {
# ifdef NEKO_STANDALONE
# define SELF_DLL NULL
# else
# define SELF_DLL "neko.dll"
# endif
if( GetModuleFileName(GetModuleHandle(SELF_DLL),exe_path,MAX_PATH) == 0 )
return val_null;
p = strrchr(exe_path,'\\');
if( p == NULL )
return val_null;
*p = 0;
path = exe_path;
}
#else
if( path == NULL ) {
allocated = strdup("/usr/local/lib/neko:/usr/lib/neko:/usr/local/bin:/usr/bin");
path = allocated;
}
#endif
while( true ) {
// windows drive letter (same behavior expected on all os)
if( *path && path[1] == ':' ) {
p = strchr(path+2,':');
p2 = strchr(path+2,';');
} else {
p = strchr(path,':');
p2 = strchr(path,';');
}
if( p == NULL || (p2 != NULL && p2 < p) )
p = p2;
if( p != NULL )
*p = 0;
tmp = alloc_array(2);
if( (p && p[-1] != '/' && p[-1] != '\\') || (!p && path[strlen(path)-1] != '/' && path[strlen(path)-1] != '\\') ) {
buffer b = alloc_buffer(path);
char c = '/';
buffer_append_sub(b,&c,1);
val_array_ptr(tmp)[0] = buffer_to_string(b);
} else
val_array_ptr(tmp)[0] = alloc_string(path);
val_array_ptr(tmp)[1] = l;
l = tmp;
if( p != NULL )
*p = (p == p2)?';':':';
else
break;
path = p+1;
}
if( allocated != NULL )
free(allocated);
return l;
}
/**
$acopy : array -> array
<doc>Make a copy of an array</doc>
**/
static value builtin_acopy( value a ) {
int i;
value a2;
val_check(a,array);
a2 = alloc_array(val_array_size(a));
for(i=0;i<val_array_size(a);i++)
val_array_ptr(a2)[i] = val_array_ptr(a)[i];
return a2;
}
static value init_module() {
neko_vm *vm = neko_vm_current();
mcontext *ctx = CONTEXT();
value env = vm->env;
ctx->main = NULL;
val_call1(val_array_ptr(env)[0],val_array_ptr(env)[1]);
cache_module(ctx->r->filename,FTIME(ctx->r),ctx->main);
return val_null;
}
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;
}
static value udpr_peer_address( value p ) {
val_check_kind(p,k_udprpeer);
ENetPeer* peer = (ENetPeer *)val_data(p);
if(peer == NULL)
neko_error();
value rv = alloc_array(2);
val_array_ptr(rv)[0] = alloc_int32(peer->address.host);
val_array_ptr(rv)[1] = alloc_int(peer->address.port);
return rv;
}
static int store_table( void *r, const char *key, const char *val ) {
value a;
if( key == NULL || val == NULL )
return 1;
a = alloc_array(3);
val_array_ptr(a)[0] = alloc_string(key);
val_array_ptr(a)[1] = alloc_string(val);
val_array_ptr(a)[2] = *(value*)r;
*((value*)r) = a;
return 1;
}
/**
socket_host : 'socket -> #address
<doc>Return the socket local address composed of an (host,port) array</doc>
**/
static value socket_host( value o ) {
struct sockaddr_in addr;
unsigned int addrlen = sizeof(addr);
value ret;
val_check_kind(o,k_socket);
if( getsockname(val_sock(o),(struct sockaddr*)&addr,&addrlen) == SOCKET_ERROR )
neko_error();
ret = alloc_array(2);
val_array_ptr(ret)[0] = alloc_int32(*(int*)&addr.sin_addr);
val_array_ptr(ret)[1] = alloc_int(ntohs(addr.sin_port));
return ret;
}
/**
module_read : fread:(buf:string -> pos:int -> len:int -> int) -> loader:object -> 'module
<doc>
Read a module using the specified read function and the specified loader.
</doc>
**/
static value module_read( value fread, value loader ) {
value p;
neko_module *m;
val_check_function(fread,3);
val_check(loader,object);
p = alloc_array(2);
val_array_ptr(p)[0] = fread;
val_array_ptr(p)[1] = alloc_empty_string(READ_BUFSIZE);
m = neko_read_module(read_proxy,p,loader);
if( m == NULL )
neko_error();
m->name = alloc_string("");
return alloc_abstract(neko_kind_module,m);
}
/**
same_closure : any -> any -> bool
<doc>
Compare two functions by checking that they refer to the same implementation and that their environments contains physically equal values.
</doc>
**/
static value same_closure( value _f1, value _f2 ) {
vfunction *f1 = (vfunction*)_f1;
vfunction *f2 = (vfunction*)_f2;
int i;
if( !val_is_function(f1) || !val_is_function(f2) )
return val_false;
if( f1 == f2 )
return val_true;
if( f1->nargs != f2->nargs || f1->addr != f2->addr || f1->module != f2->module || val_array_size(f1->env) != val_array_size(f2->env) )
return val_false;
for(i=0;i<val_array_size(f1->env);i++)
if( val_array_ptr(f1->env)[i] != val_array_ptr(f2->env)[i] )
return val_false;
return val_true;
}
/**
$ablit : dst:array -> dst_pos:int -> src:array -> src_pos:int -> len:int -> void
<doc>
Copy [len] elements from [src_pos] of [src] to [dst_pos] of [dst].
An error occurs if out of arrays bounds.
</doc>
**/
static value builtin_ablit( value dst, value dp, value src, value sp, value l ) {
int dpp, spp, ll;
val_check(dst,array);
val_check(dp,int);
val_check(src,array);
val_check(sp,int);
val_check(l,int);
dpp = val_int(dp);
spp = val_int(sp);
ll = val_int(l);
if( dpp < 0 || spp < 0 || ll < 0 || dpp + ll < 0 || spp + ll < 0 || dpp + ll > val_array_size(dst) || spp + ll > val_array_size(src) )
neko_error();
memmove(val_array_ptr(dst)+dpp,val_array_ptr(src)+spp,ll * sizeof(value));
return val_null;
}
static value neko_flush_stack( int_val *cspup, int_val *csp, value old ) {
int ncalls = (int)((cspup - csp) / 4);
value stack_trace = alloc_array(ncalls + ((old == NULL)?0:val_array_size(old)));
value *st = val_array_ptr(stack_trace);
neko_module *m;
while( csp != cspup ) {
m = (neko_module*)csp[4];
if( m ) {
if( m->dbgidxs ) {
int ppc = (int)((((int_val**)csp)[1]-2) - m->code);
int idx = m->dbgidxs[ppc>>5].base + bitcount(m->dbgidxs[ppc>>5].bits >> (31 - (ppc & 31)));
*st = val_array_ptr(m->dbgtbl)[idx];
} else
*st = m->name;
} else
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);
}
/**
$array : any* -> array
<doc>Create an array from a list of values</doc>
**/
static value builtin_array( value *args, int nargs ) {
value a = alloc_array(nargs);
int i;
for(i=0;i<nargs;i++)
val_array_ptr(a)[i] = args[i];
return a;
}
/**
$objcall : o:any -> f:int -> args:array -> any
<doc>Call the field [f] of [o] with [args] and return the value or [null] is [o] is not an object</doc>
**/
static value builtin_objcall( value o, value f, value args ) {
if( !val_is_object(o) )
return val_null; // keep dot-access semantics
val_check(f,int);
val_check(args,array);
return val_ocallN(o,val_int(f),val_array_ptr(args),val_array_size(args));
}
/**
$asub : array -> p:int -> l:int -> array
<doc>
Return [l] elements starting at position [p] of an array.
An error occurs if out of array bounds.
</doc>
**/
static value builtin_asub( value a, value p, value l ) {
value a2;
int i;
int pp, ll;
val_check(a,array);
val_check(p,int);
val_check(l,int);
pp = val_int(p);
ll = val_int(l);
if( pp < 0 || ll < 0 || pp+ll < 0 || pp+ll > val_array_size(a) )
neko_error();
a2 = alloc_array(ll);
for(i=0;i<ll;i++)
val_array_ptr(a2)[i] = val_array_ptr(a)[pp+i];
return a2;
}
static value make_array_result( value a, fd_set *tmp ) {
value r;
int i, len;
int pos = 0;
if( tmp == NULL )
return val_null;
len = val_array_size(a);
r = alloc_array(len);
for(i=0;i<len;i++) {
value s = val_array_ptr(a)[i];
if( FD_ISSET(val_sock(s),tmp) )
val_array_ptr(r)[pos++] = s;
}
val_set_size(r,pos);
return r;
}
/**
socket_poll : 'socket array -> 'poll -> timeout:float -> 'socket array
<doc>
Perform a polling for data available over a given set of sockets. This is similar to [socket_select]
except that [socket_select] is limited to a given number of simultaneous sockets to check.
</doc>
**/
static value socket_poll( value socks, value pdata, value timeout ) {
polldata *p;
value a;
int i, rcount = 0;
if( socket_poll_prepare(pdata,socks,alloc_array(0)) == NULL )
neko_error();
if( socket_poll_events(pdata,timeout) == NULL )
neko_error();
p = val_poll(pdata);
while( val_array_ptr(p->ridx)[rcount] != alloc_int(-1) )
rcount++;
a = alloc_array(rcount);
for(i=0;i<rcount;i++)
val_array_ptr(a)[i] = val_array_ptr(socks)[val_int(val_array_ptr(p->ridx)[i])];
return a;
}
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 int read_proxy( readp p, void *buf, int size ) {
value fread = val_array_ptr(p)[0];
value vbuf = val_array_ptr(p)[1];
value ret;
int len;
if( size < 0 )
return -1;
if( size > READ_BUFSIZE )
vbuf = alloc_empty_string(size);
ret = val_call3(fread,vbuf,alloc_int(0),alloc_int(size));
if( !val_is_int(ret) )
return -1;
len = val_int(ret);
if( len < 0 || len > size )
return -1;
memcpy(buf,val_string(vbuf),len);
return len;
}
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);
}
