mirrors/lua
1
0
Fork 0
mirror of https://github.com/lua/lua synced 2024-11-22 12:51:30 +03:00
Code Issues Packages Projects Releases Wiki Activity

new implementation for the Virtual Machine

Browse Source
This commit is contained in:
Roberto Ierusalimschy 2001-06-05 15:17:01 -03:00
parent 572a69b6af
commit 762d059a13
15 changed files with 1696 additions and 1538 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lapi.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lapi.c,v 1.140 2001/04/17 17:35:54 roberto Exp roberto $
** $Id: lapi.c,v 1.141 2001/04/23 16:35:45 roberto Exp roberto $
** Lua API
** See Copyright Notice in lua.h
*/
@ -184,9 +184,10 @@ LUA_API int lua_iscfunction (lua_State *L, int index) {
LUA_API int lua_isnumber (lua_State *L, int index) {
TObject *o;
int i;
TObject n;
lua_lock(L);
o = luaA_indexAcceptable(L, index);
i = (o == NULL) ? 0 : (tonumber(o) == 0);
i = (o != NULL && (ttype(o) == LUA_TNUMBER || luaV_tonumber(o, &n)));
lua_unlock(L);
return i;
}
@ -234,13 +235,18 @@ LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {
LUA_API lua_Number lua_tonumber (lua_State *L, int index) {
StkId o;
lua_Number n;
const TObject *o;
TObject n;
lua_Number res;
lua_lock(L);
o = luaA_indexAcceptable(L, index);
n = (o == NULL || tonumber(o)) ? 0 : nvalue(o);
if (o != NULL &&
(ttype(o) == LUA_TNUMBER || (o = luaV_tonumber(o, &n)) != NULL))
res = nvalue(o);
else
res = 0;
lua_unlock(L);
return n;
return res;
}
LUA_API const l_char *lua_tostring (lua_State *L, int index) {

1141
lcode.c
View File

File diff suppressed because it is too large Load Diff

49
lcode.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lcode.h,v 1.20 2001/02/20 18:15:33 roberto Exp roberto $
** $Id: lcode.h,v 1.21 2001/02/23 17:17:25 roberto Exp roberto $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
@ -31,43 +31,36 @@ typedef enum BinOpr {
OPR_NOBINOPR
} BinOpr;
#define binopistest(op) ((op) >= OPR_NE)
typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr;
enum Mode {iO, iU, iS, iAB}; /* instruction format */
#define VD 100 /* flag for variable delta */
typedef struct OpProperties {
lu_byte mode;
lu_byte push;
lu_byte pop;
} OpProperties;
extern const OpProperties luaK_opproperties[];
#define luaK_codeAsBc(fs,o,A,sBc) luaK_codeABc(fs,o,A,(sBc)+MAXARG_sBc)
void luaK_error (LexState *ls, const l_char *msg);
int luaK_code0 (FuncState *fs, OpCode o);
int luaK_code1 (FuncState *fs, OpCode o, int arg1);
int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2);
int luaK_codeABc (FuncState *fs, OpCode o, int A, int Bc);
int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C);
void luaK_nil (FuncState *fs, int from, int n);
void luaK_reserveregs (FuncState *fs, int n);
int luaK_stringk (FuncState *fs, TString *s);
int luaK_exp2anyreg (FuncState *fs, expdesc *e);
void luaK_exp2nextreg (FuncState *fs, expdesc *e);
void luaK_exp2val (FuncState *fs, expdesc *e);
int luaK_exp2RK (FuncState *fs, expdesc *e);
void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
void luaK_goiftrue (FuncState *fs, expdesc *e);
void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
void luaK_setcallreturns (FuncState *fs, expdesc *var, int nresults);
int luaK_jump (FuncState *fs);
void luaK_patchlist (FuncState *fs, int list, int target);
void luaK_fixfor (FuncState *fs, int pc, int dest);
void luaK_concat (FuncState *fs, int *l1, int l2);
void luaK_goiftrue (FuncState *fs, expdesc *v, int keepvalue);
int luaK_getlabel (FuncState *fs);
void luaK_deltastack (FuncState *fs, int delta);
void luaK_kstr (LexState *ls, int c);
void luaK_number (FuncState *fs, lua_Number f);
void luaK_adjuststack (FuncState *fs, int n);
int luaK_lastisopen (FuncState *fs);
void luaK_setcallreturns (FuncState *fs, int nresults);
void luaK_tostack (LexState *ls, expdesc *v, int onlyone);
void luaK_storevar (LexState *ls, const expdesc *var);
void luaK_prefix (LexState *ls, UnOpr op, expdesc *v);
void luaK_infix (LexState *ls, BinOpr op, expdesc *v);
void luaK_posfix (LexState *ls, BinOpr op, expdesc *v1, expdesc *v2);
void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v);
void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2);
#endif

416
ldebug.c
View File

