/* ** 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) */ }