/*
** Call a function (C or Lua). The parameters must be on the stack,
** between [stack+base,top). The function to be called is at stack+base-1.
** When returns, the results are on the stack, between [stack+base-1,top).
** The number of results is nResults, unless nResults=MULT_RET.
*/
static void do_call (StkId base, int nResults)
{
StkId firstResult;
TObject *func = stack+base-1;
int i;
if (ttype(func) == LUA_T_CFUNCTION) {
ttype(func) = LUA_T_CMARK;
firstResult = callC(fvalue(func), base);
}
else if (ttype(func) == LUA_T_FUNCTION) {
ttype(func) = LUA_T_MARK;
firstResult = lua_execute(func->value.tf->code, base);
}
else { /* func is not a function */
/* Check the tag method for invalid functions */
TObject *im = luaI_getimbyObj(func, IM_FUNCTION);
if (ttype(im) == LUA_T_NIL)
lua_error("call expression not a function");
open_stack((top-stack)-(base-1));
stack[base-1] = *im;
do_call(base, nResults);
return;
}
/* adjust the number of results */
if (nResults != MULT_RET)
adjust_top(firstResult+nResults);
/* move results to base-1 (to erase parameters and function) */
base--;
nResults = top - (stack+firstResult); /* actual number of results */
for (i=0; i<nResults; i++)
*(stack+base+i) = *(stack+firstResult+i);
top -= firstResult-base;
}
/*
** Call the specified fallback, putting it on the stack below its arguments
*/
static void callFB (int fb)
{
int nParams = luaI_fallBacks[fb].nParams;
open_stack(nParams);
*(top-nParams-1) = luaI_fallBacks[fb].function;
do_call((top-stack)-nParams, luaI_fallBacks[fb].nResults);
}
/*
** Call a function (C or Lua). The parameters must be on the stack,
** between [stack+base,top). The function to be called is at stack+base-1.
** When returns, the results are on the stack, between [stack+base-1,top).
** The number of results is nResults, unless nResults=MULT_RET.
*/
static void do_call (StkId base, int nResults)
{
StkId firstResult;
Object *func = stack+base-1;
int i;
if (tag(func) == LUA_T_CFUNCTION)
{
tag(func) = LUA_T_CMARK;
firstResult = callC(fvalue(func), base);
}
else if (tag(func) == LUA_T_FUNCTION)
{
tag(func) = LUA_T_MARK;
firstResult = lua_execute(func->value.tf->code, base);
}
else
{ /* func is not a function */
/* Call the fallback for invalid functions */
open_stack((top-stack)-(base-1));
stack[base-1] = luaI_fallBacks[FB_FUNCTION].function;
do_call(base, nResults);
return;
}
/* adjust the number of results */
if (nResults != MULT_RET && top - (stack+firstResult) != nResults)
adjust_top(firstResult+nResults);
/* move results to base-1 (to erase parameters and function) */
base--;
nResults = top - (stack+firstResult); /* actual number of results */
for (i=0; i<nResults; i++)
*(stack+base+i) = *(stack+firstResult+i);
top -= firstResult-base;
}
int lua_call (char *funcname)
{
Word n = luaI_findsymbolbyname(funcname);
open_stack((top-stack)-CLS_current.base);
stack[CLS_current.base] = s_object(n);
return do_protectedrun(MULT_RET);
}
static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults)
{
StkId base = (top-stack)-nParams;
open_stack(nParams);
stack[base].ttype = LUA_T_CFUNCTION;
stack[base].value.f = f;
do_call(base+1, nResults);
}
// Runs the given stack until it hits a condition or completes successfully.
static value_t run_stack_until_condition(value_t ambience, value_t stack) {
value_t result = run_stack_pushing_signals(ambience, stack);
if (in_condition_cause(ccSignal, result)) {
runtime_t *runtime = get_ambience_runtime(ambience);
frame_t frame = open_stack(stack);
TRY_DEF(trace, capture_backtrace(runtime, &frame));
print_ln("%9v", trace);
}
return result;
}
/*
** Execute the given lua function. Return 0 on success or 1 on error.
*/
int lua_callfunction (lua_Object function)
{
if (function == LUA_NOOBJECT)
return 1;
else
{
open_stack((top-stack)-CLS_current.base);
stack[CLS_current.base] = *Address(function);
return do_protectedrun (MULT_RET);
}
}
void test_file(char *cpFile) {
FILE *fBin;
unsigned long ulSize = 0;
unsigned long ulPos = 0;
unsigned long ulOccur = 0;
Ion ioTest;
// open file
fBin = fopen(cpFile,"rb");
printf("Loading %s ....\n",cpFile);
if(fBin) {
// check size
fseek(fBin,0,SEEK_END);
ulSize = ftell(fBin);
printf("%u bytes in file....\n",ulSize);
// go back to beginning
fseek(fBin,0,SEEK_SET);
// start processing..
printf("Starting processing....\n");
// prepare stack
open_stack();
// read and process
for(ulPos = 0; ulPos < ulSize; ulPos++) {
// push to stack
push_stack(fgetc(fBin));
// if stack is full.. process
if(stack_filled() == 1) {
// read Ion from stack
ioTest = pop_stack();
// feed to compiler
ioTest = IonExecute(ioTest);
// check if found
if(ioTest.ucFlags != 0) {
printf("Found #%d on pos %u\n",ioTest.ucFlags,ulPos);
ulOccur++;
}
}
}
// close
fclose(fBin);
// overview
printf("Found %d ions..\n",ulOccur);
} else {
printf("Can't open %s!\n",cpFile);
}
}
// Convert datapool to kml file
int datapool2kml(char *in_file, char *out_file, int listFlag, int stack)
{
datapool_type_t datapool;
dbf_header_t *dbf;
char *header;
int nCols, nColumns;
char line[1024];
// Read configuration file
read_header_config("DATAPOOL", &dbf, &nCols);
FILE *ifp = FOPEN(in_file, "r");
assert(ifp);
check_datapool_location(ifp, &header, &nColumns);
FILE *ofp = FOPEN(out_file, "w");
if (!ofp) {
printf("Failed to open output file %s: %s\n", out_file, strerror(errno));
return 0;
}
kml_header(ofp);
int ii = 0;
while (fgets(line, 1022, ifp) != NULL) {
strip_end_whitesp(line);
// now get the individual column values
datapool_init(&datapool);
if (read_datapool_line(header, nColumns, line, &datapool)) {
if (stack) {
if (ii == 0)
open_stack(ofp, &datapool);
add_to_stack_kml(ofp, &datapool, nCols);
}
else
add_to_kml(ofp, &datapool, dbf, nCols);
ii++;
}
}
if (stack)
close_stack(ofp, &datapool);
kml_footer(ofp);
fclose(ifp);
fclose(ofp);
return 1;
}
value_t run_code_block(safe_value_t s_ambience, safe_value_t code) {
runtime_t *runtime = get_ambience_runtime(deref(s_ambience));
CREATE_SAFE_VALUE_POOL(runtime, 4, pool);
E_BEGIN_TRY_FINALLY();
// Build a stack to run the code on.
E_S_TRY_DEF(s_stack, protect(pool, new_heap_stack(runtime, 1024)));
{
frame_t frame = open_stack(deref(s_stack));
// Set up the initial frame.
size_t frame_size = get_code_block_high_water_mark(deref(code));
E_TRY(push_stack_frame(runtime, deref(s_stack), &frame, frame_size,
ROOT(runtime, empty_array)));
frame_set_code_block(&frame, deref(code));
close_frame(&frame);
}
// Run until completion.
E_RETURN(run_stack_until_signal(s_ambience, s_stack));
E_FINALLY();
DISPOSE_SAFE_VALUE_POOL(pool);
E_END_TRY_FINALLY();
}
value_t run_code_block_until_condition(value_t ambience, value_t code) {
// Create the stack to run the code on.
runtime_t *runtime = get_ambience_runtime(ambience);
TRY_DEF(stack, new_heap_stack(runtime, 1024));
// Push an activation onto the empty stack to get execution going.
size_t frame_size = get_code_block_high_water_mark(code);
frame_t frame = open_stack(stack);
TRY(push_stack_frame(runtime, stack, &frame, frame_size, ROOT(runtime, empty_array)));
frame_set_code_block(&frame, code);
close_frame(&frame);
// Run the stack.
loop:
do {
value_t result = run_stack_until_condition(ambience, stack);
if (in_condition_cause(ccForceValidate, result)) {
runtime_t *runtime = get_ambience_runtime(ambience);
runtime_validate(runtime, result);
goto loop;
}
return result;
} while (false);
}
/*
** Execute the given opcode, until a RET. Parameters are between
** [stack+base,top). Returns n such that the the results are between
** [stack+n,top).
*/
static StkId lua_execute (Byte *pc, StkId base)
{
if (lua_callhook)
callHook (base, LUA_T_MARK, 0);
while (1)
{
OpCode opcode;
switch (opcode = (OpCode)*pc++)
{
case PUSHNIL: ttype(top) = LUA_T_NIL; incr_top; break;
case PUSH0: case PUSH1: case PUSH2:
ttype(top) = LUA_T_NUMBER;
nvalue(top) = opcode-PUSH0;
incr_top;
break;
case PUSHBYTE:
ttype(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break;
case PUSHWORD:
{
Word w;
get_word(w,pc);
ttype(top) = LUA_T_NUMBER; nvalue(top) = w;
incr_top;
}
break;
case PUSHFLOAT:
{
real num;
get_float(num,pc);
ttype(top) = LUA_T_NUMBER; nvalue(top) = num;
incr_top;
}
break;
case PUSHSTRING:
{
Word w;
get_word(w,pc);
ttype(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
incr_top;
}
break;
case PUSHFUNCTION:
{
TFunc *f;
get_code(f,pc);
luaI_insertfunction(f); /* may take part in GC */
top->ttype = LUA_T_FUNCTION;
top->value.tf = f;
incr_top;
}
break;
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
case PUSHLOCAL9:
*top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break;
case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break;
case PUSHGLOBAL:
{
Word w;
get_word(w,pc);
getglobal(w);
}
break;
case PUSHINDEXED:
pushsubscript();
break;
case PUSHSELF:
{
TObject receiver = *(top-1);
Word w;
get_word(w,pc);
ttype(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
incr_top;
pushsubscript();
*top = receiver;
incr_top;
break;
}
case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
case STORELOCAL9:
*((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top);
break;
case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break;
case STOREGLOBAL:
{
Word w;
get_word(w,pc);
setglobal(w);
}
break;
case STOREINDEXED0:
storesubscript(top-3, 1);
break;
case STOREINDEXED: {
int n = *pc++;
storesubscript(top-3-n, 2);
break;
}
case STORELIST0:
case STORELIST:
{
int m, n;
TObject *arr;
if (opcode == STORELIST0) m = 0;
else m = *(pc++) * FIELDS_PER_FLUSH;
n = *(pc++);
arr = top-n-1;
while (n)
{
ttype(top) = LUA_T_NUMBER; nvalue(top) = n+m;
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
break;
case STORERECORD: /* opcode obsolete: supersed by STOREMAP */
{
int n = *(pc++);
TObject *arr = top-n-1;
while (n)
{
Word w;
get_word(w,pc);
ttype(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
break;
case STOREMAP: {
int n = *(pc++);
TObject *arr = top-(2*n)-1;
while (n--) {
*(lua_hashdefine (avalue(arr), top-2)) = *(top-1);
top-=2;
}
}
break;
case ADJUST0:
adjust_top(base);
break;
case ADJUST: {
StkId newtop = base + *(pc++);
adjust_top(newtop);
break;
}
case VARARGS:
adjust_varargs(base + *(pc++));
break;
case CREATEARRAY:
{
Word size;
get_word(size,pc);
avalue(top) = lua_createarray(size);
ttype(top) = LUA_T_ARRAY;
incr_top;
}
break;
case EQOP:
{
int res = lua_equalObj(top-2, top-1);
--top;
ttype(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(top-1) = 1;
}
break;
case LTOP:
comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
break;
case LEOP:
comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
break;
case GTOP:
comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
break;
case GEOP:
comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
break;
case ADDOP:
{
TObject *l = top-2;
TObject *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_ADD);
else
{
nvalue(l) += nvalue(r);
--top;
}
}
break;
case SUBOP:
{
TObject *l = top-2;
TObject *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_SUB);
else
{
nvalue(l) -= nvalue(r);
--top;
}
}
break;
case MULTOP:
{
TObject *l = top-2;
TObject *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_MUL);
else
{
nvalue(l) *= nvalue(r);
--top;
}
}
break;
case DIVOP:
{
TObject *l = top-2;
TObject *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_DIV);
else
{
nvalue(l) /= nvalue(r);
--top;
}
}
break;
case POWOP:
call_arith(IM_POW);
break;
case CONCOP: {
TObject *l = top-2;
TObject *r = top-1;
if (tostring(l) || tostring(r))
call_binTM(IM_CONCAT, "unexpected type for concatenation");
else {
tsvalue(l) = lua_createstring(lua_strconc(svalue(l),svalue(r)));
--top;
}
}
break;
case MINUSOP:
if (tonumber(top-1))
{
ttype(top) = LUA_T_NIL;
incr_top;
call_arith(IM_UNM);
}
else
nvalue(top-1) = - nvalue(top-1);
break;
case NOTOP:
ttype(top-1) = (ttype(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(top-1) = 1;
break;
case ONTJMP:
{
Word w;
get_word(w,pc);
if (ttype(top-1) != LUA_T_NIL) pc += w;
}
break;
case ONFJMP:
{
Word w;
get_word(w,pc);
if (ttype(top-1) == LUA_T_NIL) pc += w;
}
break;
case JMP:
{
Word w;
get_word(w,pc);
pc += w;
}
break;
case UPJMP:
{
Word w;
get_word(w,pc);
pc -= w;
}
break;
case IFFJMP:
{
Word w;
get_word(w,pc);
top--;
if (ttype(top) == LUA_T_NIL) pc += w;
}
break;
case IFFUPJMP:
{
Word w;
get_word(w,pc);
top--;
if (ttype(top) == LUA_T_NIL) pc -= w;
}
break;
case POP: --top; break;
case CALLFUNC:
{
int nParams = *(pc++);
int nResults = *(pc++);
StkId newBase = (top-stack)-nParams;
do_call(newBase, nResults);
}
break;
case RETCODE0:
case RETCODE:
if (lua_callhook)
callHook (base, LUA_T_MARK, 1);
return (base + ((opcode==RETCODE0) ? 0 : *pc));
case SETLINE:
{
Word line;
get_word(line,pc);
if ((stack+base-1)->ttype != LUA_T_LINE)
{
/* open space for LINE value */
open_stack((top-stack)-base);
base++;
(stack+base-1)->ttype = LUA_T_LINE;
}
(stack+base-1)->value.i = line;
if (lua_linehook)
lineHook (line);
break;
}
default:
lua_error ("internal error - opcode doesn't match");
}
}
}
/*
** Execute the given opcode, until a RET. Parameters are between
** [stack+base,top). Returns n such that the the results are between
** [stack+n,top).
*/
static StkId lua_execute (Byte *pc, StkId base)
{
void* table[] = {
&&pushnil,
&&push0,
&&push1,
&&push2,
&&pushbyte,
&&pushword,
&&pushfloat,
&&pushstring,
&&pushfunction,
&&pushlocal0,
&&pushlocal1,
&&pushlocal2,
&&pushlocal3,
&&pushlocal4,
&&pushlocal5,
&&pushlocal6,
&&pushlocal7,
&&pushlocal8,
&&pushlocal9,
&&pushlocal,
&&pushglobal,
&&pushindexed,
&&pushself,
&&storelocal0,
&&storelocal1,
&&storelocal2,
&&storelocal3,
&&storelocal4,
&&storelocal5,
&&storelocal6,
&&storelocal7,
&&storelocal8,
&&storelocal9,
&&storelocal,
&&storeglobal,
&&storeindexed0,
&&storeindexed,
&&storelist0,
&&storelist,
&&storerecord,
&&adjust0,
&&adjust,
&&createarray,
&&eqop,
&<op,
&&leop,
&>op,
&&geop,
&&addop,
&&subop,
&&multop,
&&divop,
&&powop,
&&concop,
&&minusop,
&¬op,
&&ontjmp,
&&onfjmp,
&&jmp,
&&upjmp,
&&iffjmp,
&&iffupjmp,
&&pop,
&&callfunc,
&&retcode0,
&&retcode,
&&setline,
&&varargs
};
if (lua_callhook)
callHook (base, LUA_T_MARK, 0);
goto *table[*pc++];
pushnil: tag(top) = LUA_T_NIL; incr_top; goto *table[*pc++];
push0: push1: push2:
tag(top) = LUA_T_NUMBER;
nvalue(top) = ((OpCode)*(pc-1))-PUSH0;
incr_top;
goto *table[*pc++];
pushbyte:
tag(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; goto *table[*pc++];
pushword:
{
Word w;
get_word(w,pc);
tag(top) = LUA_T_NUMBER; nvalue(top) = w;
incr_top;
}
goto *table[*pc++];
pushfloat:
{
real num;
get_float(num,pc);
tag(top) = LUA_T_NUMBER; nvalue(top) = num;
incr_top;
}
goto *table[*pc++];
pushstring:
{
Word w;
get_word(w,pc);
tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
incr_top;
}
goto *table[*pc++];
pushfunction:
{
TFunc *f;
get_code(f,pc);
luaI_insertfunction(f); /* may take part in GC */
top->tag = LUA_T_FUNCTION;
top->value.tf = f;
incr_top;
}
goto *table[*pc++];
pushlocal0: pushlocal1: pushlocal2:
pushlocal3: pushlocal4: pushlocal5:
pushlocal6: pushlocal7: pushlocal8:
pushlocal9:
*top = *((stack+base) + (int)(((OpCode)*(pc-1))-PUSHLOCAL0)); incr_top; goto *table[*pc++];
pushlocal: *top = *((stack+base) + (*pc++)); incr_top; goto *table[*pc++];
pushglobal:
{
Word w;
get_word(w,pc);
getglobal(w);
}
goto *table[*pc++];
pushindexed:
pushsubscript();
goto *table[*pc++];
pushself:
{
Object receiver = *(top-1);
Word w;
get_word(w,pc);
tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
incr_top;
pushsubscript();
*top = receiver;
incr_top;
goto *table[*pc++];
}
storelocal0: storelocal1: storelocal2:
storelocal3: storelocal4: storelocal5:
storelocal6: storelocal7: storelocal8:
storelocal9:
*((stack+base) + (int)(((OpCode)*(pc-1))-STORELOCAL0)) = *(--top);
goto *table[*pc++];
storelocal: *((stack+base) + (*pc++)) = *(--top); goto *table[*pc++];
storeglobal:
{
Word w;
get_word(w,pc);
s_object(w) = *(--top);
}
goto *table[*pc++];
storeindexed0:
storesubscript();
goto *table[*pc++];
storeindexed:
{
int n = *pc++;
if (tag(top-3-n) != LUA_T_ARRAY)
{
lua_checkstack(top+2);
*(top+1) = *(top-1);
*(top) = *(top-2-n);
*(top-1) = *(top-3-n);
top += 2;
callFB(FB_SETTABLE);
}
else
{
Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
*h = *(top-1);
top--;
}
}
goto *table[*pc++];
storelist0:
storelist:
{
int m, n;
Object *arr;
if (((OpCode)*(pc-1)) == STORELIST0) m = 0;
else m = *(pc++) * FIELDS_PER_FLUSH;
n = *(pc++);
arr = top-n-1;
while (n)
{
tag(top) = LUA_T_NUMBER; nvalue(top) = n+m;
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
goto *table[*pc++];
storerecord:
{
int n = *(pc++);
Object *arr = top-n-1;
while (n)
{
Word w;
get_word(w,pc);
tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
goto *table[*pc++];
adjust0:
adjust_top(base);
goto *table[*pc++];
adjust:
adjust_top(base + *(pc++));
goto *table[*pc++];
varargs:
adjust_varargs(base + *(pc++));
goto *table[*pc++];
createarray:
{
Word size;
get_word(size,pc);
avalue(top) = lua_createarray(size);
tag(top) = LUA_T_ARRAY;
incr_top;
}
goto *table[*pc++];
eqop:
{
int res = lua_equalObj(top-2, top-1);
--top;
tag(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(top-1) = 1;
}
goto *table[*pc++];
ltop:
comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, "lt");
goto *table[*pc++];
leop:
comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, "le");
goto *table[*pc++];
gtop:
comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, "gt");
goto *table[*pc++];
geop:
comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, "ge");
goto *table[*pc++];
addop:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith("add");
else
{
nvalue(l) += nvalue(r);
--top;
}
}
goto *table[*pc++];
subop:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith("sub");
else
{
nvalue(l) -= nvalue(r);
--top;
}
}
goto *table[*pc++];
multop:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith("mul");
else
{
nvalue(l) *= nvalue(r);
--top;
}
}
goto *table[*pc++];
divop:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
call_arith("div");
else
{
nvalue(l) /= nvalue(r);
--top;
}
}
goto *table[*pc++];
powop:
call_arith("pow");
goto *table[*pc++];
concop:
{
Object *l = top-2;
Object *r = top-1;
if (tostring(r) || tostring(l))
callFB(FB_CONCAT);
else
{
tsvalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
--top;
}
}
goto *table[*pc++];
minusop:
if (tonumber(top-1))
{
tag(top) = LUA_T_NIL;
incr_top;
call_arith("unm");
}
else
nvalue(top-1) = - nvalue(top-1);
goto *table[*pc++];
notop:
tag(top-1) = (tag(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(top-1) = 1;
goto *table[*pc++];
ontjmp:
{
Word w;
get_word(w,pc);
if (tag(top-1) != LUA_T_NIL) pc += w;
}
goto *table[*pc++];
onfjmp:
{
Word w;
get_word(w,pc);
if (tag(top-1) == LUA_T_NIL) pc += w;
}
goto *table[*pc++];
jmp:
{
Word w;
get_word(w,pc);
pc += w;
}
goto *table[*pc++];
upjmp:
{
Word w;
get_word(w,pc);
pc -= w;
}
goto *table[*pc++];
iffjmp:
{
Word w;
get_word(w,pc);
top--;
if (tag(top) == LUA_T_NIL) pc += w;
}
goto *table[*pc++];
iffupjmp:
{
Word w;
get_word(w,pc);
top--;
if (tag(top) == LUA_T_NIL) pc -= w;
}
goto *table[*pc++];
pop: --top; goto *table[*pc++];
callfunc:
{
int nParams = *(pc++);
int nResults = *(pc++);
StkId newBase = (top-stack)-nParams;
do_call(newBase, nResults);
}
goto *table[*pc++];
retcode0:
retcode:
if (lua_callhook)
callHook (base, LUA_T_MARK, 1);
return (base + ((((OpCode)*(pc-1))==RETCODE0) ? 0 : *pc));
setline:
{
Word line;
get_word(line,pc);
if ((stack+base-1)->tag != LUA_T_LINE)
{
/* open space for LINE value */
open_stack((top-stack)-base);
base++;
(stack+base-1)->tag = LUA_T_LINE;
}
(stack+base-1)->value.i = line;
if (lua_linehook)
lineHook (line);
goto *table[*pc++];
}
lua_error ("internal error - opcode doesn't match");
}
static lua_Object put_luaObjectonTop (void)
{
open_stack((top-stack)-CLS_current.base);
stack[CLS_current.base++] = *(--top);
return CLS_current.base; /* this is +1 real position (see Ref) */
}
static void callIM (TObject *f, int nParams, int nResults)
{
open_stack(nParams);
*(top-nParams-1) = *f;
do_call((top-stack)-nParams, nResults);
}
// Runs the given stack within the given ambience until a condition is
// encountered or evaluation completes. This function also bails on and leaves
// it to the surrounding code to report error messages.
static value_t run_stack_pushing_signals(value_t ambience, value_t stack) {
CHECK_FAMILY(ofAmbience, ambience);
CHECK_FAMILY(ofStack, stack);
runtime_t *runtime = get_ambience_runtime(ambience);
frame_t frame = open_stack(stack);
code_cache_t cache;
code_cache_refresh(&cache, &frame);
E_BEGIN_TRY_FINALLY();
while (true) {
opcode_t opcode = (opcode_t) read_short(&cache, &frame, 0);
TOPIC_INFO(Interpreter, "Opcode: %s (%i)", get_opcode_name(opcode),
opcode_counter++);
IF_EXPENSIVE_CHECKS_ENABLED(MAYBE_INTERRUPT());
switch (opcode) {
case ocPush: {
value_t value = read_value(&cache, &frame, 1);
frame_push_value(&frame, value);
frame.pc += kPushOperationSize;
break;
}
case ocPop: {
size_t count = read_short(&cache, &frame, 1);
for (size_t i = 0; i < count; i++)
frame_pop_value(&frame);
frame.pc += kPopOperationSize;
break;
}
case ocCheckStackHeight: {
size_t expected = read_short(&cache, &frame, 1);
size_t height = frame.stack_pointer - frame.frame_pointer;
CHECK_EQ("stack height", expected, height);
frame.pc += kCheckStackHeightOperationSize;
break;
}
case ocNewArray: {
size_t length = read_short(&cache, &frame, 1);
E_TRY_DEF(array, new_heap_array(runtime, length));
for (size_t i = 0; i < length; i++) {
value_t element = frame_pop_value(&frame);
set_array_at(array, length - i - 1, element);
}
frame_push_value(&frame, array);
frame.pc += kNewArrayOperationSize;
break;
}
case ocInvoke: {
// Look up the method in the method space.
value_t tags = read_value(&cache, &frame, 1);
CHECK_FAMILY(ofCallTags, tags);
value_t fragment = read_value(&cache, &frame, 2);
CHECK_FAMILY(ofModuleFragment, fragment);
value_t helper = read_value(&cache, &frame, 3);
CHECK_FAMILY(ofSignatureMap, helper);
value_t arg_map;
value_t method = lookup_method_full(ambience, fragment, tags, &frame,
helper, &arg_map);
if (in_condition_cause(ccLookupError, method)) {
log_lookup_error(method, tags, &frame);
E_RETURN(method);
}
// The lookup may have failed with a different condition. Check for that.
E_TRY(method);
E_TRY_DEF(code_block, ensure_method_code(runtime, method));
// We should now have done everything that can fail so we advance the
// pc over this instruction. In reality we haven't, the frame push op
// below can fail so we should really push the next frame before
// storing the pc for this one. Laters.
frame.pc += kInvokeOperationSize;
// Push a new activation.
E_TRY(push_stack_frame(runtime, stack, &frame,
get_code_block_high_water_mark(code_block), arg_map));
frame_set_code_block(&frame, code_block);
code_cache_refresh(&cache, &frame);
break;
}
case ocSignalContinue:
case ocSignalEscape: {
// Look up the method in the method space.
value_t tags = read_value(&cache, &frame, 1);
CHECK_FAMILY(ofCallTags, tags);
frame.pc += kSignalEscapeOperationSize;
value_t arg_map = whatever();
value_t handler = whatever();
value_t method = lookup_signal_handler_method(ambience, tags, &frame,
&handler, &arg_map);
bool is_escape = (opcode == ocSignalEscape);
if (in_condition_cause(ccLookupError, method)) {
if (is_escape) {
// There was no handler for this so we have to escape out of the
// interpreter altogether. Push the signal frame onto the stack to
// record the state of it for the enclosing code.
E_TRY(push_stack_frame(runtime, stack, &frame, 1, nothing()));
// The stack tracing code expects all frames to have a valid code block
// object. The rest makes less of a difference.
frame_set_code_block(&frame, ROOT(runtime, empty_code_block));
E_RETURN(new_signal_condition(is_escape));
} else {
// There was no handler but this is not an escape so we skip over
// the post-handler goto to the default block.
CHECK_EQ("signal not followed by goto", ocGoto,
read_short(&cache, &frame, 0));
frame.pc += kGotoOperationSize;
}
} else {
// We found a method. Invoke it.
E_TRY(method);
E_TRY_DEF(code_block, ensure_method_code(runtime, method));
E_TRY(push_stack_frame(runtime, stack, &frame,
get_code_block_high_water_mark(code_block), arg_map));
frame_set_code_block(&frame, code_block);
CHECK_TRUE("subject not null", is_null(frame_get_argument(&frame, 0)));
frame_set_argument(&frame, 0, handler);
code_cache_refresh(&cache, &frame);
}
break;
}
case ocGoto: {
size_t delta = read_short(&cache, &frame, 1);
frame.pc += delta;
break;
}
case ocDelegateToLambda:
case ocDelegateToBlock: {
// This op only appears in the lambda and block delegator methods.
// They should never be executed because the delegation happens during
// method lookup. If we hit here something's likely wrong with the
// lookup process.
UNREACHABLE("delegate to lambda");
return new_condition(ccWat);
}
case ocBuiltin: {
value_t wrapper = read_value(&cache, &frame, 1);
builtin_method_t impl = (builtin_method_t) get_void_p_value(wrapper);
builtin_arguments_t args;
builtin_arguments_init(&args, runtime, &frame);
E_TRY_DEF(result, impl(&args));
frame_push_value(&frame, result);
frame.pc += kBuiltinOperationSize;
break;
}
case ocBuiltinMaybeEscape: {
value_t wrapper = read_value(&cache, &frame, 1);
builtin_method_t impl = (builtin_method_t) get_void_p_value(wrapper);
builtin_arguments_t args;
builtin_arguments_init(&args, runtime, &frame);
value_t result = impl(&args);
if (in_condition_cause(ccSignal, result)) {
// The builtin failed. Find the appropriate signal handler and call
// it. The invocation record is at the top of the stack.
value_t tags = frame_pop_value(&frame);
CHECK_FAMILY(ofCallTags, tags);
value_t arg_map = whatever();
value_t handler = whatever();
value_t method = lookup_signal_handler_method(ambience, tags, &frame,
&handler, &arg_map);
if (in_condition_cause(ccLookupError, method)) {
// Push the record back onto the stack to it's available to back
// tracing.
frame_push_value(&frame, tags);
frame.pc += kBuiltinMaybeEscapeOperationSize;
// There was no handler for this so we have to escape out of the
// interpreter altogether. Push the signal frame onto the stack to
// record the state of it for the enclosing code.
E_TRY(push_stack_frame(runtime, stack, &frame, 1, nothing()));
// The stack tracing code expects all frames to have a valid code block
// object. The rest makes less of a difference.
frame_set_code_block(&frame, ROOT(runtime, empty_code_block));
E_RETURN(new_signal_condition(true));
}
// Either found a signal or encountered a different condition.
E_TRY(method);
// Skip forward to the point we want the signal to return to, the
// leave-or-fire-barrier op that will do the leaving.
size_t dest_offset = read_short(&cache, &frame, 2);
frame.pc += dest_offset;
// Run the handler.
E_TRY_DEF(code_block, ensure_method_code(runtime, method));
E_TRY(push_stack_frame(runtime, stack, &frame,
get_code_block_high_water_mark(code_block), arg_map));
frame_set_code_block(&frame, code_block);
CHECK_TRUE("subject not null", is_null(frame_get_argument(&frame, 0)));
frame_set_argument(&frame, 0, handler);
code_cache_refresh(&cache, &frame);
} else {
// The builtin didn't cause a condition so we can just keep going.
E_TRY(result);
frame_push_value(&frame, result);
frame.pc += kBuiltinMaybeEscapeOperationSize;
}
break;
}
case ocReturn: {
value_t result = frame_pop_value(&frame);
frame_pop_within_stack_piece(&frame);
code_cache_refresh(&cache, &frame);
frame_push_value(&frame, result);
break;
}
case ocStackBottom: {
value_t result = frame_pop_value(&frame);
validate_stack_on_normal_exit(&frame);
E_RETURN(result);
}
case ocStackPieceBottom: {
value_t top_piece = frame.stack_piece;
value_t result = frame_pop_value(&frame);
value_t next_piece = get_stack_piece_previous(top_piece);
set_stack_top_piece(stack, next_piece);
frame = open_stack(stack);
code_cache_refresh(&cache, &frame);
frame_push_value(&frame, result);
break;
}
case ocSlap: {
value_t value = frame_pop_value(&frame);
size_t argc = read_short(&cache, &frame, 1);
for (size_t i = 0; i < argc; i++)
frame_pop_value(&frame);
frame_push_value(&frame, value);
frame.pc += kSlapOperationSize;
break;
}
case ocNewReference: {
// Create the reference first so that if it fails we haven't clobbered
// the stack yet.
E_TRY_DEF(ref, new_heap_reference(runtime, nothing()));
value_t value = frame_pop_value(&frame);
set_reference_value(ref, value);
frame_push_value(&frame, ref);
frame.pc += kNewReferenceOperationSize;
break;
}
case ocSetReference: {
value_t ref = frame_pop_value(&frame);
CHECK_FAMILY(ofReference, ref);
value_t value = frame_peek_value(&frame, 0);
set_reference_value(ref, value);
frame.pc += kSetReferenceOperationSize;
break;
}
case ocGetReference: {
value_t ref = frame_pop_value(&frame);
CHECK_FAMILY(ofReference, ref);
value_t value = get_reference_value(ref);
frame_push_value(&frame, value);
frame.pc += kGetReferenceOperationSize;
break;
}
case ocLoadLocal: {
size_t index = read_short(&cache, &frame, 1);
value_t value = frame_get_local(&frame, index);
frame_push_value(&frame, value);
frame.pc += kLoadLocalOperationSize;
break;
}
case ocLoadGlobal: {
value_t ident = read_value(&cache, &frame, 1);
CHECK_FAMILY(ofIdentifier, ident);
value_t fragment = read_value(&cache, &frame, 2);
CHECK_FAMILY(ofModuleFragment, fragment);
value_t module = get_module_fragment_module(fragment);
E_TRY_DEF(value, module_lookup_identifier(runtime, module,
get_identifier_stage(ident), get_identifier_path(ident)));
frame_push_value(&frame, value);
frame.pc += kLoadGlobalOperationSize;
break;
}
case ocLoadArgument: {
size_t param_index = read_short(&cache, &frame, 1);
value_t value = frame_get_argument(&frame, param_index);
frame_push_value(&frame, value);
frame.pc += kLoadArgumentOperationSize;
break;
}
case ocLoadRefractedArgument: {
size_t param_index = read_short(&cache, &frame, 1);
size_t block_depth = read_short(&cache, &frame, 2);
value_t subject = frame_get_argument(&frame, 0);
frame_t home = frame_empty();
get_refractor_refracted_frame(subject, block_depth, &home);
value_t value = frame_get_argument(&home, param_index);
frame_push_value(&frame, value);
frame.pc += kLoadRefractedArgumentOperationSize;
break;
}
case ocLoadRefractedLocal: {
size_t index = read_short(&cache, &frame, 1);
size_t block_depth = read_short(&cache, &frame, 2);
value_t subject = frame_get_argument(&frame, 0);
frame_t home = frame_empty();
get_refractor_refracted_frame(subject, block_depth, &home);
value_t value = frame_get_local(&home, index);
frame_push_value(&frame, value);
frame.pc += kLoadRefractedLocalOperationSize;
break;
}
case ocLoadLambdaCapture: {
size_t index = read_short(&cache, &frame, 1);
value_t subject = frame_get_argument(&frame, 0);
CHECK_FAMILY(ofLambda, subject);
value_t value = get_lambda_capture(subject, index);
frame_push_value(&frame, value);
frame.pc += kLoadLambdaCaptureOperationSize;
break;
}
case ocLoadRefractedCapture: {
size_t index = read_short(&cache, &frame, 1);
size_t block_depth = read_short(&cache, &frame, 2);
value_t subject = frame_get_argument(&frame, 0);
frame_t home = frame_empty();
get_refractor_refracted_frame(subject, block_depth, &home);
value_t lambda = frame_get_argument(&home, 0);
CHECK_FAMILY(ofLambda, lambda);
value_t value = get_lambda_capture(lambda, index);
frame_push_value(&frame, value);
frame.pc += kLoadRefractedLocalOperationSize;
break;
}
case ocLambda: {
value_t space = read_value(&cache, &frame, 1);
CHECK_FAMILY(ofMethodspace, space);
size_t capture_count = read_short(&cache, &frame, 2);
value_t captures;
E_TRY_DEF(lambda, new_heap_lambda(runtime, space, nothing()));
if (capture_count == 0) {
captures = ROOT(runtime, empty_array);
frame.pc += kLambdaOperationSize;
} else {
E_TRY_SET(captures, new_heap_array(runtime, capture_count));
// The pc gets incremented here because it is after we've done all
// the allocation but before anything has been popped off the stack.
// This way all the above is idempotent, and the below is guaranteed
// to succeed.
frame.pc += kLambdaOperationSize;
for (size_t i = 0; i < capture_count; i++)
set_array_at(captures, i, frame_pop_value(&frame));
}
set_lambda_captures(lambda, captures);
frame_push_value(&frame, lambda);
break;
}
case ocCreateBlock: {
value_t space = read_value(&cache, &frame, 1);
CHECK_FAMILY(ofMethodspace, space);
// Create the block object.
E_TRY_DEF(block, new_heap_block(runtime, nothing()));
// Create the stack section that describes the block.
value_t section = frame_alloc_derived_object(&frame, get_genus_descriptor(dgBlockSection));
set_barrier_state_payload(section, block);
refraction_point_init(section, &frame);
set_block_section_methodspace(section, space);
set_block_section(block, section);
value_validate(block);
value_validate(section);
// Push the block object.
frame_push_value(&frame, block);
frame.pc += kCreateBlockOperationSize;
break;
}
case ocCreateEnsurer: {
value_t code_block = read_value(&cache, &frame, 1);
value_t section = frame_alloc_derived_object(&frame,
get_genus_descriptor(dgEnsureSection));
set_barrier_state_payload(section, code_block);
refraction_point_init(section, &frame);
value_validate(section);
frame_push_value(&frame, section);
frame.pc += kCreateEnsurerOperationSize;
break;
}
case ocCallEnsurer: {
value_t value = frame_pop_value(&frame);
value_t shard = frame_pop_value(&frame);
frame_push_value(&frame, value);
frame_push_value(&frame, shard);
CHECK_GENUS(dgEnsureSection, shard);
value_t code_block = get_barrier_state_payload(shard);
CHECK_FAMILY(ofCodeBlock, code_block);
// Unregister the barrier before calling it, otherwise if we leave
// by escaping we'll end up calling it over again.
barrier_state_unregister(shard, stack);
frame.pc += kCallEnsurerOperationSize;
value_t argmap = ROOT(runtime, array_of_zero);
push_stack_frame(runtime, stack, &frame,
get_code_block_high_water_mark(code_block), argmap);
frame_set_code_block(&frame, code_block);
code_cache_refresh(&cache, &frame);
break;
}
case ocDisposeEnsurer: {
// Discard the result of the ensure block. If an ensure blocks needs
// to return a useful value it can do it via an escape.
frame_pop_value(&frame);
value_t shard = frame_pop_value(&frame);
CHECK_GENUS(dgEnsureSection, shard);
value_t value = frame_pop_value(&frame);
frame_destroy_derived_object(&frame, get_genus_descriptor(dgEnsureSection));
frame_push_value(&frame, value);
frame.pc += kDisposeEnsurerOperationSize;
break;
}
case ocInstallSignalHandler: {
value_t space = read_value(&cache, &frame, 1);
CHECK_FAMILY(ofMethodspace, space);
size_t dest_offset = read_short(&cache, &frame, 2);
// Allocate the derived object that's going to hold the signal handler
// state.
value_t section = frame_alloc_derived_object(&frame,
get_genus_descriptor(dgSignalHandlerSection));
// Initialize the handler.
set_barrier_state_payload(section, space);
refraction_point_init(section, &frame);
// Bring the frame state to the point we'll want to escape to (modulo
// the destination offset).
frame_push_value(&frame, section);
frame.pc += kInstallSignalHandlerOperationSize;
// Finally capture the escape state.
capture_escape_state(section, &frame, dest_offset);
value_validate(section);
break;
}
case ocUninstallSignalHandler: {
// The result has been left at the top of the stack.
value_t value = frame_pop_value(&frame);
value_t section = frame_pop_value(&frame);
CHECK_GENUS(dgSignalHandlerSection, section);
barrier_state_unregister(section, stack);
frame_destroy_derived_object(&frame, get_genus_descriptor(dgSignalHandlerSection));
frame_push_value(&frame, value);
frame.pc += kUninstallSignalHandlerOperationSize;
break;
}
case ocCreateEscape: {
size_t dest_offset = read_short(&cache, &frame, 1);
// Create an initially empty escape object.
E_TRY_DEF(escape, new_heap_escape(runtime, nothing()));
// Allocate the escape section on the stack, hooking the barrier into
// the barrier chain.
value_t section = frame_alloc_derived_object(&frame, get_genus_descriptor(dgEscapeSection));
// Point the state and object to each other.
set_barrier_state_payload(section, escape);
set_escape_section(escape, section);
// Get execution ready for the next operation.
frame_push_value(&frame, escape);
frame.pc += kCreateEscapeOperationSize;
// This is the execution state the escape will escape to (modulo the
// destination offset) so this is what we want to capture.
capture_escape_state(section, &frame,
dest_offset);
break;
}
case ocLeaveOrFireBarrier: {
size_t argc = read_short(&cache, &frame, 1);
// At this point the handler has been set as the subject of the call
// to the handler method. Above the arguments are also two scratch
// stack entries.
value_t handler = frame_peek_value(&frame, argc + 2);
CHECK_GENUS(dgSignalHandlerSection, handler);
if (maybe_fire_next_barrier(&cache, &frame, runtime, stack, handler)) {
// Pop the scratch entries off.
frame_pop_value(&frame);
frame_pop_value(&frame);
// Pop the value off.
value_t value = frame_pop_value(&frame);
// Escape to the handler's home.
restore_escape_state(&frame, stack, handler);
code_cache_refresh(&cache, &frame);
// Push the value back on, now in the handler's home frame.
frame_push_value(&frame, value);
} else {
// If a barrier was fired we'll want to let the interpreter loop
// around again so just break without touching .pc.
}
break;
}
case ocFireEscapeOrBarrier: {
value_t escape = frame_get_argument(&frame, 0);
CHECK_FAMILY(ofEscape, escape);
value_t section = get_escape_section(escape);
// Fire the next barrier or, if there are no more barriers, apply the
// escape.
if (maybe_fire_next_barrier(&cache, &frame, runtime, stack, section)) {
value_t value = frame_get_argument(&frame, 2);
restore_escape_state(&frame, stack, section);
code_cache_refresh(&cache, &frame);
frame_push_value(&frame, value);
} else {
// If a barrier was fired we'll want to let the interpreter loop
// around again so just break without touching .pc.
}
break;
}
case ocDisposeEscape: {
value_t value = frame_pop_value(&frame);
value_t escape = frame_pop_value(&frame);
CHECK_FAMILY(ofEscape, escape);
value_t section = get_escape_section(escape);
value_validate(section);
barrier_state_unregister(section, stack);
on_escape_section_exit(section);
frame_destroy_derived_object(&frame, get_genus_descriptor(dgEscapeSection));
frame_push_value(&frame, value);
frame.pc += kDisposeEscapeOperationSize;
break;
}
case ocDisposeBlock: {
value_t value = frame_pop_value(&frame);
value_t block = frame_pop_value(&frame);
CHECK_FAMILY(ofBlock, block);
value_t section = get_block_section(block);
barrier_state_unregister(section, stack);
on_block_section_exit(section);
frame_destroy_derived_object(&frame, get_genus_descriptor(dgBlockSection));
frame_push_value(&frame, value);
frame.pc += kDisposeBlockOperationSize;
break;
}
default:
ERROR("Unexpected opcode %i", opcode);
UNREACHABLE("unexpected opcode");
break;
}
}
E_FINALLY();
close_frame(&frame);
E_END_TRY_FINALLY();
}
static lua_Object put_luaObject (TObject *o)
{
open_stack((top-stack)-CLS_current.base);
stack[CLS_current.base++] = *o;
return CLS_current.base; /* this is +1 real position (see Ref) */
}
