diff options
| author | Roberto Ierusalimschy <roberto@inf.puc-rio.br> | 1997-09-16 16:25:59 -0300 |
|---|---|---|
| committer | Roberto Ierusalimschy <roberto@inf.puc-rio.br> | 1997-09-16 16:25:59 -0300 |
| commit | 43a2ee6ea1b7825c1892de614cb38a3fe487a19f (patch) | |
| tree | c2db158b379c56fb93c0c66ded2a6c8312102062 /opcode.c | |
| parent | 4b91e9cde630573cb35bb20101eb74cf5cf79a27 (diff) | |
| download | lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.tar.gz lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.tar.bz2 lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.zip | |
Stack and Call structure of Lua
Diffstat (limited to 'opcode.c')
| -rw-r--r-- | opcode.c | 1484 |
1 files changed, 0 insertions, 1484 deletions
diff --git a/opcode.c b/opcode.c deleted file mode 100644 index e569d284..00000000 --- a/opcode.c +++ /dev/null | |||
| @@ -1,1484 +0,0 @@ | |||
| 1 | /* | ||
| 2 | ** opcode.c | ||
| 3 | ** TecCGraf - PUC-Rio | ||
| 4 | */ | ||
| 5 | |||
| 6 | char *rcs_opcode="$Id: opcode.c,v 4.21 1997/07/31 19:37:37 roberto Exp roberto $"; | ||
| 7 | |||
| 8 | #include <setjmp.h> | ||
| 9 | #include <stdio.h> | ||
| 10 | #include <string.h> | ||
| 11 | #include <stdlib.h> | ||
| 12 | |||
| 13 | #include "lualoc.h" | ||
| 14 | #include "luadebug.h" | ||
| 15 | #include "luamem.h" | ||
| 16 | #include "opcode.h" | ||
| 17 | #include "hash.h" | ||
| 18 | #include "inout.h" | ||
| 19 | #include "table.h" | ||
| 20 | #include "lua.h" | ||
| 21 | #include "fallback.h" | ||
| 22 | #include "auxlib.h" | ||
| 23 | #include "lex.h" | ||
| 24 | |||
| 25 | #define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0)) | ||
| 26 | #define tostring(o) ((ttype(o) != LUA_T_STRING) && (lua_tostring(o) != 0)) | ||
| 27 | |||
| 28 | |||
| 29 | #define get_word(w,pc) {w=*pc+(*(pc+1)<<8); pc+=2;} | ||
| 30 | |||
| 31 | |||
| 32 | #define STACK_SIZE 128 | ||
| 33 | |||
| 34 | #ifndef STACK_LIMIT | ||
| 35 | #define STACK_LIMIT 6000 | ||
| 36 | #endif | ||
| 37 | |||
| 38 | typedef int StkId; /* index to stack elements */ | ||
| 39 | |||
| 40 | static TObject initial_stack; | ||
| 41 | |||
| 42 | static TObject *stackLimit = &initial_stack+1; | ||
| 43 | static TObject *stack = &initial_stack; | ||
| 44 | static TObject *top = &initial_stack; | ||
| 45 | |||
| 46 | |||
| 47 | /* macros to convert from lua_Object to (TObject *) and back */ | ||
| 48 | |||
| 49 | #define Address(lo) ((lo)+stack-1) | ||
| 50 | #define Ref(st) ((st)-stack+1) | ||
| 51 | |||
| 52 | |||
| 53 | /* macro to increment stack top. There must be always an empty slot in | ||
| 54 | * the stack | ||
| 55 | */ | ||
| 56 | #define incr_top if (++top >= stackLimit) growstack() | ||
| 57 | |||
| 58 | struct C_Lua_Stack { | ||
| 59 | StkId base; /* when Lua calls C or C calls Lua, points to */ | ||
| 60 | /* the first slot after the last parameter. */ | ||
| 61 | StkId lua2C; /* points to first element of "array" lua2C */ | ||
| 62 | int num; /* size of "array" lua2C */ | ||
| 63 | }; | ||
| 64 | |||
| 65 | static struct C_Lua_Stack CLS_current = {0, 0, 0}; | ||
| 66 | |||
| 67 | static jmp_buf *errorJmp = NULL; /* current error recover point */ | ||
| 68 | |||
| 69 | |||
| 70 | /* Hooks */ | ||
| 71 | lua_LHFunction lua_linehook = NULL; | ||
| 72 | lua_CHFunction lua_callhook = NULL; | ||
| 73 | |||
| 74 | |||
| 75 | static StkId lua_execute (TFunc *func, StkId base); | ||
| 76 | static void do_call (StkId base, int nResults); | ||
| 77 | |||
| 78 | |||
| 79 | |||
| 80 | TObject *luaI_Address (lua_Object o) | ||
| 81 | { | ||
| 82 | return Address(o); | ||
| 83 | } | ||
| 84 | |||
| 85 | |||
| 86 | /* | ||
| 87 | ** Init stack | ||
| 88 | */ | ||
| 89 | static void lua_initstack (void) | ||
| 90 | { | ||
| 91 | Long maxstack = STACK_SIZE; | ||
| 92 | stack = newvector(maxstack, TObject); | ||
| 93 | stackLimit = stack+maxstack; | ||
| 94 | top = stack; | ||
| 95 | *(top++) = initial_stack; | ||
| 96 | } | ||
| 97 | |||
| 98 | |||
| 99 | /* | ||
| 100 | ** Check stack overflow and, if necessary, realloc vector | ||
| 101 | */ | ||
| 102 | #define lua_checkstack(nt) if ((nt) >= stackLimit) growstack() | ||
| 103 | |||
| 104 | static void growstack (void) | ||
| 105 | { | ||
| 106 | if (stack == &initial_stack) | ||
| 107 | lua_initstack(); | ||
| 108 | else | ||
| 109 | { | ||
| 110 | static int limit = STACK_LIMIT; | ||
| 111 | StkId t = top-stack; | ||
| 112 | Long stacksize = stackLimit - stack; | ||
| 113 | stacksize = growvector(&stack, stacksize, TObject, stackEM, limit+100); | ||
| 114 | stackLimit = stack+stacksize; | ||
| 115 | top = stack + t; | ||
| 116 | if (stacksize >= limit) | ||
| 117 | { | ||
| 118 | limit = stacksize; | ||
| 119 | lua_error(stackEM); | ||
| 120 | } | ||
| 121 | } | ||
| 122 | } | ||
| 123 | |||
| 124 | |||
| 125 | /* | ||
| 126 | ** Concatenate two given strings. Return the new string pointer. | ||
| 127 | */ | ||
| 128 | static char *lua_strconc (char *l, char *r) | ||
| 129 | { | ||
| 130 | size_t nl = strlen(l); | ||
| 131 | char *buffer = luaI_buffer(nl+strlen(r)+1); | ||
| 132 | strcpy(buffer, l); | ||
| 133 | strcpy(buffer+nl, r); | ||
| 134 | return buffer; | ||
| 135 | } | ||
| 136 | |||
| 137 | |||
| 138 | /* | ||
| 139 | ** Convert, if possible, to a number object. | ||
| 140 | ** Return 0 if success, not 0 if error. | ||
| 141 | */ | ||
| 142 | static int lua_tonumber (TObject *obj) | ||
| 143 | { | ||
| 144 | double t; | ||
| 145 | char c; | ||
| 146 | if (ttype(obj) != LUA_T_STRING) | ||
| 147 | return 1; | ||
| 148 | else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) { | ||
| 149 | nvalue(obj) = (real)t; | ||
| 150 | ttype(obj) = LUA_T_NUMBER; | ||
| 151 | return 0; | ||
| 152 | } | ||
| 153 | else | ||
| 154 | return 2; | ||
| 155 | } | ||
| 156 | |||
| 157 | |||
| 158 | /* | ||
| 159 | ** Convert, if possible, to a string ttype | ||
| 160 | ** Return 0 in success or not 0 on error. | ||
| 161 | */ | ||
| 162 | static int lua_tostring (TObject *obj) | ||
| 163 | { | ||
| 164 | if (ttype(obj) != LUA_T_NUMBER) | ||
| 165 | return 1; | ||
| 166 | else { | ||
| 167 | char s[60]; | ||
| 168 | real f = nvalue(obj); | ||
| 169 | int i; | ||
| 170 | if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f) | ||
| 171 | sprintf (s, "%d", i); | ||
| 172 | else | ||
| 173 | sprintf (s, "%g", (double)nvalue(obj)); | ||
| 174 | tsvalue(obj) = luaI_createstring(s); | ||
| 175 | ttype(obj) = LUA_T_STRING; | ||
| 176 | return 0; | ||
| 177 | } | ||
| 178 | } | ||
| 179 | |||
| 180 | |||
| 181 | /* | ||
| 182 | ** Adjust stack. Set top to the given value, pushing NILs if needed. | ||
| 183 | */ | ||
| 184 | static void adjust_top_aux (StkId newtop) | ||
| 185 | { | ||
| 186 | TObject *nt; | ||
| 187 | lua_checkstack(stack+newtop); | ||
| 188 | nt = stack+newtop; /* warning: previous call may change stack */ | ||
| 189 | while (top < nt) ttype(top++) = LUA_T_NIL; | ||
| 190 | } | ||
| 191 | |||
| 192 | |||
| 193 | #define adjust_top(newtop) { if (newtop <= top-stack) \ | ||
| 194 | top = stack+newtop; \ | ||
| 195 | else adjust_top_aux(newtop); } | ||
| 196 | |||
| 197 | #define adjustC(nParams) adjust_top(CLS_current.base+nParams) | ||
| 198 | |||
| 199 | |||
| 200 | static void checkCparams (int nParams) | ||
| 201 | { | ||
| 202 | if (top-stack < CLS_current.base+nParams) | ||
| 203 | lua_error("API error - wrong number of arguments in C2lua stack"); | ||
| 204 | } | ||
| 205 | |||
| 206 | |||
| 207 | /* | ||
| 208 | ** Open a hole below "nelems" from the top. | ||
| 209 | */ | ||
| 210 | static void open_stack (int nelems) | ||
| 211 | { | ||
| 212 | int i; | ||
| 213 | for (i=0; i<nelems; i++) | ||
| 214 | *(top-i) = *(top-i-1); | ||
| 215 | incr_top; | ||
| 216 | } | ||
| 217 | |||
| 218 | |||
| 219 | static lua_Object put_luaObject (TObject *o) | ||
| 220 | { | ||
| 221 | open_stack((top-stack)-CLS_current.base); | ||
| 222 | stack[CLS_current.base++] = *o; | ||
| 223 | return CLS_current.base; /* this is +1 real position (see Ref) */ | ||
| 224 | } | ||
| 225 | |||
| 226 | |||
| 227 | static lua_Object put_luaObjectonTop (void) | ||
| 228 | { | ||
| 229 | open_stack((top-stack)-CLS_current.base); | ||
| 230 | stack[CLS_current.base++] = *(--top); | ||
| 231 | return CLS_current.base; /* this is +1 real position (see Ref) */ | ||
| 232 | } | ||
| 233 | |||
| 234 | |||
| 235 | lua_Object lua_pop (void) | ||
| 236 | { | ||
| 237 | checkCparams(1); | ||
| 238 | return put_luaObjectonTop(); | ||
| 239 | } | ||
| 240 | |||
| 241 | |||
| 242 | |||
| 243 | /* | ||
| 244 | ** call Line hook | ||
| 245 | */ | ||
| 246 | static void lineHook (int line) | ||
| 247 | { | ||
| 248 | struct C_Lua_Stack oldCLS = CLS_current; | ||
| 249 | StkId old_top = CLS_current.lua2C = CLS_current.base = top-stack; | ||
| 250 | CLS_current.num = 0; | ||
| 251 | (*lua_linehook)(line); | ||
| 252 | top = stack+old_top; | ||
| 253 | CLS_current = oldCLS; | ||
| 254 | } | ||
| 255 | |||
| 256 | |||
| 257 | /* | ||
| 258 | ** Call hook | ||
| 259 | ** The function being called is in [stack+base-1] | ||
| 260 | */ | ||
| 261 | static void callHook (StkId base, lua_Type type, int isreturn) | ||
| 262 | { | ||
| 263 | struct C_Lua_Stack oldCLS = CLS_current; | ||
| 264 | StkId old_top = CLS_current.lua2C = CLS_current.base = top-stack; | ||
| 265 | CLS_current.num = 0; | ||
| 266 | if (isreturn) | ||
| 267 | (*lua_callhook)(LUA_NOOBJECT, "(return)", 0); | ||
| 268 | else | ||
| 269 | { | ||
| 270 | TObject *f = stack+base-1; | ||
| 271 | if (type == LUA_T_MARK) | ||
| 272 | (*lua_callhook)(Ref(f), f->value.tf->fileName->str, | ||
| 273 | f->value.tf->lineDefined); | ||
| 274 | else | ||
| 275 | (*lua_callhook)(Ref(f), "(C)", -1); | ||
| 276 | } | ||
| 277 | top = stack+old_top; | ||
| 278 | CLS_current = oldCLS; | ||
| 279 | } | ||
| 280 | |||
| 281 | |||
| 282 | /* | ||
| 283 | ** Call a C function. CLS_current.base will point to the top of the stack, | ||
| 284 | ** and CLS_current.num is the number of parameters. Returns an index | ||
| 285 | ** to the first result from C. | ||
| 286 | */ | ||
| 287 | static StkId callC (lua_CFunction func, StkId base) | ||
| 288 | { | ||
| 289 | struct C_Lua_Stack oldCLS = CLS_current; | ||
| 290 | StkId firstResult; | ||
| 291 | CLS_current.num = (top-stack) - base; | ||
| 292 | /* incorporate parameters on the stack */ | ||
| 293 | CLS_current.lua2C = base; | ||
| 294 | CLS_current.base = base+CLS_current.num; /* == top-stack */ | ||
| 295 | if (lua_callhook) | ||
| 296 | callHook(base, LUA_T_CMARK, 0); | ||
| 297 | (*func)(); | ||
| 298 | if (lua_callhook) /* func may have changed lua_callhook */ | ||
| 299 | callHook(base, LUA_T_CMARK, 1); | ||
| 300 | firstResult = CLS_current.base; | ||
| 301 | CLS_current = oldCLS; | ||
| 302 | return firstResult; | ||
| 303 | } | ||
| 304 | |||
| 305 | static void callIM (TObject *f, int nParams, int nResults) | ||
| 306 | { | ||
| 307 | open_stack(nParams); | ||
| 308 | *(top-nParams-1) = *f; | ||
| 309 | do_call((top-stack)-nParams, nResults); | ||
| 310 | } | ||
| 311 | |||
| 312 | |||
| 313 | /* | ||
| 314 | ** Call a function (C or Lua). The parameters must be on the stack, | ||
| 315 | ** between [stack+base,top). The function to be called is at stack+base-1. | ||
| 316 | ** When returns, the results are on the stack, between [stack+base-1,top). | ||
| 317 | ** The number of results is nResults, unless nResults=MULT_RET. | ||
| 318 | */ | ||
| 319 | static void do_call (StkId base, int nResults) | ||
| 320 | { | ||
| 321 | StkId firstResult; | ||
| 322 | TObject *func = stack+base-1; | ||
| 323 | int i; | ||
| 324 | if (ttype(func) == LUA_T_CFUNCTION) { | ||
| 325 | ttype(func) = LUA_T_CMARK; | ||
| 326 | firstResult = callC(fvalue(func), base); | ||
| 327 | } | ||
| 328 | else if (ttype(func) == LUA_T_FUNCTION) { | ||
| 329 | ttype(func) = LUA_T_MARK; | ||
| 330 | firstResult = lua_execute(func->value.tf, base); | ||
| 331 | } | ||
| 332 | else { /* func is not a function */ | ||
| 333 | /* Check the tag method for invalid functions */ | ||
| 334 | TObject *im = luaI_getimbyObj(func, IM_FUNCTION); | ||
| 335 | if (ttype(im) == LUA_T_NIL) | ||
| 336 | lua_error("call expression not a function"); | ||
| 337 | open_stack((top-stack)-(base-1)); | ||
| 338 | stack[base-1] = *im; | ||
| 339 | do_call(base, nResults); | ||
| 340 | return; | ||
| 341 | } | ||
| 342 | /* adjust the number of results */ | ||
| 343 | if (nResults != MULT_RET) | ||
| 344 | adjust_top(firstResult+nResults); | ||
| 345 | /* move results to base-1 (to erase parameters and function) */ | ||
| 346 | base--; | ||
| 347 | nResults = top - (stack+firstResult); /* actual number of results */ | ||
| 348 | for (i=0; i<nResults; i++) | ||
| 349 | *(stack+base+i) = *(stack+firstResult+i); | ||
| 350 | top -= firstResult-base; | ||
| 351 | } | ||
| 352 | |||
| 353 | |||
| 354 | /* | ||
| 355 | ** Function to index a table. Receives the table at top-2 and the index | ||
| 356 | ** at top-1. | ||
| 357 | */ | ||
| 358 | static void pushsubscript (void) | ||
| 359 | { | ||
| 360 | TObject *im; | ||
| 361 | if (ttype(top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */ | ||
| 362 | im = luaI_getimbyObj(top-2, IM_GETTABLE); | ||
| 363 | else { /* object is a table... */ | ||
| 364 | int tg = (top-2)->value.a->htag; | ||
| 365 | im = luaI_getim(tg, IM_GETTABLE); | ||
| 366 | if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */ | ||
| 367 | TObject *h = lua_hashget(avalue(top-2), top-1); | ||
| 368 | if (h != NULL && ttype(h) != LUA_T_NIL) { | ||
| 369 | --top; | ||
| 370 | *(top-1) = *h; | ||
| 371 | } | ||
| 372 | else if (ttype(im=luaI_getim(tg, IM_INDEX)) != LUA_T_NIL) | ||
| 373 | callIM(im, 2, 1); | ||
| 374 | else { | ||
| 375 | --top; | ||
| 376 | ttype(top-1) = LUA_T_NIL; | ||
| 377 | } | ||
| 378 | return; | ||
| 379 | } | ||
| 380 | /* else it has a "gettable" method, go through to next command */ | ||
| 381 | } | ||
| 382 | /* object is not a table, or it has a "gettable" method */ | ||
| 383 | if (ttype(im) != LUA_T_NIL) | ||
| 384 | callIM(im, 2, 1); | ||
| 385 | else | ||
| 386 | lua_error("indexed expression not a table"); | ||
| 387 | } | ||
| 388 | |||
| 389 | |||
| 390 | lua_Object lua_rawgettable (void) | ||
| 391 | { | ||
| 392 | checkCparams(2); | ||
| 393 | if (ttype(top-2) != LUA_T_ARRAY) | ||
| 394 | lua_error("indexed expression not a table in raw gettable"); | ||
| 395 | else { | ||
| 396 | TObject *h = lua_hashget(avalue(top-2), top-1); | ||
| 397 | --top; | ||
| 398 | if (h != NULL) | ||
| 399 | *(top-1) = *h; | ||
| 400 | else | ||
| 401 | ttype(top-1) = LUA_T_NIL; | ||
| 402 | } | ||
| 403 | return put_luaObjectonTop(); | ||
| 404 | } | ||
| 405 | |||
| 406 | |||
| 407 | /* | ||
| 408 | ** Function to store indexed based on values at the top | ||
| 409 | ** mode = 0: raw store (without internal methods) | ||
| 410 | ** mode = 1: normal store (with internal methods) | ||
| 411 | ** mode = 2: "deep stack" store (with internal methods) | ||
| 412 | */ | ||
| 413 | static void storesubscript (TObject *t, int mode) | ||
| 414 | { | ||
| 415 | TObject *im = (mode == 0) ? NULL : luaI_getimbyObj(t, IM_SETTABLE); | ||
| 416 | if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) { | ||
| 417 | TObject *h = lua_hashdefine(avalue(t), t+1); | ||
| 418 | *h = *(top-1); | ||
| 419 | top -= (mode == 2) ? 1 : 3; | ||
| 420 | } | ||
| 421 | else { /* object is not a table, and/or has a specific "settable" method */ | ||
| 422 | if (im && ttype(im) != LUA_T_NIL) { | ||
| 423 | if (mode == 2) { | ||
| 424 | lua_checkstack(top+2); | ||
| 425 | *(top+1) = *(top-1); | ||
| 426 | *(top) = *(t+1); | ||
| 427 | *(top-1) = *t; | ||
| 428 | top += 2; | ||
| 429 | } | ||
| 430 | callIM(im, 3, 0); | ||
| 431 | } | ||
| 432 | else | ||
| 433 | lua_error("indexed expression not a table"); | ||
| 434 | } | ||
| 435 | } | ||
| 436 | |||
| 437 | |||
| 438 | static void getglobal (Word n) | ||
| 439 | { | ||
| 440 | TObject *value = &lua_table[n].object; | ||
| 441 | TObject *im = luaI_getimbyObj(value, IM_GETGLOBAL); | ||
| 442 | if (ttype(im) == LUA_T_NIL) { /* default behavior */ | ||
| 443 | *top = *value; | ||
| 444 | incr_top; | ||
| 445 | } | ||
| 446 | else { | ||
| 447 | ttype(top) = LUA_T_STRING; | ||
| 448 | tsvalue(top) = lua_table[n].varname; | ||
| 449 | incr_top; | ||
| 450 | *top = *value; | ||
| 451 | incr_top; | ||
| 452 | callIM(im, 2, 1); | ||
| 453 | } | ||
| 454 | } | ||
| 455 | |||
| 456 | /* | ||
| 457 | ** Traverse all objects on stack | ||
| 458 | */ | ||
| 459 | void lua_travstack (int (*fn)(TObject *)) | ||
| 460 | { | ||
| 461 | StkId i; | ||
| 462 | for (i = (top-1)-stack; i>=0; i--) | ||
| 463 | fn (stack+i); | ||
| 464 | } | ||
| 465 | |||
| 466 | |||
| 467 | /* | ||
| 468 | ** Error messages and debug functions | ||
| 469 | */ | ||
| 470 | |||
| 471 | |||
| 472 | static void auxerrorim (char *form) | ||
| 473 | { | ||
| 474 | lua_Object s = lua_getparam(1); | ||
| 475 | if (lua_isstring(s)) | ||
| 476 | fprintf(stderr, form, lua_getstring(s)); | ||
| 477 | } | ||
| 478 | |||
| 479 | |||
| 480 | static void emergencyerrorf (void) | ||
| 481 | { | ||
| 482 | auxerrorim("WARNING - THERE WAS AN ERROR INSIDE AN ERROR METHOD:\n%s\n"); | ||
| 483 | } | ||
| 484 | |||
| 485 | |||
| 486 | static void stderrorim (void) | ||
| 487 | { | ||
| 488 | auxerrorim("lua: %s\n"); | ||
| 489 | } | ||
| 490 | |||
| 491 | |||
| 492 | TObject luaI_errorim = {LUA_T_CFUNCTION, {stderrorim}}; | ||
| 493 | |||
| 494 | |||
| 495 | static void lua_message (char *s) | ||
| 496 | { | ||
| 497 | TObject im = luaI_errorim; | ||
| 498 | if (ttype(&im) != LUA_T_NIL) { | ||
| 499 | luaI_errorim.ttype = LUA_T_CFUNCTION; | ||
| 500 | luaI_errorim.value.f = emergencyerrorf; | ||
| 501 | lua_pushstring(s); | ||
| 502 | callIM(&im, 1, 0); | ||
| 503 | luaI_errorim = im; | ||
| 504 | } | ||
| 505 | } | ||
| 506 | |||
| 507 | /* | ||
| 508 | ** Reports an error, and jumps up to the available recover label | ||
| 509 | */ | ||
| 510 | void lua_error (char *s) | ||
| 511 | { | ||
| 512 | if (s) lua_message(s); | ||
| 513 | if (errorJmp) | ||
| 514 | longjmp(*errorJmp, 1); | ||
| 515 | else | ||
| 516 | { | ||
| 517 | fprintf (stderr, "lua: exit(1). Unable to recover\n"); | ||
| 518 | exit(1); | ||
| 519 | } | ||
| 520 | } | ||
| 521 | |||
| 522 | |||
| 523 | lua_Function lua_stackedfunction (int level) | ||
| 524 | { | ||
| 525 | StkId i; | ||
| 526 | for (i = (top-1)-stack; i>=0; i--) | ||
| 527 | if (stack[i].ttype == LUA_T_MARK || stack[i].ttype == LUA_T_CMARK) | ||
| 528 | if (level-- == 0) | ||
| 529 | return Ref(stack+i); | ||
| 530 | return LUA_NOOBJECT; | ||
| 531 | } | ||
| 532 | |||
| 533 | |||
| 534 | int lua_currentline (lua_Function func) | ||
| 535 | { | ||
| 536 | TObject *f = Address(func); | ||
| 537 | return (f+1 < top && (f+1)->ttype == LUA_T_LINE) ? (f+1)->value.i : -1; | ||
| 538 | } | ||
| 539 | |||
| 540 | |||
| 541 | lua_Object lua_getlocal (lua_Function func, int local_number, char **name) | ||
| 542 | { | ||
| 543 | TObject *f = luaI_Address(func); | ||
| 544 | /* check whether func is a Lua function */ | ||
| 545 | if (ttype(f) != LUA_T_MARK && ttype(f) != LUA_T_FUNCTION) | ||
| 546 | return LUA_NOOBJECT; | ||
| 547 | *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func)); | ||
| 548 | if (*name) | ||
| 549 | { | ||
| 550 | /* if "*name", there must be a LUA_T_LINE */ | ||
| 551 | /* therefore, f+2 points to function base */ | ||
| 552 | return Ref((f+2)+(local_number-1)); | ||
| 553 | } | ||
| 554 | else | ||
| 555 | return LUA_NOOBJECT; | ||
| 556 | } | ||
| 557 | |||
| 558 | int lua_setlocal (lua_Function func, int local_number) | ||
| 559 | { | ||
| 560 | TObject *f = Address(func); | ||
| 561 | char *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func)); | ||
| 562 | checkCparams(1); | ||
| 563 | --top; | ||
| 564 | if (name) | ||
| 565 | { | ||
| 566 | /* if "name", there must be a LUA_T_LINE */ | ||
| 567 | /* therefore, f+2 points to function base */ | ||
| 568 | *((f+2)+(local_number-1)) = *top; | ||
| 569 | return 1; | ||
| 570 | } | ||
| 571 | else | ||
| 572 | return 0; | ||
| 573 | } | ||
| 574 | |||
| 575 | /* | ||
| 576 | ** Call the function at CLS_current.base, and incorporate results on | ||
| 577 | ** the Lua2C structure. | ||
| 578 | */ | ||
| 579 | static void do_callinc (int nResults) | ||
| 580 | { | ||
| 581 | StkId base = CLS_current.base; | ||
| 582 | do_call(base+1, nResults); | ||
| 583 | CLS_current.lua2C = base; /* position of the new results */ | ||
| 584 | CLS_current.num = (top-stack) - base; /* number of results */ | ||
| 585 | CLS_current.base = base + CLS_current.num; /* incorporate results on stack */ | ||
| 586 | } | ||
| 587 | |||
| 588 | |||
| 589 | static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) | ||
| 590 | { | ||
| 591 | StkId base = (top-stack)-nParams; | ||
| 592 | open_stack(nParams); | ||
| 593 | stack[base].ttype = LUA_T_CFUNCTION; | ||
| 594 | stack[base].value.f = f; | ||
| 595 | do_call(base+1, nResults); | ||
| 596 | } | ||
| 597 | |||
| 598 | |||
| 599 | /* | ||
| 600 | ** Execute a protected call. Assumes that function is at CLS_current.base and | ||
| 601 | ** parameters are on top of it. Leave nResults on the stack. | ||
| 602 | */ | ||
| 603 | static int do_protectedrun (int nResults) | ||
| 604 | { | ||
| 605 | jmp_buf myErrorJmp; | ||
| 606 | int status; | ||
| 607 | struct C_Lua_Stack oldCLS = CLS_current; | ||
| 608 | jmp_buf *oldErr = errorJmp; | ||
| 609 | errorJmp = &myErrorJmp; | ||
| 610 | if (setjmp(myErrorJmp) == 0) { | ||
| 611 | do_callinc(nResults); | ||
| 612 | status = 0; | ||
| 613 | } | ||
| 614 | else { /* an error occurred: restore CLS_current and top */ | ||
| 615 | CLS_current = oldCLS; | ||
| 616 | top = stack+CLS_current.base; | ||
| 617 | status = 1; | ||
| 618 | } | ||
| 619 | errorJmp = oldErr; | ||
| 620 | return status; | ||
| 621 | } | ||
| 622 | |||
| 623 | int luaI_dorun (TFunc *tf) | ||
| 624 | { | ||
| 625 | int status; | ||
| 626 | adjustC(1); /* one slot for the pseudo-function */ | ||
| 627 | stack[CLS_current.base].ttype = LUA_T_FUNCTION; | ||
| 628 | stack[CLS_current.base].value.tf = tf; | ||
| 629 | status = do_protectedrun(MULT_RET); | ||
| 630 | return status; | ||
| 631 | } | ||
| 632 | |||
| 633 | |||
| 634 | int lua_domain (void) | ||
| 635 | { | ||
| 636 | int status; | ||
| 637 | TFunc *tf = new(TFunc); | ||
| 638 | jmp_buf myErrorJmp; | ||
| 639 | jmp_buf *oldErr = errorJmp; | ||
| 640 | errorJmp = &myErrorJmp; | ||
| 641 | luaI_initTFunc(tf); | ||
| 642 | adjustC(1); /* one slot for the pseudo-function */ | ||
| 643 | stack[CLS_current.base].ttype = LUA_T_FUNCTION; | ||
| 644 | stack[CLS_current.base].value.tf = tf; | ||
| 645 | if (setjmp(myErrorJmp) == 0) { | ||
| 646 | lua_parse(tf); | ||
| 647 | status = 0; | ||
| 648 | } | ||
| 649 | else { | ||
| 650 | adjustC(0); /* erase extra slot */ | ||
| 651 | status = 1; | ||
| 652 | } | ||
| 653 | if (status == 0) | ||
| 654 | status = do_protectedrun(MULT_RET); | ||
| 655 | errorJmp = oldErr; | ||
| 656 | return status; | ||
| 657 | } | ||
| 658 | |||
| 659 | /* | ||
| 660 | ** Execute the given lua function. Return 0 on success or 1 on error. | ||
| 661 | */ | ||
| 662 | int lua_callfunction (lua_Object function) | ||
| 663 | { | ||
| 664 | if (function == LUA_NOOBJECT) | ||
| 665 | return 1; | ||
| 666 | else | ||
| 667 | { | ||
| 668 | open_stack((top-stack)-CLS_current.base); | ||
| 669 | stack[CLS_current.base] = *Address(function); | ||
| 670 | return do_protectedrun (MULT_RET); | ||
| 671 | } | ||
| 672 | } | ||
| 673 | |||
| 674 | |||
| 675 | lua_Object lua_gettagmethod (int tag, char *event) | ||
| 676 | { | ||
| 677 | lua_pushnumber(tag); | ||
| 678 | lua_pushstring(event); | ||
| 679 | do_unprotectedrun(luaI_gettagmethod, 2, 1); | ||
| 680 | return put_luaObjectonTop(); | ||
| 681 | } | ||
| 682 | |||
| 683 | lua_Object lua_settagmethod (int tag, char *event) | ||
| 684 | { | ||
| 685 | TObject newmethod; | ||
| 686 | checkCparams(1); | ||
| 687 | newmethod = *(--top); | ||
| 688 | lua_pushnumber(tag); | ||
| 689 | lua_pushstring(event); | ||
| 690 | *top = newmethod; incr_top; | ||
| 691 | do_unprotectedrun(luaI_settagmethod, 3, 1); | ||
| 692 | return put_luaObjectonTop(); | ||
| 693 | } | ||
| 694 | |||
| 695 | lua_Object lua_seterrormethod (void) | ||
| 696 | { | ||
| 697 | checkCparams(1); | ||
| 698 | do_unprotectedrun(luaI_seterrormethod, 1, 1); | ||
| 699 | return put_luaObjectonTop(); | ||
| 700 | } | ||
| 701 | |||
| 702 | |||
| 703 | /* | ||
| 704 | ** API: receives on the stack the table and the index. | ||
| 705 | ** returns the value. | ||
| 706 | */ | ||
| 707 | lua_Object lua_gettable (void) | ||
| 708 | { | ||
| 709 | checkCparams(2); | ||
| 710 | pushsubscript(); | ||
| 711 | return put_luaObjectonTop(); | ||
| 712 | } | ||
| 713 | |||
| 714 | |||
| 715 | #define MAX_C_BLOCKS 10 | ||
| 716 | |||
| 717 | static int numCblocks = 0; | ||
| 718 | static struct C_Lua_Stack Cblocks[MAX_C_BLOCKS]; | ||
| 719 | |||
| 720 | /* | ||
| 721 | ** API: starts a new block | ||
| 722 | */ | ||
| 723 | void lua_beginblock (void) | ||
| 724 | { | ||
| 725 | if (numCblocks >= MAX_C_BLOCKS) | ||
| 726 | lua_error("`lua_beginblock': too many nested blocks"); | ||
| 727 | Cblocks[numCblocks] = CLS_current; | ||
| 728 | numCblocks++; | ||
| 729 | } | ||
| 730 | |||
| 731 | /* | ||
| 732 | ** API: ends a block | ||
| 733 | */ | ||
| 734 | void lua_endblock (void) | ||
| 735 | { | ||
| 736 | --numCblocks; | ||
| 737 | CLS_current = Cblocks[numCblocks]; | ||
| 738 | adjustC(0); | ||
| 739 | } | ||
| 740 | |||
| 741 | void lua_settag (int tag) | ||
| 742 | { | ||
| 743 | checkCparams(1); | ||
| 744 | luaI_settag(tag, --top); | ||
| 745 | } | ||
| 746 | |||
| 747 | /* | ||
| 748 | ** API: receives on the stack the table, the index, and the new value. | ||
| 749 | */ | ||
| 750 | void lua_settable (void) | ||
| 751 | { | ||
| 752 | checkCparams(3); | ||
| 753 | storesubscript(top-3, 1); | ||
| 754 | } | ||
| 755 | |||
| 756 | void lua_rawsettable (void) | ||
| 757 | { | ||
| 758 | checkCparams(3); | ||
| 759 | storesubscript(top-3, 0); | ||
| 760 | } | ||
| 761 | |||
| 762 | /* | ||
| 763 | ** API: creates a new table | ||
| 764 | */ | ||
| 765 | lua_Object lua_createtable (void) | ||
| 766 | { | ||
| 767 | TObject o; | ||
| 768 | avalue(&o) = lua_createarray(0); | ||
| 769 | ttype(&o) = LUA_T_ARRAY; | ||
| 770 | return put_luaObject(&o); | ||
| 771 | } | ||
| 772 | |||
| 773 | /* | ||
| 774 | ** Get a parameter, returning the object handle or LUA_NOOBJECT on error. | ||
| 775 | ** 'number' must be 1 to get the first parameter. | ||
| 776 | */ | ||
| 777 | lua_Object lua_lua2C (int number) | ||
| 778 | { | ||
| 779 | if (number <= 0 || number > CLS_current.num) return LUA_NOOBJECT; | ||
| 780 | /* Ref(stack+(CLS_current.lua2C+number-1)) == | ||
| 781 | stack+(CLS_current.lua2C+number-1)-stack+1 == */ | ||
| 782 | return CLS_current.lua2C+number; | ||
| 783 | } | ||
| 784 | |||
| 785 | int lua_isnil (lua_Object o) | ||
| 786 | { | ||
| 787 | return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL); | ||
| 788 | } | ||
| 789 | |||
| 790 | int lua_istable (lua_Object o) | ||
| 791 | { | ||
| 792 | return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY); | ||
| 793 | } | ||
| 794 | |||
| 795 | int lua_isuserdata (lua_Object o) | ||
| 796 | { | ||
| 797 | return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA); | ||
| 798 | } | ||
| 799 | |||
| 800 | int lua_iscfunction (lua_Object o) | ||
| 801 | { | ||
| 802 | int t = lua_tag(o); | ||
| 803 | return (t == LUA_T_CMARK) || (t == LUA_T_CFUNCTION); | ||
| 804 | } | ||
| 805 | |||
| 806 | int lua_isnumber (lua_Object o) | ||
| 807 | { | ||
| 808 | return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0); | ||
| 809 | } | ||
| 810 | |||
| 811 | int lua_isstring (lua_Object o) | ||
| 812 | { | ||
| 813 | int t = lua_tag(o); | ||
| 814 | return (t == LUA_T_STRING) || (t == LUA_T_NUMBER); | ||
| 815 | } | ||
| 816 | |||
| 817 | int lua_isfunction (lua_Object o) | ||
| 818 | { | ||
| 819 | int t = lua_tag(o); | ||
| 820 | return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION) || | ||
| 821 | (t == LUA_T_MARK) || (t == LUA_T_CMARK); | ||
| 822 | } | ||
| 823 | |||
| 824 | /* | ||
| 825 | ** Given an object handle, return its number value. On error, return 0.0. | ||
| 826 | */ | ||
| 827 | real lua_getnumber (lua_Object object) | ||
| 828 | { | ||
| 829 | if (object == LUA_NOOBJECT) return 0.0; | ||
| 830 | if (tonumber (Address(object))) return 0.0; | ||
| 831 | else return (nvalue(Address(object))); | ||
| 832 | } | ||
| 833 | |||
| 834 | /* | ||
| 835 | ** Given an object handle, return its string pointer. On error, return NULL. | ||
| 836 | */ | ||
| 837 | char *lua_getstring (lua_Object object) | ||
| 838 | { | ||
| 839 | if (object == LUA_NOOBJECT || tostring (Address(object))) | ||
| 840 | return NULL; | ||
| 841 | else return (svalue(Address(object))); | ||
| 842 | } | ||
| 843 | |||
| 844 | |||
| 845 | void *lua_getuserdata (lua_Object object) | ||
| 846 | { | ||
| 847 | if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA) | ||
| 848 | return NULL; | ||
| 849 | else return tsvalue(Address(object))->u.v; | ||
| 850 | } | ||
| 851 | |||
| 852 | |||
| 853 | /* | ||
| 854 | ** Given an object handle, return its cfuntion pointer. On error, return NULL. | ||
| 855 | */ | ||
| 856 | lua_CFunction lua_getcfunction (lua_Object object) | ||
| 857 | { | ||
| 858 | if (object == LUA_NOOBJECT || ((ttype(Address(object)) != LUA_T_CFUNCTION) && | ||
| 859 | (ttype(Address(object)) != LUA_T_CMARK))) | ||
| 860 | return NULL; | ||
| 861 | else return (fvalue(Address(object))); | ||
| 862 | } | ||
| 863 | |||
| 864 | |||
| 865 | lua_Object lua_getref (int ref) | ||
| 866 | { | ||
| 867 | TObject *o = luaI_getref(ref); | ||
| 868 | if (o == NULL) | ||
| 869 | return LUA_NOOBJECT; | ||
| 870 | return put_luaObject(o); | ||
| 871 | } | ||
| 872 | |||
| 873 | |||
| 874 | int lua_ref (int lock) | ||
| 875 | { | ||
| 876 | checkCparams(1); | ||
| 877 | return luaI_ref(--top, lock); | ||
| 878 | } | ||
| 879 | |||
| 880 | |||
| 881 | |||
| 882 | /* | ||
| 883 | ** Get a global object. | ||
| 884 | */ | ||
| 885 | lua_Object lua_getglobal (char *name) | ||
| 886 | { | ||
| 887 | getglobal(luaI_findsymbolbyname(name)); | ||
| 888 | return put_luaObjectonTop(); | ||
| 889 | } | ||
| 890 | |||
| 891 | |||
| 892 | lua_Object lua_rawgetglobal (char *name) | ||
| 893 | { | ||
| 894 | return put_luaObject(&lua_table[luaI_findsymbolbyname(name)].object); | ||
| 895 | } | ||
| 896 | |||
| 897 | |||
| 898 | /* | ||
| 899 | ** Store top of the stack at a global variable array field. | ||
| 900 | */ | ||
| 901 | static void setglobal (Word n) | ||
| 902 | { | ||
| 903 | TObject *oldvalue = &lua_table[n].object; | ||
| 904 | TObject *im = luaI_getimbyObj(oldvalue, IM_SETGLOBAL); | ||
| 905 | if (ttype(im) == LUA_T_NIL) /* default behavior */ | ||
| 906 | s_object(n) = *(--top); | ||
| 907 | else { | ||
| 908 | TObject newvalue = *(top-1); | ||
| 909 | ttype(top-1) = LUA_T_STRING; | ||
| 910 | tsvalue(top-1) = lua_table[n].varname; | ||
| 911 | *top = *oldvalue; | ||
| 912 | incr_top; | ||
| 913 | *top = newvalue; | ||
| 914 | incr_top; | ||
| 915 | callIM(im, 3, 0); | ||
| 916 | } | ||
| 917 | } | ||
| 918 | |||
| 919 | |||
| 920 | void lua_setglobal (char *name) | ||
| 921 | { | ||
| 922 | checkCparams(1); | ||
| 923 | setglobal(luaI_findsymbolbyname(name)); | ||
| 924 | } | ||
| 925 | |||
| 926 | void lua_rawsetglobal (char *name) | ||
| 927 | { | ||
| 928 | Word n = luaI_findsymbolbyname(name); | ||
| 929 | checkCparams(1); | ||
| 930 | s_object(n) = *(--top); | ||
| 931 | } | ||
| 932 | |||
| 933 | /* | ||
| 934 | ** Push a nil object | ||
| 935 | */ | ||
| 936 | void lua_pushnil (void) | ||
| 937 | { | ||
| 938 | ttype(top) = LUA_T_NIL; | ||
| 939 | incr_top; | ||
| 940 | } | ||
| 941 | |||
| 942 | /* | ||
| 943 | ** Push an object (ttype=number) to stack. | ||
| 944 | */ | ||
| 945 | void lua_pushnumber (real n) | ||
| 946 | { | ||
| 947 | ttype(top) = LUA_T_NUMBER; nvalue(top) = n; | ||
| 948 | incr_top; | ||
| 949 | } | ||
| 950 | |||
| 951 | /* | ||
| 952 | ** Push an object (ttype=string) to stack. | ||
| 953 | */ | ||
| 954 | void lua_pushstring (char *s) | ||
| 955 | { | ||
| 956 | if (s == NULL) | ||
| 957 | ttype(top) = LUA_T_NIL; | ||
| 958 | else | ||
| 959 | { | ||
| 960 | tsvalue(top) = luaI_createstring(s); | ||
| 961 | ttype(top) = LUA_T_STRING; | ||
| 962 | } | ||
| 963 | incr_top; | ||
| 964 | } | ||
| 965 | |||
| 966 | |||
| 967 | /* | ||
| 968 | ** Push an object (ttype=cfunction) to stack. | ||
| 969 | */ | ||
| 970 | void lua_pushcfunction (lua_CFunction fn) | ||
| 971 | { | ||
| 972 | ttype(top) = LUA_T_CFUNCTION; fvalue(top) = fn; | ||
| 973 | incr_top; | ||
| 974 | } | ||
| 975 | |||
| 976 | |||
| 977 | |||
| 978 | void lua_pushusertag (void *u, int tag) | ||
| 979 | { | ||
| 980 | if (tag < 0 && tag != LUA_ANYTAG) | ||
| 981 | luaI_realtag(tag); /* error if tag is not valid */ | ||
| 982 | tsvalue(top) = luaI_createudata(u, tag); | ||
| 983 | ttype(top) = LUA_T_USERDATA; | ||
| 984 | incr_top; | ||
| 985 | } | ||
| 986 | |||
| 987 | /* | ||
| 988 | ** Push an object on the stack. | ||
| 989 | */ | ||
| 990 | void luaI_pushobject (TObject *o) | ||
| 991 | { | ||
| 992 | *top = *o; | ||
| 993 | incr_top; | ||
| 994 | } | ||
| 995 | |||
| 996 | /* | ||
| 997 | ** Push a lua_Object on stack. | ||
| 998 | */ | ||
| 999 | void lua_pushobject (lua_Object o) | ||
| 1000 | { | ||
| 1001 | if (o == LUA_NOOBJECT) | ||
| 1002 | lua_error("API error - attempt to push a NOOBJECT"); | ||
| 1003 | *top = *Address(o); | ||
| 1004 | if (ttype(top) == LUA_T_MARK) ttype(top) = LUA_T_FUNCTION; | ||
| 1005 | else if (ttype(top) == LUA_T_CMARK) ttype(top) = LUA_T_CFUNCTION; | ||
| 1006 | incr_top; | ||
| 1007 | } | ||
| 1008 | |||
| 1009 | int lua_tag (lua_Object lo) | ||
| 1010 | { | ||
| 1011 | if (lo == LUA_NOOBJECT) return LUA_T_NIL; | ||
| 1012 | else { | ||
| 1013 | TObject *o = Address(lo); | ||
| 1014 | lua_Type t = ttype(o); | ||
| 1015 | if (t == LUA_T_USERDATA) | ||
| 1016 | return o->value.ts->tag; | ||
| 1017 | else if (t == LUA_T_ARRAY) | ||
| 1018 | return o->value.a->htag; | ||
| 1019 | else return t; | ||
| 1020 | } | ||
| 1021 | } | ||
| 1022 | |||
| 1023 | |||
| 1024 | void luaI_gcIM (TObject *o) | ||
| 1025 | { | ||
| 1026 | TObject *im = luaI_getimbyObj(o, IM_GC); | ||
| 1027 | if (ttype(im) != LUA_T_NIL) { | ||
| 1028 | *top = *o; | ||
| 1029 | incr_top; | ||
| 1030 | callIM(im, 1, 0); | ||
| 1031 | } | ||
| 1032 | } | ||
| 1033 | |||
| 1034 | |||
| 1035 | static void call_binTM (IMS event, char *msg) | ||
| 1036 | { | ||
| 1037 | TObject *im = luaI_getimbyObj(top-2, event); /* try first operand */ | ||
| 1038 | if (ttype(im) == LUA_T_NIL) { | ||
| 1039 | im = luaI_getimbyObj(top-1, event); /* try second operand */ | ||
| 1040 | if (ttype(im) == LUA_T_NIL) { | ||
| 1041 | im = luaI_getim(0, event); /* try a 'global' i.m. */ | ||
| 1042 | if (ttype(im) == LUA_T_NIL) | ||
| 1043 | lua_error(msg); | ||
| 1044 | } | ||
| 1045 | } | ||
| 1046 | lua_pushstring(luaI_eventname[event]); | ||
| 1047 | callIM(im, 3, 1); | ||
| 1048 | } | ||
| 1049 | |||
| 1050 | |||
| 1051 | static void call_arith (IMS event) | ||
| 1052 | { | ||
| 1053 | call_binTM(event, "unexpected type at arithmetic operation"); | ||
| 1054 | } | ||
| 1055 | |||
| 1056 | |||
| 1057 | static void comparison (lua_Type ttype_less, lua_Type ttype_equal, | ||
| 1058 | lua_Type ttype_great, IMS op) | ||
| 1059 | { | ||
| 1060 | TObject *l = top-2; | ||
| 1061 | TObject *r = top-1; | ||
| 1062 | int result; | ||
| 1063 | if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER) | ||
| 1064 | result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1; | ||
| 1065 | else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING) | ||
| 1066 | result = strcoll(svalue(l), svalue(r)); | ||
| 1067 | else { | ||
| 1068 | call_binTM(op, "unexpected type at comparison"); | ||
| 1069 | return; | ||
| 1070 | } | ||
| 1071 | top--; | ||
| 1072 | nvalue(top-1) = 1; | ||
| 1073 | ttype(top-1) = (result < 0) ? ttype_less : | ||
| 1074 | (result == 0) ? ttype_equal : ttype_great; | ||
| 1075 | } | ||
| 1076 | |||
| 1077 | |||
| 1078 | static void adjust_varargs (StkId first_extra_arg) | ||
| 1079 | { | ||
| 1080 | TObject arg; | ||
| 1081 | TObject *firstelem = stack+first_extra_arg; | ||
| 1082 | int nvararg = top-firstelem; | ||
| 1083 | int i; | ||
| 1084 | if (nvararg < 0) nvararg = 0; | ||
| 1085 | avalue(&arg) = lua_createarray(nvararg+1); /* +1 for field 'n' */ | ||
| 1086 | ttype(&arg) = LUA_T_ARRAY; | ||
| 1087 | for (i=0; i<nvararg; i++) { | ||
| 1088 | TObject index; | ||
| 1089 | ttype(&index) = LUA_T_NUMBER; | ||
| 1090 | nvalue(&index) = i+1; | ||
| 1091 | *(lua_hashdefine(avalue(&arg), &index)) = *(firstelem+i); | ||
| 1092 | } | ||
| 1093 | /* store counter in field "n" */ { | ||
| 1094 | TObject index, extra; | ||
| 1095 | ttype(&index) = LUA_T_STRING; | ||
| 1096 | tsvalue(&index) = luaI_createstring("n"); | ||
| 1097 | ttype(&extra) = LUA_T_NUMBER; | ||
| 1098 | nvalue(&extra) = nvararg; | ||
| 1099 | *(lua_hashdefine(avalue(&arg), &index)) = extra; | ||
| 1100 | } | ||
| 1101 | adjust_top(first_extra_arg); | ||
| 1102 | *top = arg; incr_top; | ||
| 1103 | } | ||
| 1104 | |||
| 1105 | |||
| 1106 | |||
| 1107 | /* | ||
| 1108 | ** Execute the given opcode, until a RET. Parameters are between | ||
| 1109 | ** [stack+base,top). Returns n such that the the results are between | ||
| 1110 | ** [stack+n,top). | ||
| 1111 | */ | ||
| 1112 | static StkId lua_execute (TFunc *func, StkId base) | ||
| 1113 | { | ||
| 1114 | Byte *pc = func->code; | ||
| 1115 | if (lua_callhook) | ||
| 1116 | callHook (base, LUA_T_MARK, 0); | ||
| 1117 | while (1) | ||
| 1118 | { | ||
| 1119 | OpCode opcode; | ||
| 1120 | switch (opcode = (OpCode)*pc++) | ||
| 1121 | { | ||
| 1122 | case PUSHNIL: ttype(top) = LUA_T_NIL; incr_top; break; | ||
| 1123 | |||
| 1124 | case PUSH0: case PUSH1: case PUSH2: | ||
| 1125 | ttype(top) = LUA_T_NUMBER; | ||
| 1126 | nvalue(top) = opcode-PUSH0; | ||
| 1127 | incr_top; | ||
| 1128 | break; | ||
| 1129 | |||
| 1130 | case PUSHBYTE: | ||
| 1131 | ttype(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break; | ||
| 1132 | |||
| 1133 | case PUSHWORD: | ||
| 1134 | { | ||
| 1135 | Word w; | ||
| 1136 | get_word(w,pc); | ||
| 1137 | ttype(top) = LUA_T_NUMBER; nvalue(top) = w; | ||
| 1138 | incr_top; | ||
| 1139 | } | ||
| 1140 | break; | ||
| 1141 | |||
| 1142 | case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: | ||
| 1143 | case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5: | ||
| 1144 | case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8: | ||
| 1145 | case PUSHLOCAL9: | ||
| 1146 | *top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break; | ||
| 1147 | |||
| 1148 | case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break; | ||
| 1149 | |||
| 1150 | case PUSHGLOBAL: | ||
| 1151 | { | ||
| 1152 | Word w; | ||
| 1153 | get_word(w,pc); | ||
| 1154 | getglobal(w); | ||
| 1155 | } | ||
| 1156 | break; | ||
| 1157 | |||
| 1158 | case PUSHINDEXED: | ||
| 1159 | pushsubscript(); | ||
| 1160 | break; | ||
| 1161 | |||
| 1162 | case PUSHSELF: | ||
| 1163 | { | ||
| 1164 | TObject receiver = *(top-1); | ||
| 1165 | Word w; | ||
| 1166 | get_word(w,pc); | ||
| 1167 | *top = func->consts[w]; | ||
| 1168 | incr_top; | ||
| 1169 | pushsubscript(); | ||
| 1170 | *top = receiver; | ||
| 1171 | incr_top; | ||
| 1172 | break; | ||
| 1173 | } | ||
| 1174 | |||
| 1175 | case PUSHCONSTANTB: { | ||
| 1176 | *top = func->consts[*pc++]; | ||
| 1177 | incr_top; | ||
| 1178 | break; | ||
| 1179 | } | ||
| 1180 | |||
| 1181 | case PUSHCONSTANT: { | ||
| 1182 | Word w; | ||
| 1183 | get_word(w,pc); | ||
| 1184 | *top = func->consts[w]; | ||
| 1185 | incr_top; | ||
| 1186 | break; | ||
| 1187 | } | ||
| 1188 | |||
| 1189 | case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: | ||
| 1190 | case STORELOCAL3: case STORELOCAL4: case STORELOCAL5: | ||
| 1191 | case STORELOCAL6: case STORELOCAL7: case STORELOCAL8: | ||
| 1192 | case STORELOCAL9: | ||
| 1193 | *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top); | ||
| 1194 | break; | ||
| 1195 | |||
| 1196 | case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break; | ||
| 1197 | |||
| 1198 | case STOREGLOBAL: | ||
| 1199 | { | ||
| 1200 | Word w; | ||
| 1201 | get_word(w,pc); | ||
| 1202 | setglobal(w); | ||
| 1203 | } | ||
| 1204 | break; | ||
| 1205 | |||
| 1206 | case STOREINDEXED0: | ||
| 1207 | storesubscript(top-3, 1); | ||
| 1208 | break; | ||
| 1209 | |||
| 1210 | case STOREINDEXED: { | ||
| 1211 | int n = *pc++; | ||
| 1212 | storesubscript(top-3-n, 2); | ||
| 1213 | break; | ||
| 1214 | } | ||
| 1215 | |||
| 1216 | case STORELIST0: | ||
| 1217 | case STORELIST: | ||
| 1218 | { | ||
| 1219 | int m, n; | ||
| 1220 | TObject *arr; | ||
| 1221 | if (opcode == STORELIST0) m = 0; | ||
| 1222 | else m = *(pc++) * FIELDS_PER_FLUSH; | ||
| 1223 | n = *(pc++); | ||
| 1224 | arr = top-n-1; | ||
| 1225 | while (n) | ||
| 1226 | { | ||
| 1227 | ttype(top) = LUA_T_NUMBER; nvalue(top) = n+m; | ||
| 1228 | *(lua_hashdefine (avalue(arr), top)) = *(top-1); | ||
| 1229 | top--; | ||
| 1230 | n--; | ||
| 1231 | } | ||
| 1232 | } | ||
| 1233 | break; | ||
| 1234 | |||
| 1235 | case STOREMAP: { | ||
| 1236 | int n = *(pc++); | ||
| 1237 | TObject *arr = top-(2*n)-1; | ||
| 1238 | while (n--) { | ||
| 1239 | *(lua_hashdefine (avalue(arr), top-2)) = *(top-1); | ||
| 1240 | top-=2; | ||
| 1241 | } | ||
| 1242 | } | ||
| 1243 | break; | ||
| 1244 | |||
| 1245 | case ADJUST0: | ||
| 1246 | adjust_top(base); | ||
| 1247 | break; | ||
| 1248 | |||
| 1249 | case ADJUST: { | ||
| 1250 | StkId newtop = base + *(pc++); | ||
| 1251 | adjust_top(newtop); | ||
| 1252 | break; | ||
| 1253 | } | ||
| 1254 | |||
| 1255 | case VARARGS: | ||
| 1256 | adjust_varargs(base + *(pc++)); | ||
| 1257 | break; | ||
| 1258 | |||
| 1259 | case CREATEARRAY: | ||
| 1260 | { | ||
| 1261 | Word size; | ||
| 1262 | get_word(size,pc); | ||
| 1263 | avalue(top) = lua_createarray(size); | ||
| 1264 | ttype(top) = LUA_T_ARRAY; | ||
| 1265 | incr_top; | ||
| 1266 | } | ||
| 1267 | break; | ||
| 1268 | |||
| 1269 | case EQOP: | ||
| 1270 | { | ||
| 1271 | int res = lua_equalObj(top-2, top-1); | ||
| 1272 | --top; | ||
| 1273 | ttype(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL; | ||
| 1274 | nvalue(top-1) = 1; | ||
| 1275 | } | ||
| 1276 | break; | ||
| 1277 | |||
| 1278 | case LTOP: | ||
| 1279 | comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); | ||
| 1280 | break; | ||
| 1281 | |||
| 1282 | case LEOP: | ||
| 1283 | comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE); | ||
| 1284 | break; | ||
| 1285 | |||
| 1286 | case GTOP: | ||
| 1287 | comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT); | ||
| 1288 | break; | ||
| 1289 | |||
| 1290 | case GEOP: | ||
| 1291 | comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE); | ||
| 1292 | break; | ||
| 1293 | |||
| 1294 | case ADDOP: | ||
| 1295 | { | ||
| 1296 | TObject *l = top-2; | ||
| 1297 | TObject *r = top-1; | ||
| 1298 | if (tonumber(r) || tonumber(l)) | ||
| 1299 | call_arith(IM_ADD); | ||
| 1300 | else | ||
| 1301 | { | ||
| 1302 | nvalue(l) += nvalue(r); | ||
| 1303 | --top; | ||
| 1304 | } | ||
| 1305 | } | ||
| 1306 | break; | ||
| 1307 | |||
| 1308 | case SUBOP: | ||
| 1309 | { | ||
| 1310 | TObject *l = top-2; | ||
| 1311 | TObject *r = top-1; | ||
| 1312 | if (tonumber(r) || tonumber(l)) | ||
| 1313 | call_arith(IM_SUB); | ||
| 1314 | else | ||
| 1315 | { | ||
| 1316 | nvalue(l) -= nvalue(r); | ||
| 1317 | --top; | ||
| 1318 | } | ||
| 1319 | } | ||
| 1320 | break; | ||
| 1321 | |||
| 1322 | case MULTOP: | ||
| 1323 | { | ||
| 1324 | TObject *l = top-2; | ||
| 1325 | TObject *r = top-1; | ||
| 1326 | if (tonumber(r) || tonumber(l)) | ||
| 1327 | call_arith(IM_MUL); | ||
| 1328 | else | ||
| 1329 | { | ||
| 1330 | nvalue(l) *= nvalue(r); | ||
| 1331 | --top; | ||
| 1332 | } | ||
| 1333 | } | ||
| 1334 | break; | ||
| 1335 | |||
| 1336 | case DIVOP: | ||
| 1337 | { | ||
| 1338 | TObject *l = top-2; | ||
| 1339 | TObject *r = top-1; | ||
| 1340 | if (tonumber(r) || tonumber(l)) | ||
| 1341 | call_arith(IM_DIV); | ||
| 1342 | else | ||
| 1343 | { | ||
| 1344 | nvalue(l) /= nvalue(r); | ||
| 1345 | --top; | ||
| 1346 | } | ||
| 1347 | } | ||
| 1348 | break; | ||
| 1349 | |||
| 1350 | case POWOP: | ||
| 1351 | call_arith(IM_POW); | ||
| 1352 | break; | ||
| 1353 | |||
| 1354 | case CONCOP: { | ||
| 1355 | TObject *l = top-2; | ||
| 1356 | TObject *r = top-1; | ||
| 1357 | if (tostring(l) || tostring(r)) | ||
| 1358 | call_binTM(IM_CONCAT, "unexpected type for concatenation"); | ||
| 1359 | else { | ||
| 1360 | tsvalue(l) = luaI_createstring(lua_strconc(svalue(l),svalue(r))); | ||
| 1361 | --top; | ||
| 1362 | } | ||
| 1363 | } | ||
| 1364 | break; | ||
| 1365 | |||
| 1366 | case MINUSOP: | ||
| 1367 | if (tonumber(top-1)) | ||
| 1368 | { | ||
| 1369 | ttype(top) = LUA_T_NIL; | ||
| 1370 | incr_top; | ||
| 1371 | call_arith(IM_UNM); | ||
| 1372 | } | ||
| 1373 | else | ||
| 1374 | nvalue(top-1) = - nvalue(top-1); | ||
| 1375 | break; | ||
| 1376 | |||
| 1377 | case NOTOP: | ||
| 1378 | ttype(top-1) = (ttype(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL; | ||
| 1379 | nvalue(top-1) = 1; | ||
| 1380 | break; | ||
| 1381 | |||
| 1382 | case ONTJMP: | ||
| 1383 | { | ||
| 1384 | Word w; | ||
| 1385 | get_word(w,pc); | ||
| 1386 | if (ttype(top-1) != LUA_T_NIL) pc += w; | ||
| 1387 | else top--; | ||
| 1388 | } | ||
| 1389 | break; | ||
| 1390 | |||
| 1391 | case ONFJMP: | ||
| 1392 | { | ||
| 1393 | Word w; | ||
| 1394 | get_word(w,pc); | ||
| 1395 | if (ttype(top-1) == LUA_T_NIL) pc += w; | ||
| 1396 | else top--; | ||
| 1397 | } | ||
| 1398 | break; | ||
| 1399 | |||
| 1400 | case JMP: | ||
| 1401 | { | ||
| 1402 | Word w; | ||
| 1403 | get_word(w,pc); | ||
| 1404 | pc += w; | ||
| 1405 | } | ||
| 1406 | break; | ||
| 1407 | |||
| 1408 | case UPJMP: | ||
| 1409 | { | ||
| 1410 | Word w; | ||
| 1411 | get_word(w,pc); | ||
| 1412 | pc -= w; | ||
| 1413 | } | ||
| 1414 | break; | ||
| 1415 | |||
| 1416 | case IFFJMP: | ||
| 1417 | { | ||
| 1418 | Word w; | ||
| 1419 | get_word(w,pc); | ||
| 1420 | top--; | ||
| 1421 | if (ttype(top) == LUA_T_NIL) pc += w; | ||
| 1422 | } | ||
| 1423 | break; | ||
| 1424 | |||
| 1425 | case IFFUPJMP: | ||
| 1426 | { | ||
| 1427 | Word w; | ||
| 1428 | get_word(w,pc); | ||
| 1429 | top--; | ||
| 1430 | if (ttype(top) == LUA_T_NIL) pc -= w; | ||
| 1431 | } | ||
| 1432 | break; | ||
| 1433 | |||
| 1434 | case CALLFUNC: | ||
| 1435 | { | ||
| 1436 | int nParams = *(pc++); | ||
| 1437 | int nResults = *(pc++); | ||
| 1438 | StkId newBase = (top-stack)-nParams; | ||
| 1439 | do_call(newBase, nResults); | ||
| 1440 | } | ||
| 1441 | break; | ||
| 1442 | |||
| 1443 | case RETCODE0: | ||
| 1444 | case RETCODE: | ||
| 1445 | if (lua_callhook) | ||
| 1446 | callHook (base, LUA_T_MARK, 1); | ||
| 1447 | return (base + ((opcode==RETCODE0) ? 0 : *pc)); | ||
| 1448 | |||
| 1449 | case SETLINE: | ||
| 1450 | { | ||
| 1451 | Word line; | ||
| 1452 | get_word(line,pc); | ||
| 1453 | if ((stack+base-1)->ttype != LUA_T_LINE) | ||
| 1454 | { | ||
| 1455 | /* open space for LINE value */ | ||
| 1456 | open_stack((top-stack)-base); | ||
| 1457 | base++; | ||
| 1458 | (stack+base-1)->ttype = LUA_T_LINE; | ||
| 1459 | } | ||
| 1460 | (stack+base-1)->value.i = line; | ||
| 1461 | if (lua_linehook) | ||
| 1462 | lineHook (line); | ||
| 1463 | break; | ||
| 1464 | } | ||
| 1465 | |||
| 1466 | default: | ||
| 1467 | lua_error ("internal error - opcode doesn't match"); | ||
| 1468 | } | ||
| 1469 | } | ||
| 1470 | } | ||
| 1471 | |||
| 1472 | |||
| 1473 | #if LUA_COMPAT2_5 | ||
| 1474 | /* | ||
| 1475 | ** API: set a function as a fallback | ||
| 1476 | */ | ||
| 1477 | lua_Object lua_setfallback (char *name, lua_CFunction fallback) | ||
| 1478 | { | ||
| 1479 | lua_pushstring(name); | ||
| 1480 | lua_pushcfunction(fallback); | ||
| 1481 | do_unprotectedrun(luaI_setfallback, 2, 1); | ||
| 1482 | return put_luaObjectonTop(); | ||
| 1483 | } | ||
| 1484 | #endif | ||
