opensources
/
lua
mirror of https://github.com/lua/lua.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

new format for test intructions (handle NaN correctly)

v5-2
Roberto Ierusalimschy 23 years ago
parent
85dcb411a8
commit
0dbf0c5953
8 changed files with 147 additions and 146 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 4
      lapi.c
  2. 148
      lcode.c
  3. 8
      lobject.c
  4. 11
      lobject.h
  5. 24
      lopcodes.c
  6. 26
      lopcodes.h
  7. 68
      lvm.c
  8. 4
      lvm.h

4
lapi.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lapi.c,v 1.186 2002/05/01 20:48:12 roberto Exp roberto $
** $Id: lapi.c,v 1.187 2002/05/02 16:55:55 roberto Exp roberto $
** Lua API
** See Copyright Notice in lua.h
*/
@ -231,7 +231,7 @@ LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {
o1 = luaA_indexAcceptable(L, index1);
o2 = luaA_indexAcceptable(L, index2);
i = (o1 == NULL || o2 == NULL) ? 0 /* index out-of-range */
: luaV_lessthan(L, o1, o2);
: luaV_cmp(L, o1, o2, CMP_LT);
lua_unlock(L);
return i;
}

148
lcode.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lcode.c,v 1.96 2002/04/22 14:37:09 roberto Exp roberto $
** $Id: lcode.c,v 1.97 2002/04/24 20:07:46 roberto Exp roberto $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
@ -107,16 +107,21 @@ static Instruction *getjumpcontrol (FuncState *fs, int pc) {
}
static int need_value (FuncState *fs, int list, OpCode op) {
/* check whether list has any jump different from `op' */
for (; list != NO_JUMP; list = luaK_getjump(fs, list))
if (GET_OPCODE(*getjumpcontrol(fs, list)) != op) return 1;
/*
** check whether list has any jump that do not produce a value
** (or produce an inverted value)
*/
static int need_value (FuncState *fs, int list, int cond) {
for (; list != NO_JUMP; list = luaK_getjump(fs, list)) {
Instruction i = *getjumpcontrol(fs, list);
if (GET_OPCODE(i) != OP_TEST || GETARG_B(i) != cond) return 1;
}
return 0; /* not found */
}
static void patchtestreg (Instruction *i, int reg) {
if (reg == NO_REG) reg = GETARG_B(*i);
if (reg == NO_REG) reg = GETARG_C(*i);
SETARG_A(*i, reg);
}
@ -126,20 +131,20 @@ static void luaK_patchlistaux (FuncState *fs, int list,
while (list != NO_JUMP) {
int next = luaK_getjump(fs, list);
Instruction *i = getjumpcontrol(fs, list);
switch (GET_OPCODE(*i)) {
case OP_TESTT: {
if (GET_OPCODE(*i) != OP_TEST) {
lua_assert(dtarget != NO_JUMP);
luaK_fixjump(fs, list, dtarget); /* jump to default target */
}
else {
if (GETARG_B(*i)) {
lua_assert(ttarget != NO_JUMP);
patchtestreg(i, treg);
luaK_fixjump(fs, list, ttarget);
break;
}
case OP_TESTF: {
else {
lua_assert(ftarget != NO_JUMP);
patchtestreg(i, freg);
luaK_fixjump(fs, list, ftarget);
break;
}
default: {
luaK_fixjump(fs, list, dtarget); /* jump to default target */
break;
}
}
list = next;
@ -342,9 +347,8 @@ static void luaK_exp2reg (FuncState *fs, expdesc *e, int reg) {
int final; /* position after whole expression */
int p_f = NO_JUMP; /* position of an eventual PUSH false */
int p_t = NO_JUMP; /* position of an eventual PUSH true */
if (e->k == VJMP || need_value(fs, e->f, OP_TESTF) ||
need_value(fs, e->t, OP_TESTT)) {
/* expression needs values */
if (e->k == VJMP || need_value(fs, e->t, 1)
|| need_value(fs, e->f, 0)) {
if (e->k != VJMP) {
luaK_getlabel(fs); /* these instruction may be jump target */
luaK_codeAsBx(fs, OP_JMP, 0, 2); /* to jump over both pushes */
@ -463,40 +467,36 @@ void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
}
static OpCode invertoperator (OpCode op) {
switch (op) {
case OP_TESTNE: return OP_TESTEQ;
case OP_TESTEQ: return OP_TESTNE;
case OP_TESTLT: return OP_TESTGE;
case OP_TESTLE: return OP_TESTGT;
case OP_TESTGT: return OP_TESTLE;
case OP_TESTGE: return OP_TESTLT;
case OP_TESTT: return OP_TESTF;
case OP_TESTF: return OP_TESTT;
default: lua_assert(0); return op; /* invalid jump instruction */
}
}
static void invertjump (FuncState *fs, expdesc *e) {
Instruction *pc = getjumpcontrol(fs, e->info);
SET_OPCODE(*pc, invertoperator(GET_OPCODE(*pc)));
OpCode op = GET_OPCODE(*pc);
switch (op) {
case OP_EQ: {
SETARG_B(*pc, !(GETARG_B(*pc)));
return;
}
case OP_CMP: {
SETARG_B(*pc, ~(GETARG_B(*pc)));
return;
}
default: lua_assert(0); /* invalid jump instruction */
}
SET_OPCODE(*pc, op);
}
static int jumponcond (FuncState *fs, expdesc *e, OpCode op) {
static int jumponcond (FuncState *fs, expdesc *e, int cond) {
if (e->k == VRELOCABLE) {
Instruction ie = getcode(fs, e);
if (GET_OPCODE(ie) == OP_NOT) {
op = invertoperator(op);
fs->pc--; /* remove previous OP_NOT */
return luaK_condjump(fs, op, NO_REG, GETARG_B(ie), 0);
return luaK_condjump(fs, OP_TEST, NO_REG, !cond ,GETARG_B(ie));
}
/* else go through */
}
discharge2anyreg(fs, e);
freeexp(fs, e);
return luaK_condjump(fs, op, NO_REG, e->info, 0);
return luaK_condjump(fs, OP_TEST, NO_REG, cond, e->info);
}
@ -518,7 +518,7 @@ void luaK_goiftrue (FuncState *fs, expdesc *e) {
break;
}
default: {
pc = jumponcond(fs, e, OP_TESTF);
pc = jumponcond(fs, e, 0);
break;
}
}
@ -545,7 +545,7 @@ static void luaK_goiffalse (FuncState *fs, expdesc *e) {
break;
}
default: {
pc = jumponcond(fs, e, OP_TESTT);
pc = jumponcond(fs, e, 1);
break;
}
}
@ -639,23 +639,46 @@ void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
/* opcode for each binary operator */
static const OpCode codes[] = { /* ORDER OPR */
OP_ADD, OP_SUB, OP_MUL, OP_DIV,
OP_POW, OP_CONCAT,
OP_TESTNE, OP_TESTEQ,
OP_TESTLT, OP_TESTLE, OP_TESTGT, OP_TESTGE
static const OpCode cmp_masks[] = { /* ORDER OPR */
CMP_LT, (CMP_LT | CMP_EQ), CMP_GT, (CMP_GT | CMP_EQ)
};
/* `inverted' opcode for each binary operator */
/* ( -1 means operator has no inverse) */
static const OpCode invcodes[] = { /* ORDER OPR */
OP_ADD, (OpCode)-1, OP_MUL, (OpCode)-1,
(OpCode)-1, (OpCode)-1,
OP_TESTNE, OP_TESTEQ,
OP_TESTGT, OP_TESTGE, OP_TESTLT, OP_TESTLE
};
static void codebinop (FuncState *fs, expdesc *res, BinOpr op,
int o1, int o2, int ic) {
switch (op) {
case OPR_SUB:
case OPR_DIV:
case OPR_POW:
lua_assert(!ic);
/* go through */
case OPR_ADD:
case OPR_MULT: {
OpCode opc = cast(OpCode, (op - OPR_ADD) + OP_ADD);
res->info = luaK_codeABC(fs, opc, 0, o1, o2);
res->k = VRELOCABLE;
break;
}
case OPR_NE:
case OPR_EQ: {
res->info = luaK_condjump(fs, OP_EQ, o1, (op == OPR_EQ), o2);
res->k = VJMP;
break;
}
case OPR_LT:
case OPR_LE:
case OPR_GT:
case OPR_GE: {
int mask = cmp_masks[op - OPR_LT];
if (ic) /* operands were interchanged? */
mask ^= (CMP_LT | CMP_GT); /* correct condition */
res->info = luaK_condjump(fs, OP_CMP, o1, mask, o2);
res->k = VJMP;
break;
}
default: lua_assert(0);
}
}
void luaK_posfix (FuncState *fs, BinOpr op, expdesc *e1, expdesc *e2) {
@ -693,27 +716,20 @@ void luaK_posfix (FuncState *fs, BinOpr op, expdesc *e1, expdesc *e2) {
}
default: {
int o1, o2;
OpCode opc;
int ic; /* interchange flag */
if (e1->k != VK) { /* not a constant operator? */
o1 = e1->info;
o2 = luaK_exp2RK(fs, e2); /* maybe other operator is constant... */
opc = codes[op];
ic = 0;
}
else { /* invert operands */
else { /* interchange operands */
o2 = luaK_exp2RK(fs, e1); /* constant must be 2nd operand */
o1 = luaK_exp2anyreg(fs, e2); /* other operator must be in register */
opc = invcodes[op]; /* use inverted operator */
ic = 1;
}
freeexp(fs, e2);
freeexp(fs, e1);
if (op < OPR_NE) { /* ORDER OPR */
e1->info = luaK_codeABC(fs, opc, 0, o1, o2);
e1->k = VRELOCABLE;
}
else { /* jump */
e1->info = luaK_condjump(fs, opc, o1, 0, o2);
e1->k = VJMP;
}
codebinop(fs, e1, op, o1, o2, ic);
}
}
}

8
lobject.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lobject.c,v 1.76 2002/04/05 18:54:31 roberto Exp roberto $
** $Id: lobject.c,v 1.77 2002/04/22 14:40:23 roberto Exp roberto $
** Some generic functions over Lua objects
** See Copyright Notice in lua.h
*/
@ -49,7 +49,9 @@ int luaO_log2 (unsigned int x) {
}
/*
** warning: this function must return 1 for true (see opcode OP_TESTEQ)
*/
int luaO_equalObj (const TObject *t1, const TObject *t2) {
if (ttype(t1) != ttype(t2)) return 0;
switch (ttype(t1)) {
@ -58,7 +60,7 @@ int luaO_equalObj (const TObject *t1, const TObject *t2) {
case LUA_TNIL:
return 1;
case LUA_TBOOLEAN:
return bvalue(t1) == bvalue(t2); /* true must be 1 !! */
return bvalue(t1) == bvalue(t2); /* boolean true must be 1 !! */
case LUA_TUDATAVAL:
return pvalue(t1) == pvalue(t2);
default: /* other types are equal if struct pointers are equal */

11
lobject.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lobject.h,v 1.128 2002/03/25 17:47:14 roberto Exp roberto $
** $Id: lobject.h,v 1.129 2002/04/05 18:54:31 roberto Exp roberto $
** Type definitions for Lua objects
** See Copyright Notice in lua.h
*/
@ -230,6 +230,15 @@ typedef struct Table {
#define sizearray(t) ((t)->sizearray)
/*
** masks for comparison results
*/
#define CMP_EQ 1
#define CMP_LT 2
#define CMP_GT 4
#define CMP_N 8 /* not comparable values (e.g. NaN) */
extern const TObject luaO_nilobject;
int luaO_log2 (unsigned int x);

24
lopcodes.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lopcodes.c,v 1.16 2002/04/10 18:05:08 roberto Exp roberto $
** $Id: lopcodes.c,v 1.17 2002/04/24 20:07:46 roberto Exp roberto $
** extracted automatically from lopcodes.h by mkprint.lua
** DO NOT EDIT
** See Copyright Notice in lua.h
@ -36,14 +36,9 @@ const char *const luaP_opnames[] = {
"NOT",
"CONCAT",
"JMP",
"TESTEQ",
"TESTNE",
"TESTLT",
"TESTLE",
"TESTGT",
"TESTGE",
"TESTT",
"TESTF",
"EQ",
"CMP",
"TEST",
"CALL",
"TAILCALL",
"RETURN",
@ -86,14 +81,9 @@ const lu_byte luaP_opmodes[NUM_OPCODES] = {
,opmode(0,0,1,0, 1,0,iABC) /* OP_NOT */
,opmode(0,0,1,1, 1,0,iABC) /* OP_CONCAT */
,opmode(0,0,0,0, 0,0,iAsBx) /* OP_JMP */
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTEQ */
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTNE */
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTLT */
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTLE */
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTGT */
,opmode(1,0,0,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(1,0,0,1, 0,0,iABC) /* OP_EQ */
,opmode(1,0,0,1, 0,0,iABC) /* OP_CMP */
,opmode(1,0,0,1, 1,0,iABC) /* OP_TEST */
,opmode(0,0,0,0, 0,0,iABC) /* OP_CALL */
,opmode(0,0,0,0, 0,0,iABC) /* OP_TAILCALL */
,opmode(0,0,0,0, 0,0,iABC) /* OP_RETURN */

26
lopcodes.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lopcodes.h,v 1.94 2002/04/09 19:47:44 roberto Exp roberto $
** $Id: lopcodes.h,v 1.95 2002/04/24 20:07:46 roberto Exp roberto $
** Opcodes for Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -81,19 +81,19 @@ enum OpMode {iABC, iABx, iAsBx}; /* basic instruction format */
#define GETARG_A(i) (cast(int, (i)>>POS_A))
#define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \
(cast(Instruction, u)<<POS_A)))
((cast(Instruction, u)<<POS_A)&MASK1(SIZE_A,POS_A))))
#define GETARG_B(i) (cast(int, ((i)>>POS_B) & MASK1(SIZE_B,0)))
#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \
(cast(Instruction, b)<<POS_B)))
((cast(Instruction, b)<<POS_B)&MASK1(SIZE_B,POS_B))))
#define GETARG_C(i) (cast(int, ((i)>>POS_C) & MASK1(SIZE_C,0)))
#define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) | \
(cast(Instruction, b)<<POS_C)))
((cast(Instruction, b)<<POS_C)&MASK1(SIZE_C,POS_C))))
#define GETARG_Bx(i) (cast(int, ((i)>>POS_Bx) & MASK1(SIZE_Bx,0)))
#define SETARG_Bx(i,b) ((i) = (((i)&MASK0(SIZE_Bx,POS_Bx)) | \
(cast(Instruction, b)<<POS_Bx)))
((cast(Instruction, b)<<POS_Bx)&MASK1(SIZE_Bx,POS_Bx))))
#define GETARG_sBx(i) (GETARG_Bx(i)-MAXARG_sBx)
#define SETARG_sBx(i,b) SETARG_Bx((i),cast(unsigned int, (b)+MAXARG_sBx))
@ -157,19 +157,14 @@ OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */
OP_JMP,/* sBx PC += sBx */
OP_TESTEQ,/* A C if not (R(A) == R/K(C)) then pc++ */
OP_TESTNE,/* A C if not (R(A) ~= R/K(C)) then pc++ */
OP_TESTLT,/* A C if not (R(A) < R/K(C)) then pc++ */
OP_TESTLE,/* A C if not (R(A) <= R/K(C)) then pc++ */
OP_TESTGT,/* A C if not (R(A) > R/K(C)) then pc++ */
OP_TESTGE,/* A C if not (R(A) >= R/K(C)) then pc++ */
OP_EQ,/* A B C if ((R(A) == R/K(C)) ~= B) then pc++ */
OP_CMP,/* A B C if not (R(A) <B> R/K(C)) then pc++ (see note) */
OP_TESTT,/* A B if (R(B)) then R(A) := R(B) else pc++ */
OP_TESTF,/* A B if not (R(B)) then R(A) := R(B) else pc++ */
OP_TEST,/* A B C if (R(C) <=> B) then R(A) := R(C) else pc++ */
OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */
OP_TAILCALL,/* A B return R(A)(R(A+1), ... ,R(A+B-1)) */
OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see (3)) */
OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */
OP_FORLOOP,/* A sBx R(A)+=R(A+2); if R(A) <?= R(A+1) then PC+= sBx */
@ -196,8 +191,9 @@ OP_CLOSURE/* A Bx R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n)) */
next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use `top'.
(2) In OP_RETURN, if (B == 0) then return up to `top'
===========================================================================*/
(3) For comparisons, B specifies what conditions the test should accept.
===========================================================================*/
/*

68
lvm.c
View File

@ -1,5 +1,5 @@
/*
** $Id: lvm.c,v 1.227 2002/04/24 20:07:46 roberto Exp roberto $
** $Id: lvm.c,v 1.228 2002/05/02 13:06:20 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -189,20 +189,21 @@ static void call_arith (lua_State *L, StkId p1, const TObject *p2,
}
static int luaV_strlessthan (const TString *ls, const TString *rs) {
static int luaV_strcmp (const TString *ls, const TString *rs) {
const char *l = getstr(ls);
size_t ll = ls->tsv.len;
const char *r = getstr(rs);
size_t lr = rs->tsv.len;
for (;;) {
int temp = strcoll(l, r);
if (temp != 0) return (temp < 0);
if (temp < 0) return CMP_LT;
else if (temp > 0) return CMP_GT;
else { /* strings are equal up to a `\0' */
size_t len = strlen(l); /* index of first `\0' in both strings */
if (len == lr) /* r is finished? */
return 0; /* l is equal or greater than r */
return (len == ll) ? CMP_EQ : CMP_GT; /* l is eq. or gt. than r */
else if (len == ll) /* l is finished? */
return 1; /* l is smaller than r (because r is not finished) */
return CMP_LT; /* l is smaller than r (because r is not finished) */
/* both strings longer than `len'; go on comparing (after the `\0') */
len++;
l += len; ll -= len; r += len; lr -= len;
@ -211,15 +212,24 @@ static int luaV_strlessthan (const TString *ls, const TString *rs) {
}
int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r) {
if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER)
return (nvalue(l) < nvalue(r));
int luaV_cmp (lua_State *L, const TObject *l, const TObject *r, int cond) {
if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER) {
lua_Number n1 = nvalue(l);
lua_Number n2 = nvalue(r);
if (n1 < n2) return (cond & CMP_LT);
else if (n1 > n2) return (cond & CMP_GT);
else if (n1 == n2) return (cond & CMP_EQ);
else return (cond & CMP_N);
}
else if (ttype(l) == LUA_TSTRING && ttype(r) == LUA_TSTRING)
return luaV_strlessthan(tsvalue(l), tsvalue(r));
return luaV_strcmp(tsvalue(l), tsvalue(r)) & cond;
else { /* try TM */
if (cond & CMP_EQ ? cond & CMP_LT : cond & CMP_GT) { /* `<=' or `>' ? */
const TObject *temp = l; l = r; r = temp; /* exchange terms */
}
if (!call_binTM(L, l, r, L->top, TM_LT))
luaG_ordererror(L, l, r);
return !l_isfalse(L->top);
return (cond & CMP_EQ) ? l_isfalse(L->top) : !l_isfalse(L->top);
}
}
@ -437,40 +447,18 @@ StkId luaV_execute (lua_State *L) {
dojump(pc, GETARG_sBx(i));
break;
}
case OP_TESTEQ: { /* skip next instruction if test fails */
if (!luaO_equalObj(ra, RKC(i))) pc++;
break;
}
case OP_TESTNE: {
if (luaO_equalObj(ra, RKC(i))) pc++;
break;
}
case OP_TESTLT: {
if (!luaV_lessthan(L, ra, RKC(i))) pc++;
break;
}
case OP_TESTLE: { /* b <= c === !(c<b) */
if (luaV_lessthan(L, RKC(i), ra)) pc++;
break;
}
case OP_TESTGT: { /* b > c === (c<b) */
if (!luaV_lessthan(L, RKC(i), ra)) pc++;
case OP_EQ: { /* skip next instruction if test fails */
if (luaO_equalObj(ra, RKC(i)) != GETARG_B(i)) pc++;
break;
}
case OP_TESTGE: { /* b >= c === !(b<c) */
if (luaV_lessthan(L, ra, RKC(i))) pc++;
case OP_CMP: {
if (!(luaV_cmp(L, ra, RKC(i), GETARG_B(i)))) pc++;
break;
}
case OP_TESTT: {
StkId rb = RB(i);
if (l_isfalse(rb)) pc++;
else setobj(ra, rb);
break;
}
case OP_TESTF: {
StkId rb = RB(i);
if (!l_isfalse(rb)) pc++;
else setobj(ra, rb);
case OP_TEST: {
StkId rc = RKC(i);
if (l_isfalse(rc) == GETARG_B(i)) pc++;
else setobj(ra, rc);
break;
}
case OP_CALL: {

4
lvm.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lvm.h,v 1.37 2002/03/04 21:33:09 roberto Exp roberto $
** $Id: lvm.h,v 1.38 2002/03/19 12:45:25 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -19,12 +19,12 @@
(((o) = luaV_tonumber(o,n)) != NULL))
int luaV_cmp (lua_State *L, const TObject *l, const TObject *r, int cond);
const TObject *luaV_tonumber (const TObject *obj, TObject *n);
int luaV_tostring (lua_State *L, TObject *obj);
void luaV_gettable (lua_State *L, const TObject *t, TObject *key, StkId res);
void luaV_settable (lua_State *L, const TObject *t, TObject *key, StkId val);
StkId luaV_execute (lua_State *L);
int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r);
void luaV_strconc (lua_State *L, int total, int last);
#endif

Write Preview
Loading…
Cancel
Save