@ -1,5 +1,5 @@
/*
** $Id: ldebug.c,v 1.75 2001/03/26 14:31:49 roberto Exp roberto $
** $Id: ldebug.c,v 1.76 2001/04/06 18:25:00 roberto Exp roberto $
** Debug Interface
** See Copyright Notice in lua.h
*/
@ -22,6 +22,7 @@
#include "ltable.h"
#include "ltm.h"
#include "luadebug.h"
#include "lvm.h"
@ -298,6 +299,10 @@ LUA_API int lua_getinfo (lua_State *L, const l_char *what, lua_Debug *ar) {
#define check(x) if (!(x)) return 0;
#define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode)
#define checkreg(pt,reg) check((reg) < (pt)->maxstacksize)
static int checklineinfo (const Proto *pt) {
int *lineinfo = pt->lineinfo;
@ -318,231 +323,199 @@ static int precheck (const Proto *pt) {
}
/* value for non-initialized entries in array stacklevel */
#define SL_EMPTY 255
#define checkjump(pt,sl,top,pc) if (!checkjump_aux(pt,sl,top,pc)) return 0;
static int checkjump_aux (const Proto *pt, lu_byte *sl, int top, int pc) {
check(0 <= pc && pc < pt->sizecode);
if (sl == NULL) return 1; /* not full checking */
if (sl[pc] == SL_EMPTY)
sl[pc] = (lu_byte)top;
else
check(sl[pc] == top);
return 1;
static int checkopenop (Instruction i) {
OpCode op = GET_OPCODE(i);
switch (op) {
case OP_CALL:
case OP_RETURN: {
check(GETARG_B(i) == NO_REG);
return 1;
}
case OP_SETLISTO: return 1;
default: return 0; /* invalid instruction after an open call */
}
}
static Instruction luaG_symbexec (lua_State *L, const Proto *pt,
int lastpc, int stackpos) {
int stack[MAXSTACK]; /* stores last instruction that changed a stack entry */
lu_byte *sl = NULL;
int top;
static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
int pc;
if (stackpos < 0) { /* full check? */
int i;
sl = luaO_openspace(L, pt->sizecode, lu_byte);
for (i=0; i<pt->sizecode; i++) /* initialize stack-level array */
sl[i] = SL_EMPTY;
int last; /* stores position of last instruction that changed `reg' */
last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */
if (reg == NO_REG) /* full check? */
check(precheck(pt));
}
top = pt->numparams;
pc = 0;
if (pt->is_vararg) /* varargs? */
top++; /* `arg' */
if (sl) sl[0] = (lu_byte)top;
while (pc < lastpc) {
const Instruction i = pt->code[pc++];
for (pc = 0; pc < lastpc; pc++) {
const Instruction i = pt->code[pc];
OpCode op = GET_OPCODE(i);
int arg1 = 0;
int arg2 = 0;
int push, pop;
check(op < NUM_OPCODES);
push = (int)luaK_opproperties[op].push;
pop = (int)luaK_opproperties[op].pop;
switch ((enum Mode)luaK_opproperties[op].mode) {
case iO: break;
case iU: arg1 = GETARG_U(i); check(arg1 >= 0); break;
case iS: arg1 = GETARG_S(i); break;
case iAB:
arg1 = GETARG_A(i); arg2 = GETARG_B(i); check(arg1 >= 0); break;
}
switch (op) {
case OP_RETURN: {
check(arg1 <= top);
pop = top-arg1;
break;
}
case OP_CALL: {
if (arg2 == MULT_RET) arg2 = 1;
check(arg1 < top);
pop = top-arg1;
push = arg2;
break;
}
case OP_PUSHNIL: {
check(arg1 > 0);
push = arg1;
break;
}
case OP_POP: {
pop = arg1;
break;
}
case OP_PUSHSTRING:
case OP_GETGLOBAL:
case OP_GETDOTTED:
case OP_PUSHSELF:
case OP_SETGLOBAL: {
check(arg1 < pt->sizekstr);
break;
}
case OP_PUSHNUM:
case OP_PUSHNEGNUM: {
check(arg1 < pt->sizeknum);
break;
}
case OP_PUSHUPVALUE: {
check(arg1 < pt->nupvalues);
break;
}
case OP_GETLOCAL:
case OP_GETINDEXED:
case OP_SETLOCAL: {
check(arg1 < top);
break;
}
case OP_SETTABLE: {
check(3 <= arg1 && arg1 <= top);
pop = arg2;
break;
}
case OP_SETLIST: {
check(arg2 >= 0);
pop = top-arg2-1;
break;
}
case OP_SETMAP: {
check(arg1 >= 0);
pop = top-arg1-1;
break;
}
case OP_CONCAT: {
pop = arg1;
break;
}
case OP_CLOSURE: {
check(arg1 < pt->sizekproto);
check(arg2 == pt->kproto[arg1]->nupvalues);
pop = arg2;
break;
}
case OP_JMPNE:
case OP_JMPEQ:
case OP_JMPLT:
case OP_JMPLE:
case OP_JMPGT:
case OP_JMPGE:
case OP_JMPT:
case OP_JMPF:
case OP_JMP: {
checkjump(pt, sl, top-pop, pc+arg1);
break;
}
case OP_FORLOOP:
case OP_LFORLOOP:
case OP_JMPONT:
case OP_JMPONF: {
int newpc = pc+arg1;
checkjump(pt, sl, top, newpc);
/* jump is forward and do not skip `lastpc' and not full check? */
if (pc < newpc && newpc <= lastpc && stackpos >= 0) {
stack[top-1] = pc-1; /* value comes from `and'/`or' */
pc = newpc; /* do the jump */
pop = 0; /* do not pop */
int a = GETARG_A(i);
int b = 0;
int c = 0;
#undef check
#define check(x) if (!(x)) { \
printf(">>>%d %d %d %d %d %d\n", op, a, b, c, pt->maxstacksize, pt->sizek); \
return 0; }
switch (getOpMode(op)) {
case iABC: {
b = GETARG_B(i);
c = GETARG_C(i);
if (testOpMode(op, OpModeBreg)) {
checkreg(pt, b);
check(c < pt->maxstacksize ||
(c >= MAXSTACK && c-MAXSTACK < pt->sizek));
}
break;
}
case OP_PUSHNILJMP: {
check(GET_OPCODE(pt->code[pc]) == OP_PUSHINT); /* only valid sequence */
case iABc: {
b = GETARG_Bc(i);
if (testOpMode(op, OpModeK)) check(b < pt->sizek);
break;
}
case OP_FORPREP: {
int endfor = pc-arg1-1; /* jump is `negative' here */
check(top >= 3);
checkjump(pt, sl, top+push, endfor);
check(GET_OPCODE(pt->code[endfor]) == OP_FORLOOP);
check(GETARG_S(pt->code[endfor]) == arg1);
break;
}
case OP_LFORPREP: {
int endfor = pc-arg1-1; /* jump is `negative' here */
check(top >= 1);
checkjump(pt, sl, top+push, endfor);
check(GET_OPCODE(pt->code[endfor]) == OP_LFORLOOP);
check(GETARG_S(pt->code[endfor]) == arg1);
break;
}
case OP_PUSHINT:
case OP_GETTABLE:
case OP_CREATETABLE:
case OP_ADD:
case OP_ADDI:
case OP_SUB:
case OP_MULT:
case OP_DIV:
case OP_POW:
case OP_MINUS:
case OP_NOT: {
case iAsBc: {
b = GETARG_sBc(i);
break;
}
}
top -= pop;
check(0 <= top && top+push <= pt->maxstacksize);
while (push--) stack[top++] = pc-1;
checkjump(pt, sl, top, pc);
if (testOpMode(op, OpModeAreg)) checkreg(pt, a);
if (testOpMode(op, OpModesetA)) {
if (a == reg) last = pc; /* change register `a' */
}
if (testOpMode(op, OpModeT))
check(GET_OPCODE(pt->code[pc+1]) == OP_CJMP);
switch (op) {
case OP_LOADNIL: {
if (a <= reg && reg <= b)
last = pc; /* set registers from `a' to `b' */
break;
}
case OP_LOADUPVAL: {
check(b < pt->nupvalues);
break;
}
case OP_GETGLOBAL:
case OP_SETGLOBAL: {
check(ttype(&pt->k[b]) == LUA_TSTRING);
break;
}
case OP_SELF: {
checkreg(pt, a+1);
if (reg == a+1) last = pc;
break;
}
case OP_CONCAT: {
check(b < c); /* at least two operands */
break;
}
case OP_JMP:
case OP_CJMP: {
int dest = pc+1+b;
check(0 <= dest && dest < pt->sizecode);
/* not full check and jump is forward and do not skip `lastpc'? */
if (reg != NO_REG && pc < dest && dest <= lastpc)
pc += b; /* do the jump */
break;
}
case OP_TESTT:
case OP_TESTF: {
if (a != NO_REG)
checkreg(pt, a);
break;
}
case OP_NILJMP: {
check(pc+2 < pt->sizecode); /* check its jump */
break;
}
case OP_CALL: {
if (b == NO_REG) b = pt->maxstacksize;
if (c == NO_REG) {
check(checkopenop(pt->code[pc+1]));
c = 1;
}
check(b > a);
checkreg(pt, b-1);
checkreg(pt, a+c-1);
if (reg >= a) last = pc; /* affect all registers above base */
break;
}
case OP_RETURN: {
if (b == NO_REG) b = pt->maxstacksize;
checkreg(pt, b-1);
break;
}
case OP_FORPREP:
case OP_TFORPREP: {
int dest = pc-b; /* jump is negated here */
check(0 <= dest && dest < pt->sizecode &&
GET_OPCODE(pt->code[dest]) == op+1);
break;
}
case OP_FORLOOP:
case OP_TFORLOOP: {
int dest = pc+b;
check(0 <= dest && dest < pt->sizecode &&
pt->code[dest] == SET_OPCODE(i, op-1));
checkreg(pt, a + ((op == OP_FORLOOP) ? 2 : 3));
break;
}
case OP_SETLIST: {
checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1);
break;
}
case OP_CLOSURE: {
check(b < pt->sizekproto);
checkreg(pt, a + pt->kproto[b]->nupvalues - 1);
break;
}
default: break;
}
}
return (stackpos >= 0) ? pt->code[stack[stackpos]] : 1;
return pt->code[last];
}
/* }====================================================== */
int luaG_checkcode (lua_State *L, const Proto *pt) {
return luaG_symbexec(L, pt, pt->sizecode-1, -1);
int luaG_checkcode (const Proto *pt) {
return luaG_symbexec(pt, pt->sizecode, NO_REG);
}
static const l_char *getobjname (lua_State *L, StkId obj, const l_char **name) {
CallInfo *ci = ci_stack(L, obj);
if (!isLmark(ci))
return NULL; /* not an active Lua function */
else {
if (isLmark(ci)) { /* an active Lua function? */
Proto *p = ci_func(ci)->f.l;
int pc = currentpc(ci);
int stackpos = obj - ci->base;
Instruction i = luaG_symbexec(L, p, pc, stackpos);
Instruction i;
*name = luaF_getlocalname(p, stackpos+1, pc);
if (*name) /* is a local? */
return l_s("local");
i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */
lua_assert(pc != -1);
switch (GET_OPCODE(i)) {
case OP_GETGLOBAL: {
*name = getstr(p->kstr[GETARG_U(i)]);
lua_assert(ttype(&p->k[GETARG_Bc(i)]) == LUA_TSTRING);
*name = getstr(tsvalue(&p->k[GETARG_Bc(i)]));
return l_s("global");
}
case OP_GETLOCAL: {
*name = luaF_getlocalname(p, GETARG_U(i)+1, pc);
lua_assert(*name);
return l_s("local");
case OP_MOVE: {
int a = GETARG_A(i);
int b = GETARG_B(i); /* move from `b' to `a' */
if (b < a)
return getobjname(L, ci->base+b, name); /* get name for `b' */
break;
}
case OP_PUSHSELF:
case OP_GETDOTTED: {
*name = getstr(p->kstr[GETARG_U(i)]);
return l_s("field");
case OP_GETTABLE:
case OP_SELF: {
int c = GETARG_C(i) - MAXSTACK;
if (c >= 0 && ttype(&p->k[c]) == LUA_TSTRING) {
*name = getstr(tsvalue(&p->k[c]));
return l_s("field");
}
break;
}
default:
return NULL; /* no useful name found */
default: break;
}
}
return NULL; /* no useful name found */
}
@ -576,10 +549,18 @@ void luaG_typeerror (lua_State *L, StkId o, const l_char *op) {
}
void luaG_binerror (lua_State *L, StkId p1, int t, const l_char *op) {
if (ttype(p1) == t) p1++;
lua_assert(ttype(p1) != t);
luaG_typeerror(L, p1, op);
void luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
if (ttype(p1) == LUA_TSTRING) p1 = p2;
lua_assert(ttype(p1) != LUA_TSTRING);
luaG_typeerror(L, p1, l_s("concat"));
}
void luaG_aritherror (lua_State *L, StkId p1, TObject *p2) {
TObject temp;
if (luaV_tonumber(p1, &temp) != NULL)
p1 = p2; /* first operand is OK; error is in the second */
luaG_typeerror(L, p1, l_s("perform arithmetic on"));
}
@ -592,3 +573,52 @@ void luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2) {
luaO_verror(L, l_s("attempt to compare %.10s with %.10s"), t1, t2);
}
#define opmode(t,a,b,c,sa,k,m) (((t)<<OpModeT) | \
((a)<<OpModeAreg) | ((b)<<OpModeBreg) | ((c)<<OpModeCreg) | \
((sa)<<OpModesetA) | ((k)<<OpModeK) | (m))
const unsigned char luaG_opmodes[] = {
/* T A B C sA K mode opcode */
opmode(0,1,1,0, 1,0,iABC), /* OP_MOVE */
opmode(0,1,0,0, 1,1,iABc), /* OP_LOADK */
opmode(0,1,0,0, 1,0,iAsBc), /* OP_LOADINT */
opmode(0,1,1,0, 1,0,iABC), /* OP_LOADNIL */
opmode(0,1,0,0, 1,0,iABc), /* OP_LOADUPVAL */
opmode(0,1,0,0, 1,1,iABc), /* OP_GETGLOBAL */
opmode(0,1,1,1, 1,0,iABC), /* OP_GETTABLE */
opmode(0,1,0,0, 0,1,iABc), /* OP_SETGLOBAL */
opmode(0,1,1,1, 0,0,iABC), /* OP_SETTABLE */
opmode(0,1,0,0, 1,0,iABc), /* OP_NEWTABLE */
opmode(0,1,1,1, 1,0,iABC), /* OP_SELF */
opmode(0,1,1,1, 1,0,iABC), /* OP_ADD */
opmode(0,1,1,1, 1,0,iABC), /* OP_SUB */
opmode(0,1,1,1, 1,0,iABC), /* OP_MUL */
opmode(0,1,1,1, 1,0,iABC), /* OP_DIV */
opmode(0,1,1,1, 1,0,iABC), /* OP_POW */
opmode(0,1,1,0, 1,0,iABC), /* OP_UNM */
opmode(0,1,1,0, 1,0,iABC), /* OP_NOT */
opmode(0,1,1,1, 1,0,iABC), /* OP_CONCAT */
opmode(0,0,0,0, 0,0,iAsBc), /* OP_JMP */
opmode(0,0,0,0, 0,0,iAsBc), /* OP_CJMP */
opmode(1,0,1,1, 0,0,iABC), /* OP_TESTEQ */
opmode(1,0,1,1, 0,0,iABC), /* OP_TESTNE */
opmode(1,0,1,1, 0,0,iABC), /* OP_TESTLT */
opmode(1,0,1,1, 0,0,iABC), /* OP_TESTLE */
opmode(1,0,1,1, 0,0,iABC), /* OP_TESTGT */
opmode(1,0,1,1, 0,0,iABC), /* OP_TESTGE */
opmode(1,0,1,0, 1,0,iABC), /* OP_TESTT */
opmode(1,0,1,0, 1,0,iABC), /* OP_TESTF */
opmode(0,1,0,0, 1,0,iAsBc), /* OP_NILJMP */
opmode(0,1,0,0, 0,0,iABC), /* OP_CALL */
opmode(0,1,0,0, 0,0,iABC), /* OP_RETURN */
opmode(0,1,0,0, 0,0,iAsBc), /* OP_FORPREP */
opmode(0,1,0,0, 0,0,iAsBc), /* OP_FORLOOP */
opmode(0,1,0,0, 0,0,iAsBc), /* OP_TFORPREP */
opmode(0,1,0,0, 0,0,iAsBc), /* OP_TFORLOOP */
opmode(0,1,0,0, 0,0,iABc), /* OP_SETLIST */
opmode(0,1,0,0, 0,0,iABc), /* OP_SETLIST0 */
opmode(0,1,0,0, 0,0,iABc) /* OP_CLOSURE */
};

27
ldebug.h
View File

@ -1,5 +1,5 @@
/*
** $Id: ldebug.h,v 1.10 2001/02/12 19:54:50 roberto Exp roberto $
** $Id: ldebug.h,v 1.11 2001/02/23 17:17:25 roberto Exp roberto $
** Auxiliary functions from Debug Interface module
** See Copyright Notice in lua.h
*/
@ -12,11 +12,32 @@
#include "luadebug.h"
enum OpMode {iABC, iABc, iAsBc}; /* basic instruction format */
/*
** masks for instruction properties
*/
enum OpModeMask {
OpModeAreg = 2, /* A is a register */
OpModeBreg, /* B is a register */
OpModeCreg, /* C is a register/constant */
OpModesetA, /* instruction set register A */
OpModeK, /* Bc is a constant */
OpModeT /* operator is a test */
};
extern const unsigned char luaG_opmodes[];
#define getOpMode(m) ((enum OpMode)(luaG_opmodes[m] & 3))
#define testOpMode(m, b) (luaG_opmodes[m] & (1 << (b)))
void luaG_typeerror (lua_State *L, StkId o, const l_char *op);
void luaG_binerror (lua_State *L, StkId p1, int t, const l_char *op);
void luaG_concaterror (lua_State *L, StkId p1, StkId p2);
void luaG_aritherror (lua_State *L, StkId p1, TObject *p2);
int luaG_getline (int *lineinfo, int pc, int refline, int *refi);
void luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2);
int luaG_checkcode (lua_State *L, const Proto *pt);
int luaG_checkcode (const Proto *pt);
#endif

11
lfunc.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lfunc.c,v 1.42 2001/02/23 17:17:25 roberto Exp roberto $
** $Id: lfunc.c,v 1.43 2001/03/26 14:31:49 roberto Exp roberto $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
@ -30,10 +30,8 @@ Closure *luaF_newclosure (lua_State *L, int nelems) {
Proto *luaF_newproto (lua_State *L) {
Proto *f = luaM_new(L, Proto);
f->knum = NULL;
f->sizeknum = 0;
f->kstr = NULL;
f->sizekstr = 0;
f->k = NULL;
f->sizek = 0;
f->kproto = NULL;
f->sizekproto = 0;
f->code = NULL;
@ -58,8 +56,7 @@ Proto *luaF_newproto (lua_State *L) {
void luaF_freeproto (lua_State *L, Proto *f) {
luaM_freearray(L, f->code, f->sizecode, Instruction);
luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);
luaM_freearray(L, f->kstr, f->sizekstr, TString *);
luaM_freearray(L, f->knum, f->sizeknum, lua_Number);
luaM_freearray(L, f->k, f->sizek, TObject);
luaM_freearray(L, f->kproto, f->sizekproto, Proto *);
luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);
luaM_freelem(L, f, Proto);

8
lgc.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lgc.c,v 1.96 2001/04/11 14:42:41 roberto Exp roberto $
** $Id: lgc.c,v 1.97 2001/04/17 17:35:54 roberto Exp roberto $
** Garbage Collector
** See Copyright Notice in lua.h
*/
@ -48,8 +48,10 @@ static void protomark (Proto *f) {
int i;
f->marked = 1;
strmark(f->source);
for (i=0; i<f->sizekstr; i++)
strmark(f->kstr[i]);
for (i=0; i<f->sizek; i++) {
if (ttype(f->k+i) == LUA_TSTRING)
strmark(tsvalue(f->k+i));
}
for (i=0; i<f->sizekproto; i++)
protomark(f->kproto[i]);
for (i=0; i<f->sizelocvars; i++) /* mark local-variable names */

89
llimits.h
View File

@ -1,5 +1,5 @@
/*
** $Id: llimits.h,v 1.27 2001/02/23 20:28:56 roberto Exp roberto $
** $Id: llimits.h,v 1.28 2001/03/26 14:31:49 roberto Exp roberto $
** Limits, basic types, and some other `installation-dependent' definitions
** See Copyright Notice in lua.h
*/
@ -89,92 +89,23 @@ union L_Umaxalign { double d; void *s; long l; };
/*
** type for virtual-machine instructions
** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
** For a very small machine, you may change that to 2 bytes (and adjust
** the following limits accordingly)
*/
typedef unsigned long Instruction;
/*
** size and position of opcode arguments.
** For an instruction with 2 bytes, size is 16, and size_b can be 5
** (accordingly, size_u will be 10, and size_a will be 5)
*/
#define SIZE_INSTRUCTION 32
#define SIZE_B 8
#define SIZE_OP 6
#define SIZE_U (SIZE_INSTRUCTION-SIZE_OP)
#define POS_U SIZE_OP
#define POS_B SIZE_OP
#define SIZE_A (SIZE_INSTRUCTION-(SIZE_OP+SIZE_B))
#define POS_A (SIZE_OP+SIZE_B)
/*
** limits for opcode arguments.
** we use (signed) int to manipulate most arguments,
** so they must fit in BITS_INT-1 bits (-1 for sign)
*/
#if SIZE_U < BITS_INT-1
#define MAXARG_U ((1<<SIZE_U)-1)
#define MAXARG_S (MAXARG_U>>1) /* `S' is signed */
#else
#define MAXARG_U MAX_INT
#define MAXARG_S MAX_INT
#endif
#if SIZE_A < BITS_INT-1
#define MAXARG_A ((1<<SIZE_A)-1)
#else
#define MAXARG_A MAX_INT
#endif
#if SIZE_B < BITS_INT-1
#define MAXARG_B ((1<<SIZE_B)-1)
#else
#define MAXARG_B MAX_INT
#endif
/* maximum stack size in a function */
#ifndef MAXSTACK
/* maximum stack for a Lua function */
#define MAXSTACK 250
#endif
#if MAXSTACK > MAXARG_B
#undef MAXSTACK
#define MAXSTACK MAXARG_B
#endif
/* maximum number of local variables */
#ifndef MAXLOCALS
#define MAXLOCALS 200 /* arbitrary limit (<MAXSTACK) */
#endif
#if MAXLOCALS>=MAXSTACK
#undef MAXLOCALS
#define MAXLOCALS (MAXSTACK-1)
#endif
/* maximum number of upvalues */
#ifndef MAXUPVALUES
#define MAXUPVALUES 32 /* arbitrary limit (<=MAXARG_B) */
#endif
#if MAXUPVALUES>MAXARG_B
#undef MAXUPVALUES
#define MAXUPVALUES MAXARG_B
#endif
/* maximum number of variables in the left side of an assignment */
#ifndef MAXVARSLH
#define MAXVARSLH 100 /* arbitrary limit (<MULT_RET) */
#endif
#if MAXVARSLH>=MULT_RET
#undef MAXVARSLH
#define MAXVARSLH (MULT_RET-1)
#define MAXUPVALUES 32 /* arbitrary limit (<MAXSTACK) */
#endif
@ -182,27 +113,17 @@ typedef unsigned long Instruction;
#ifndef MAXPARAMS
#define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */
#endif
#if MAXPARAMS>=MAXLOCALS
#undef MAXPARAMS
#define MAXPARAMS (MAXLOCALS-1)
#endif
/* number of list items to accumulate before a SETLIST instruction */
/* (must be a power of 2) */
#define LFIELDS_PER_FLUSH 64
#if LFIELDS_PER_FLUSH>(MAXSTACK/4)
#undef LFIELDS_PER_FLUSH
#define LFIELDS_PER_FLUSH (MAXSTACK/4)
#endif
/* number of record items to accumulate before a SETMAP instruction */
/* (each item counts 2 elements on the stack: an index and a value) */
#define RFIELDS_PER_FLUSH (LFIELDS_PER_FLUSH/2)
/* maximum lookback to find a real constant (for code generation) */
#ifndef LOOKBACKNUMS
#define LOOKBACKNUMS 20 /* arbitrary constant */
#define LOOKBACKNUMS 40 /* arbitrary constant */
#endif

8
lobject.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lobject.h,v 1.101 2001/03/07 18:09:25 roberto Exp roberto $
** $Id: lobject.h,v 1.102 2001/04/11 14:42:41 roberto Exp roberto $
** Type definitions for Lua objects
** See Copyright Notice in lua.h
*/
@ -114,10 +114,8 @@ union L_UTString {
** Function Prototypes
*/
typedef struct Proto {
lua_Number *knum; /* numbers used by the function */
int sizeknum; /* size of `knum' */
struct TString **kstr; /* strings used by the function */
int sizekstr; /* size of `kstr' */
TObject *k; /* constants used by the function */
int sizek; /* size of `k' */
struct Proto **kproto; /* functions defined inside the function */
int sizekproto; /* size of `kproto' */
Instruction *code;

219
lopcodes.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lopcodes.h,v 1.71 2001/03/07 13:22:55 roberto Exp roberto $
** $Id: lopcodes.h,v 1.72 2001/04/06 18:25:00 roberto Exp roberto $
** Opcodes for Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -12,29 +12,55 @@
/*===========================================================================
We assume that instructions are unsigned numbers.
All instructions have an opcode in the first 6 bits. Moreover,
an instruction can have 0, 1, or 2 arguments. Instructions can
have the following types:
type 0: no arguments
type 1: 1 unsigned argument in the higher bits (called `U')
type 2: 1 signed argument in the higher bits (`S')
type 3: 1st unsigned argument in the higher bits (`A')
2nd unsigned argument in the middle bits (`B')
All instructions have an opcode in the first 6 bits.
Instructions can have the following fields:
`A' : 8 bits (25-32)
`B' : 8 bits (17-24)
`C' : 10 bits (7-16)
`Bc' : 18 bits (`B' and `C' together)
`sBc' : signed Bc
A signed argument is represented in excess K; that is, the number
value is the unsigned value minus K. K is exactly the maximum value
for that argument (so that -max is represented by 0, and +max is
represented by 2*max), which is half the maximum for the corresponding
unsigned argument.
The size of each argument is defined in `llimits.h'. The usual is an
instruction with 32 bits, U arguments with 26 bits (32-6), B arguments
with 9 bits, and A arguments with 17 bits (32-6-9). For small
installations, the instruction size can be 16, so U has 10 bits,
and A and B have 5 bits each.
===========================================================================*/
/*
** size and position of opcode arguments.
*/
#define SIZE_C 10
#define SIZE_B 8
#define SIZE_Bc (SIZE_C + SIZE_B)
#define SIZE_A 8
#define SIZE_OP 6
#define POS_C SIZE_OP
#define POS_B (POS_C + SIZE_C)
#define POS_Bc POS_C
#define POS_A (POS_B + SIZE_B)
/*
** limits for opcode arguments.
** we use (signed) int to manipulate most arguments,
** so they must fit in BITS_INT-1 bits (-1 for sign)
*/
#if SIZE_Bc < BITS_INT-1
#define MAXARG_Bc ((1<<SIZE_Bc)-1)
#define MAXARG_sBc (MAXARG_Bc>>1) /* `sBc' is signed */
#else
#define MAXARG_Bc MAX_INT
#define MAXARG_sBc MAX_INT
#endif
#define MAXARG_A ((1<<SIZE_A)-1)
#define MAXARG_B ((1<<SIZE_B)-1)
#define MAXARG_C ((1<<SIZE_C)-1)
/* creates a mask with `n' 1 bits at position `p' */
@ -47,120 +73,129 @@
** the following macros help to manipulate instructions
*/
#define CREATE_0(o) ((Instruction)(o))
#define GET_OPCODE(i) ((OpCode)((i)&MASK1(SIZE_OP,0)))
#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) | (Instruction)(o)))
#define SET_OPCODE(i,o) (((i)&MASK0(SIZE_OP,0)) | (Instruction)(o))
#define CREATE_U(o,u) ((Instruction)(o) | ((Instruction)(u)<<POS_U))
#define GETARG_U(i) ((int)((i)>>POS_U))
#define SETARG_U(i,u) ((i) = (((i)&MASK0(SIZE_U,POS_U)) | \
((Instruction)(u)<<POS_U)))
#define CREATE_S(o,s) CREATE_U((o),(s)+MAXARG_S)
#define GETARG_S(i) (GETARG_U(i)-MAXARG_S)
#define SETARG_S(i,s) SETARG_U((i),(s)+MAXARG_S)
#define CREATE_AB(o,a,b) ((Instruction)(o) | ((Instruction)(a)<<POS_A) \
| ((Instruction)(b)<<POS_B))
#define GETARG_A(i) ((int)((i)>>POS_A))
#define SETARG_A(i,a) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \
((Instruction)(a)<<POS_A)))
#define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \
((Instruction)(u)<<POS_A)))
#define GETARG_B(i) ((int)(((i)>>POS_B) & MASK1(SIZE_B,0)))
#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \
((Instruction)(b)<<POS_B)))
#define GETARG_C(i) ((int)(((i)>>POS_C) & MASK1(SIZE_C,0)))
#define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) | \
((Instruction)(b)<<POS_C)))
#define GETARG_Bc(i) ((int)(((i)>>POS_Bc) & MASK1(SIZE_Bc,0)))
#define SETARG_Bc(i,b) ((i) = (((i)&MASK0(SIZE_Bc,POS_Bc)) | \
((Instruction)(b)<<POS_Bc)))
#define GETARG_sBc(i) (GETARG_Bc(i)-MAXARG_sBc)
#define SETARG_sBc(i,b) SETARG_Bc((i),(b)+MAXARG_sBc)
#define CREATE_ABC(o,a,b,c) ((Instruction)(o) \
| ((Instruction)(a)<<POS_A) \
| ((Instruction)(b)<<POS_B) \
| ((Instruction)(c)<<POS_C))
#define CREATE_ABc(o,a,bc) ((Instruction)(o) \
| ((Instruction)(a)<<POS_A) \
| ((Instruction)(bc)<<POS_Bc))
/*
** K = U argument used as index to `kstr'
** J = S argument used as jump offset (relative to pc of next instruction)
** L = unsigned argument used as index of local variable
** N = U argument used as index to `knum'
** an invalid register that fits in 8 bits
*/
#define NO_REG MAXARG_A
/*
** R(x) - register
** Kst(x) - constant (in constant table)
** R/K(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK)
*/
typedef enum {
/*----------------------------------------------------------------------
name args stack before stack after side effects
name args description
------------------------------------------------------------------------*/
OP_RETURN,/* U v_n-v_x(at u) (return) returns v_x-v_n */
OP_MOVE,/* A B R(A) := R(B) */
OP_LOADK,/* A Bc R(A) := Kst(Bc) */
OP_LOADINT,/* A sBc R(A) := (Number)sBc */
OP_LOADNIL,/* A B R(A) := ... := R(B) := nil */
OP_LOADUPVAL,/* A Bc R(A) := UpValue[Bc] */
OP_CALL,/* A B v_n-v_1 f(at a) r_b-r_1 f(v1,...,v_n) */
OP_GETGLOBAL,/* A Bc R(A) := Gbl[Kst(Bc)] */
OP_GETTABLE,/* A B C R(A) := R(B)[R/K(C)] */
OP_PUSHNIL,/* U - nil_1-nil_u */
OP_POP,/* U a_u-a_1 - */
OP_SETGLOBAL,/* A Bc Gbl[Kst(Bc)] := R(A) */
OP_SETTABLE,/* A B C R(B)[R/K(C)] := R(A) */
OP_PUSHINT,/* S - (lua_Number)s */
OP_PUSHSTRING,/* K - KSTR[k] */
OP_PUSHNUM,/* N - KNUM[n] */
OP_PUSHNEGNUM,/* N - -KNUM[n] */
OP_NEWTABLE,/* A Bc R(A) := {} (size = Bc) */
OP_PUSHUPVALUE,/* U - Closure[u] */
OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[R/K(C)] */
OP_GETLOCAL,/* L - LOC[l] */
OP_GETGLOBAL,/* K - VAR[KSTR[k]] */
OP_ADD,/* A B C R(A) := R(B) + R/K(C) */
OP_SUB,/* A B C R(A) := R(B) - R/K(C) */
OP_MUL,/* A B C R(A) := R(B) * R/K(C) */
OP_DIV,/* A B C R(A) := R(B) / R/K(C) */
OP_POW,/* A B C R(A) := R(B) ^ R/K(C) */
OP_UNM,/* A B R(A) := -R(B) */
OP_NOT,/* A B R(A) := not R(B) */
OP_GETTABLE,/* - i t t[i] */
OP_GETDOTTED,/* K t t[KSTR[k]] */
OP_GETINDEXED,/* L t t[LOC[l]] */
OP_PUSHSELF,/* K t t t[KSTR[k]] */
OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */
OP_CREATETABLE,/* U - newarray(size = u) */
OP_JMP,/* sBc PC += sBc */
OP_CJMP,/* sBc if test then PC += sBc (see (1)) */
OP_SETLOCAL,/* L x - LOC[l]=x */
OP_SETGLOBAL,/* K x - VAR[KSTR[k]]=x */
OP_SETTABLE,/* A B v a_a-a_1 i t (pops b values) t[i]=v */
OP_TESTEQ,/* B C test := (R(B) == R/K(C)) */
OP_TESTNE,/* B C test := (R(B) ~= R/K(C)) */
OP_TESTLT,/* B C test := (R(B) < R/K(C)) */
OP_TESTLE,/* B C test := (R(B) <= R/K(C)) */
OP_TESTGT,/* B C test := (R(B) > R/K(C)) */
OP_TESTGE,/* B C test := (R(B) >= R/K(C)) */
OP_SETLIST,/* A B v_n-v_1 v_b v_b v_b[i+a*FPF]=v_i */
OP_SETMAP,/* U v_n k_n - v_1 k_1 v_u v_u v_u[k_i]=v_i */
OP_TESTT,/* A B test := R(B); if (test) R(A) := R(B) */
OP_TESTF,/* A B test := not R(B); if (test) R(A) := nil */
OP_ADD,/* - y x x+y */
OP_ADDI,/* S x x+s */
OP_SUB,/* - y x x-y */
OP_MULT,/* - y x x*y */
OP_DIV,/* - y x x/y */
OP_POW,/* - y x x^y */
OP_CONCAT,/* U v_u-v_1 v1..-..v_u */
OP_MINUS,/* - x -x */
OP_NOT,/* - x (x==nil)? 1 : nil */
OP_NILJMP,/* A R(A) := nil; PC++; */
OP_JMPNE,/* J y x - (x~=y)? PC+=s */
OP_JMPEQ,/* J y x - (x==y)? PC+=s */
OP_JMPLT,/* J y x - (x<y)? PC+=s */
OP_JMPLE,/* J y x - (x<y)? PC+=s */
OP_JMPGT,/* J y x - (x>y)? PC+=s */
OP_JMPGE,/* J y x - (x>=y)? PC+=s */
OP_CALL,/* A B C R(A), ... ,R(A+C-1) := R(A)(R(A+1), ... ,R(B-1))*/
OP_RETURN,/* A B return R(A), ... ,R(B-1) (see (3)) */
OP_JMPT,/* J x - (x~=nil)? PC+=s */
OP_JMPF,/* J x - (x==nil)? PC+=s */
OP_JMPONT,/* J x (x~=nil)? x : - (x~=nil)? PC+=s */
OP_JMPONF,/* J x (x==nil)? x : - (x==nil)? PC+=s */
OP_JMP,/* J - - PC+=s */
OP_FORPREP,/* A sBc */
OP_FORLOOP,/* A sBc */
OP_PUSHNILJMP,/* - - nil PC++; */
OP_TFORPREP,/* A sBc */
OP_TFORLOOP,/* A sBc */
OP_FORPREP,/* J */
OP_FORLOOP,/* J */
OP_LFORPREP,/* J */
OP_LFORLOOP,/* J */
OP_CLOSURE/* A B v_b-v_1 closure(KPROTO[a], v_1-v_b) */
OP_SETLIST,/* A Bc R(A)[Bc-Bc%FPF+i] := R(A+i), 1 <= i <= Bc%FPF+1 */
OP_SETLISTO,/* A Bc */
OP_CLOSURE /* A Bc R(A) := closure(KPROTO[Bc], R(A), ... ,R(A+n)) */
} OpCode;
#define NUM_OPCODES ((int)OP_CLOSURE+1)
#define ISJUMP(o) (OP_JMPNE <= (o) && (o) <= OP_JMP)
/*===========================================================================
Notes:
(1) In the current implementation there is no `test' variable;
instructions OP_TEST* and OP_CJMP must always occur together.
(2) In OP_CALL, if (B == NO_REG) then B = top. C is the number of returns,
and can be NO_REG. OP_CALL always set "top" to last_result+1, so
next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use "top".
/* special code to fit a LUA_MULTRET inside an argB */
#define MULT_RET 255 /* (<=MAXARG_B) */
#if MULT_RET>MAXARG_B
#undef MULT_RET
#define MULT_RET MAXARG_B
#endif
(3) In OP_RETURN, if (B == NO_REG) then B = top.
===========================================================================*/
#endif

