void su_seq_reverse(su_state *s, int idx) {
su_pushnil(s);
su_copy(s, idx - 1);
while (su_type(s, -1) == SU_SEQ) {
su_first(s, -1);
su_copy(s, -3);
su_cons(s);
su_swap(s, -3, -1);
su_pop(s, 1);
su_rest(s, -1);
su_swap(s, -2, -1);
su_pop(s, 1);
}
su_pop(s, 1);
}
int su_load_call_wrp(lua_State *L) {
su_state *s = (su_state*)lua_touserdata(L, -3);
int len = lua_tointeger(L, -2);
code = lua_tostring(L, -1);
len = su_load(s, reader, &len);
if (!len) {
su_pushnil(s);
su_call(s, 1, 1);
push_sexp(L, s, s->stack[s->stack_top - 1]);
su_pop(s, 1);
} else {
lua_pushnil(L);
}
return 1;
}
void su_call(su_state *s, int narg, int nret) {
int pc, tmp, fret;
prototype_t *prot;
int top = s->stack_top - narg - 1;
value_t *f = &s->stack[top];
frame_t *frame = &s->frames[s->frame_top++];
assert(s->frame_top <= MAX_CALLS);
frame->ret_addr = 0xffff;
frame->func = f->obj.func;
frame->stack_top = top;
pc = s->pc;
prot = s->prot;
tmp = s->narg;
s->narg = narg;
if (f->type == SU_FUNCTION) {
if (f->obj.func->narg < 0) {
su_vector(s, narg);
s->narg = narg = 1;
} else {
su_assert(s, f->obj.func->narg == narg, "Bad number of argument to function!");
}
vm_loop(s, f->obj.func);
if (nret == 0)
su_pop(s, 1);
} else if (f->type == SU_NATIVEFUNC) {
fret = f->obj.nfunc(s, narg);
if (nret > 0 && fret > 0) {
s->stack[top] = *STK(-1);
su_pop(s, narg);
} else {
s->stack_top = top;
if (nret > 0)
su_pushnil(s);
}
s->frame_top--;
} else {
assert(0);
}
s->narg = tmp;
s->prot = prot;
s->pc = pc;
}
su_state *su_init(su_alloc alloc) {
int i;
value_t v;
su_state *s;
su_alloc mf;
main_state_internal_t *msi;
assert(sizeof(value_t) <= SU_VALUE_SIZE);
assert(sizeof(value_t) > SU_VALUE_DATA_SIZE);
mf = alloc ? alloc : default_alloc;
msi = (main_state_internal_t*)mf(NULL, sizeof(main_state_internal_t));
s = &msi->threads[0];
memset(msi, 0, sizeof(main_state_internal_t));
for (i = 0; i < SU_OPT_MAX_THREADS; i++)
msi->threads[i].thread_finished.value = 1;
s->alloc = mf;
s->msi = msi;
s->main_state = s;
msi->gc_state = GC_STATE_SWEEP;
s->fstdin = stdin;
s->fstdout = stdout;
s->fstderr = stderr;
s->errtop = s->ferrtop = -1;
s->pc = 0xffff;
s->msi->ref_counter = 0x1;
s->msi->tid_count.value = 1;
s->msi->thread_count.value = 1;
v = init_globals(s);
su_pushnil(s); /* SU_NIL_INDEX */
push_value(s, &v); /* SU_GLOBAL_INDEX */
su_map(s, 0); /* SU_REGISTRY_INDEX */
rw_barrier();
return s;
}
void su_seq(su_state *s, int idx, int reverse) {
value_t v;
value_t *seq = STK(TOP(idx));
switch (su_type(s, idx)) {
case SU_NIL:
su_pushnil(s);
return;
case SU_VECTOR:
v = it_create_vector(s, seq->obj.vec, reverse);
break;
case SU_MAP:
v = tree_create_map(s, seq->obj.m);
break;
case SU_STRING:
v = it_create_string(s, seq->obj.str, reverse);
break;
case SU_SEQ:
if (reverse) {
su_seq_reverse(s, idx);
return;
} else {
v = *seq;
}
break;
case SU_NUMBER:
if (reverse)
v = range_create(s, (int)seq->obj.num, 0);
else
v = range_create(s, 0, (int)seq->obj.num);
break;
case SU_FUNCTION:
case SU_NATIVEFUNC:
if (!reverse) {
v = lazy_create(s, seq);
break;
}
default:
su_error(s, "Can't sequence object of type: %s", type_name((su_object_type_t)seq->type));
}
push_value(s, &v);
}