extern OBJ _javabind_fromObjectArray(int dim, jclass clazz,
OBJ (*conv)(jobject),
jarray jarr){
OBJ arr;
if (jarr != NULL){
jsize leng,i;
leng = (*javabind_env)->GetArrayLength(javabind_env, jarr);
arr = alloc_array(leng);
for (i = 0; i < leng; i++){
jobject jo =
(*javabind_env)->GetObjectArrayElement(javabind_env,
jarr,
i);
javabind_catch_abort();
if (dim > 1){
data_array(arr)[i] =
_javabind_fromObjectArray(dim-1,
clazz,
conv, jo);
} else {
data_array(arr)[i] = (*conv)(jo);
}
}
(*javabind_env)->DeleteLocalRef(javabind_env, jarr);
return arr;
} else {
arr = alloc_array(0);
set_sflag(arr, null_sflag);
return arr;
}
}
static value socket_poll_alloc( value nsocks ) {
polldata *p;
int i;
val_check(nsocks,int);
p = (polldata*)malloc(sizeof(polldata));
p->max = val_int(nsocks);
if( p->max < 0 || p->max > 1000000 )
return alloc_null();
# ifdef NEKO_WINDOWS
{
p->fdr = (fd_set*)malloc(FDSIZE(p->max));
p->fdw = (fd_set*)malloc(FDSIZE(p->max));
p->outr = (fd_set*)malloc(FDSIZE(p->max));
p->outw = (fd_set*)malloc(FDSIZE(p->max));
p->fdr->fd_count = 0;
p->fdw->fd_count = 0;
}
# else
p->fds = (struct pollfd*)malloc(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);
val_gc_add_root(&p->ridx);
val_gc_add_root(&p->widx);
for(i=0;i<=p->max;i++) {
val_array_set_i(p->ridx,i, alloc_int(-1));
val_array_set_i(p->widx,i, alloc_int(-1));
}
value v = alloc_abstract(k_poll, p);
val_gc(v,free_sock);
return v;
}
EXTERN neko_vm *neko_vm_alloc( void *custom ) {
neko_vm *vm = (neko_vm*)alloc(sizeof(neko_vm));
# ifdef NEKO_WINDOWS
int stack_size = 0x100000; // 1MB default
# else
struct rlimit st;
int stack_size;
if( getrlimit(RLIMIT_STACK,&st) != 0 || st.rlim_cur == RLIM_INFINITY )
stack_size = 8192 << 10;
else
stack_size = st.rlim_cur;
# endif
vm->spmin = (int_val*)alloc(INIT_STACK_SIZE*sizeof(int_val));
vm->print = default_printer;
vm->print_param = stdout;
vm->clist = NULL;
// the maximum stack position for a C call is estimated
// - stack grows bottom
// - neko_vm_alloc should be near the beginning of the stack
// - we keep 64KB for the C call work space and error margin
vm->c_stack_max = (void*)(((int_val)&vm) - (stack_size - 0x10000));
vm->exc_stack = alloc_array(0);
vm->spmax = vm->spmin + INIT_STACK_SIZE;
vm->sp = vm->spmax;
vm->csp = vm->spmin - 1;
vm->vthis = val_null;
vm->env = alloc_array(0);
vm->jit_val = NULL;
vm->run_jit = 0;
vm->resolver = NULL;
vm->trusted_code = 0;
vm->fstats = NULL;
vm->pstats = NULL;
return vm;
}
/**
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);
}
extern OBJ _AUserAndGroup_Ahc_Agetgroups(OBJ x1) /* hc_getgroups */
{OBJ r;
int gasize;
free_some(x1,1);
gasize=getgroups(0,NULL);
if(gasize<0){
return_unix_failure(errno);
}
if(gasize==0){
r=alloc_array(0);
}
else{
gid_t *gidarray;
int i;
gidarray=(gid_t*)malloc_aux(sizeof(gid_t)*gasize);
if(getgroups(gasize,gidarray)!=gasize){
return_unix_failure(errno);
}
r=alloc_array(gasize);
for(i=0;i<gasize;i++){
make_groupid(gidarray[i],data_array(r)[i]);
}
free_aux(gidarray);
}
return_okay(r);
}
void idict_to_array(image_dict * idict)
{
if (idict_ptr - idict_array == 0) {
/*tex align to count from 1 */
alloc_array(idict, 1, SMALL_BUF_SIZE);
idict_ptr++;
}
alloc_array(idict, 1, SMALL_BUF_SIZE);
*idict_ptr = idict;
idict_ptr++;
}
static int store_table( void *r, const char *key, const char *val ) {
value a;
if( key == NULL || val == NULL )
return 1;
a = alloc_array(2);
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;
}
fn Scene*
new_scene(memory::Block* storage, i32 entity_count, i32 camera_count)
{
auto s = alloc_struct(storage, Scene);
s->num_entities = 0;
s->entities = alloc_array(storage, Entity, entity_count);
s->num_cameras = 0;
s->cameras = alloc_array(storage, Camera, camera_count);
scene::set_context(s);
scene::new_entity();
scene::new_camera();
return s;
}
/**
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( val_is_null( socket_poll_prepare(pdata,socks,alloc_array(0))) )
return alloc_null();
socket_poll_events(pdata,timeout);
p = val_poll(pdata);
while( val_int(val_array_i(p->ridx,rcount)) != -1 )
rcount++;
a = alloc_array(rcount);
for(i=0;i<rcount;i++)
val_array_set_i(a,i, val_array_i(socks,val_int(val_array_i(p->ridx,i))));
return a;
}
value hxfcgi_get_cookies(value hreq) {
val_check_kind(hreq,hxRequest);
hxfcgi::BasicData d;
string ret = d.getHeader("COOKIE");
if (ret.compare("")==0)
return val_null;
char *k = (char*)ret.c_str();
char *start, *end;
value p = val_null, tmp;
while( (start = strchr(k,'=')) != NULL ) {
start++;
end = start;
while( *end != 0 && *end != '\r' && *end != '\n' && *end != ';' )
end++;
tmp = alloc_array(3);
val_array_set_i(tmp,0,copy_string(k,(int)(start-k-1)));
val_array_set_i(tmp,1,copy_string(start,(int)(end-start)));
val_array_set_i(tmp,2,p);
p = tmp;
if( *end != ';' || end[1] != ' ' )
break;
k = end + 2;
}
return p;
}
/**
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;
}
void pushpacketstate(void)
{
alloc_array(packet, 1, SMALL_ARRAY_SIZE);
packet_ptr->dataptr = packet_data_ptr;
packet_ptr->len = vfpacketlength;
packet_ptr++;
}
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;
}
}
DEFINE_FUNC_1(webp_decode_argb, data_buffer_value) {
if (!val_is_buffer(data_buffer_value)) {
val_throw(alloc_string("webp_decode_argb: Expected to be a buffer"));
return alloc_null();
}
buffer data_buffer = val_to_buffer(data_buffer_value);
int data_len = buffer_size(data_buffer);
char *data_ptr = buffer_data(data_buffer);
int webp_width = -1, webp_height = -1;
char *webp_data_ptr = (char *)WebPDecodeARGB((const unsigned char *)data_ptr, data_len, &webp_width, &webp_height);
int webp_data_len = webp_width * webp_height * 4;
if (webp_data_ptr == NULL) {
val_throw(alloc_string("webp_decode_argb: Invalid webp data"));
return alloc_null();
}
buffer webp_buffer = alloc_buffer_len(0);
buffer_append_sub(webp_buffer, webp_data_ptr, webp_data_len);
buffer_set_size(webp_buffer, webp_data_len);
value array = alloc_array(3);
val_array_set_i(array, 0, alloc_int(webp_width));
val_array_set_i(array, 1, alloc_int(webp_height));
val_array_set_i(array, 2, buffer_val(webp_buffer));
if (webp_data_ptr != NULL) free(webp_data_ptr);
return array;
}
DEFINE_FUNC_1(webp_get_features, data_buffer_value) {
if (!val_is_buffer(data_buffer_value)) {
val_throw(alloc_string("webp_get_features: Expected to be a buffer"));
return alloc_null();
}
buffer data_buffer = val_to_buffer(data_buffer_value);
int data_len = buffer_size(data_buffer);
char *data_ptr = buffer_data(data_buffer);
WebPBitstreamFeatures features = {0};
VP8StatusCode code = WebPGetFeatures((const unsigned char *)data_ptr, data_len, &features);
if (code != VP8_STATUS_OK) {
val_throw(alloc_string("webp_get_features: Error: (code != VP8_STATUS_OK)"));
return alloc_null();
}
value array = alloc_array(7);
val_array_set_i(array, 0, alloc_int(features.width));
val_array_set_i(array, 1, alloc_int(features.height));
val_array_set_i(array, 2, alloc_int(features.has_alpha));
//val_array_set_i(array, 3, alloc_int(features.bitstream_version));
val_array_set_i(array, 3, alloc_int(0));
val_array_set_i(array, 4, alloc_int(features.no_incremental_decoding));
val_array_set_i(array, 5, alloc_int(features.rotate));
val_array_set_i(array, 6, alloc_int(features.uv_sampling));
return array;
}
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);
}
static value alloc_host_entry(struct hostent *entry)
{
value res;
value name = Val_unit, aliases = Val_unit;
value addr_list = Val_unit, adr = Val_unit;
Begin_roots4 (name, aliases, addr_list, adr);
name = copy_string((char *)(entry->h_name));
/* PR#4043: protect against buggy implementations of gethostbyname()
that return a NULL pointer in h_aliases */
if (entry->h_aliases)
aliases = copy_string_array((const char**)entry->h_aliases);
else
aliases = Atom(0);
entry_h_length = entry->h_length;
#ifdef h_addr
addr_list = alloc_array(alloc_one_addr, (const char**)entry->h_addr_list);
#else
adr = alloc_one_addr(entry->h_addr);
addr_list = alloc_small(1, 0);
Field(addr_list, 0) = adr;
#endif
res = alloc_small(4, 0);
Field(res, 0) = name;
Field(res, 1) = aliases;
switch (entry->h_addrtype) {
case PF_UNIX: Field(res, 2) = Val_int(0); break;
case PF_INET: Field(res, 2) = Val_int(1); break;
default: /*PF_INET6 */ Field(res, 2) = Val_int(2); break;
}
Field(res, 3) = addr_list;
End_roots();
return res;
}
cell_t *new_string_of_size(secd_t *secd, size_t size) {
cell_t *mem;
mem = alloc_array(secd, bytes_to_cell(size));
assert_cell(mem, "new_string_of_size: alloc failed");
return new_strref(secd, mem, size);
}
/**
$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;
}
/**
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;
}
boolean Nexttableau(entry* t, lie_Index n)
{ lie_Index i,r; lie_Index* lambda,* skew;
{ lie_Index c=n; /* sufficiently large starting value */
if (n==1) return false;
lambda=alloc_array(lie_Index,2*n+1); skew=&lambda[n];
/* |lambda| and |skew| are |1|-based */
for (i=2*n; i>0; --i) lambda[i]=0; /* clear |lambda| and |skew| */
for (i=0; i<n; ++i) ++lambda[t[i]]; /* set $\lambda=\mathop{\rm sh}(T)$ */
for (i=n-1; i>=0; --i)
{ --lambda[r=t[i]]; ++skew[r];
if (lambda[r]>c) goto found; else c=lambda[r];
}
freearr(lambda); return false; /* final tableau */
found: {}
}
{ do ++r; while (skew[r]==0 || lambda[r]==lambda[r-1]);
/* find row for first changing entry */
t[i++]=r; --skew[r]; /* replace |t[i]|, update skew */
for (r=1; r<=n; ++r)
while (skew[r]-->0) t[i++]=r; /* distribute remaining squares */
freearr(lambda);
}
return true;
}
/**
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;
}
PyObject*
PyPath_Create(PyObject* self, PyObject* args)
{
PyObject* data;
int count;
double *xy;
if (PyArg_ParseTuple(args, "i:Path", &count)) {
/* number of vertices */
xy = alloc_array(count);
if (!xy)
return NULL;
} else {
/* sequence or other path */
PyErr_Clear();
if (!PyArg_ParseTuple(args, "O", &data))
return NULL;
count = PyPath_Flatten(data, &xy);
if (count < 0)
return NULL;
}
return (PyObject*) path_new(count, xy, 0);
}
static value alloc_host_entry(struct hostent *entry)
{
value res;
value name = Val_unit, aliases = Val_unit;
value addr_list = Val_unit, adr = Val_unit;
Begin_roots4 (name, aliases, addr_list, adr);
name = copy_string((char *)(entry->h_name));
/* PR#4043: protect against buggy implementations of gethostbyname()
that return a NULL pointer in h_aliases */
if (entry->h_aliases)
aliases = copy_string_array((const char**)entry->h_aliases);
else
aliases = Atom(0);
entry_h_length = entry->h_length;
#ifdef h_addr
addr_list = alloc_array(alloc_one_addr, (const char**)entry->h_addr_list);
#else
adr = alloc_one_addr(entry->h_addr);
addr_list = caml_alloc_1(0, adr);
#endif
int addrtype;
switch (entry->h_addrtype) {
case PF_UNIX: addrtype = 0; break;
case PF_INET: addrtype = 1; break;
default: /*PF_INET6 */ addrtype = 2; break;
}
res = caml_alloc_4(0, name, aliases,
Val_int(addrtype), addr_list);
End_roots();
return res;
}
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;
}
void *alloc_array1(long m, int size) {
long dimen[1];
dimen[0] = m;
return alloc_array(1, dimen, size);
}
/**
socket_epoll_alloc : void -> 'epoll
<doc>
Allocate memory for edge/level-triggered polling (epoll).
On Linux, this will use epoll; on other systems, this will fall back to select.
</doc>
**/
static value socket_epoll_alloc(value maxevents) {
epolldata *ep;
val_check(maxevents,int);
ep = (epolldata*)alloc(sizeof(epolldata));
ep->maxevents = val_int(maxevents);
ep->result = alloc_array(val_int(maxevents));
#ifndef HAS_EPOLL
ep->read = alloc_array(FD_SETSIZE);
ep->write = alloc_array(FD_SETSIZE);
ep->rcount = 0;
ep->wcount = 0;
#else
ep->epollfd = epoll_create1(0);
ep->events = (struct epoll_event*)alloc(sizeof(struct epoll_event) * val_int(maxevents));
#endif
return alloc_abstract(k_epoll, ep);
}
cell_t *new_array(secd_t *secd, size_t size) {
/* try to allocate memory */
cell_t *mem = alloc_array(secd, size);
assert_cell(mem, "new_array: memory allocation failed");
arr_meta(mem)->as.mcons.cells = true;
return new_array_for(secd, mem);
}
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);
}