560
lparser.c
View File

File diff suppressed because it is too large Load Diff

32
lparser.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lparser.h,v 1.29 2000/12/28 12:55:41 roberto Exp roberto $
** $Id: lparser.h,v 1.30 2001/02/20 18:28:11 roberto Exp roberto $
** LL(1) Parser and code generator for Lua
** See Copyright Notice in lua.h
*/
@ -16,25 +16,32 @@
*/
typedef enum {
VGLOBAL,
VLOCAL,
VINDEXED,
VEXP
VVOID, /* no value */
VNIL,
VNUMBER, /* n = value */
VK, /* info = index of constant in `k' */
VGLOBAL, /* info = index of global name in `k' */
VLOCAL, /* info = local register */
VINDEXED, /* info = table register; aux = index register (or `k') */
VRELOCABLE, /* info = instruction pc */
VNONRELOC, /* info = result register */
VJMP, /* info = result register */
VCALL /* info = result register */
} expkind;
typedef struct expdesc {
expkind k;
union {
int index; /* VGLOBAL: `kstr' index of global name; VLOCAL: stack index */
struct {
int t; /* patch list of `exit when true' */
int f; /* patch list of `exit when false' */
} l;
int info, aux;
} i;
lua_Number n;
} u;
int t; /* patch list of `exit when true' */
int f; /* patch list of `exit when false' */
} expdesc;
/* state needed to generate code for a given function */
typedef struct FuncState {
Proto *f; /* current function header */
@ -44,10 +51,9 @@ typedef struct FuncState {
int pc; /* next position to code (equivalent to `ncode') */
int lasttarget; /* `pc' of last `jump target' */
int jlt; /* list of jumps to `lasttarget' */
int stacklevel; /* number of values on activation register */
int nkstr; /* number of elements in `kstr' */
int freereg; /* first free register */
int nk; /* number of elements in `k' */
int nkproto; /* number of elements in `kproto' */
int nknum; /* number of elements in `knum' */
int nlineinfo; /* number of elements in `lineinfo' */
int nlocvars; /* number of elements in `locvars' */
int nactloc; /* number of active local variables */

133
ltests.c
View File

@ -1,5 +1,5 @@
/*
** $Id: ltests.c,v 1.79 2001/04/17 17:35:54 roberto Exp roberto $
** $Id: ltests.c,v 1.80 2001/04/23 16:35:45 roberto Exp roberto $
** Internal Module for Debugging of the Lua Implementation
** See Copyright Notice in lua.h
*/
@ -140,77 +140,65 @@ void *debug_realloc (void *block, size_t oldsize, size_t size) {
static const l_char *const instrname[NUM_OPCODES] = {
l_s("RETURN"),
l_s("CALL"),
l_s("PUSHNIL"),
l_s("POP"),
l_s("PUSHINT"),
l_s("PUSHSTRING"),
l_s("PUSHNUM"),
l_s("PUSHNEGNUM"),
l_s("PUSHUPVALUE"),
l_s("GETLOCAL"),
l_s("GETGLOBAL"),
l_s("GETTABLE"),
l_s("GETDOTTED"),
l_s("GETINDEXED"),
l_s("PUSHSELF"),
l_s("CREATETABLE"),
l_s("SETLOCAL"),
l_s("SETGLOBAL"),
l_s("SETTABLE"),
l_s("SETLIST"),
l_s("SETMAP"),
l_s("ADD"),
l_s("ADDI"),
l_s("SUB"),
l_s("MULT"),
l_s("DIV"),
l_s("POW"),
l_s("CONCAT"),
l_s("MINUS"),
l_s("NOT"),
l_s("JMPNE"),
l_s("JMPEQ"),
l_s("JMPLT"),
l_s("JMPLE"),
l_s("JMPGT"),
l_s("JMPGE"),
l_s("JMPT"),
l_s("JMPF"),
l_s("JMPONT"),
l_s("JMPONF"),
l_s("JMP"),
l_s("PUSHNILJMP"),
l_s("FORPREP"),
l_s("FORLOOP"),
l_s("LFORPREP"),
l_s("LFORLOOP"),
l_s("CLOSURE")
l_s("OP_MOVE"),
l_s("OP_LOADK"),
l_s("OP_LOADINT"),
l_s("OP_LOADNIL"),
l_s("OP_LOADUPVAL"),
l_s("OP_GETGLOBAL"),
l_s("OP_GETTABLE"),
l_s("OP_SETGLOBAL"),
l_s("OP_SETTABLE"),
l_s("OP_NEWTABLE"),
l_s("OP_SELF"),
l_s("OP_ADD"),
l_s("OP_SUB"),
l_s("OP_MUL"),
l_s("OP_DIV"),
l_s("OP_POW"),
l_s("OP_UNM"),
l_s("OP_NOT"),
l_s("OP_CONCAT"),
l_s("OP_JMP"),
l_s("OP_CJMP"),
l_s("OP_TESTEQ"),
l_s("OP_TESTNE"),
l_s("OP_TESTLT"),
l_s("OP_TESTLE"),
l_s("OP_TESTGT"),
l_s("OP_TESTGE"),
l_s("OP_TESTT"),
l_s("OP_TESTF"),
l_s("OP_NILJMP"),
l_s("OP_CALL"),
l_s("OP_RETURN"),
l_s("OP_FORPREP"),
l_s("OP_FORLOOP"),
l_s("OP_LFORPREP"),
l_s("OP_LFORLOOP"),
l_s("OP_SETLIST"),
l_s("OP_CLOSURE")
};
static void pushop (lua_State *L, Proto *p, int pc) {
l_char buff[100];
static l_char *buildop (Proto *p, int pc, l_char *buff) {
Instruction i = p->code[pc];
OpCode o = GET_OPCODE(i);
const l_char *name = instrname[o];
sprintf(buff, l_s("%5d - "), luaG_getline(p->lineinfo, pc, 1, NULL));
switch ((enum Mode)luaK_opproperties[o].mode) {
case iO:
sprintf(buff+8, l_s("%-12s"), name);
sprintf(buff, l_s("%4d - "), pc);
switch (getOpMode(o)) {
case iABC:
sprintf(buff+strlen(buff), l_s("%-12s%4d %4d %4d"), name,
GETARG_A(i), GETARG_B(i), GETARG_C(i));
break;
case iU:
sprintf(buff+8, l_s("%-12s%4u"), name, GETARG_U(i));
case iABc:
sprintf(buff+strlen(buff), l_s("%-12s%4d %4d"), name, GETARG_A(i), GETARG_Bc(i));
break;
case iS:
sprintf(buff+8, l_s("%-12s%4d"), name, GETARG_S(i));
break;
case iAB:
sprintf(buff+8, l_s("%-12s%4d %4d"), name, GETARG_A(i), GETARG_B(i));
case iAsBc:
sprintf(buff+strlen(buff), l_s("%-12s%4d %4d"), name, GETARG_A(i), GETARG_sBc(i));
break;
}
lua_pushstring(L, buff);
return buff;
}
@ -224,24 +212,25 @@ static int listcode (lua_State *L) {
setnameval(L, l_s("maxstack"), p->maxstacksize);
setnameval(L, l_s("numparams"), p->numparams);
for (pc=0; pc<p->sizecode; pc++) {
l_char buff[100];
lua_pushnumber(L, pc+1);
pushop(L, p, pc);
lua_pushstring(L, buildop(p, pc, buff));
lua_settable(L, -3);
}
return 1;
}
static int liststrings (lua_State *L) {
static int listk (lua_State *L) {
Proto *p;
int i;
luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
1, l_s("Lua function expected"));
p = clvalue(luaA_index(L, 1))->f.l;
lua_newtable(L);
for (i=0; i<p->sizekstr; i++) {
for (i=0; i<p->sizek; i++) {
lua_pushnumber(L, i+1);
lua_pushstring(L, getstr(p->kstr[i]));
luaA_pushobject(L, p->k+i);
lua_settable(L, -3);
}
return 1;
@ -276,20 +265,10 @@ static int get_limits (lua_State *L) {
lua_newtable(L);
setnameval(L, l_s("BITS_INT"), BITS_INT);
setnameval(L, l_s("LFPF"), LFIELDS_PER_FLUSH);
setnameval(L, l_s("MAXARG_A"), MAXARG_A);
setnameval(L, l_s("MAXARG_B"), MAXARG_B);
setnameval(L, l_s("MAXARG_S"), MAXARG_S);
setnameval(L, l_s("MAXARG_U"), MAXARG_U);
setnameval(L, l_s("MAXLOCALS"), MAXLOCALS);
setnameval(L, l_s("MAXPARAMS"), MAXPARAMS);
setnameval(L, l_s("MAXSTACK"), MAXSTACK);
setnameval(L, l_s("MAXUPVALUES"), MAXUPVALUES);
setnameval(L, l_s("MAXVARSLH"), MAXVARSLH);
setnameval(L, l_s("RFPF"), RFIELDS_PER_FLUSH);
setnameval(L, l_s("SIZE_A"), SIZE_A);
setnameval(L, l_s("SIZE_B"), SIZE_B);
setnameval(L, l_s("SIZE_OP"), SIZE_OP);
setnameval(L, l_s("SIZE_U"), SIZE_U);
return 1;
}
@ -700,7 +679,7 @@ static const struct luaL_reg tests_funcs[] = {
{l_s("hash"), hash_query},
{l_s("limits"), get_limits},
{l_s("listcode"), listcode},
{l_s("liststrings"), liststrings},
{l_s("listk"), listk},
{l_s("listlocals"), listlocals},
{l_s("loadlib"), loadlib},
{l_s("querystr"), string_query},

516
lvm.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lvm.c,v 1.177 2001/03/26 14:31:49 roberto Exp roberto $
** $Id: lvm.c,v 1.178 2001/04/06 18:25:00 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -28,15 +28,14 @@
int luaV_tonumber (TObject *obj) {
if (ttype(obj) != LUA_TSTRING)
return 1;
else {
if (!luaO_str2d(svalue(obj), &nvalue(obj)))
return 2;
ttype(obj) = LUA_TNUMBER;
return 0;
const TObject *luaV_tonumber (const TObject *obj, TObject *n) {
if (ttype(obj) == LUA_TNUMBER) return obj;
if (ttype(obj) == LUA_TSTRING && luaO_str2d(svalue(obj), &nvalue(n))) {
ttype(n) = LUA_TNUMBER;
return n;
}
else
return NULL;
}
@ -148,8 +147,7 @@ void luaV_gettable (lua_State *L, StkId t, TObject *key, StkId res) {
}
}
/* else will call the tag method */
}
else { /* not a table; try a `gettable' tag method */
} else { /* not a table; try a `gettable' tag method */
tm = luaT_gettmbyObj(G(L), t, TM_GETTABLE);
if (tm == NULL) /* no tag method? */
luaG_typeerror(L, t, l_s("index"));
@ -162,7 +160,7 @@ void luaV_gettable (lua_State *L, StkId t, TObject *key, StkId res) {
/*
** Receives table at `t', key at `key' and value at `val'.
*/
void luaV_settable (lua_State *L, StkId t, StkId key, StkId val) {
void luaV_settable (lua_State *L, StkId t, TObject *key, StkId val) {
Closure *tm;
if (ttype(t) == LUA_TTABLE) { /* `t' is a table? */
int tg = hvalue(t)->htag;
@ -172,8 +170,7 @@ void luaV_settable (lua_State *L, StkId t, StkId key, StkId val) {
return;
}
/* else will call the tag method */
}
else { /* not a table; try a `settable' tag method */
} else { /* not a table; try a `settable' tag method */
tm = luaT_gettmbyObj(G(L), t, TM_SETTABLE);
if (tm == NULL) /* no tag method? */
luaG_typeerror(L, t, l_s("index"));
@ -188,8 +185,7 @@ void luaV_getglobal (lua_State *L, TString *name, StkId res) {
if (!HAS_TM_GETGLOBAL(L, ttype(value)) || /* is there a tag method? */
(tm = luaT_gettmbyObj(G(L), value, TM_GETGLOBAL)) == NULL) {
setobj(res, value); /* default behavior */
}
else
} else
callTM(L, l_s("csor"), tm, name, value, res);
}
@ -200,8 +196,7 @@ void luaV_setglobal (lua_State *L, TString *name, StkId val) {
if (!HAS_TM_SETGLOBAL(L, ttype(oldvalue)) || /* no tag methods? */
(tm = luaT_gettmbyObj(G(L), oldvalue, TM_SETGLOBAL)) == NULL) {
setobj(oldvalue, val); /* raw set */
}
else
} else
callTM(L, l_s("csoo"), tm, name, oldvalue, val);
}
@ -224,9 +219,10 @@ static int call_binTM (lua_State *L, const TObject *p1, const TObject *p2,
}
static void call_arith (lua_State *L, StkId p1, TMS event) {
if (!call_binTM(L, p1, p1+1, p1, event))
luaG_binerror(L, p1, LUA_TNUMBER, l_s("perform arithmetic on"));
static void call_arith (lua_State *L, StkId p1, TObject *p2,
StkId res, TMS event) {
if (!call_binTM(L, p1, p2, res, event))
luaG_aritherror(L, p1, p2);
}
@ -270,9 +266,8 @@ void luaV_strconc (lua_State *L, int total, StkId top) {
int n = 2; /* number of elements handled in this pass (at least 2) */
if (tostring(L, top-2) || tostring(L, top-1)) {
if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT))
luaG_binerror(L, top-2, LUA_TSTRING, l_s("concat"));
}
else if (tsvalue(top-1)->len > 0) { /* if len=0, do nothing */
luaG_concaterror(L, top-2, top-1);
} else if (tsvalue(top-1)->len > 0) { /* if len=0, do nothing */
/* at least two string values; get as many as possible */
lu_mem tl = (lu_mem)tsvalue(top-1)->len + (lu_mem)tsvalue(top-2)->len;
l_char *buffer;
@ -321,7 +316,32 @@ static void adjust_varargs (lua_State *L, StkId base, int nfixargs) {
#define dojump(pc, i) ((pc) += GETARG_S(i))
/*
** some macros for common tasks in `luaV_execute'
*/
#define runtime_check(L, c) { if (!(c)) return L->top; }
#define RA(i) (base+GETARG_A(i))
#define RB(i) (base+GETARG_B(i))
#define RC(i) (base+GETARG_C(i))
#define RKC(i) ((GETARG_C(i) < MAXSTACK) ? \
base+GETARG_C(i) : \
tf->k+GETARG_C(i)-MAXSTACK)
#define KBc(i) (tf->k+GETARG_Bc(i))
#define Arith(op, optm) { \
const TObject *b = RB(i); const TObject *c = RKC(i); \
TObject tempb, tempc; \
if ((ttype(b) == LUA_TNUMBER || (b = luaV_tonumber(b, &tempb)) != NULL) && \
(ttype(c) == LUA_TNUMBER || (c = luaV_tonumber(c, &tempc)) != NULL)) { \
setnvalue(RA(i), nvalue(b) op nvalue(c)); \
} else \
call_arith(L, RB(i), RKC(i), RA(i), optm); \
}
#define dojump(pc, i) ((pc) += GETARG_sBc(i))
/*
** Executes the given Lua function. Parameters are between [base,top).
@ -329,328 +349,294 @@ static void adjust_varargs (lua_State *L, StkId base, int nfixargs) {
*/
StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
const Proto *const tf = cl->f.l;
StkId top; /* keep top local, for performance */
const Instruction *pc = tf->code;
const lua_Hook linehook = L->linehook;
L->ci->pc = &pc;
const Instruction *pc;
lua_Hook linehook;
if (tf->is_vararg) /* varargs? */
adjust_varargs(L, base, tf->numparams);
luaD_adjusttop(L, base, tf->maxstacksize);
top = base+tf->numparams+tf->is_vararg;
pc = tf->code;
L->ci->pc = &pc;
linehook = L->linehook;
/* main loop of interpreter */
for (;;) {
const Instruction i = *pc++;
lua_assert(L->top == base+tf->maxstacksize);
if (linehook)
traceexec(L, linehook);
switch (GET_OPCODE(i)) {
case OP_RETURN: {
L->top = top;
return base+GETARG_U(i);
}
case OP_CALL: {
int nres = GETARG_B(i);
if (nres == MULT_RET) nres = LUA_MULTRET;
L->top = top;
luaD_call(L, base+GETARG_A(i), nres);
top = L->top;
L->top = base+tf->maxstacksize;
case OP_MOVE: {
setobj(RA(i), RB(i));
break;
}
case OP_PUSHNIL: {
int n = GETARG_U(i);
lua_assert(n>0);
case OP_LOADK: {
setobj(RA(i), KBc(i));
break;
}
case OP_LOADINT: {
setnvalue(RA(i), (lua_Number)GETARG_sBc(i));
break;
}
case OP_LOADUPVAL: {
setobj(RA(i), cl->upvalue+GETARG_Bc(i));
break;
}
case OP_LOADNIL: {
TObject *ra = RA(i);
TObject *rb = RB(i);
do {
setnilvalue(top++);
} while (--n > 0);
break;
}
case OP_POP: {
top -= GETARG_U(i);
break;
}
case OP_PUSHINT: {
setnvalue(top, (lua_Number)GETARG_S(i));
top++;
break;
}
case OP_PUSHSTRING: {
setsvalue(top, tf->kstr[GETARG_U(i)]);
top++;
break;
}
case OP_PUSHNUM: {
setnvalue(top, tf->knum[GETARG_U(i)]);
top++;
break;
}
case OP_PUSHNEGNUM: {
setnvalue(top, -tf->knum[GETARG_U(i)]);
top++;
break;
}
case OP_PUSHUPVALUE: {
setobj(top++, &cl->upvalue[GETARG_U(i)]);
break;
}
case OP_GETLOCAL: {
setobj(top++, base+GETARG_U(i));
setnilvalue(ra++);
} while (ra <= rb);
break;
}
case OP_GETGLOBAL: {
luaV_getglobal(L, tf->kstr[GETARG_U(i)], top);
top++;
lua_assert(ttype(KBc(i)) == LUA_TSTRING);
luaV_getglobal(L, tsvalue(KBc(i)), RA(i));
break;
}
case OP_GETTABLE: {
top--;
luaV_gettable(L, top-1, top, top-1);
break;
}
case OP_GETDOTTED: {
setsvalue(top, tf->kstr[GETARG_U(i)]);
luaV_gettable(L, top-1, top, top-1);
break;
}
case OP_GETINDEXED: {
luaV_gettable(L, top-1, base+GETARG_U(i), top-1);
break;
}
case OP_PUSHSELF: {
setobj(top, top-1);
setsvalue(top+1, tf->kstr[GETARG_U(i)]);
luaV_gettable(L, top-1, top+1, top-1);
top++;
break;
}
case OP_CREATETABLE: {
luaC_checkGC(L);
sethvalue(top, luaH_new(L, GETARG_U(i)));
top++;
break;
}
case OP_SETLOCAL: {
setobj(base+GETARG_U(i), --top);
luaV_gettable(L, RB(i), RKC(i), RA(i));
break;
}
case OP_SETGLOBAL: {
top--;
luaV_setglobal(L, tf->kstr[GETARG_U(i)], top);
lua_assert(ttype(KBc(i)) == LUA_TSTRING);
luaV_setglobal(L, tsvalue(KBc(i)), RA(i));
break;
}
case OP_SETTABLE: {
StkId t = top-GETARG_A(i);
luaV_settable(L, t, t+1, top-1);
top -= GETARG_B(i); /* pop values */
luaV_settable(L, RB(i), RKC(i), RA(i));
break;
}
case OP_SETLIST: {
int aux = GETARG_A(i) * LFIELDS_PER_FLUSH;
TObject *t = base+GETARG_B(i);
Hash *h = hvalue(t);
int n;
for (n = top-t-1; n; n--)
setobj(luaH_setnum(L, h, n+aux), --top);
case OP_NEWTABLE: {
luaC_checkGC(L);
sethvalue(RA(i), luaH_new(L, GETARG_Bc(i)));
break;
}
case OP_SETMAP: {
TObject *t = base+GETARG_U(i);
Hash *h = hvalue(t);
while (top-1 > t) {
top-=2;
setobj(luaH_set(L, h, top), top+1);
}
case OP_SELF: {
StkId ra = RA(i);
StkId rb = RB(i);
setobj(ra+1, rb);
luaV_gettable(L, rb, RKC(i), ra);
break;
}
case OP_ADD: {
if (tonumber(top-2) || tonumber(top-1))
call_arith(L, top-2, TM_ADD);
else
nvalue(top-2) += nvalue(top-1);
top--;
break;
}
case OP_ADDI: {
if (tonumber(top-1)) {
setnvalue(top, (lua_Number)GETARG_S(i));
call_arith(L, top-1, TM_ADD);
}
else
nvalue(top-1) += (lua_Number)GETARG_S(i);
Arith( + , TM_ADD);
break;
}
case OP_SUB: {
if (tonumber(top-2) || tonumber(top-1))
call_arith(L, top-2, TM_SUB);
else
nvalue(top-2) -= nvalue(top-1);
top--;
Arith( - , TM_SUB);
break;
}
case OP_MULT: {
if (tonumber(top-2) || tonumber(top-1))
call_arith(L, top-2, TM_MUL);
else
nvalue(top-2) *= nvalue(top-1);
top--;
case OP_MUL: {
Arith( * , TM_MUL);
break;
}
case OP_DIV: {
if (tonumber(top-2) || tonumber(top-1))
call_arith(L, top-2, TM_DIV);
else
nvalue(top-2) /= nvalue(top-1);
top--;
Arith( / , TM_DIV);
break;
}
case OP_POW: {
if (!call_binTM(L, top-2, top-1, top-2, TM_POW))
luaD_error(L, l_s("undefined operation"));
top--;
call_arith(L, RB(i), RKC(i), RA(i), TM_POW);
break;
}
case OP_CONCAT: {
int n = GETARG_U(i);
luaV_strconc(L, n, top);
top -= n-1;
luaC_checkGC(L);
break;
}
case OP_MINUS: {
if (tonumber(top-1)) {
setnilvalue(top);
call_arith(L, top-1, TM_UNM);
case OP_UNM: {
const TObject *rb = RB(i);
StkId ra = RA(i);
if (ttype(rb) == LUA_TNUMBER || (rb=luaV_tonumber(rb, ra)) != NULL) {
setnvalue(ra, -nvalue(rb));
}
else {
TObject temp;
setnilvalue(&temp);
call_arith(L, RB(i), &temp, ra, TM_UNM);
}
else
nvalue(top-1) = -nvalue(top-1);
break;
}
case OP_NOT: {
ttype(top-1) =
(ttype(top-1) == LUA_TNIL) ? LUA_TNUMBER : LUA_TNIL;
nvalue(top-1) = 1;
if (ttype(RB(i)) == LUA_TNIL) {
setnvalue(RA(i), 1);
} else {
setnilvalue(RA(i));
}
break;
}
case OP_JMPNE: {
top -= 2;
if (!luaO_equalObj(top, top+1)) dojump(pc, i);
break;
}
case OP_JMPEQ: {
top -= 2;
if (luaO_equalObj(top, top+1)) dojump(pc, i);
break;
}
case OP_JMPLT: {
top -= 2;
if (luaV_lessthan(L, top, top+1)) dojump(pc, i);
break;
}
case OP_JMPLE: { /* a <= b === !(b<a) */
top -= 2;
if (!luaV_lessthan(L, top+1, top)) dojump(pc, i);
break;
}
case OP_JMPGT: { /* a > b === (b<a) */
top -= 2;
if (luaV_lessthan(L, top+1, top)) dojump(pc, i);
break;
}
case OP_JMPGE: { /* a >= b === !(a<b) */
top -= 2;
if (!luaV_lessthan(L, top, top+1)) dojump(pc, i);
break;
}
case OP_JMPT: {
if (ttype(--top) != LUA_TNIL) dojump(pc, i);
break;
}
case OP_JMPF: {
if (ttype(--top) == LUA_TNIL) dojump(pc, i);
break;
}
case OP_JMPONT: {
if (ttype(top-1) == LUA_TNIL) top--;
else dojump(pc, i);
break;
}
case OP_JMPONF: {
if (ttype(top-1) != LUA_TNIL) top--;
else dojump(pc, i);
case OP_CONCAT: {
StkId top = RC(i)+1;
StkId rb = RB(i);
luaV_strconc(L, top-rb, top);
setobj(RA(i), rb);
luaC_checkGC(L);
break;
}
case OP_CJMP:
case OP_JMP: {
dojump(pc, i);
break;
}
case OP_PUSHNILJMP: {
setnilvalue(top++);
case OP_TESTEQ: {
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (luaO_equalObj(RB(i), RKC(i))) dojump(pc, *pc);
pc++;
break;
}
case OP_TESTNE: {
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (!luaO_equalObj(RB(i), RKC(i))) dojump(pc, *pc);
pc++;
break;
}
case OP_TESTLT: {
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (luaV_lessthan(L, RB(i), RKC(i))) dojump(pc, *pc);
pc++;
break;
}
case OP_TESTLE: { /* b <= c === !(c<b) */
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (!luaV_lessthan(L, RKC(i), RB(i))) dojump(pc, *pc);
pc++;
break;
}
case OP_TESTGT: { /* b > c === (c<b) */
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (luaV_lessthan(L, RKC(i), RB(i))) dojump(pc, *pc);
pc++;
break;
}
case OP_TESTGE: { /* b >= c === !(b<c) */
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (!luaV_lessthan(L, RB(i), RKC(i))) dojump(pc, *pc);
pc++;
break;
}
case OP_TESTT: {
StkId rb = RB(i);
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (ttype(rb) != LUA_TNIL) {
int a = GETARG_A(i);
if (a != NO_REG) setobj(base+a, rb);
dojump(pc, *pc);
}
pc++;
break;
}
case OP_TESTF: {
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
if (ttype(RB(i)) == LUA_TNIL) {
int a = GETARG_A(i);
if (a != NO_REG) setnilvalue(base+a);
dojump(pc, *pc);
}
pc++;
break;
}
case OP_NILJMP: {
setnilvalue(RA(i));
pc++;
break;
}
case OP_CALL: {
int nres;
int b = GETARG_B(i);
if (b != NO_REG)
L->top = base+b;
nres = GETARG_C(i);
if (nres == NO_REG) nres = LUA_MULTRET;
luaD_call(L, RA(i), nres);
if (nres != LUA_MULTRET) {
lua_assert(L->top == RA(i)+nres);
L->top = base+tf->maxstacksize;
}
break;
}
case OP_RETURN: {
int b = GETARG_B(i);
if (b != NO_REG)
L->top = base+b;
return RA(i);
}
case OP_FORPREP: {
int jmp = GETARG_S(i);
if (tonumber(top-1))
luaD_error(L, l_s("`for' step must be a number"));
if (tonumber(top-2))
luaD_error(L, l_s("`for' limit must be a number"));
if (tonumber(top-3))
int jmp = GETARG_sBc(i);
StkId breg = RA(i);
if (luaV_tonumber(breg, breg) == NULL)
luaD_error(L, l_s("`for' initial value must be a number"));
if (luaV_tonumber(breg+1, breg+1) == NULL)
luaD_error(L, l_s("`for' limit must be a number"));
if (luaV_tonumber(breg+2, breg+2) == NULL)
luaD_error(L, l_s("`for' step must be a number"));
pc += -jmp; /* `jump' to loop end (delta is negated here) */
goto forloop; /* do not increment index */
nvalue(breg) -= nvalue(breg+2);/* decrement index (to be incremented) */
/* go through */
}
case OP_FORLOOP: {
lua_assert(ttype(top-1) == LUA_TNUMBER);
lua_assert(ttype(top-2) == LUA_TNUMBER);
if (ttype(top-3) != LUA_TNUMBER)
StkId breg = RA(i);
if (ttype(breg) != LUA_TNUMBER)
luaD_error(L, l_s("`for' index must be a number"));
nvalue(top-3) += nvalue(top-1); /* increment index */
forloop:
if (nvalue(top-1) > 0 ?
nvalue(top-3) > nvalue(top-2) :
nvalue(top-3) < nvalue(top-2))
top -= 3; /* end loop: remove control variables */
else
runtime_check(L, ttype(breg+1) == LUA_TNUMBER &&
ttype(breg+2) == LUA_TNUMBER);
nvalue(breg) += nvalue(breg+2); /* increment index */
if (nvalue(breg+2) > 0 ?
nvalue(breg) <= nvalue(breg+1) :
nvalue(breg) >= nvalue(breg+1))
dojump(pc, i); /* repeat loop */
break;
}
case OP_LFORPREP: {
int jmp = GETARG_S(i);
if (ttype(top-1) != LUA_TTABLE)
case OP_TFORPREP: {
int jmp = GETARG_sBc(i);
StkId breg = RA(i);
if (ttype(breg) != LUA_TTABLE)
luaD_error(L, l_s("`for' table must be a table"));
top += 3; /* index,key,value */
setnvalue(top-3, -1); /* initial index */
setnilvalue(top-2);
setnilvalue(top-1);
setnvalue(breg+1, -1); /* initial index */
setnilvalue(breg+2);
setnilvalue(breg+3);
pc += -jmp; /* `jump' to loop end (delta is negated here) */
/* go through */
}
case OP_LFORLOOP: {
Hash *t = hvalue(top-4);
int n = (int)nvalue(top-3);
lua_assert(ttype(top-3) == LUA_TNUMBER);
lua_assert(ttype(top-4) == LUA_TTABLE);
case OP_TFORLOOP: {
StkId breg = RA(i);
Hash *t;
int n;
runtime_check(L, ttype(breg) == LUA_TTABLE);
runtime_check(L, ttype(breg+1) == LUA_TNUMBER);
t = hvalue(breg);
n = (int)nvalue(breg+1);
n = luaH_nexti(t, n);
if (n == -1) /* end loop? */
top -= 4; /* remove table, index, key, and value */
else {
if (n != -1) { /* repeat loop? */
Node *node = node(t, n);
setnvalue(top-3, n); /* index */
setkey2obj(top-2, node);
setobj(top-1, val(node));
setnvalue(breg+1, n); /* index */
setkey2obj(breg+2, node);
setobj(breg+3, val(node));
dojump(pc, i); /* repeat loop */
}
break;
}
case OP_SETLIST:
case OP_SETLISTO: {
int bc;
int n;
Hash *h;
StkId ra = RA(i);
runtime_check(L, ttype(ra) == LUA_TTABLE);
h = hvalue(ra);
bc = GETARG_Bc(i);
if (GET_OPCODE(i) == OP_SETLIST)
n = (bc&(LFIELDS_PER_FLUSH-1)) + 1;
else
n = L->top - ra - 1;
bc &= ~(LFIELDS_PER_FLUSH-1); /* bc = bc - bc%FPF */
for (; n > 0; n--)
setobj(luaH_setnum(L, h, bc+n), ra+n);
break;
}
case OP_CLOSURE: {
int nup = GETARG_B(i);
luaC_checkGC(L);
L->top = top;
luaV_Lclosure(L, tf->kproto[GETARG_A(i)], nup);
top -= (nup-1);
Proto *p = tf->kproto[GETARG_Bc(i)];
int nup = p->nupvalues;
StkId ra = RA(i);
L->top = ra+nup;
luaV_Lclosure(L, p, nup);
L->top = base+tf->maxstacksize;
luaC_checkGC(L);
break;
}
}
}
}

7
lvm.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lvm.h,v 1.28 2001/02/01 16:03:38 roberto Exp roberto $
** $Id: lvm.h,v 1.29 2001/02/07 18:13:49 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -13,14 +13,13 @@
#include "ltm.h"
#define tonumber(o) ((ttype(o) != LUA_TNUMBER) && (luaV_tonumber(o) != 0))
#define tostring(L,o) ((ttype(o) != LUA_TSTRING) && (luaV_tostring(L, o) != 0))
int luaV_tonumber (TObject *obj);
const TObject *luaV_tonumber (const TObject *obj, TObject *n);
int luaV_tostring (lua_State *L, TObject *obj);
void luaV_gettable (lua_State *L, StkId t, TObject *key, StkId res);
void luaV_settable (lua_State *L, StkId t, StkId key, StkId val);
void luaV_settable (lua_State *L, StkId t, TObject *key, StkId val);
void luaV_getglobal (lua_State *L, TString *s, StkId res);
void luaV_setglobal (lua_State *L, TString *s, StkId val);
StkId luaV_execute (lua_State *L, const Closure *cl, StkId base);