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_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;
}
/**
$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;
}
/**
socket_poll_prepare : 'poll -> read:'socket array -> write:'socket array -> int array array
<doc>
Prepare a poll for scanning events on sets of sockets.
</doc>
**/
static value socket_poll_prepare( value pdata, value rsocks, value wsocks ) {
polldata *p;
int i,len;
val_check(rsocks,array);
val_check(wsocks,array);
val_check_kind(pdata,k_poll);
p = val_poll(pdata);
len = val_array_size(rsocks);
if( len + val_array_size(wsocks) > p->max )
val_throw(alloc_string("Too many sockets in poll"));
# ifdef NEKO_WINDOWS
for(i=0;i<len;i++) {
value s = val_array_ptr(rsocks)[i];
val_check_kind(s,k_socket);
p->fdr->fd_array[i] = val_sock(s);
}
p->fdr->fd_count = len;
len = val_array_size(wsocks);
for(i=0;i<len;i++) {
value s = val_array_ptr(wsocks)[i];
val_check_kind(s,k_socket);
p->fdw->fd_array[i] = val_sock(s);
}
p->fdw->fd_count = len;
# else
for(i=0;i<len;i++) {
value s = val_array_ptr(rsocks)[i];
val_check_kind(s,k_socket);
p->fds[i].fd = val_sock(s);
p->fds[i].events = POLLIN;
p->fds[i].revents = 0;
}
p->rcount = len;
len = val_array_size(wsocks);
for(i=0;i<len;i++) {
int k = i + p->rcount;
value s = val_array_ptr(wsocks)[i];
val_check_kind(s,k_socket);
p->fds[k].fd = val_sock(s);
p->fds[k].events = POLLOUT;
p->fds[k].revents = 0;
}
p->wcount = len;
# endif
{
value a = alloc_array(2);
val_array_ptr(a)[0] = p->ridx;
val_array_ptr(a)[1] = p->widx;
return a;
}
}
/**
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;
}
// Array access - generic
int api_val_array_size(value arg1)
{
if (val_is_array(arg1))
return val_array_size(arg1);
value l = val_field(arg1,length_id);
return val_int(l);
}
/**
$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));
}
value lime_alc_create_context (value device, value attrlist) {
ALCdevice* alcDevice = (ALCdevice*)val_data (device);
ALCint* list = NULL;
if (val_is_null (attrlist) == false) {
int size = val_array_size (attrlist);
list = new ALCint[size];
for (int i = 0; i < size; ++i) {
list[i] = (ALCint)val_int( val_array_i (attrlist, i) );
}
}
ALCcontext* alcContext = alcCreateContext (alcDevice, list);
if (list != NULL) {
delete[] list;
}
return CFFIPointer (alcContext);
}
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;
}
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 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 void report( neko_vm *vm, value exc ) {
#if OSX
CFStringRef title = CFSTR("Uncaught exception");
CFStringRef message;
#endif
int i = 0;
buffer b = alloc_buffer(NULL);
value st = neko_exc_stack(vm);
if( val_array_size(st) > 20 ) {
i = val_array_size(st) - 20;
buffer_append(b,"...\n");
}
for(i;i<val_array_size(st);i++) {
value s = val_array_ptr(st)[i];
if( val_is_null(s) )
buffer_append(b,"Called from a C function\n");
else if( val_is_string(s) ) {
buffer_append(b,"Called from ");
buffer_append(b,val_string(s));
buffer_append(b," (no debug available)\n");
} 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]) ) {
buffer_append(b,"Called from ");
buffer_append(b,val_string(val_array_ptr(s)[0]));
buffer_append(b," line ");
val_buffer(b,val_array_ptr(s)[1]);
buffer_append(b,"\n");
} else {
buffer_append(b,"Called from ");
val_buffer(b,s);
buffer_append(b,"\n");
}
}
val_buffer(b,exc);
#if _WIN32
MessageBox(NULL,val_string(buffer_to_string(b)),"Uncaught exception",MB_OK | MB_ICONERROR);
#elif OSX
message = CFStringCreateWithCString(NULL,val_string(buffer_to_string(b)), kCFStringEncodingUTF8);
CFUserNotificationDisplayNotice(0,0,NULL,NULL,NULL,title,message,NULL);
#elif LINUX
fprintf(stderr,"Uncaught Exception: %s\n",val_string(buffer_to_string(b)));
#endif
}
void lime_gamepad_add_mappings (value mappings) {
int length = val_array_size (mappings);
for (int i = 0; i < length; i++) {
Gamepad::AddMapping (val_string (val_array_i (mappings, i)));
}
}
/**
$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;
}
value rtmidi_out_sendmessage(value obj, value msg) {
RtMidiOut *midiout = (RtMidiOut *)(intptr_t)val_float(obj);
std::vector<unsigned char> message;
int size = val_array_size(msg);
for (int i = 0; i < size; ++i) {
message.push_back(val_int(val_array_i(msg, i)));
}
midiout->sendMessage(&message);
return alloc_null();
}
/**
$aconcat : array array -> array
<doc>
Build a single array from several ones.
</doc>
**/
static value builtin_aconcat( value arrs ) {
int tot = 0;
int len;
int i;
value all;
val_check(arrs,array);
len = val_array_size(arrs);
for(i=0;i<len;i++) {
value a = val_array_ptr(arrs)[i];
val_check(a,array);
tot += val_array_size(a);
}
all = alloc_array(tot);
tot = 0;
for(i=0;i<len;i++) {
value a = val_array_ptr(arrs)[i];
int j, max = val_array_size(a);
for(j=0;j<max;j++)
val_array_ptr(all)[tot++] = val_array_ptr(a)[j];
}
return all;
}
/**
$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
/**
$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_i(a,i);
if( FD_ISSET(val_sock(s),tmp) )
val_array_set_i(r,pos++,s);
}
val_array_set_size(r,pos);
return r;
}
void lime_cairo_set_dash (value handle, value dash) {
int length = val_array_size (dash);
double* dashPattern = new double[length];
for (int i = 0; i < length; i++) {
dashPattern[i] = val_number (val_array_i (dash, i));
}
cairo_set_dash ((cairo_t*)val_data (handle), dashPattern, length, 0);
delete dashPattern;
}
void lime_al_source_pausev (int n, value sources) {
if (val_is_null (sources) == false) {
int size = val_array_size (sources);
ALuint* data = new ALuint[size];
for (int i = 0; i < size; ++i) {
data[i] = (ALuint)val_int( val_array_i (sources, i) );
}
alSourcePausev (n, data);
delete[] data;
}
}
void lime_al_delete_buffers (int n, value buffers) {
if (val_is_null (buffers) == false) {
int size = val_array_size (buffers);
ALuint* data = new ALuint[size];
for (int i = 0; i < size; ++i) {
data[i] = (ALuint)val_int( val_array_i (buffers, i) );
}
alDeleteBuffers (n, data);
delete[] data;
}
}
void lime_al_listenerfv (int param, value values) {
if (val_is_null (values) == false) {
int size = val_array_size (values);
ALfloat *data = new ALfloat[size];
for (int i = 0; i < size; ++i) {
data[i] = (ALfloat)val_float( val_array_i (values, i) );
}
alListenerfv(param, data);
delete[] data;
}
}
void lime_al_source_queue_buffers (int source, int nb, value buffers) {
if (val_is_null (buffers) == false) {
int size = val_array_size (buffers);
ALuint* data = new ALuint[size];
for (int i = 0; i < size; ++i) {
data[i] = (ALuint)val_int( val_array_i (buffers, i) );
}
alSourceQueueBuffers (source, nb, data);
delete[] data;
}
}
void lime_al_sourceiv (int source, int param, value values) {
if (val_is_null (values) == false) {
int size = val_array_size (values);
ALint* data = new ALint[size];
for (int i = 0; i < size; ++i) {
data[i] = (ALint)val_int( val_array_i (values, i) );
}
alSourceiv (source, param, data);
delete[] data;
}
}
static fd_set *make_socket_array( value a, fd_set *tmp, SOCKET *n ) {
int i, len;
SOCKET sock;
FD_ZERO(tmp);
if( val_is_null(a) )
return tmp;
if( !val_is_array(a) )
return &INVALID;
len = val_array_size(a);
if( len > FD_SETSIZE )
val_throw(alloc_string("Too many sockets in select"));
for(i=0;i<len;i++) {
value s = val_array_i(a,i);
// make sure it is a socket...
sock = val_sock(s);
if( sock > *n )
*n = sock;
FD_SET(sock,tmp);
}
return tmp;
}
static void make_array_result_inplace(value a, fd_set *tmp)
{
if (tmp == NULL) {
val_array_set_size(a, 0);
return;
}
int len = val_array_size(a);
value *results = (value *) malloc(sizeof(value) * len);
int result_len = 0;
for (int i = 0; i < len; i++) {
value s = val_array_i(a, i);
if (FD_ISSET(val_sock(s), tmp)) {
results[result_len++] = s;
}
}
val_array_set_size(a, result_len);
for (int i = 0; i < result_len; i++) {
val_array_set_i(a, i, results[i]);
}
free(results);
}
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);
}
void NekoCodeChunk::neko_dump(std::string const & indent) const {
for (const_iterator it = begin();
it != end();
++it)
{
std::cout << indent << it->first << ": ";
print_neko_instruction((OPCODE) it->second.first, it->second.second, parameter_table[it->second.first]);
std::cout << "; // ";
{
int ppc = (int)((int_val *)it->first - m->code);
int idx = m->dbgidxs[ppc>>5].base + bitcount(m->dbgidxs[ppc>>5].bits >> (31 - (ppc & 31)));
value s = val_array_ptr(m->dbgtbl)[idx];
if( val_is_string(s) )
printf("%s",val_string(s));
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]) )
printf("file %s line %d",val_string(val_array_ptr(s)[0]),val_int(val_array_ptr(s)[1]));
else
printf("???");
}
std::cout << std::endl;
}
}